Subversion Repositories DevTools

Rev

Details | Last modification | View Log | RSS feed

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