Subversion Repositories DevTools

Rev

Rev 5456 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
5456 dpurdie 1
<% @LANGUAGE = VBScript %>
2
<%
3
'+----------------------------------------------------------------------------+
4
'| Description:                                                               |
5
'|    WikiAsp is a derivative of AspWiki, a wiki program written in ASP.      |
6
'|    WikiAsp will run on Windows with IIS, MDAC v2.5. WikiAsp will           |
7
'|    automatically create MS Access DB on first time use.                    |
8
'|                                                                            |
9
'|    The following are the dlls to make mdb creation work.                   |
10
'|    1. Program Files\Common Files\System\ado\msadox.dll                     |
11
'|    2. WINDOWS\System32\scrrun.dll                                          |
12
'|                                                                            |
13
'| Credits:                                                                   |
14
'|    Elrey Ronald Velicaria. - Author of WikiAsp. (lambda326@hotmail.com)    |
15
'|    Dino Chiesa - AspWiki author.                                           |
16
'|    Contributors: Bjarne D, Julian Tosh                                     |
17
'|                                                                            |
18
'| Websites:                                                                  |
19
'|    http://www.c2.com/cgi/wiki,  http://www.c2.com/cgi/wiki?WikiAsp         |
20
'+----------------------------------------------------------------------------+
21
'| Please retain the above credits on any future versions of this program     |
22
'+----------------------------------------------------------------------------+
23
 
24
Option Explicit
25
Response.CacheControl  = "no-cache"
26
Response.Expires       = -1
27
Response.AddHeader "Pragma", "no-cache"
28
 
29
Dim gDefaultIcon, gDefaultHomePage, gAutoCreateMdb, gFavIcon
30
Dim gHttpDomain , gDebug, gEngineVersion, gDbTableName
31
Dim gProvider, gDataConn, gDataSource, gDataSourceName
32
Dim gDocRootDir, gDataSourceDir, gDataSourceFile, gSpaceNames
33
Dim gScript, gScriptURL, giEditAreaRows, giEditAreaCols, giNumRecentFiles
34
Dim gHomeTopic, gStyleSheet, gIconName
35
Dim glsTopic, glsMode  , gHideLastEditor,  gLoginFlag, gRemoveHtml,gBlackListedIps
36
Dim gRE, gHighlightFlag, gHideWikiSource, gHideWikiFooter, gHideLogin, gHtmlHeadStr
37
Dim gDisableSave,gTimeZoneOffset, gRssStyle, gRedirectURL
38
Dim gBannerTemplate, gWikiBodyPrefix, gHideTopSearch, gDisableScripting
39
Dim gMdbExtension , gSearchLabel, gBlackListedIpsRE
40
Dim gFooterHtml, gEnableEdit, gDevNotePrefix, gBulkDelete
41
 
42
'+-----------------------------------------------------------------------------+
43
'| AN IMPORTANT NOTE:  !!!!!                                                   |
44
'| Enter your password below for creating new DB and for Delete.               |
45
'| Enter your URL inside quotes below e.g. http://www28.brinkster.com/site     |
46
'| Modify gDefaultIcon, gDefaultHomePage here is FSO objects is not installed  |
47
'+-----------------------------------------------------------------------------+
48
gAutoCreateMdb     =  true                            ' Create db automatically
49
gDisableSave       =  false                           ' Set to true if you have to fully disable save.
50
gBlackListedIps    =  ""                              ' List of IPs to reject. (Exact match 1st 3 digits of IP, delimit list by ~)
51
gBlackListedIpsRE  =  ""                              ' List of IPs to reject (Regular ExpressionMatch)
52
gRemoveHtml        =  false                           ' Set to true if  HTML input in wiki will be enabled.
53
gLoginFlag         =  "log"                           ' The default enable login flag ( must be overriden by config.asp).
54
gHideWikiSource    =  false                           ' Allow viewing of unformatted wiki text when loggin in.
55
gHideWikiFooter    =  false                           ' Show or Hide the whole wiki footer
56
gHideLogin         =  false                           ' Enable/Disable double-click or Edit. This can be overriden by &log
57
gHideLastEditor    =  false                           ' Show/Hide in  the footer the info about last edit
58
gHttpDomain        = "auto"                           ' URL for RSS links to work. Override in config.asp . Set to "" to remove rss footer links
59
gDefaultIcon       = "icon"                           ' This default. Maybe overridden if your site has icon.gif, icon.jpg or xxxx.gif and if FSO is working.
60
gDefaultHomePage   = "WikiAsp"                        ' modify your start page here. this may be overridden by .ini file. The .ini file is same dir as mdb file
61
gDataSourceDir     = "db"                             ' MSAccess folder. this is normally `db`
62
gDocRootDir        = ""                               ' physical absolute path of root (e.g. c:/dc2/mysite.com)  make it blank if `gDataSourceDir` is relative to wiki.asp
63
gTimeZoneOffset    = "-0400"                          ' Put your serverTimezone offset here. East Coast is -0400 .
64
gRssStyle          = ""                               ' Example:  "<?xml-stylesheet type=""text/xsl"" href=""rss.xsl"" ?>"
65
gRedirectURL       = ""
66
gMdbExtension      = ".mdb"
67
gBannerTemplate    = ""                               ' Banner html is now replaceable you need to remember $$icon$$, $$banner_text$$ variable though
68
gWikiBodyPrefix    = ""
69
gHideTopSearch     = false
70
gDisableScripting  = true
71
gSearchLabel       = " Search On:"
72
gFooterHtml        = "</body></html>"                 ' Now you can customize the footer with your chosen html. Even remove ads
73
gEnableEdit        = false
74
gDevNotePrefix     = "??"                             ' Dev Note Prefix
75
gBulkDelete        = false                            ' Bulk delete mode
76
gFavIcon           = ""                               ' FavIcon
77
 
78
'+-----------------------------------------------------------------------------+
79
'| DO YOU WANT TO SEPARATE SOME CONFIG SETTINGS IN ANOTHER FILE?               |
80
'+-----------------------------------------------------------------------------+
81
'| IF yes,just uncomment line after this box (by removing single quote as      |
82
'| the first character. If you do this,  BE SURE TO CREATE config.asp          |
83
'| which will override the same variable settings above this box               |
84
'+-----------------------------------------------------------------------------+
85
 
86
%><!--#include file="config.asp"--><%
87
 
88
gDebug               = 0                             ' 0 - no debug message 1-6 for verbose debug
89
gEngineVersion       = "v1.6.4 beta  Elrey Ronald V."  ' Engine Version
90
gScript              = "wiki.asp"                    ' Main ASP filename (this file)
91
gProvider            = "Microsoft.Jet.OLEDB.4.0"     ' Db Provider
92
giEditAreaRows       = 30                            ' Edit Rows
93
giEditAreaCols       = 115                           ' Edit Columns
94
giNumRecentFiles     = 15                            ' No. of wikipages to list in Recent files page
95
gDbTableName         = "WikiData"                    ' Table name in the database
96
gSpaceNames          = 1                             ' 1 means put spaces in WikiNames, 0 - no spaces
97
 
98
 
99
' Elrey 3/06  Now Override the gHttpDomain with this!!
100
If gHttpDomain = "auto" Then
101
  gHttpDomain  = "http://" & Request.ServerVariables("HTTP_HOST") & _
102
                 Replace(Request.ServerVariables("URL"), "/" & gScript, "" )
103
End If
104
 
105
'check for database name
106
If len(request("db")) > 0 Then
107
    gDataSourceFile = request("db")
108
Else
109
    gDataSourceFile = gDefaultHomePage
110
End If
111
 
112
If len(gDocRootDir) > 0 Then
113
  gDataSource = gDocRootDir & "\" & gDataSourceDir & "\" & gDataSourceFile & gMdbExtension 
114
Else
115
  gDataSource = gDataSourceDir & "\" & gDataSourceFile & gMdbExtension 
116
End If
117
 
118
'check for database human-readable name
119
If len(request("dbname")) > 0 Then
120
    gDataSourceName = request("dbname")
121
Else
122
    gDataSourceName = "DefaultDb"
123
End If
124
 
125
' Can only Edit on the Test / Development System not on the Live System
126
If (IsEmpty(Application("LiveSystem"))) Then
127
    gHideLogin = false
128
    If (Session("login") <> 0) Then
129
            gHideWikiFooter = false
130
            gEnableEdit = true
131
            Session("login") = 1
132
            If Session("BulkDelete") = 1 Then
133
                gBulkDelete = true
134
            Else
135
                gBulkDelete = false
136
            End If
137
 
138
    End If
139
    gHideWikiFooter = NOT gEnableEdit
140
Else
141
    gHideLogin = true
142
    gHideWikiFooter = true
143
    gBulkDelete = false
144
End If
145
 
146
'set destination URL
147
gScriptURL    = gScript & "?db=" & gDataSourceFile  ' removed & "&dbname=" & server.urlencode(gDataSourceName)
148
gHomeTopic    = gDataSourceFile  ' default home topic is the same as ms access db name unless overwritten by .ini
149
gStyleSheet   = "wiki.css"
150
 
151
 
152
Call GetHomeTopic 'Get the topic from wiki.ini if it exists
153
 
154
gIconName = gDefaultIcon
155
 
156
Call GetIconName   'Get the real icon name
157
 
158
Dim rs, dts, i, sqlQuery
159
 
160
Const ADOERROR_NOFILE  = -2147467259  ' cannot find file (*.mdb)
161
Const ADOERROR_NOTABLE = -2147217865  ' Cannot find output table
162
Const FOR_READING      = 1
163
Const FOR_WRITING      = 2
164
 
165
' Determine the action mode (edit/browse/save/list/search) or browse
166
glsMode = ""
167
If Not isEmpty(request("a")) Then
168
   glsMode = request("a")
169
Else
170
   glsMode = "browse"
171
End If
172
 
173
' Determine the topic otherwise use home topic.
174
glsTopic = "WikiAsp"
175
If Not isEmpty(request("o")) Then
176
   glsTopic = request("o")
177
Else
178
   glsTopic = gHomeTopic
179
End If
180
 
181
' Determine if RSS contains highlighting or not
182
If Not isEmpty(request("h")) then
183
   gHighlightFlag = true
184
Else
185
   gHighlightFlag = false
186
End If
187
 
188
' Initialize the Regular Expression object variable
189
Set gRE=server.createobject("VBScript.Regexp")
190
gRE.IgnoreCase  = False
191
gRE.Global      = True
192
 
193
dim httpReferer
194
httpReferer= Request.ServerVariables("HTTP_REFERER")
195
 
196
 
197
' Get remote addresses globally
198
dim remoteIPHost
199
remoteIPHost = Request.ServerVariables("REMOTE_HOST")
200
 
201
dim remoteIPAddr
202
remoteIPAddr = Request.ServerVariables("REMOTE_ADDR")
203
 
204
If IsNull( remoteIPHost) Then
205
  remoteIPHost = "0.0.0.0"
206
End If
207
 
208
If IsNull( remoteIPHost) Then
209
  remoteIPAddr = "0.0.0.0"
210
End If
211
 
212
'-- Let us get he IP first 3 numbers
213
dim remoteIPHost3numbers
214
Dim DotPos 
215
DotPos = InStrRev(remoteIPHost,".")
216
remoteIPHost3numbers= mid(remoteIPHost,1,DotPos)
217
 
218
'------------------------------------------------------------------------------------------------------------
219
'                                        SUBROUTINES AND FUNCTIONS
220
'------------------------------------------------------------------------------------------------------------
221
 
222
Sub GetHomeTopic
223
    '-----------------------------------------------------------------------
224
    ' This looks for the Home Topic Name from the 1-line file wiki.ini file.
225
    '-----------------------------------------------------------------------
226
    Dim objFSO
227
    err.Clear
228
    On Error Resume Next
229
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
230
    On Error GoTo 0
231
    If Not IsObject(objFSO) Then
232
        Exit Sub
233
    End If
234
 
235
    'Open the ini file whch should be at same dir as access db file
236
    Dim objTextStream
237
    Dim strIniFile
238
 
239
    if len(gDocRootDir) > 0 then
240
       strIniFile= gDocRootDir & "\" & gDataSourceDir & "\" & gDataSourceFile & ".ini"
241
    else
242
       strIniFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".ini")
243
    end if
244
 
245
    If objFSO.FileExists(strIniFile) Then
246
        Set objTextStream = objFSO.OpenTextFile(strIniFile, FOR_READING)
247
        gHomeTopic = objTextStream.ReadLine()
248
        objTextStream.Close
249
    End If
250
 
251
    '
252
    ' Check For db specific style sheet if any. First look CSS at the roo
253
    ' If it is not there, look in the DB Folder.  If not again there don't
254
    ' Override the default  (which is Wiki.css).
255
    '
256
    Dim strCss
257
    strCss= Server.MapPath( gDataSourceFile & ".css")
258
    If objFSO.FileExists(strCss) Then
259
        gStyleSheet = gDataSourceFile & ".css"
260
    Else
261
        Dim strCssFile
262
        strCssFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".css")
263
        If objFSO.FileExists(strCssFile) Then
264
            gStyleSheet =  gDataSourceDir & "\" & gDataSourceFile & ".css"
265
        End If
266
    End If
267
 
268
    Set objTextStream = Nothing
269
    Set objFSO = Nothing
270
 
271
End Sub
272
 
273
Function DayName (intDay)
274
  '------------------------------------------
275
  ' Returns Abbreviated Day of Week
276
  '------------------------------------------
277
  select case intDay
278
      case 1
279
          DayName = "Sun"
280
      case 2
281
          DayName = "Mon"
282
      case 3
283
          DayName = "Tue"
284
      case 4
285
          DayName = "Wed"
286
      case 5
287
          DayName = "Thu"
288
      case 6
289
          DayName = "Fri"
290
      case 7
291
          DayName = "Sat"
292
  end select
293
end function
294
 
295
function MonthName(intMonth)
296
  '-----------------------------------------
