Subversion Repositories DevTools

Rev

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