297
  ' Returns Abbreviated Month Name
298
  '-----------------------------------------
299
  select case intMonth
300
      case 1
301
         MonthName = "Jan"
302
      case 2
303
         MonthName = "Feb"
304
      case 3
305
         MonthName = "Mar"
306
      case 4
307
         MonthName = "Apr"
308
      case 5
309
         MonthName = "May"
310
      case 6
311
         MonthName = "Jun"
312
      case 7
313
         MonthName = "Jul"
314
      case 8
315
         MonthName = "Aug"
316
      case 9
317
         MonthName = "Sep"
318
      case 10
319
         MonthName = "Oct"
320
      case 11
321
         MonthName = "Nov"
322
      case 12
323
          MonthName = "Dec"
324
  end select
325
end function
326
 
327
Function GetRFC822date(dateVar)
328
   '----------------------------------------------
329
   ' Returns standard format date for RSS feeds
330
   '----------------------------------------------
331
   GetRFC822date =  DayName (WeekDay(dateVar)) & ", " & _
332
                    Day(dateVar) & " " & MonthName(Month(dateVar)) & " " & _
333
                    Year(dateVar) & " " & FormatDateTime(dateVar, 4) &":00 " & gTimeZoneOffset
334
End Function
335
 
336
 
337
Function WrappedQueryExecute( connObject, queryString )  
338
   '----------------------------------------------
339
   ' If something is wrong with db connection redirect to URL
340
   '----------------------------------------------
341
  Dim rsResult
342
  If gRedirectURL = "" Then
343
      set rsResult = connObject.execute(queryString)
344
  Else
345
      on error resume next
346
      set rsResult = connObject.execute(queryString)
347
      on error goto 0
348
 
349
      If  isEmpty(rsResult) then
350
	       Response.Redirect gRedirectURL
351
         Response.End
352
      End If
353
  End If
354
  Set WrappedQueryExecute = rsResult
355
End Function
356
 
357
 
358
Function AnyFileExistsIn( objFSO, extensions, baseFilename)
359
 
360
    Dim arrIconExts, sIconPathFile, sIconFile, element
361
 
362
    AnyFileExistsIn = false
363
    arrIconExts = Split(extensions, ",")
364
 
365
    For Each element In arrIconExts
366
 
367
        sIconFile =  baseFilename & element
368
        sIconPathFile= Server.MapPath( sIconFile)
369
 
370
        If objFSO.FileExists(sIconPathFile) Then
371
           gIconName = sIconFile
372
           AnyFileExistsIn = true
373
           Exit For
374
        End If
375
 
376
    Next
377
 
378
 
379
End Function
380
 
381
 
382
Sub GetIconName
383
    '-------------------------------------------------
384
    ' Get the icon file name. gif first then jpg
385
    ' Now it look a various places to guarantee an icon
386
    '-------------------------------------------------
387
    Dim objFSO, sIconPathFile, sIconFile
388
    err.Clear
389
    On Error Resume Next
390
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
391
    On Error GoTo 0
392
    If Not IsObject(objFSO)  Then
393
        Exit Sub
394
    End If
395
 
396
    ' look for <msaccessdb>.xxx icon file
397
 
398
    Dim iconSearchOrder 
399
    iconSearchOrder = ".gif,.jpg,.png"
400
 
401
    ' first look at the db directory, then on root , then for icon.xxx, otherwise default to the c2 icon
402
 
403
    If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceDir & "/" & gDataSourceFile ) Then
404
        If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceFile ) Then
405
            If not AnyFileExistsIn( objFSO, iconSearchOrder , gIconName ) Then
406
                gIconName = "http://c2.com/sig/wiki.gif"
407
            End If
408
        End If
409
    End If
410
    Set objFSO = Nothing
411
End Sub
412
 
413
Function SpaceName(strX)
414
   '------------------------------------------------------------
415
   ' This function splits up a string into words by inserting a
416
   ' space before each upper case letter. Ignores numbers and .
417
   '------------------------------------------------------------
418
   Dim i, strY
419
   i = 1
420
   strY = ""
421
   Do While i <= len(strX)
422
     If UCase(mid(strX,i,1)) = mid(strX,i,1) Then
423
       if  (( mid(strX,i,1) < "0" ) OR ( mid(strX,i,1) > "9")) AND ( mid(strX,i,1) <> ".")then
424
        strY = strY & " "
425
       end if
426
     End If
427
     strY = strY & mid(strX,i,1)
428
     i = i + 1
429
   Loop
430
   EmitDebug 9,  2, "Original string: " & strX & " ... Spaced out string: " & strY & "<br/>"
431
   SpaceName = strY
432
End Function
433
 
434
 
435
Function removeHTML(txt)
436
  removeHTML=server.htmlencode(txt)
437
End Function
438
 
439
Function safeQuote(txt)
440
  If IsNull(txt) Then
441
     txt = ""
442
  End If
443
  safeQuote=replace(txt,"'","''")
444
End Function
445
 
446
 
447
Function replaceBoundingPattern(txt, pattern, tag)
448
  Dim workingText
449
  workingText = txt
450
  gRE.Pattern = pattern & "([^\n]{0,}?)" & pattern    ' kgreiner
451
  workingText= gRE.Replace(workingText, "<" & tag & ">$1</" & tag & ">")
452
  replaceBoundingPattern = workingText
453
End Function
454
 
455
' Elrey Ronald
456
Function replaceTableColumnPattern(txt)
457
  Dim workingText
458
  Dim aryLines, aryLinesCount
459
  Dim i
460
  workingText = txt
461
 
462
  aryLines = Split(workingText,vbCRLF)
463
  aryLinesCount = UBound(aryLines)
464
 
465
  For i = 0 To aryLinesCount
466
           If left(aryLines(i), 6 ) = "_tmp_0"  Then
467
               aryLines(i) = Replace(aryLines(i), "_tmp_0", "<tr><td valign=top class=TableCell>")
468
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
469
           End If
470
           If left(aryLines(i), 6 ) = "_tmp_1"  Then
471
               aryLines(i) = Replace(aryLines(i), "_tmp_1", "<tr class=TableRow1><td  valign=top class=TableCell>")
472
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
473
           End If
474
           If left(aryLines(i), 6 ) = "_tmp_2"  Then
475
               aryLines(i) = Replace(aryLines(i), "_tmp_2", "<tr class=TableRow2><td  valign=top class=TableCell>")
476
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
477
           End If
478
           If left(aryLines(i), 6 ) = "_tmp_3"  Then
479
               aryLines(i) = Replace(aryLines(i), "_tmp_3", "<tr class=TableRow3><td  valign=top class=TableCell>")
480
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
481
           End If
482
  Next
483
  replaceTableColumnPattern= Join(aryLines,vbCRLF)
484
End Function
485
 
486
Function AddAnchors(txt)
487
  Dim workingText
488
  Dim aryLines, aryLinesCount
489
  Dim i
490
  Dim tocText
491
  workingText = txt
492
 
493
  dim toc(100)
494
  dim tocIndex: tocIndex = 0
495
 
496
  aryLines = Split(workingText,vbCRLF)
497
  aryLinesCount = UBound(aryLines)
498
 
499
  For i = 0 To aryLinesCount
500
           If left(aryLines(i), 3 ) = "== "  Then
501
               toc(tocIndex) = "<a href=""#Section_"& tocIndex &""">" & Mid(aryLines(i), 3) &"</a>"
502
               aryLines(i) = "<a name=""Section_"& tocIndex &"""></a>" & vbCRLF & aryLines(i)
503
               tocIndex = tocIndex + 1
504
           End If
505
  Next
506
 
507
  if ( tocIndex > 0 ) then
508
      Dim ii
509
      Dim Text
510
      For ii = 0 to tocIndex -1
511
          Text = Text & vbcrlf & " *" & toc(ii)
512
      Next
513
      tocText = Text & vbcrlf & tocText
514
  end if
515
 
516
  ' Look for the spot to drop the TOC
517
  ' [[TOC]]
518
  For i = 0 To aryLinesCount
519
           If left(aryLines(i), 7 ) = "[[TOC]]"  Then
520
            aryLines(i) = tocText & vbCRLF' & aryLines(i)
521
           End If
522
  Next
523
 
524
 
525
  AddAnchors = Join(aryLines,vbCRLF)
526
End Function
527
 
528
 
529
 
530
'Elrey 3/06
531
Function RandomInteger(HighValue , LowValue )
532
     Rnd -1
533
     Randomize (time)
534
     RandomInteger = Int((HighValue - Lowvalue + 1) * Rnd() + Lowvalue)
535
End Function
536
 
537
 
538
Function replaceListPattern(txt, wikiPattern, topPattern, bottomPattern, startLinePattern, endLinePattern)
539
  '
540
  ' Search through the text, creating numbered lists
541
  ' where so indicated by the pattern occurances.
542
  '
543
  ' To indicate a numbered list, the pattern must always
544
  ' appear at the very beginning of a line.
545
  '
546
  Dim workingText,replaceText
547
  Dim aryLines,aryLinesCount
548
  Dim nPatternLength,bInsidePattern
549
  Dim i
550
 
551
  'Elrey  - added multiple pattern
552
  Dim aPatterns
553
  Dim aPatternsCount
554
  Dim aPatternLength
555
  aPatterns = Split(wikiPattern,"^")
556
  aPatternsCount = UBound(aPatterns)
557
  Dim patternFound, j
558
 
559
  Dim aStartPattern
560
  aStartPattern = Split(startLinePattern,"^")
561
 
562
  workingText = txt
563
  nPatternLength = len(wikiPattern)
564
  bInsidePattern = False
565
  aryLines = Split(workingText,vbCRLF)
566
  aryLinesCount = UBound(aryLines)
567
 
568
  For i = 0 To aryLinesCount
569
         ' Elrey
570
         patternFound = 0
571
         For j = 0 to aPatternsCount
572
             aPatternLength = len( aPatterns(j) )
573
             If  left( aryLines(i), aPatternLength ) = aPatterns(j) Then
574
                patternFound = 1
575
                Exit For
576
             End If
577
         Next
578
 
579
    If patternFound = 1 Then
580
        If Not bInsidePattern Then
581
            replaceText = topPattern & vbCRLF & aStartPattern (j)
582
 
583
            bInsidePattern = True
584
        Else
585
            replaceText = aStartPattern (j)
586
        End If
587
        aryLines(i) = replaceText & right(aryLines(i),len(aryLines(i)) - aPatternLength ) & endLinePattern
588
    Else
589
        If bInsidePattern Then
590
            aryLines(i) = bottomPattern & vbCRLF & aryLines(i)
591
            bInsidePattern = False
592
        End If
593
    End If
594
  Next
595
 
596
  replaceListPattern = Join(aryLines,vbCRLF)
597
 
598
End Function
599
 
600
 
601
Function imageize(txt)
602
  ' Include a tag like img:http://www.brinkster.com/images/brinksterlogo.gif
603
  ' to get an inlined-image. <img src="foo">
604
  Dim workingText
605
  workingText = txt
606
 
607
  ' referencing local images  Elrey Ronald 1/2006
608
  gRE.IgnoreCase = True
609
  gRE.Pattern = "(\s)(image:local|img:local):([^ \t\n\r]+)"
610
  workingText=gRE.Replace(workingText,"$1<img src='$3'  >")
611
 
612
  gRE.IgnoreCase = True
613
  gRE.Pattern = "(\s)(imageleft:local|imgleft:local):([^ \t\n\r]+)"
614
  workingText=gRE.Replace(workingText,"$1<img src='$3' align='left' style='margin-right:15pt'>")
615
 
616
  gRE.IgnoreCase = True
617
  gRE.Pattern = "(\s)(imageright:local|imgright:local):([^ \t\n\r]+)"
618
  workingText=gRE.Replace(workingText,"$1<img src='$3' align='right' style='margin-left:15pt'>")
619
 
620
  gRE.IgnoreCase = True
621
  gRE.Pattern = "(\s)(imgcenter:local|imagecenter:local|imgmiddle:local|imagemiddle:local):([^ \t\n\r]+)"
622
  workingText=gRE.Replace(workingText,"$1<p align=center><img src='$3' align='middle'></p>" )
623
 
624
 
625
  gRE.IgnoreCase = True
626
  gRE.Pattern = "(\s)(img|image):([^ \t\n\r]+)"
627
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3'>")
628
 
629
  gRE.Pattern = "(\s)(imgleft|imageleft):([^ \t\n\r]+)"
630
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3' align='left' style='margin-right:15pt'>")
631
 
632
  gRE.Pattern = "(\s)(imgright|imageright):([^ \t\n\r]+)"
633
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3' align='right' style='margin-left:15pt'>")
634
 
635
  gRE.Pattern = "(\s)(imgcenter|imagecenter|imgmiddle|imagemiddle):([^ \t\n\r]+)"
636
  workingText=gRE.Replace(workingText,"$1<p align=center><img title='$3' src='$3' align='middle' ></p>")
637
 
638
  ' local links
639
  gRE.IgnoreCase = True
640
  gRE.Pattern = "(\s)(local):([^ \t\n\r]+)"
641
  workingText=gRE.Replace(workingText,"$1<a href='$3' >$3</a>")
642
 
643
 
644
  gRE.IgnoreCase = False
645
  imageize = workingText
646
 
647
End Function
648
 
649
Function isbnize(txt)
650
  ' include a tag like isbn:0000000000
651
  ' to get a link to a book on Amazon <a href="amazonURL?isbn=0000">0000</a>
652
  Dim workingText
653
  workingText = txt
654
 
655
  gRE.IgnoreCase = True
656
  gRE.Pattern = "(\s)(isbn|ISBN):(\d{9}[\dX])"
657
  workingText=gRE.Replace(workingText,"$1<a  title='Amazon $3' href='http://www.amazon.com/exec/obidos/ISBN=$3'>ISBN:$3</a>")
658
 
659
  gRE.IgnoreCase = False  ' switch it back
660
  isbnize = workingText
661
 
662
End Function
663
 
664
Function IsRequestFromWikiASPPage
665
 
666
  dim sHidden
667
  sHidden = Request.Form("hiddenInput")
668
 
669
  If IsEmpty(sHidden) Then
670
     response.write "hmmm empty"
671
     IsRequestFromWikiASPPage = False
672
  End if
673
 
674
  If sHidden <> "errv2010" Then
675
     response.write "hmmm=" & sHidden
676
     IsRequestFromWikiASPPage = False
677
  End if
678
 
679
  IsRequestFromWikiASPPage = True
680
 
681
End Function
682
 
683
' Regular expression version ---------------------------
684
Function IsRemoteAdressBlackListedRE
685
 
686
  If Trim(gBlackListedIpsRE  ) = "" Then
687
     IsRemoteAdressBlackListedRE = False
688
  else
689
     gRE.Pattern = gBlackListedIpsRE  
690
 
691
     IsRemoteAdressBlackListedRE = gRE.Test( remoteIPHost)
692
  End If
693
End Function
694
 
695
' Non RE version (Exact)--------------------------------
696
Function IsRemoteBlackListed 
697
 
698
    IsRemoteBlackListed = False
699
 
700
    Dim pos
701
 
702
    pos =  InStr(gBlackListedIps, remoteIPHost3numbers) ' Leading 3 digits. Set IP list as ~1.2.3.~4.5.3~
703
 
704
    If Not IsNull(pos) and pos > 0 Then
705
       IsRemoteBlackListed = True
706
    End If
707
 
708
End Function
709
 
710
 
711
Function hyperlink(txt)
712
  Dim workingText
713
  Dim matches
714
  Dim nHits
715
  Dim thisMatchBefore, thisMatchAfter
716
 
717
  workingText = txt
718
 
719
 
720
  'pattern with no spaces:
721
  'gRE.Pattern = "(http|https)://[^ \t\n\r]+"
722
  'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]]+)"
723
 
724
  'ElreyRonald 8/03  Bjarne 10/31
725
  gRE.Pattern = "([^\[])\[([^\|\]]+)\|((http://|https://|ftp://|mailto:|news:|file:)[^\]\r\n\t]+)\]"
726
  workingText=gRE.Replace(workingText,"$1<a href='$3'>$2</a>")
727
 
728
  'ElreyRonald  local links inside [ | ]
729
  gRE.Pattern = "([^\[])\[([^\|\]]+)\|(local):([^ \t\n\r]+)\]"
730
  workingText=gRE.Replace(workingText,"$1<a href='$4'>$2</a>")
731
 
732
 
733
  'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]\r\n\t]+)"
734
  'Bjarne
735
  gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:|file:)[^\s\<\>\(\)\[\]\r\n\t]+)"
736
  workingText=gRE.Replace(workingText,"$1<a href=""$2"">$2</a>")
737
 
738
 
739
   'This is new  5/2006 see [/Drop]
740
  '[Drop#001##Test]
741
            '       1    [    2      ::              3            ]
742
  gRE.Pattern = "([^\[])\[Drop\#(\S+)\#\#([^\<\>\(\)\=\r\n\t\]]+)\]"
743
  workingText=gRE.Replace(workingText,   _
744
   "$1<div><span style=""font-weight: bold; color: white; background-color: green ; cursor: pointer"" onclick=""var div=document.getElementById('$2');if(div.style.display=='none') {div.style.display='block'; this.innerText='&nbsp;&#8592;&nbsp;';} else {div.style.display='none';this.innerText='&nbsp;+&nbsp;'}"">&nbsp;+&nbsp;</span>$3<div id='$2' style='display:none'> " )
745
 
746
 
747
 
748
  ' interwiki  by Elrey
749
  ' example:  [Sample One=CpOrders::SampleOne]
750
            '       1    [     2    =   3      ::               4            ]
751
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^=\]]+)\:\:([^\s\<\>\(\)\=\r\n\t\]]+)\]"
752
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$3&o=$4'>$2</a>")
753
 
754
  ' interwiki  by Elrey
755
  ' example:  [Sample One=CpOrders::]
756
            '       1    [     2    =   3      ::    ]
757
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^=\]]+)\:\:\]"
758
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$3'>$2</a>")
759
 
760
 
761
 
762
  ' intern link by Bernd Michalke 9/15/2005
763
  ' [anything geht=WikiASP]
764
 
765
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^\s\<\>\(\)\=\r\n\t\]]+)\]"
766
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$3'>$2</a>")
767
 
768
  ' intern link by Elrey 3/2006
769
  ' [=WikiASP]
770
  '              (--1--)   (-2----)
771
  gRE.Pattern = "([^\[])\[=([^\]]+)\]"
772
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$2'>$2</a>")
773
 
774
' intern link by Elrey 3/2006
775
  ' [[WikiAS P topic]]
776
  '              (--1--)    (---2--)
777
  gRE.Pattern = "([^\[])\[\[([^\]]+)\]\]"
778
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$2'>$2</a>")
779
 
780
 
781
  ' interwiki  by Elrey
782
  ' example:  [CpOrders::SampleOne]
783
            '       1    [     2   ::   3         ]
784
  gRE.Pattern = "([^\[])\[([^=\]]+)\:\:([^\s\<\>\(\)\=\r\n\t\]]+)\]"
785
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$2&o=$3'>$3</a>")
786
 
787
  ' interwiki  by Elrey
788
  ' example:  [CpOrders::]
789
            '       1    [    2  ::    ]
790
  gRE.Pattern = "([^\[])\[([^=\]]+)\:\:\]"
791
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$2'>$2</a>")
792
 
793
 
794
  hyperlink = workingText
795
 
796
End Function
797
 
798
 
799
 
800
Function PreHack(isTeksten)
801
    Dim arr
802
    Dim element
803
    Dim preOn
804
    Dim newText
805
 
806
    preOn = False
807
    arr = Split(isTeksten, vbCrLf)
808
 
809
    For Each element In arr
810
    If newtext <> "" Then
811
        newtext = newtext & vbCrLf
812
    End If
813
    ' line begins with a space
814
    If left(element, 1) = " " Then
815
        ' start pre tag
816
        If preOn = False Then
817
        preon = true
818
        newText = newtext & "<pre>" & vbcrlf & element
819
        ' already in pre tag
820
        else
821
        newtext = newtext & element
822
        end if
823
    ' empty line
824
    elseif element = "" then
825
        newtext = newtext & vbcrlf
826
    ' line begins with something besides a space
827
    else
828
        ' turn pre off
829
        if preon then
830
        newText = newtext & "</pre>" & vbcrlf & element
831
        preon = false
832
        ' just append element
833
        else
834
        newtext = newtext & element
835
        end if
836
    end if
837
    next
838
    if preon then
839
    newtext = newtext & "</pre>"
840
    preon = false
841
    end if
842
    prehack = newtext
843
end function
844
 
845
 
846
 
847
function xform(isTeksten)
848
  ' this is the transformation routine, in which all the markup
849
  ' is transformed into HTML.
850
  '
851
  ' ordering of the stages is important.
852
  '
853
  dim newText
854
  newText = vbcrlf & isTeksten ' need a space to deal with first-line wikiname
855
 
856
  'Elrey - move HTML removal into here
857
  If gRemoveHtml Then
858
     newText = removeHTML(newText)
859
  End If
860
 
861
  'David Purdie
862
  'Remove comments - Lines starting with //
863
  gRE.Pattern = "(\r\n)//([^\r\n]+)"
864
  newText=gRE.Replace(newText,"")
865
 
866
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey
867
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:80pt;"">")
868
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:60pt;"">")
869
  newText=replace(newText,vbcrlf & "&gt;&gt;",vbcrlf & "<p style=""margin-left:40pt;"">")
870
  newText=replace(newText,vbcrlf & "&gt;",vbcrlf & "<p style=""margin-left:20pt;"">")
871
 ' Elrey 3/2007
872
 newText=replace(newText,vbcrlf & ">>>>>>>>>*",vbcrlf & "<p style=""margin-left:135pt;margin-top:2pt;"">&#9827;&nbsp;")
873
 newText=replace(newText,vbcrlf & ">>>>>>>>*",vbcrlf & "<p style=""margin-left:120pt;margin-top:2pt;"">&#8574;&nbsp;")
874
 newText=replace(newText,vbcrlf & ">>>>>>>*",vbcrlf & "<p style=""margin-left:105pt;margin-top:2pt;"">&#959;&nbsp;")
875
 newText=replace(newText,vbcrlf & ">>>>>>*",vbcrlf & "<p style=""margin-left:90pt;margin-top:2pt;"">&#8226;&nbsp;")
876
 newText=replace(newText,vbcrlf & ">>>>>*",vbcrlf & "<p style=""margin-left:75pt;margin-top:2pt;"">&#9830;&nbsp;")
877
 newText=replace(newText,vbcrlf & ">>>>*",vbcrlf & "<p style=""margin-left:60pt;margin-top:2pt;"">&#8594;&nbsp;")
878
 newText=replace(newText,vbcrlf & ">>>*",vbcrlf & "<p style=""margin-left:45pt;margin-top:2pt;"">&#9674;&nbsp;")
879
 newText=replace(newText,vbcrlf & ">>*",vbcrlf & "<p style=""margin-left:30pt;margin-top:2pt;"">&#959;&nbsp;")
880
 newText=replace(newText,vbcrlf & ">*",vbcrlf & "<p style=""margin-left:15pt;margin-top:2pt;"">&#8226;&nbsp;")
881
 
882
 
883
 
884
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey  updated 3/2007
885
  newText=replace(newText,vbcrlf & ">>>>>>>>>",vbcrlf & "<p style=""margin-left:135pt;margin-top:2pt;"">")
886
  newText=replace(newText,vbcrlf & ">>>>>>>>",vbcrlf & "<p style=""margin-left:120pt;margin-top:2pt;"">")
887
  newText=replace(newText,vbcrlf & ">>>>>>>",vbcrlf & "<p style=""margin-left:105pt;margin-top:2pt;"">")
888
  newText=replace(newText,vbcrlf & ">>>>>>",vbcrlf & "<p style=""margin-left:90pt;margin-top:2pt;"">")
889
  newText=replace(newText,vbcrlf & ">>>>>",vbcrlf & "<p style=""margin-left:75pt;margin-top:2pt;"">")
890
  newText=replace(newText,vbcrlf & ">>>>",vbcrlf & "<p style=""margin-left:60pt;margin-top:2pt;"">")
891
  newText=replace(newText,vbcrlf & ">>>",vbcrlf & "<p style=""margin-left:45pt;margin-top:2pt;"">")
892
  newText=replace(newText,vbcrlf & ">>",vbcrlf & "<p style=""margin-left:30pt;margin-top:2pt;"">")
893
  newText=replace(newText,vbcrlf & ">",vbcrlf & "<p style=""margin-left:15pt;margin-top:2pt;"">")
894
 
895
 
896
 
897
 
898
  ' newlines: three newlines = a blank line
899
  newText=replace(newText,vbcrlf & vbcrlf & vbcrlf,vbcrlf & "<br/>&nbsp;<br/></p><p>" & vbcrlf )
900
 
901
  ' newlines: two newlines = a hard return
902
  newText=replace(newText,vbcrlf & vbcrlf,vbcrlf & "<br/></p><p>" & vbcrlf )
903
 
904
 
905
  EmitDebug 10, 4, "xform-before(" &  newText & ")<br/>"
906
 
907
  If right(newText,2) <> vbcrlf Then
908
    newText = newText & vbcrlf
909
  End If
910
 
911
  'David Purdie
912
  newText=replace(newText, "$Page$", glsTopic )
913
  newText=replace(newText, "$image$", "local:images/page_" + glsTopic )
914
  newText=replace(newText, "$domain$", gHttpDomain )
915
 
916
  ' toc david
917
  newText = AddAnchors(newText)
918
 
919
  'Elrey Ronald
920
  newText=replaceListPattern(newText, "        *", "<ul>", "</ul>", "<li> ", "</li>")
921
  newText=replaceListPattern(newText, "        :*", "<ol>", "</ol>", "<li> ", "</li>")
922
  newText=replaceListPattern(newText, "        1.", "<ol class='nlist'>", "</ol>", "<li> ", "</li>")
923
 
924
  'Elrey Ronald - more convenient bullet list
925
  newText=replaceListPattern(newText, " *", "<ul>", "</ul>", "<li> ", "</li>")
926
  newText=replaceListPattern(newText, " :*", "<ol>", "</ol>", "<li> ", "</li>")
927
  newText=replaceListPattern(newText, " 1.", "<ol class='nlist'>", "</ol>", "<li> ", "</li>")
928
 
929
  'Elrey Ronald - Table Pattern
930
  newText=replaceListPattern(newText, "||^!|^|!^!!", "<table border=1 class=TableClass>", "</table>", "_tmp_0^_tmp_1^_tmp_2^_tmp_3", "</td></tr>")
931
 
932
  newText=replaceTableColumnPattern(newText)
933
 
934
  ' leading space rule
935
  newText = PreHack(newText)
936
 
937
' outline ( ElreyRonald )
938
 
939
  gRE.Pattern = "\r\n\[(\d+)\]======([^\r\n]+)"
940
  newText=gRE.Replace(newText,"<h6>[<a name='$1' href='#fn_$1'>$1</a>] $2</h6>")
941
  gRE.Pattern = "\r\n\[(\d+)\]=====([^\r\n]+)"
942
  newText=gRE.Replace(newText,"<h5>[<a name='$1' href='#fn_$1'>$1</a>] $2</h5>")
943
  gRE.Pattern = "\r\n\[(\d+)\]====([^\r\n]+)"
944
  newText=gRE.Replace(newText,"<h4>[<a name='$1' href='#fn_$1'>$1</a>] $2</h4>")
945
  gRE.Pattern = "\r\n\[(\d+)\]===([^\r\n]+)"
946
  newText=gRE.Replace(newText,"<h3>[<a name='$1' href='#fn_$1'>$1</a>] $2</h3>")
947
  gRE.Pattern = "\r\n\[(\d+)\]==([^\r\n]+)"
948
  newText=gRE.Replace(newText,"<h2>[<a name='$1' href='#fn_$1'>$1</a>] $2</h2>")
949
 
950
  ' footnote ( ElreyRonald )
951
 
952
  gRE.Pattern = "\r\n\[(\d+)\]\r\n"    ' blank footnote will just be an anchor (ElreyRonald)
953
  newText=gRE.Replace(newText,  "<a name='$1' href='#fn_$1'><hr size=1></a>" & vbcrlf)
954
 
955
  gRE.Pattern = "\r\n\[(\d+)\]"
956
  newText=gRE.Replace(newText,  "<br>[<a name='$1' href='#fn_$1'>$1</a>]")
957
 
958
  gRE.Pattern = "\[(\d+)\]"
959
  newText=gRE.Replace(newText, "[<a href='#$1' name='fn_$1'>$1</a>]")
960
 
961
  ' topic line (ElreyRonald)
962
  gRE.Pattern = "\r\n======([^\r\n]+)"
963
  newText=gRE.Replace(newText,"<h6>$1</h6>")
964
  gRE.Pattern = "\r\n=====([^\r\n]+)"
965
  newText=gRE.Replace(newText,"<h5>$1</h5>")
966
  gRE.Pattern = "\r\n====([^\r\n]+)"
967
  newText=gRE.Replace(newText,"<h4>$1</h4>")
968
  gRE.Pattern = "\r\n===([^\r\n]+)"
969
  newText=gRE.Replace(newText,"<h3>$1</h3>")
970
  gRE.Pattern = "\r\n==([^\r\n]+)"
971
  newText=gRE.Replace(newText,"<h2>$1</h2>")
972
 
973
  ' horizontal rule
974
  gRE.Pattern = "\r\n-{4,}"
975
  newText=gRE.Replace(newText,vbCrLf & "<hr size=1 noshade=false />" & vbcrlf)
976
 
977
  ' special case for dash and a-umlaut - MARKUS
978
  'newText=replace(newText,"-", "&minus;")  ' this change breaks image URLs that include dashes
979
  newText=replace(newText,"", "&auml;")
980
 
981
  ' removed by ElreyRonald, use "|"
982
  ' newText=replace(newText,chr(9) & " :" & chr(9),"<p style=""margin-left:20pt;"">")
983
 
984
  ' Removed by ElreyRonald, use "|"
985
  ' newText=replace(newText,vbcrlf & chr(9) & "]",vbcrlf & "<p style=""margin-left:20pt;"">")
986
 
987
 
988
  '[MARKUS] Underline neu hinzugefgt - -_ irgendwas _-
989
  newText=replace(newText,"-_", "<u>")
990
  newText=replace(newText,"_-","</u>")
991
 
992
  '[Markus] LEERSTELLEN werden in HTML-Leerstellen umgewandelt
993
  'newText=replace(newText," ","&nbsp;")  ' this change screws up images.  Why necessary?   dinoch Thu, 17 Oct 2002
994
 
995
  ' bulleted lists: tab-star
996
  'newText=replace(newText,chr(9) & "*","<li> ")
997
  newText=replaceListPattern(newText, chr(9) & "*", "<ul>", "</ul>", "<li> ", "</li>")
998
 
999
  ' numbered lists: tab-colon-star
1000
  newText=replaceListPattern(newText, chr(9) & ":*", "<ol>", "</ol>", "<li> ", "</li>")
1001
 
1002
  ' numbered lists: Changed to use 1. to conform with http://www.c2.com/cgi/wiki?TextFormattingRules
1003
  newText=replaceListPattern(newText, chr(9) & "1.", "<ol>", "</ol>", "<li> ", "</li>")
1004
 
1005
  ' COLORS: (german and english)- german removed (ElreyRonald)
1006
  'SCHRIFTFARBEN {schwarz} {braun} {grn} {blau} {gelb} {rot} {orange}
1007
  '{farbe} {/farbe}
1008
  newText=replace(newText,"{black}","<font color=black>")
1009
  newText=replace(newText,"{/black}","</font>")
1010
  newText=replace(newText,"{green}","<font color=darkgreen>")
1011
  newText=replace(newText,"{/green}","</font>")
1012
  newText=replace(newText,"{blue}","<font color=darkblue>")
1013
  newText=replace(newText,"{/blue}","</font>")
1014
  newText=replace(newText,"{sienna}","<font color=sienna>")
1015
  newText=replace(newText,"{/sienna}","</font>")
1016
  newText=replace(newText,"{red}","<font color=firebrick>")
1017
  newText=replace(newText,"{/red}","</font>")
1018
  newText=replace(newText,"{pink}","<font color=deeppink>")
1019
  newText=replace(newText,"{/pink}","</font>")
1020
 
1021
  ' 5/2006
1022
  newText=replace(newText,"[/Drop]","</div></div>")
1023
 
1024
  '
1025
  newText=replace(newText,"{italic}","<I>")
1026
  newText=replace(newText,"{/italic}","</I>")
1027
  newText=replace(newText,"{bold}","<strong>")
1028
  newText=replace(newText,"{/bold}","</strong>")
1029
 
1030
  ' CHANGE SIZE / SCHRIFTGRSSE
1031
  'SMALLER / KLEINER
1032
  newText=replace(newText,"{small}","<font size='-1'>")
1033
  newText=replace(newText,"{/small}","</font>")
1034
  newText=replace(newText,"{smaller}","<font size='-2'>")
1035
  newText=replace(newText,"{/smaller}","</font>")
1036
  newText=replace(newText,"{smallest}","<font size='-3'>")
1037
  newText=replace(newText,"{/smallest}","</font>")
1038
  'LARGER / GRSSER
1039
  newText=replace(newText,"{big}","<font size='+1'>")
1040
  newText=replace(newText,"{/big}","</font>")
1041
  newText=replace(newText,"{bigger}","<font size='+2'>")
1042
  newText=replace(newText,"{/bigger}","</font>")
1043
  newText=replace(newText,"{biggest}","<font size='+3'>")
1044
  newText=replace(newText,"{/biggest}","</font>")
1045
 
1046
  ' this is were you can insert your own bracket comands...
1047
  newText=replace(newText,"{br}","<br/>")
1048
 
1049
 
1050
  ' images:
1051
  newText= imageize(newText)
1052
 
1053
  ' isbns:
1054
  newText= isbnize(newText)
1055
 
1056
  ' auto-hyperlinks
1057
  newText= hyperlink(newText)
1058
 
1059
  ' bold text: three single quotes
1060
  newText= replaceBoundingPattern(newText,"'''","b")
1061
 
1062
  ' em text: two single quotes
1063
  newText= replaceBoundingPattern(newText,"''","em")
1064
 
1065
  ' consolidate a series of trailing vbcrlf to just 2.
1066
  gRE.Pattern = "(\r\n){3,}$"
1067
  newText=gRE.Replace(newText, vbcrlf & vbcrlf)
1068
 
1069
  If  gDisableScripting = false Then
1070
    ' 2007.08.25 disable scripts
1071
    gRE.Pattern = "<([s|S][c|C][r|R][i|I][p|P][t|T])"
1072
    newText=gRE.Replace(newText, "&lt;$1")
1073
  End If
1074
 
1075
 
1076
  EmitDebug 11, 4, "xform-after(" &  newText & ")<br/>"
1077
 
1078
  newText = Replace(newText, "#@91;", "[")
1079
  newText = Replace(newText, "#@93;", "]")
1080
  newText = Replace(newText, "#@3A;", ":")
1081
  newText = Replace(newText, "#@3C;", "<")
1082
  newText = Replace(newText, "#@3E;", ">")
1083
 
1084
  xform = newText
1085
 
1086
End Function
1087
 
1088
 
1089
Function WalkWiki(isTeksten)
1090
    Dim myText
1091
    myText = isTeksten
1092
    WalkWiki = myText
1093
 
1094
End Function
1095
 
1096
function RemoveBrackets(s)
1097
  Dim ts
1098
  ts = replace( s, "[","")
1099
  ts = replace( ts, "]","")
1100
  RemoveBrackets = ts
1101
end function
1102
 
1103
function RemoveSpaces(s)
1104
  Dim ts
1105
  ts = replace( s, " ","")
1106
  RemoveSpaces = ts
1107
end function
1108
 
1109
 
1110
 
1111
Sub EmitDebug(sig,lvl,arg)
1112
  If gDebug >= lvl Then Response.Write("debug:" & sig & " " & arg & vbcrlf)
1113
End Sub
1114
 
1115
 
1116
'----------------------------------------------------
1117
' This function builds and returns the connection
1118
' string, based on input provided from the web form.
1119
'
1120
function ConnStr(includeMode)
1121
  dim localDs
1122
  ' Map MDB database to physical path
1123
   if len(gDocRootDir) > 0 then
1124
      localDs = gDataSource
1125
   else
1126
      localDs = Server.MapPath(gDataSource)
1127
   end if
1128
 
1129
  ConnStr= "Provider=" & gProvider & ";Data Source=" & localDs & ";"
1130
  if (includeMode) then
1131
      ConnStr=   ConnStr & "mode= Share Deny None"
1132
  end if
1133
  EmitDebug 20, 3, "ConnStr= (" &  ConnStr & ")<br/>"
1134
end function
1135
 
1136
 
1137
 
1138
sub CheckDbErrors
1139
  if  gDataConn.errors.count> 0 then
1140
    dim counter
1141
    response.write "<br/><b>Database Errors Occurred" & "</b><br/>" & vbcrlf
1142
    for counter= 0 to gDataConn.errors.count
1143
      response.write "Error #" & gDataConn.errors(counter).number & vbcrlf & "<br/>"
1144
      response.write "  Description(" & gDataConn.errors(counter).description & ")" & vbcrlf & "<br/>"
1145
    next
1146
  else
1147
    response.write "<br/><b>No Database Errors Occurred" & "</b><br/>" & vbcrlf
1148
  end if
1149
end sub
1150
 
1151
 
1152
' Elrey Ronald  2/21/05
1153
sub VerifyWikiTableNoAdoxComponent
1154
  on error resume next
1155
  gDataConn.Open ConnStr(0)
1156
  on error goto 0
1157
 
1158
  on error resume next
1159
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1160
  on error goto 0
1161
 
1162
end sub
1163
 
1164
'----------------------------------------------------------------------------
1165
' VerifyWikiTable
1166
' This routine:
1167
' (a) verifies the existence of the target database (dbname) at the given
1168
'     ADO connection.  If necessary, this routine creates that
1169
'     database.
1170
' (b) verifies the existence of the table in that database.  If necessary,
1171
'     this routine will create the required table, and build the table
1172
'     structure.  The columns in the target table are determined by the
1173
'     fields in the source record set (sourceRs).   Two additional
1174
'     columns are also added. (in fact we do not use the entire recordset,
1175
'     but only the collection of fields in the recordset.
1176
'
1177
 
1178
sub VerifyWikiTable
1179
  if not gAutoCreateMdb then
1180
     Call VerifyWikiTableNoAdoxComponent
1181
     Exit Sub
1182
  End If
1183
  dim tbl, cat, dbname, fso
1184
  dim fsoErrMessage, adoxErrMessage, instructions
1185
 
1186
  fsoErrMessage  = "<font color=red >ERROR: Directory or MS Access File can not be created! Automatic DB creation is not possible. Your server is missing the needed <b>FileSystemObject component</b>.</font><BR>"
1187
  adoxErrMessage = "<font color=red >ERROR: Database file can not be created! Some file actions are disabled. Your server is missing the needed <b>ADOX.Catalog component</b>.</font><BR>"
1188
  instructions =   "<LI>You may have to <b>MANUALLY</b> create the folder/MsAccess file -> <b>" & gDataSource & " </b> </LI>"  & _
1189
                   "<LI>You may modify 'gDefaultIcon', 'gDefaultHomePage' variables in the WikiAsp program to view your default icon and access the proper Ms Access file (mdb).</LI>" & _
1190
                   "<LI>You may modify 'gAutoCreateMdb' and set it to false to prevent creation of MDB and avoid this message." & _
1191
                   "<LI>The program will attempt to continue using default values, if this works you can just remove these comments from the program (look for VerifyWikiTable  subroutine).</LI>" & _
1192
                   "<BR><BR><B><i>Now trying to use default values to see if this would work...</i></B>"
1193
 
1194
  err.clear
1195
  ' Check if ADOX.Catalog component is available in this computer
1196
  on error resume next
1197
  set cat= CreateObject("ADOX.Catalog")
1198
  on error goto 0
1199
 
1200
  ' Check if FileSystemObject component is available in this computer
1201
  on error resume next
1202
  set fso = CreateObject("Scripting.FileSystemObject")
1203
  on error goto 0
1204
 
1205
  If Not IsObject(cat) or cat is nothing Then
1206
     Response.Write( adoxErrMessage)
1207
     Response.Write( instructions )
1208
     Call VerifyWikiTableNoAdoxComponent
1209
     Exit Sub
1210
  End If
1211
 
1212
  err.clear
1213
  If Not IsObject(fso)  Then
1214
     Response.Write( fsoErrMessage)
1215
     Response.Write( instructions )
1216
     Call VerifyWikiTableNoAdoxComponent
1217
     Exit Sub
1218
  End If
1219
 
1220
  if len (gDocRootDir) > 0 then
1221
    dbname = gDataSource
1222
  else
1223
    dbname = Server.MapPath(gDataSource)
1224
  end if
1225
 
1226
  '--------------------------------------------
1227
  ' step 0: check the directory, create if necessary
1228
  dim folder, f1
1229
  if len (gDocRootDir) > 0 then
1230
    f1 = gDocRootDir & "\" & gDataSourceDir
1231
  else
1232
    f1 = Server.MapPath(gDataSourceDir)
1233
  end if
1234
  if not fso.FolderExists(f1) then
1235
      on error resume next
1236
      Set folder = fso.CreateFolder(f1)
1237
      on error goto 0
1238
      If Not IsObject(folder) Then
1239
         Response.Write( "Unable to create [" & f1 & "].  Please modify DOCROOT and gDataSourceDir in the program. Consult your website settings." )
1240
         Response.End
1241
      End If
1242
      set folder = nothing
1243
  end if
1244
  set fso = nothing
1245
  '---- some security here
1246
 
1247
  If gDataSourceFile <> gDefaultHomePage Then
1248
 
1249
    ' Expecting delVerified=1 for deletion confirmation
1250
    If Request.QueryString("dbCreate") <> "1" Then
1251
      Response.Write("<center><h2>Database Creation</h2></center><hr>")
1252
      Response.Write("<center>")
1253
      If gHideLogin Then
1254
          Response.Write("The Database --> <b>" &  gDataSource & "</b> <--- Cannot be created on this Server")
1255
          Response.Write("<br><a href='" & gScript & "'><button>Return to Home</button></a>")
1256
      ElseIf NOT gEnableEdit Then
1257
          Response.Write("The Database --> <b>" &  gDataSource & "</b> <--- Cannot be created until you enable editing")
1258
          Response.Write("<br><a href='" & gScript & "'><button>Return to Home</button></a>")
1259
      Else
1260
          Response.Write("<br><br><span style='border: solid 5px red; padding: 10px;display:inline-block'>")
1261
          response.write("Create Database --> <b>" &  gDataSource & "</b>  <---")
1262
          Response.Write("<p align=left>Folder: " & f1 & ".")
1263
          Response.Write("<br>DataBase: " & gDataSource & ".")
1264
          response.write("<p>Are your sure that you wish to continue!")
1265
          response.write( "<br><br><a href='" & gScriptURL & "&dbCreate=1'><button style='color:red'>Create Database.</button></a>" )
1266
          response.write( "&nbsp;&nbsp;<a href='" & gScript & "'><button>No,  don't create it.</button></a>" )
1267
          response.write( "</span>" )
1268
      End If
1269
      Response.Write("</center>")
1270
      Response.End
1271
    End If
1272
  End If
1273
 
1274
  '--------------------------------------------
1275
  ' step 1: create the new db catalog, if necessary
1276
  Err.Clear
1277
  EmitDebug 21, 2, vbcrlf & " creating db " & dbname & "<br/>"
1278
  on error resume next
1279
  cat.Create ConnStr(0)
1280
  on error goto 0
1281
  EmitDebug 22, 2, ">> error(" & err.Number & "," & err.Description &  ")<br/>"
1282
  'EmitDebug 23, 2, vbcrlf & " catConnErrorCount(" & _
1283
  '    cat.ActiveConnection.errors.count  & ")<br/>"
1284
 
1285
  if not (err.Number = 0) then
1286
    if not (err.Description = "Database already exists." ) then
1287
      dim sError
1288
      sError = ">> error(" & err.Number & "," & err.Description & ")" & _
1289
          "(EXPECTED ""Database already exists"")..." & "<br/>"
1290
      EmitDebug 24, 2, sError
1291
      Response.Write( "<span style='color:red'>Fatal error creating db: " & err.Number & " " & err.description & "</span>")
1292
    else
1293
      EmitDebug 25, 2, ">> Database already exists..." & "<br/>"
1294
      cat.ActiveConnection= ConnStr(0)
1295
    end if
1296
  else
1297
    EmitDebug 26, 2, ">> Database has just been created..." & "<br/>"
1298
  end if
1299
  EmitDebug 27, 2, " Database now exists..." & "<br/>"
1300
 
1301
 
1302
  '--------------------------------------------
1303
  ' step 2: create the new table, with columns, if necessary
1304
  Err.Clear
1305
  EmitDebug 28, 2, " verifying presence of table(" & gDbTableName & ")<br/>"
1306
  'if not isNothing(gDataConn) then set gDataConn = nothing
1307
  on error resume next
1308
  set gDataConn = Server.CreateObject("ADODB.Connection")
1309
  on error goto 0
1310
  If Not IsObject(gDataConn) Then
1311
    Response.Write ( "Unable to establish connection. Missing ADO object.")
1312
    Response.End
1313
  End If
1314
 
1315
  on error resume next
1316
  gDataConn.Open ConnStr(0)
1317
  on error goto 0
1318
 
1319
 
1320
  on error resume next
1321
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1322
  on error goto 0
1323
 
1324
  if (0 = gDataConn.errors.count) then
1325
      EmitDebug 29, 1, vbcrlf & "(no db errors, ergo table exists)"  & "<br/>"
1326
  elseif ((gDataConn.errors.count>0) and ( ADOERROR_NOTABLE = gDataConn.errors(0).number)) then
1327
      set gDataConn = nothing
1328
      ' error: table does not exist.
1329
      EmitDebug 30, 2, vbcrlf & " creating table " & gDbTableName  & "<br/>"
1330
      Dim idx 'As New ADOX.Index
1331
      set idx= CreateObject("ADOX.Index")
1332
      ' now, create a new table in the db:
1333
      set tbl= CreateObject("ADOX.Table")
1334
      With tbl
1335
      ' drop tbl into a MDB provider context; need to do this NOW
1336
      ' to be able to use autoIncrement, later.
1337
      set .ParentCatalog = cat
1338
 
1339
      ' Name the new table.
1340
      .Name = gDbTableName
1341
 
1342
      .Columns.Append "ID", 3
1343
      .Columns("ID").Properties("AutoIncrement") = True
1344
 
1345
      .Columns.Append "Title", 202, 127
1346
      .Columns.Append "PageData", 203
1347
      .Columns.Append "PrevPageData", 203
1348
      .Columns("PrevPageData").Properties("Jet OLEDB:Allow Zero Length") = True
1349
      .Columns("PrevPageData").Properties("Nullable") = True
1350
      .Columns.Append "LastUpdate", 7     ' timestamp
1351
      .Columns.Append "LastEditor", 202, 127
1352
 
1353
      ' create the Primary Key :
1354
      idx.Name = "RecordIndex"
1355
      idx.Columns.Append "ID"
1356
      idx.PrimaryKey = True
1357
      idx.Unique = True
1358
      .Indexes.Append idx
1359
 
1360
 
1361
 
1362
      End With
1363
 
1364
      ' this appends the table to the db catalog
1365
      cat.Tables.Append  tbl
1366
      EmitDebug 31, 2, vbcrlf & " post-append: catConnErrorCount(" & _
1367
      cat.ActiveConnection.errors.count  & ")<br/>"
1368
 
1369
      set idx= nothing
1370
 
1371
      ' insert the first record into the newly-created table
1372
      EmitDebug 32, 2,  ">> inserting into table(" & gDbTableName  & ")<br/>"
1373
 
1374
      set gDataConn = Server.CreateObject("ADODB.Connection")
1375
      gDataConn.Open ConnStr(1)
1376
 
1377
      dts = Now
1378
      EmitDebug 33, 2,  ">> the time is now(" & dts  & ")<br/>"
1379
 
1380
      DoInitialPageCreation(".")
1381
 
1382
  else
1383
      EmitDebug 34, 2,  ">> table " & tablename & " already exists?" & "<br/>"
1384
  end if
1385
 
1386
  set cat = nothing
1387
  set tbl = nothing
1388
  on error goto  0
1389
 
1390
end sub
1391
 
1392
 
1393
Function DoInitialPageCreation(folderspec)
1394
  Dim fso, f, f1, fc, s, dts, sPageData, fPage, stmnt
1395
  Set fso = CreateObject( "Scripting.FileSystemObject" )
1396
 
1397
  EmitDebug 35, 2,  ">> checking dir (" & Server.MapPath(folderspec) & ")<br/>"
1398
  Set f = fso.GetFolder(Server.MapPath(folderspec))
1399
  Set fc = f.Files
1400
  EmitDebug 36, 2,  ">> files counted (" & fc.Count & ")<br/>"
1401
  For Each f1 in fc
1402
    if (Right(f1.name, 4) = ".wik") then
1403
        s = Left(f1.name, Len(f1.name)-4)
1404
        EmitDebug 37, 2,  ">> found file  (" & s & ")<br/>"
1405
        on error resume next
1406
        set fPage= fso.OpenTextFile(Server.MapPath(f1.name),FOR_READING)
1407
        sPageData = fPage.ReadAll
1408
        on error goto 0
1409
        fPage.Close
1410
        set fPage = nothing
1411
        dts = Now  ' timestamp
1412
        EmitDebug 38, 2,  ">> inserting record (" & s & ")<br/>"
1413
 
1414
        stmnt = "INSERT INTO " & gDbTableName & " (Title,PageData,PrevPageData,LastUpdate,LastEditor) " & _
1415
        "VALUES ( '" & s & "','" & safeQuote(sPageData) & "', '--', '" & dts & "', '" & gScript & " (initial creation)');"
1416
        on error resume next
1417
        gDataConn.execute(stmnt)
1418
        on error goto 0
1419
        if gDebug>=1 then CheckDbErrors
1420
    end if
1421
  Next
1422
  set fso = nothing
1423
  set f = nothing
1424
  set fc = nothing
1425
 
1426
end Function
1427
 
1428
 
1429
 
1430
function theWhereClause(theStr)
1431
  dim result
1432
  result= ""
1433
  dim myArray
1434
  dim element
1435
  EmitDebug 39, 1, "whereClause(" & theStr & ")<br/>" & vbcrlf
1436
 
1437
  myArray = split(Trim(theStr), " ")
1438
  for each element in myArray
1439
    element = Trim(element)
1440
    if (result = "") then
1441
      result = " where "
1442
    else
1443
      result = result & " and "
1444
    end if
1445
    result= result &  " PageData like '%" & element & "%'"
1446
  next
1447
  EmitDebug 40, 1, "whereClause:result(" & result & ")<br/>" & vbcrlf
1448
  theWhereClause = result
1449
 
1450
end function
1451
 
1452
sub handleLogout
1453
    Dim url
1454
    url = gScriptURL & "&o=" & glsTopic
1455
    gEnableEdit = false
1456
    Session.Abandon
1457
    Response.Redirect(url)
1458
end sub
1459
 
1460
sub handleLogin
1461
    Dim url
1462
    url = gScriptURL & "&o=" & glsTopic
1463
    gEnableEdit = true
1464
    Session("login") = 1
1465
    Response.Redirect(url)
1466
end sub
1467
 
1468
sub handleEdit
1469
    If NOT gEnableEdit Then
1470
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed</h2></center>")
1471
        Response.End
1472
        exit sub
1473
    End If
1474
 
1475
    If IsRemoteBlackListed Then
1476
 
1477
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Please send e-mail to this site's Web Master ASAP.</h2></center>")
1478
        Response.End
1479
        Exit Sub
1480
 
1481
    End If
1482
 
1483
      sqlQuery = "select PageData,Title, lastupdate, PrevPageData from " & gDbTableName & " where title='" & glsTopic & "'"
1484
      EmitDebug 41, 2, "Edit query(" & sqlQuery & ")<br/>" & vbcrlf
1485
 
1486
      'set rs = gDataConn.execute(sqlQuery)
1487
      set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1488
 
1489
 
1490
      dim strPageData, strTitle, strLastUpdate, strPrevPageData
1491
 
1492
      if not rs.eof then
1493
         'page exists
1494
          strTitle = rs("title")
1495
          strPageData = rs("pageData")
1496
          strLastUpdate = CStr(rs("lastupdate"))
1497
          strPrevPageData = rs("PrevPageData")
1498
      else
1499
          'page does not exist
1500
          strTitle = glsTopic
1501
          strPageData = ""
1502
          strLastUpdate = ""
1503
          strPrevPageData = ""
1504
      end if
1505
 
1506
     'If Not gHideWikiSource Then
1507
              response.write("<form id=form1 name=form1 method=""POST"" action=""" & gScript & """>" & vbcrlf)
1508
              response.write "<h4>Edit: <font color=blue>&nbsp;" & SpaceName(strTitle) & "</font>&nbsp;&nbsp;&nbsp;&nbsp;<input type=submit value=Save>&nbsp;&nbsp;&nbsp;&nbsp;<input type=button value='Cancel' onclick='location.href=""" & gScriptURL & "&o=" & strTitle & """'></h4>"  & vbcrlf
1509
              ' [MARKUS - replace virtual with hard]
1510
              response.write("<textarea id=""pagetext""  name=""pagetext"" rows='" & giEditAreaRows & "'  cols='" & giEditAreaCols & _
1511
                "'  style='width:100%'>"  & _
1512
                Server.HtmlEncode(strPageData) & _
1513
                "</textarea>" & vbcrlf & _
1514
                "<br/> <input type=submit value=' Save '>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type=button value='Cancel' onclick='location.href=""" & gScriptURL & "&o=" & strTitle & """'>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & _
1515
                "<br/></br/> "  & _
1516
                vbcrlf & "<input type=hidden name=lupdt value='" & strLastUpdate & "'>" & _
1517
                vbcrlf & "<input type=hidden name=o value='" & strTitle & "'>" & _
1518
                vbcrlf & "<input type=hidden name=db value='" & gDataSourceFile & "'>" & _
1519
                vbcrlf & "<input type=hidden name=hiddenInput value='errv2010'>" & _
1520
                vbcrlf & "<input type=hidden name=dbname value='" & gDataSourceName & "'>" & _
1521
                vbcrlf & "<input type=hidden name='a' value='save'>" & vbcrlf )
1522
 
1523
 
1524
 
1525
    'End If
1526
 
1527
    If gHideWikiSource then
1528
       exit sub
1529
    end if
1530
 
1531
    'History of changes
1532
    response.write("<br><br><br><br><br><h3>History of Changes:</h3><textarea readonly style='font-size:8pt; background:silver;' rows='" & giEditAreaRows & "' cols='" & giEditAreaCols & _
1533
    "'  style='width:100%'>" & strPrevPageData & "</textarea>")
1534
 
1535
    'Original Text
1536
    response.Write("<textarea name=""pagetextorig"" rows=0 cols=0 style='width:0;'>" & strPageData & "</textarea></form>" )
1537
    response.Write("<script language=javascript>form1.pagetext.rows=window.screen.height/26;</script>")
1538
 
1539
    Session("CurrentEditPage") = "# "  & strTitle 
1540
end sub
1541
 
1542
 
1543
sub handleSearch
1544
 
1545
  dim pageTitle, s
1546
  's= Request.QueryString("o")  BUG - Fri, 2002 jan 22 - Dan Shaw
1547
  s= glsTopic
1548
  if not isEmpty(s) then
1549
    EmitDebug 42, 2, "<br/>SEARCH(" & s & ")<br/>" & vbcrlf
1550
    pageTitle = "Search Results (" & s & ")"
1551
    dim myClause
1552
    myClause= theWhereClause(s)
1553
    sqlQuery="select ID, Title, LastUpdate , LastEditor from " & gDbTableName & myClause & " order by Title"
1554
  end if
1555
 
1556
  EmitTabularOutput pageTitle, ""
1557
 
1558
end sub
1559
 
1560
'ElreyRonald 4/2004
1561
Sub HandleDelete
1562
    Dim sh
1563
    sh = "<br><a href='" & gScriptURL & "' >Click here proceed to home page</a>"
1564
 
1565
  ' Expecting delVerified=1 for deletion confirmation
1566
  Response.Write("<center><h2>Page Deletion</h2></center><hr>")
1567
  Response.Write("<center>")
1568
 
1569
  If Request.QueryString("delVerified") <> 1  Then
1570
    if gHideLogin Then
1571
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Cannot be created on this Server")
1572
          Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1573
    ElseIf NOT gEnableEdit Then
1574
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Cannot be deleted until you enable editing")
1575
          Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1576
    Else
1577
        Response.Write("<br><br><span style='border: solid 5px red; padding: 10px;display:inline-block'>")
1578
        response.write("Deletion of the page --> <b>" &  glsTopic & "</b>  <--- cannot be undone")
1579
        response.write("<br>Are your sure that you wish to continue!")
1580
        response.write( "<br><br><a href='" & gScriptURL & "&a=del&delVerified=1&o=" & glsTopic & "'><button style='color:red'>Delete this page.</button></a>" )
1581
        response.write( "&nbsp;&nbsp;<a href='" & gScriptURL & "'><button>No,  don't delete it.</button></a>" )
1582
        response.write( "</span>" )
1583
    End If
1584
  Else
1585
 
1586
      Dim topic
1587
      topic = Request.QueryString("o") ' Topic to delete
1588
      If IsNull(topic) or topic = "" Then
1589
        Response.Write( "Specify page name to delete i.e.  &o=MyPage" & sh)
1590
        Response.End
1591
      End If
1592
 
1593
      Dim stmnt
1594
      stmnt = "delete from WikiData where Title='" & topic & "'"
1595
      Set gDataConn = Server.CreateObject("ADODB.Connection")
1596
      on error resume next
1597
      gDataConn.Open ConnStr(1)
1598
      on error goto 0
1599
      on error resume next
1600
      gDataConn.execute(stmnt)
1601
      on error goto 0
1602
      If  gDataConn.errors.count = 0 then
1603
        Response.Write( "<b>" & topic & " </b> was successfully deleted. " )
1604
      Else
1605
        Response.Write( "<b>" & topic & " </b>  was not deleted due to some errors. " )
1606
      End if
1607
      Set gDataConn = nothing
1608
      Response.write  sh
1609
    End If
1610
    Response.Write("</center>")
1611
    Response.End
1612
end sub
1613
 
1614
Sub HandleConfig
1615
  Dim showSessionData
1616
 
1617
  Response.Write("<center><h2>Edit Configuration</h2></center><hr>")
1618
 
1619
  if gHideLogin Then
1620
      Response.Write("Configuration not available on this server")
1621
      Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1622
  ElseIf NOT gEnableEdit Then
1623
      Response.Write("Configuration not available until you enable editing")
1624
      Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1625
  Else
1626
      select case (glsTopic)
1627
          case "bde"
1628
              Session("BulkDelete") = 1
1629
              gBulkDelete = true
1630
 
1631
          case "bdd"
1632
              Session.Contents.Remove("BulkDelete")
1633
              gBulkDelete = false
1634
 
1635
          case "ssv"
1636
                showSessionData = true
1637
      end select
1638
 
1639
      response.write( "<br><a href='" & gScriptURL & "&a=config&o=ssv'><button>Show Session Variables</button></a>" )
1640
      If not gBulkDelete Then
1641
        response.write( "<br><a href='" & gScriptURL & "&a=config&o=bde'><button>Enable Bulk Delete</button></a>" )
1642
      Else
1643
        response.write( "<br><a href='" & gScriptURL & "&a=config&o=bdd'><button>Disable Bulk Delete</button></a>" )
1644
      End If
1645
      response.write( "<br><form action="&gScriptURL&"&a=config&o=cdb>"&_
1646
                            "<input type=submit value='Create New Wiki Database'>"&_
1647
                            "<input type=text name=db>"&_
1648
                            "<input type=hidden name=a value=config>"&_
1649
                            "<input type=hidden name=aa value=cdb>"&_
1650
                            "</form>" )
1651
      response.write( "<br><a href='" & gScriptURL & "'><button>Return to Wiki.</button></a>" )
1652
  End If
1653
 
1654
  If showSessionData Then WriteSessionData
1655
 
1656
  Response.End
1657
end sub
1658
 
1659
 
1660
'ElreyRonald 4/2004
1661
sub handleRss
1662
 
1663
  dim pageTitle, initialRow, s, sSortOrder
1664
  dim modifiedUrl
1665
 
1666
  sqlQuery="select top " & giNumRecentFiles & " ID, LastEditor, Title,PageData,PrevPageData, LastUpdate from " & gDbTableName & " order by LastUpdate DESC"
1667
 
1668
  sqlQuery = sqlQuery & sSortOrder
1669
 
1670
  set gDataConn = Server.CreateObject("ADODB.Connection")
1671
 
1672
  on error resume next
1673
  gDataConn.Open ConnStr(1)
1674
  on error goto 0
1675
 
1676
  if not (0 = gDataConn.errors.count) then
1677
    if (ADOERROR_NOFILE = gDataConn.errors(0).number) then
1678
      EmitDebug 54, 1, "<br/>ErrorCount(" & gDataConn.errors.count & ")<br/>" & vbcrlf
1679
      EmitDebug 55, 1, "<br/>Error(" & gDataConn.errors(0).number &") desc(" &_
1680
      gDataConn.errors(0).description & ")<br/>" & vbcrlf
1681
      VerifyWikiTable
1682
    end if
1683
  end if
1684
 
1685
  'set rs= gDataConn.execute(sqlQuery)
1686
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1687
 
1688
 
1689
  modifiedUrl = Replace(gScriptURL, "&", "&amp;")
1690
  if not rs.eof then
1691
    response.ContentType = "text/xml"
1692
    response.Write("<?xml version=""1.0"" encoding=""ISO-8859-1"" ?>")
1693
    response.Write(gRssStyle)
1694
    response.Write("<rss version=""2.0"">")
1695
    response.Write("<channel>")
1696
    response.Write("<title>" & SpaceName(gHomeTopic) & "</title> ")
1697
    response.Write("<link>" & gHttpDomain & "/" & modifiedUrl &  "&amp;a=rss</link> ")
1698
    Response.Write("<ttl>1000</ttl>")
1699
    response.Write("<description>Latest changes and postings for the topic:" & SpaceName(gHomeTopic) & ". </description> ")
1700
    response.Write("<copyright>Copyright (C)2003  Elrey Ronald Vel. All rights reserved.</copyright> ")
1701
    response.Write("<generator> WikiAsp RSS Generator by Elrey </generator> ")
1702
    Response.Write("<webMaster>lambda326@hotmail.com</webMaster>")
1703
    response.Write("<image><width>80</width><height>40</height>")
1704
    response.Write("<title>" & SpaceName(gHomeTopic) & "</title> ")
1705
    response.Write("<link>" & gHttpDomain & "/" & modifiedUrl & "</link> ")
1706
    If  left(gIconName,4) = "http" Then
1707
      response.Write("<url>" &  gIconName &" </url></image>")
1708
    Else
1709
      response.Write("<url>" & gHttpDomain & "/" & gIconName &" </url></image>")
1710
    End If
1711
 
1712
    Do while Not rs.eof
1713
      Response.Write("<item>")
1714
      Response.Write("<title>" & SpaceName(rs("Title"))&  "</title>")
1715
      Response.Write("<link>" & gHttpDomain & "/" & modifiedUrl & "&amp;o=" & rs("Title") & "</link> ")
1716
      Response.Write("<category>" & SpaceName(gHomeTopic) & "</category>")
1717
      Response.Write("<author>user@" & rs("LastEditor")& "</author>")
1718
      Response.Write("<description>")
1719
      Response.Write( "<![CD" & "ATA[ ")
1720
      If gHighlightFlag Then
1721
          Response.Write(  ProcessRssItem(rs) )
1722
      Else
1723
          Response.Write WalkWiki(xform(  rs("PageData")  ))
1724
      End If
1725
      Response.Write("]]></description>")
1726
      Response.Write("<pubDate>" & GetRFC822date(rs("LastUpdate")) & "</pubDate> ")
1727
      Response.Write("</item>")
1728
      rs.MoveNext
1729
      i= i+1
1730
    Loop
1731
 
1732
    response.Write( "</channel></rss>")
1733
  end if
1734
  Set gDataConn = nothing
1735
  Set rs = nothing
1736
end sub
1737
 
1738
 
1739
'Get the nth page in History
1740
'ElreyRonald
1741
Function GetPrevData(rs, n)
1742
   Dim arrD, tmpStr, i, cnt, getFlag
1743
   Dim prevData
1744
   prevData = rs("PrevPageData")
1745
   If    IsNull(prevData) Then
1746
      GetPrevData   = ""
1747
   Else
1748
 
1749
      arrD    =  Split( rs("PrevPageData"), vbCRLF)
1750
      cnt     = 0
1751
      getFlag = 0
1752
      tmpSTr  = ""
1753
      For i = 1 to UBound(arrD)
1754
         If left(arrD(i), 8) = "--------"   Then
1755
            cnt = cnt + 1
1756
            if getFlag = 1 Then Exit For
1757
            if  n =  cnt Then
1758
               getFlag = 1
1759
            end if
1760
         End If
1761
         If getFlag = 1 and left(arrD(i), 8) <> "--------" Then
1762
            tmpStr = tmpStr & arrD(i) & vbCRLF
1763
         End If
1764
 
1765
      Next
1766
      GetPrevData = tmpStr
1767
   End If
1768
End Function
1769
 
1770
 
1771
'Process the current record (rs) for RSS
1772
'ElreyRonald
1773
Function    ProcessRssItem(rs)
1774
   Dim currData, prevData, markedStr
1775
   Dim beginMark, endMark, tmpS
1776
   beginMark = "###s###"
1777
   endMark  = "###e###"
1778
   currData = rs("PageData")
1779
   prevData = GetPrevData( rs, 1 )
1780
   markedStr =  MarkWhatWasAdded( prevData, currData, beginMark , endMark)
1781
   tmpS = WalkWiki(xform(markedStr))
1782
   tmpS = Replace( tmpS, beginMark, "<U style='background:yellow' >")
1783
   tmpS = Replace( tmpS, endMark,   "</U>")
1784
   ProcessRssItem = tmpS
1785
End Function
1786
 
1787
Function MarkWhatWasAdded( prevData, currData, st, en)
1788
Dim arrCurrData, arrPrevData
1789
Dim currMaxIndex
1790
Dim prevMaxIndex, i
1791
arrCurrData  = Split( currData, vbCRLF)
1792
arrPrevData  = Split( prevData, vbCRLF)
1793
currMaxIndex =  UBound( arrCurrData )
1794
prevMaxIndex =  UBound( arrPrevData )
1795
If  prevMaxIndex <  0 Then
1796
  MarkWhatWasAdded = currData
1797
  Exit Function
1798
End If
1799
 
1800
Dim marked, prevPtr, started
1801
marked =    0
1802
prevPtr = 0
1803
started = 0
1804
'Search delta forward
1805
For i = 0 to prevMaxIndex
1806
   If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For
1807
Next
1808
prevPtr = i  'start here
1809
For i   = 0 to currMaxIndex
1810
   If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then
1811
 
1812
   Else
1813
      Started = 1
1814
      If    prevPtr <=  prevMaxIndex Then
1815
         If arrCurrData(i)  <>  arrPrevData( prevPtr) Then
1816
            if ( i > 0 ) then
1817
               if arrCurrData(i-1) = "" Then
1818
                 arrCurrData(i-1)   =  vbCRLF & arrCurrData(i-1) & st
1819
               else
1820
                 arrCurrData(i-1)   = arrCurrData(i-1) & st
1821
               end if
1822
            else
1823
               arrCurrData(i)   = st &   vbCRLF & arrCurrData(i)
1824
            end if
1825
            marked =    1
1826
            Exit For
1827
         End If
1828
         prevPtr = prevPtr + 1
1829
         if prevPtr >  prevMaxIndex and i < currMaxIndex then
1830
            arrCurrData(i)  = arrCurrData(i+1) & st
1831
            marked = 1
1832
            exit for
1833
         end if
1834
      End If
1835
   End If
1836
Next
1837
 
1838
If  marked =    0 Then
1839
   MarkWhatWasAdded = currData
1840
   exit function
1841
End If
1842
 
1843
'Search delta Backwards
1844
For i = prevMaxIndex to 0 step -1
1845
   If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For
1846
Next
1847
Dim pi
1848
pi  = i
1849
started = 0
1850
For i   = currMaxIndex  to  0 step -1
1851
  If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then
1852
     ' do nothing
1853
  Else
1854
    Started  = 1
1855
    If  pi  >= 0 Then
1856
      'Response.Write "backward Compare " & Cstr(i) & "-" & Cstr(pi) &" [" &arrCurrData(i) & "]=["& arrPrevData(pi) & "] " &    vbCRLF
1857
      If    arrCurrData(i)  <>  arrPrevData(pi) Then
1858
         arrCurrData(i) = arrCurrData(i) & en
1859
         Exit For
1860
      End If
1861
      pi    = pi - 1
1862
      if pi < 0 and i > 0 then
1863
         arrCurrData(i-1)   = arrCurrData(i-1) & en
1864
         exit for
1865
      End if
1866
    End If
1867
  End If
1868
Next
1869
 
1870
Dim sres
1871
sres = ""
1872
For i   = 0 to currMaxIndex
1873
   sres = sres  & arrCurrData(i) & vbCRLF
1874
Next
1875
MarkWhatWasAdded = sres
1876
 
1877
End Function
1878
 
1879
 
1880
 
1881
 
1882
sub handleList
1883
 
1884
  dim pageTitle, initialRow, s, sDirection, sSortOrder, sNextDirectionTitle, sNextDirectionDate
1885
  ' Request.ServerVariables("HTTP_REFERER")
1886
 
1887
  initialRow= ""
1888
  s = Request.QueryString("o")
1889
  EmitDebug 43, 2, "<br/>" & s & "<br/>" & vbcrlf
1890
  if (s = "recent") then
1891
    pageTitle = "Recently Modified Topics"
1892
    sqlQuery="select top " & giNumRecentFiles & " ID, Title, LastUpdate, LastEditor from " & gDbTableName & " order by LastUpdate DESC"
1893
  else
1894
    pageTitle = "List of All Topics"
1895
    sqlQuery= "select ID, Title, LastUpdate , LastEditor from " & gDbTableName & " order by "
1896
    sDirection = Request.QueryString("d")
1897
 
1898
    if (s = "ByDate") then
1899
      sqlQuery = sqlQuery & "LastUpdate "
1900
      if (sDirection = "down") then
1901
    sSortOrder = ""  ' the reverse natural sort order (oldest first)
1902
    sNextDirectionDate= ""
1903
      else
1904
    sSortOrder = "DESC"  ' the natural sort order (most recent first)
1905
    sNextDirectionDate= "&d=down"
1906
      end if
1907
    elseif (s = "ByTitle") then
1908
      sqlQuery = sqlQuery & "Title "
1909
      if (sDirection = "down") then
1910
    sSortOrder = "DESC"   ' the reverse natural sort order (alphabetic)
1911
    sNextDirectionTitle = ""
1912
      else
1913
    sSortOrder = ""   ' the natural sort order (alphabetic)
1914
    sNextDirectionTitle = "&d=down"
1915
      end if
1916
    end if
1917
 
1918
    sqlQuery = sqlQuery & sSortOrder
1919
 
1920
 
1921
    'initialRow= "<tr style='background-color:White;'> <td></td><td align='right'><a href='" & gScript & "?a=list&o=ByTitle" & sNextDirectionTitle & "'>Sort</a></td> <td align='right'><a href='" & gScript & "?a=list&o=ByDate" & sNextDirectionDate & "'>Sort</a></td></tr>"
1922
    initialRow= "<tr style='background-color:White;'> <td></td><td align='right'><a href='" & gScriptURL & "&a=list&o=ByTitle" & sNextDirectionTitle & "'>Sort by Title</a></td> <td align='right'><a href='" & gScriptURL & "&a=list&o=ByDate" & sNextDirectionDate & "'>Sort by Date</a></td></tr>"
1923
 
1924
 
1925
  end if
1926
 
1927
  EmitTabularOutput pageTitle, initialRow
1928
 
1929
end sub
1930
 
1931
 
1932
 
1933
sub EmitTabularOutput(pageTitle, initialRow)
1934
 
1935
  EmitDebug 44, 2, "<br/>query(" & sqlQuery & ")<br/>" & vbcrlf
1936
 
1937
  'set rs= gDataConn.execute(sqlQuery)
1938
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1939
 
1940
  Call WriteBanner(pageTitle,"")
1941
 
1942
  if not rs.eof  then
1943
'    Response.write("<h2>" & pageTitle & ":</h2>)
1944
    Response.write("<table cellpadding=5  cellspacing=0 border=0 >" & vbcrlf)
1945
    i = 1
1946
    if not isEmpty(initialRow) then
1947
      Response.write initialRow & vbcrlf
1948
    end if
1949
    Do while (Not rs.eof )
1950
      if (i mod 2 = 0) then
1951
          Response.Write("<tr style=""background-color:whitesmoke;"">")
1952
      else
1953
          Response.Write("<tr style=""background-color:lightcyan;"">")
1954
      end if
1955
 
1956
      Dim deleteColumn
1957
      deleteColumn = ""
1958
 
1959
      ' Allow bulk deletion
1960
      If (gBulkDelete)  Then
1961
          deleteColumn = "<td class='tabular'><a href=""" & gScriptURL & "&o=" & rs("Title")&"&a=del&delVerified=1" & """>[Delete Page]</td>"
1962
      End If
1963
 
1964
      Response.Write("<td class='tabular'>" & i & ".</td><td class='tabular'><a href=""" &_
1965
                  gScriptURL & "&o=" & rs("Title") & """>" & rs("Title") & "</a></td> <td class='tabular'>" & _
1966
                  rs("LastUpdate") & " by " & rs("LastEditor")& "</td>" &  deleteColumn & _
1967
                  "</tr>" &  vbcrlf)
1968
      i= i+1
1969
      rs.MoveNext
1970
    Loop
1971
    Response.write("</table>" & vbcrlf)
1972
  else
1973
'    Response.write("<h2>" & pageTitle & ":</h2>)
1974
    Response.write("<table style='border: 1px solid gainsboro'>" & vbcrlf)
1975
    Response.write("<tr><td>This topic is not mentioned on any other page! </td></tr>" & vbcrlf)
1976
    Response.write("</table>" & vbcrlf)
1977
  end if
1978
 
1979
   Call WriteFooter("","",""  )
1980
end sub
1981
 
1982
 
1983
sub handleSave
1984
  if gDisableSave = "yes" then
1985
    exit sub
1986
  end if
1987
 
1988
  dim sText, dts, sLupdt
1989
  dim sChanges, sTextOrig
1990
  sText=request.Form("pagetext")
1991
  sTextOrig=request.Form("pagetextorig")
1992
  sLupdt=request.Form("lupdt")  ' last update (ElreyRonald)
1993
 
1994
 
1995
  Dim lastPageEdited
1996
  if IsEmpty (Session("CurrentEditPage") ) Then
1997
        lastPageEdited = "*"
1998
        Exit Sub
1999
  else
2000
    lastPageEdited =Session("CurrentEditPage")
2001
  end if
2002
 
2003
  If not IsRequestFromWikiASPPage Then
2004
     response.write("1:>" & remoteIPHost & " - " & remoteIPAddr  )
2005
     response.end
2006
     exit sub
2007
  End if
2008
 
2009
  If IsRemoteAdressBlackListedRE Then
2010
     response.write("2:>" & remoteIPHost & " - " & remoteIPAddr  )
2011
     exit sub
2012
  End if
2013
 
2014
  If IsRemoteBlackListed Then
2015
     response.write("3:>" & remoteIPHost & " - " & remoteIPAddr  )
2016
     exit sub
2017
  End if
2018
 
2019
  sqlQuery = "select Title,PageData, lastupdate , PrevPageData, LastEditor from " & gDbTableName & " where title='" & glsTopic & "'"
2020
  EmitDebug 45, 2, "<br/>save-check query(" & sqlQuery & ")<br/>" & vbcrlf
2021
 
2022
 
2023
  'set rs = gDataConn.execute(sqlQuery)
2024
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007          
2025
 
2026
  dts = Now
2027
 
2028
  'update record
2029
  if not rs.eof then
2030
 
2031
 
2032
 
2033
      EmitDebug 46, 2, "Record already exists....<br/>" & vbcrlf
2034
 
2035
      ' check if someone has updated the record while you were editing (ElreyRonald)
2036
      if  Trim(Cstr( rs("lastupdate"))) <> Trim(sLupdt) then
2037
        response.write("<html><head></head><body>")
2038
        Response.Write(  "["& Trim(Cstr( rs("lastupdate"))) & "]["& Trim(sLupdt)& "]<br>" )
2039
        Response.Write("<b>Sorry! That page is being edited by another user or is in the process of being saved. <br>Your changes were not saved.</b>" )
2040
 
2041
        response.write( "<br><br> <a href='" & gScriptURL & "&a=edit&o=" & glsTopic & "'>Click here to re-edit the page. </a>" )
2042
        response.end
2043
      else
2044
 
2045
      ' consolidate a series of trailing vbcrlf to just 2.
2046
      gRE.Pattern = "(\r\n){3,}$"
2047
      sText=gRE.Replace(sText, vbcrlf & vbcrlf)
2048
 
2049
      ' replace 8 spaces with tab (ElreyRonald)
2050
      sText = replace(sText, vbcrlf & "        *", vbcrlf & chr(9) & "*" )
2051
      sText = replace(sText, vbcrlf & chr(9) & " :        ", vbcrlf & chr(9)& " :" & chr(9) )
2052
 
2053
      If abs( len(sText) - len(sTextOrig) ) > 10 Then
2054
        sChanges =  vbcrlf & vbcrlf & "@@@@@@@@@@@@@@@@" & rs("lastupdate") & " : " & _
2055
          rs("lasteditor") & "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" & vbcrlf & vbcrlf &  rs("PageData")  & rs("PrevPageData")
2056
        sChanges =  left(sChanges, 15000)
2057
      else
2058
        sChanges = rs("PrevPageData")
2059
      End if
2060
 
2061
      sqlQuery = "UPDATE " & gDbTableName & " SET PageData='" &_
2062
      safeQuote(sText) & "',PrevPageData='" & safeQuote(  sChanges   ) &_
2063
      "',LastUpdate='" & dts & "', LastEditor='" & remoteIPHost  &_
2064
      "'  WHERE title='" & rs("title") & "'"
2065
 
2066
 
2067
      EmitDebug 47, 1, "update sqlQuery(" & sqlQuery & ")<br/>"
2068
 
2069
      'gDataConn.execute(sqlQuery)
2070
 
2071
      call WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
2072
 
2073
 
2074
      end if
2075
      ' new record
2076
  else
2077
 
2078
 
2079
      EmitDebug 48, 2, "Record does not exist, inserting...." & vbcrlf
2080
      sqlQuery = "INSERT INTO " & gDbTableName & " (Title,PageData,LastEditor,LastUpdate) " & _
2081
      "VALUES ('" & glsTopic   & "', '" & safeQuote(sText) & "', '" & remoteIPHost   &_
2082
       "', '" & dts & "')"
2083
      EmitDebug 49, 1, "<br/>sqlQuery(" & sqlQuery & ")<br/>"
2084
 
2085
      'gDataConn.execute(sqlQuery)
2086
 
2087
      call WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
2088
 
2089
 
2090
  end if
2091
 
2092
  ' direct to the newly saved page :
2093
  'Response.Redirect gScript & "?" & glsTopic
2094
  Response.Redirect gScriptURL & "&o=" & glsTopic
2095
 
2096
end sub
2097
 
2098
Sub WriteBanner(title,search)
2099
      Dim iconPart, bannerPart, bannerTextPart
2100
      iconPart = "<a  href='" & gScriptURL & "'><img src='" & gIconName & "' border='0' alt='Go to Start Page'></a>"
2101
 
2102
      if search <> "" then
2103
         bannerTextPart = "<a  title='Search for references to " & title & "' href='" & gScriptURL & "&a=search&o=" & search & "'>" &  SpaceName(title) & "</a>"
2104
      else
2105
         bannerTextPart = SpaceName(title)
2106
      end if
2107
 
2108
      If gBannerTemplate = "" Then
2109
         bannerPart = ""
2110
         bannerPart =  bannerPart &  "<a href='" & gScriptURL & "'>Wiki Home</a>"
2111
         bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=list&o=ByTitle' title='this may take a loooong time'>List all pages</a>"
2112
         if ( NOT gHideLogin ) Then
2113
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2114
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<span style='color: #FF0000;font-weight: bold;'>Development Web Server</span>"
2115
            if (search <> "") AND (gEnableEdit) then
2116
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=edit&o=" & search & "'>Edit page</a>"
2117
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=del&o=" & search & "'>Del page</a>"
2118
            end if
2119
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ReleaseNotes&o=TextFormattingRules'>Formatting Rules</a>"
2120
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ReleaseNotes'>Release Notes</a>"
2121
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ImplementationNotes'>"& gDevNotePrefix &" Dev Notes</a>"
2122
            if gEnableEdit Then
2123
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=config&o='>Config</a>"
2124
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=logout&o=" & search & "'>Disable Editing</a>"
2125
            Else
2126
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=login&o=" & search & "'>Enable Editing</a>"
2127
            End If
2128
         End If
2129
         bannerPart =  bannerPart &  "<hr>"
2130
 
2131
         bannerPart =  bannerPart &  " <table class='cssBannerTable' id='idBannerTable' cellSpacing='0' cellPadding='0' border='0'>"
2132
         bannerPart =  bannerPart &  "    </tr>"
2133
         bannerPart =  bannerPart &  "    <tr class='cssBannerRow' id='idBannerRow'> "
2134
         bannerPart =  bannerPart &  "          <td class='cssBannerCellIcon' id='idBannerCellIcon' valign='top'> $$icon$$</td>"
2135
         bannerPart =  bannerPart &  "          <td width=90% class='cssBannerCellText' id='idBannerCellText' valign='bottom' align='left' >"
2136
         bannerPart =  bannerPart &  "            <h1 class='cssBannerSpanText' id='idBannerSpanText'>$$banner_text$$</h1>"
2137
         bannerPart =  bannerPart &  "          </td>"
2138
         bannerPart =  bannerPart &  "          <td>"
2139
         bannerPart =  bannerPart &  "          <td class='cssTopSearch'id='idTopSearch' >"         	
2140
         If not gHideTopSearch Then
2141
             bannerPart =  bannerPart &  "          <form method=POST action='wiki.asp?a=search&db="& gDataSourceFile &"' id=search001 name=search001 >" & gSearchLabel & "<br/><input class='cssTopSearchbox' id='idTopSearchbox' title='Click and enter search text here!' size=12 type=text name=o value='" & gDataSourceFile & "' onclick=this.value="""" /></form>&nbsp;&nbsp;&nbsp;&nbsp;"
2142
         End If
2143
         bannerPart =  bannerPart &  "          </td><td>&nbsp;&nbsp;&nbsp;</d>"
2144
         bannerPart =  bannerPart &  "    </tr>"
2145
         bannerPart =  bannerPart &  " </table>"
2146
 
2147
      Else
2148
 
2149
         bannerPart = gBannerTemplate
2150
      End if
2151
 
2152
      bannerPart = Replace( bannerPart, "$$icon$$", iconPart)
2153
      bannerPart = Replace( bannerPart, "$$banner_text$$", bannerTextPart)
2154
 
2155
 
2156
      Response.Write ( bannerPart )
2157
 
2158
End Sub
2159
 
2160
Sub WriteFooter(hideScript,lastUpdate,lastEditor)
2161
      If Not gHideWikiFooter Then
2162
          response.write "<div id=wikifooter class=footer ><form method='POST' action=""" & gScript & """ id=""formFooter"" name=""formFooter""><br>"
2163
          response.write "<hr size=1 noshade=true>"
2164
 
2165
          If Not gHideLastEditor Then
2166
            if lastUpdate <> "" Then
2167
                response.write "<span title='Click this now to prepare page for Printing by removing unnecessary portions! ' onclick=""" & hideScript & """ ><font size=-1>Last Updated " & lastUpdate & " by '" & lastEditor &  "' </font></span><br/>"
2168
            End If
2169
          end if
2170
          response.write "<font size=-1>Domain: " & gHttpDomain & "</font><br>"
2171
 
2172
'          response.write "<a href='" & gScriptURL & "' title='GO TO START PAGE'>Home</a> | "
2173
'          if  Not gHideLogin Then
2174
'            response.write "<a href='" & gScriptURL & "&a=edit&o=" & rs("title") & "'>Edit page</a> | "
2175
'          end if
2176
'          response.write "<a href='" & gScriptURL & "&a=logout&o=" & rs("title") & "'>Log out</a> | "
2177
'          response.write "<a href='" & gScriptURL & "&a=list&o=ByTitle'>List pages</a> |  "
2178
'          response.write "<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2179
'          If gHttpDomain <> "" Then
2180
'            response.write " | <a href='" & gScriptURL & "&a=rss' ><span style='background:#FF6600;text-decoration:none;font-family:tahoma;' >&nbsp;<b><font color=white>RSS</font></b>&nbsp;</span></a>"
2181
'          End If
2182
'
2183
'          response.write "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"&gSearchLabel&"&nbsp;<input title='Type in your search terms and press [Enter]' type='text' name='o' value=''/><input type='hidden' name='db' value='"& gDataSourceFile & "'><input type='hidden' name='dbname' value='" & gDataSourceName & "'><input type='hidden' name='a' value='search'></form></div> "
2184
 
2185
          response.write "<font size='-1'>WikiAsp Engine version:  " & gEngineVersion & "</font>" & vbcrlf
2186
'          response.write "<br><font size='-1'>gScriptURL:  " & gScriptURL & "</font>" & vbcrlf
2187
          response.write "</div>"
2188
      End If
2189
End Sub
2190
 
2191
Sub WriteSessionData
2192
    Dim name
2193
    If 0 Then
2194
        ' Display all the Server Request Variables
2195
        %>
2196
        <h1>Server Request Variables</h1>
2197
        <div align="left">
2198
        <table border="0" cellpadding="0" cellspacing="0" width="850">
2199
        <tr>
2200
        <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2201
        <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2202
        </tr>
2203
        <%
2204
        for each name in request.servervariables
2205
            %>
2206
            <tr>
2207
            <td valign="top" align="left" width="250">
2208
            <font face="Arial" size="1" color="#FF0000">
2209
            <%= name %></font></td>
2210
            <td valign="top" align="left" width="600">
2211
            <font face="Arial" size="1"><%= request.servervariables(name) %></font></td>
2212
            </tr>
2213
            <%
2214
        Next
2215
        %>
2216
        </table>
2217
        </div>
2218
        <%
2219
    End If
2220
    ' Display all the Contents of the Session Variable
2221
    %>
2222
    <h1>Session Variables</h1>
2223
    <div align="left">
2224
    <table border="0" cellpadding="0" cellspacing="0" width="850">
2225
    <tr>
2226
    <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2227
    <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2228
    </tr>
2229
    <%for each name in Session.Contents%>
2230
    <tr>
2231
    <td valign="top" align="left" width="250">
2232
    <font face="Arial" size="1" color="#FF0000"><%= name %></font></td>
2233
    <td valign="top" align="left" width="600">
2234
    <%If VarType(Session(name)) < 100 Then %>
2235
    <font face="Arial" size="1">[<%=TypeName(Session(name))%>:<%=VarType(Session(name))%>]&nbsp;<%=Session(name) %></font></td>
2236
    <%Else%>
2237
    <font face="Arial" size="1">[<%=TypeName(Session(name))%>:<%=VarType(Session(name))%>]</font></td>
2238
    <%End If%>
2239
    </tr>
2240
    <%Next%>
2241
    <tr>
2242
    <td><font face="Arial" size="1" color="#FF0000">Timeout</font></td>
2243
    <td><font face="Arial" size="1"><%=Session.Timeout%></font></td>
2244
 
2245
    <tr>
2246
    <td><font face="Arial" size="1" color="#FF0000">SessionId</font></td>
2247
    <td><font face="Arial" size="1"><%=Session.SessionId%></font></td>
2248
    </table>
2249
    </div>
2250
 
2251
    <%
2252
    ' Display all the Contents of the Application Variable
2253
    %>
2254
    <h1>Application Variables</h1>
2255
    <div align="left">
2256
    <table border="0" cellpadding="0" cellspacing="0" width="850">
2257
    <tr>
2258
    <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2259
    <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2260
    </tr>
2261
    <%
2262
    for each name in Application.Contents
2263
    %>
2264
    <tr>
2265
    <td valign="top" align="left" width="250">
2266
    <font face="Arial" size="1" color="#FF0000">
2267
    <%= name %></font></td>
2268
    <td valign="top" align="left" width="600">
2269
    <font face="Arial" size="1"><%= Application(name) %></font></td>
2270
    </tr>
2271
    <%
2272
    Next
2273
    %>
2274
    </table>
2275
    </div>
2276
    <%
2277
End Sub
2278
 
2279
Sub HandleBrowse
2280
 
2281
  sqlQuery = "select PageData,Title,LastEditor,LastUpdate from " & gDbTableName & " where title='" & glsTopic & "'"
2282
  EmitDebug 50, 2, "Browse query(" & sqlQuery & ")<br/>" & vbcrlf
2283
 
2284
  set rs = gDataConn.execute(sqlQuery)
2285
 
2286
  if rs.eof=true then
2287
        Response.Write("<center><h2>Page Creation</h2><hr>")
2288
    if gHideLogin Then
2289
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Does not exit and it cannot be created on this Server")
2290
    ElseIf NOT gEnableEdit Then
2291
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Does not exit and it cannot be created until you enable editing")
2292
    Else
2293
        Response.Write("<br><br><span style='border: solid 2px black; padding: 10px;display:inline-block'>")
2294
        response.write("The page --> <b>" &  glsTopic & "</b>  <--- does not exist.")
2295
        response.write("<br><br><a href='" & gScriptURL & "&a=edit&o=" & glsTopic & "'><button style='color:red'>Create this page.</button></a>" )
2296
        response.write("&nbsp;&nbsp;<a href='" & gScriptURL & "'><button>Don't create page.</button></a>" )
2297
        Response.Write("</span>")
2298
    End If
2299
        Response.Write("</center>")
2300
 
2301
  else
2302
      EmitDebug 51, 3, "found...(" & rs("PageData") & ")<br/>" & vbcrlf
2303
 
2304
      If gEnableEdit Then
2305
        response.write" <body ondblclick=" & chr(34) & "document.location.href='" & _
2306
            gScriptURL & "&a=edit&o=" & glsTopic    & "'" & chr(34) &">"
2307
      Else
2308
         response.write" <body >"
2309
 
2310
      End If
2311
 
2312
      Call WriteBanner(rs("title"),rs("title"))
2313
      response.write " <div class='wikibody'>" & WalkWiki(  xform( "<span id=bodyPrefix>" & vbcrlf & gWikiBodyPrefix & VbCrLF & "</span>" & VbCrLF &  rs("PageData")))  ' Elrey - xform func now removes html
2314
      response.write "</b></i></font></u></strong></font>"
2315
 
2316
 
2317
      dim hideScript
2318
      hideScript = "var div1=document.getElementById('wikifooter'); if (div1) {div1.style.display='none';}"
2319
      hideScript = hideScript & "div1=document.getElementById('bodyPrefix'); if (div1) {div1.style.display='none';}"
2320
      hideScript = hideScript & "div1=document.getElementById('idTopSearch'); if (div1) {div1.style.display='none';}"
2321
 
2322
      Call WriteFooter(hideScript, rs("LastUpdate"), rs("LastEditor")  )
2323
  end if
2324
 
2325
end sub
2326
 
2327
 
2328
 
2329
sub handleCreate
2330
    If gHideLogin Then
2331
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed</h2></center>")
2332
        Response.End
2333
        exit sub
2334
    End If
2335
 
2336
    If NOT gEnableEdit Then
2337
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed until logged in</h2></center>")
2338
        Response.End
2339
        exit sub
2340
    End If
2341
 
2342
  on error resume next
2343
  VerifyWikiTable
2344
  on error goto 0
2345
  Response.Redirect gScriptURL
2346
end sub
2347
 
2348
 
2349
'Intercept RSS request here
2350
if ( glsMode = "rss" ) then
2351
  If ( gHttpDomain = "" ) then
2352
    response.write("RSS is not enabled")
2353
  Else
2354
    handleRss
2355
  End If
2356
  response.End
2357
end if
2358
 
2359
'********************************************************************
2360
'*********************************************************************
2361
'<?xml version="1.0" encoding="UTF-8" ?>
2362
'<!DOCTYPE html
2363
'     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
2364
'     "DTD/xhtml1-transitional.dtd">
2365
'
2366
 
2367
    Response.Buffer=TRUE
2368
%>
2369
<html>
2370
    <head>
2371
        <meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
2372
        <title>
2373
<%
2374
        if not isEmpty(glsMode) and glsMode <> "browse" then
2375
            response.write(glsMode & " ")
2376
        end if
2377
        response.write(SpaceName(glsTopic))
2378
%>
2379
        </title>
2380
        <LINK REL="StyleSheet" HREF="<%=gStyleSheet%>" TYPE="text/css" >
2381
<%
2382
       Response.Write(gHtmlHeadStr)
2383
%>
2384
    <link rel="shortcut icon" href="<%=gFavIcon%>"/>
2385
    </head>
2386
    <body>
2387
 
2388
    <%
2389
 
2390
      if  Session("Hits") = "" then
2391
    Session("Hits")= 1
2392
      else
2393
    Session("Hits")= Session("Hits") + 1
2394
      end if
2395
 
2396
      EmitDebug 52, 1, "debug(" & gDebug & ")<br/>" & vbcrlf
2397
      EmitDebug 53, 1, "<br/>QueryString = (" & Request.QueryString & ")<br/>" & _
2398
    "Hits(" & Session("Hits") & ")<br/>" & _
2399
    "mode(" & glsMode & ")<br/>" & _
2400
    "topic(" & glsTopic & ")<br/>"
2401
 
2402
      set gDataConn = Server.CreateObject("ADODB.Connection")
2403
 
2404
      ' 21 nov - need resume next to catch "no file" error
2405
      on error resume next
2406
      gDataConn.Open ConnStr(1)
2407
      on error goto 0
2408
 
2409
      if not (0 = gDataConn.errors.count) then
2410
    if (ADOERROR_NOFILE = gDataConn.errors(0).number) then
2411
      EmitDebug 54, 1, "<br/>ErrorCount(" & gDataConn.errors.count & ")<br/>" & vbcrlf
2412
      EmitDebug 55, 1, "<br/>Error(" & gDataConn.errors(0).number &") desc(" &_
2413
        gDataConn.errors(0).description & ")<br/>" & vbcrlf
2414
      VerifyWikiTable
2415
    end if
2416
      end if
2417
 
2418
    select case (glsMode)
2419
        case "edit"    handleEdit
2420
        case "list"    handleList
2421
        case "search"  handleSearch
2422
        case "create"  handleCreate
2423
        case "save"    handleSave
2424
        case "browse"  handleBrowse
2425
        case "logout"  handleLogout
2426
        case "login"   handleLogin
2427
        case "del"     handleDelete
2428
        case "config"  handleConfig
2429
        case else
2430
    end select
2431
 
2432
    EmitDebug 56, 2, "<br/>done...<br/>" & vbcrlf
2433
    gDataConn.Close()
2434
    set gDataConn = nothing
2435
    %>
2436
 
2437
<% Response.Write(gFooterHtml) %>
2438
<% Response.Flush  %>
2439