Subversion Repositories DevTools

Rev

Rev 6324 | 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,"")
6709 dpurdie 869
 
870
  ' Remove lines as the end of a section
871
  gRE.Pattern = "(\r\n)+== "
872
  newText=gRE.Replace(newText,vbCrLf & "== ")
873
 
874
  ' Remove lines as the end of the page
875
  gRE.Pattern = "(\r\n)+$"
876
  newText=gRE.Replace(newText,"" )
877
 
3959 dpurdie 878
 
1405 dpurdie 879
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey
880
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:80pt;"">")
881
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:60pt;"">")
882
  newText=replace(newText,vbcrlf & "&gt;&gt;",vbcrlf & "<p style=""margin-left:40pt;"">")
883
  newText=replace(newText,vbcrlf & "&gt;",vbcrlf & "<p style=""margin-left:20pt;"">")
884
 ' Elrey 3/2007
6709 dpurdie 885
 newText=replace(newText,vbcrlf & ">>>>>>>>>*",vbcrlf & "<p class='windent' class='windent' style=""margin-left:135pt;margin-top:2pt;"">&#9827;&nbsp;")
886
 newText=replace(newText,vbcrlf & ">>>>>>>>*",vbcrlf & "<p class='windent' style=""margin-left:120pt;margin-top:2pt;"">&#8574;&nbsp;")
887
 newText=replace(newText,vbcrlf & ">>>>>>>*",vbcrlf & "<p class='windent' style=""margin-left:105pt;margin-top:2pt;"">&#959;&nbsp;")
888
 newText=replace(newText,vbcrlf & ">>>>>>*",vbcrlf & "<p class='windent' style=""margin-left:90pt;margin-top:2pt;"">&#8226;&nbsp;")
889
 newText=replace(newText,vbcrlf & ">>>>>*",vbcrlf & "<p class='windent' style=""margin-left:75pt;margin-top:2pt;"">&#9830;&nbsp;")
890
 newText=replace(newText,vbcrlf & ">>>>*",vbcrlf & "<p class='windent' style=""margin-left:60pt;margin-top:2pt;"">&#8594;&nbsp;")
891
 newText=replace(newText,vbcrlf & ">>>*",vbcrlf & "<p class='windent' style=""margin-left:45pt;margin-top:2pt;"">&#9674;&nbsp;")
892
 newText=replace(newText,vbcrlf & ">>*",vbcrlf & "<p class='windent' style=""margin-left:30pt;margin-top:2pt;"">&#959;&nbsp;")
893
 newText=replace(newText,vbcrlf & ">*",vbcrlf & "<p class='windent' style=""margin-left:15pt;margin-top:2pt;"">&#8226;&nbsp;")
1405 dpurdie 894
 
895
 
896
 
897
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey  updated 3/2007
6709 dpurdie 898
  newText=replace(newText,vbcrlf & ">>>>>>>>>",vbcrlf & "<p class='windent' style=""margin-left:135pt;margin-top:2pt;"">")
899
  newText=replace(newText,vbcrlf & ">>>>>>>>",vbcrlf & "<p class='windent' style=""margin-left:120pt;margin-top:2pt;"">")
900
  newText=replace(newText,vbcrlf & ">>>>>>>",vbcrlf & "<p class='windent' style=""margin-left:105pt;margin-top:2pt;"">")
901
  newText=replace(newText,vbcrlf & ">>>>>>",vbcrlf & "<p class='windent' style=""margin-left:90pt;margin-top:2pt;"">")
902
  newText=replace(newText,vbcrlf & ">>>>>",vbcrlf & "<p class='windent' style=""margin-left:75pt;margin-top:2pt;"">")
903
  newText=replace(newText,vbcrlf & ">>>>",vbcrlf & "<p class='windent' style=""margin-left:60pt;margin-top:2pt;"">")
904
  newText=replace(newText,vbcrlf & ">>>",vbcrlf & "<p class='windent' style=""margin-left:45pt;margin-top:2pt;"">")
905
  newText=replace(newText,vbcrlf & ">>",vbcrlf & "<p class='windent' style=""margin-left:30pt;margin-top:2pt;"">")
906
  newText=replace(newText,vbcrlf & ">",vbcrlf & "<p class='windent' style=""margin-left:15pt;margin-top:2pt;"">")
1405 dpurdie 907
 
908
 
909
 
910
 
911
  ' newlines: three newlines = a blank line
912
  newText=replace(newText,vbcrlf & vbcrlf & vbcrlf,vbcrlf & "<br/>&nbsp;<br/></p><p>" & vbcrlf )
913
 
914
  ' newlines: two newlines = a hard return
915
  newText=replace(newText,vbcrlf & vbcrlf,vbcrlf & "<br/></p><p>" & vbcrlf )
916
 
917
 
918
  EmitDebug 10, 4, "xform-before(" &  newText & ")<br/>"
919
 
920
  If right(newText,2) <> vbcrlf Then
921
    newText = newText & vbcrlf
922
  End If
923
 
924
  'David Purdie
5482 dpurdie 925
  newText=replace(newText, "$Page$", glsTopicClean )
926
  newText=replace(newText, "$image$", "local:images/page_" + glsTopicClean )
927
  newText=replace(newText, "$domain$", glsTopicClean )
1405 dpurdie 928
 
929
  ' toc david
930
  newText = AddAnchors(newText)
931
 
932
  'Elrey Ronald
933
  newText=replaceListPattern(newText, "        *", "<ul>", "</ul>", "<li> ", "</li>")
934
  newText=replaceListPattern(newText, "        :*", "<ol>", "</ol>", "<li> ", "</li>")
3959 dpurdie 935
  newText=replaceListPattern(newText, "        1.", "<ol class='nlist'>", "</ol>", "<li> ", "</li>")
1405 dpurdie 936
 
937
  'Elrey Ronald - more convenient bullet list
938
  newText=replaceListPattern(newText, " *", "<ul>", "</ul>", "<li> ", "</li>")
939
  newText=replaceListPattern(newText, " :*", "<ol>", "</ol>", "<li> ", "</li>")
3959 dpurdie 940
  newText=replaceListPattern(newText, " 1.", "<ol class='nlist'>", "</ol>", "<li> ", "</li>")
1405 dpurdie 941
 
942
  'Elrey Ronald - Table Pattern
943
  newText=replaceListPattern(newText, "||^!|^|!^!!", "<table border=1 class=TableClass>", "</table>", "_tmp_0^_tmp_1^_tmp_2^_tmp_3", "</td></tr>")
944
 
945
  newText=replaceTableColumnPattern(newText)
946
 
947
  ' leading space rule
948
  newText = PreHack(newText)
949
 
950
' outline ( ElreyRonald )
951
 
952
  gRE.Pattern = "\r\n\[(\d+)\]======([^\r\n]+)"
953
  newText=gRE.Replace(newText,"<h6>[<a name='$1' href='#fn_$1'>$1</a>] $2</h6>")
954
  gRE.Pattern = "\r\n\[(\d+)\]=====([^\r\n]+)"
955
  newText=gRE.Replace(newText,"<h5>[<a name='$1' href='#fn_$1'>$1</a>] $2</h5>")
956
  gRE.Pattern = "\r\n\[(\d+)\]====([^\r\n]+)"
957
  newText=gRE.Replace(newText,"<h4>[<a name='$1' href='#fn_$1'>$1</a>] $2</h4>")
958
  gRE.Pattern = "\r\n\[(\d+)\]===([^\r\n]+)"
959
  newText=gRE.Replace(newText,"<h3>[<a name='$1' href='#fn_$1'>$1</a>] $2</h3>")
960
  gRE.Pattern = "\r\n\[(\d+)\]==([^\r\n]+)"
961
  newText=gRE.Replace(newText,"<h2>[<a name='$1' href='#fn_$1'>$1</a>] $2</h2>")
962
 
963
  ' footnote ( ElreyRonald )
964
 
965
  gRE.Pattern = "\r\n\[(\d+)\]\r\n"    ' blank footnote will just be an anchor (ElreyRonald)
966
  newText=gRE.Replace(newText,  "<a name='$1' href='#fn_$1'><hr size=1></a>" & vbcrlf)
967
 
968
  gRE.Pattern = "\r\n\[(\d+)\]"
969
  newText=gRE.Replace(newText,  "<br>[<a name='$1' href='#fn_$1'>$1</a>]")
970
 
971
  gRE.Pattern = "\[(\d+)\]"
972
  newText=gRE.Replace(newText, "[<a href='#$1' name='fn_$1'>$1</a>]")
973
 
974
  ' topic line (ElreyRonald)
975
  gRE.Pattern = "\r\n======([^\r\n]+)"
976
  newText=gRE.Replace(newText,"<h6>$1</h6>")
977
  gRE.Pattern = "\r\n=====([^\r\n]+)"
978
  newText=gRE.Replace(newText,"<h5>$1</h5>")
979
  gRE.Pattern = "\r\n====([^\r\n]+)"
980
  newText=gRE.Replace(newText,"<h4>$1</h4>")
981
  gRE.Pattern = "\r\n===([^\r\n]+)"
982
  newText=gRE.Replace(newText,"<h3>$1</h3>")
983
  gRE.Pattern = "\r\n==([^\r\n]+)"
984
  newText=gRE.Replace(newText,"<h2>$1</h2>")
985
 
986
  ' horizontal rule
987
  gRE.Pattern = "\r\n-{4,}"
988
  newText=gRE.Replace(newText,vbCrLf & "<hr size=1 noshade=false />" & vbcrlf)
989
 
990
  ' special case for dash and a-umlaut - MARKUS
991
  'newText=replace(newText,"-", "&minus;")  ' this change breaks image URLs that include dashes
992
  newText=replace(newText,"", "&auml;")
993
 
994
  ' removed by ElreyRonald, use "|"
995
  ' newText=replace(newText,chr(9) & " :" & chr(9),"<p style=""margin-left:20pt;"">")
996
 
997
  ' Removed by ElreyRonald, use "|"
998
  ' newText=replace(newText,vbcrlf & chr(9) & "]",vbcrlf & "<p style=""margin-left:20pt;"">")
999
 
1000
 
1001
  '[MARKUS] Underline neu hinzugefgt - -_ irgendwas _-
1002
  newText=replace(newText,"-_", "<u>")
1003
  newText=replace(newText,"_-","</u>")
1004
 
1005
  '[Markus] LEERSTELLEN werden in HTML-Leerstellen umgewandelt
1006
  'newText=replace(newText," ","&nbsp;")  ' this change screws up images.  Why necessary?   dinoch Thu, 17 Oct 2002
1007
 
1008
  ' bulleted lists: tab-star
1009
  'newText=replace(newText,chr(9) & "*","<li> ")
1010
  newText=replaceListPattern(newText, chr(9) & "*", "<ul>", "</ul>", "<li> ", "</li>")
1011
 
1012
  ' numbered lists: tab-colon-star
1013
  newText=replaceListPattern(newText, chr(9) & ":*", "<ol>", "</ol>", "<li> ", "</li>")
1014
 
1015
  ' numbered lists: Changed to use 1. to conform with http://www.c2.com/cgi/wiki?TextFormattingRules
1016
  newText=replaceListPattern(newText, chr(9) & "1.", "<ol>", "</ol>", "<li> ", "</li>")
1017
 
1018
  ' COLORS: (german and english)- german removed (ElreyRonald)
1019
  'SCHRIFTFARBEN {schwarz} {braun} {grn} {blau} {gelb} {rot} {orange}
1020
  '{farbe} {/farbe}
1021
  newText=replace(newText,"{black}","<font color=black>")
1022
  newText=replace(newText,"{/black}","</font>")
1023
  newText=replace(newText,"{green}","<font color=darkgreen>")
1024
  newText=replace(newText,"{/green}","</font>")
1025
  newText=replace(newText,"{blue}","<font color=darkblue>")
1026
  newText=replace(newText,"{/blue}","</font>")
1027
  newText=replace(newText,"{sienna}","<font color=sienna>")
1028
  newText=replace(newText,"{/sienna}","</font>")
1029
  newText=replace(newText,"{red}","<font color=firebrick>")
1030
  newText=replace(newText,"{/red}","</font>")
1031
  newText=replace(newText,"{pink}","<font color=deeppink>")
1032
  newText=replace(newText,"{/pink}","</font>")
1033
 
1034
  ' 5/2006
1035
  newText=replace(newText,"[/Drop]","</div></div>")
1036
 
1037
  '
1038
  newText=replace(newText,"{italic}","<I>")
1039
  newText=replace(newText,"{/italic}","</I>")
1040
  newText=replace(newText,"{bold}","<strong>")
1041
  newText=replace(newText,"{/bold}","</strong>")
1042
 
1043
  ' CHANGE SIZE / SCHRIFTGRSSE
1044
  'SMALLER / KLEINER
1045
  newText=replace(newText,"{small}","<font size='-1'>")
1046
  newText=replace(newText,"{/small}","</font>")
1047
  newText=replace(newText,"{smaller}","<font size='-2'>")
1048
  newText=replace(newText,"{/smaller}","</font>")
1049
  newText=replace(newText,"{smallest}","<font size='-3'>")
1050
  newText=replace(newText,"{/smallest}","</font>")
1051
  'LARGER / GRSSER
1052
  newText=replace(newText,"{big}","<font size='+1'>")
1053
  newText=replace(newText,"{/big}","</font>")
1054
  newText=replace(newText,"{bigger}","<font size='+2'>")
1055
  newText=replace(newText,"{/bigger}","</font>")
1056
  newText=replace(newText,"{biggest}","<font size='+3'>")
1057
  newText=replace(newText,"{/biggest}","</font>")
1058
 
1059
  ' this is were you can insert your own bracket comands...
1060
  newText=replace(newText,"{br}","<br/>")
1061
 
1062
 
1063
  ' images:
1064
  newText= imageize(newText)
1065
 
1066
  ' isbns:
1067
  newText= isbnize(newText)
1068
 
1069
  ' auto-hyperlinks
1070
  newText= hyperlink(newText)
1071
 
1072
  ' bold text: three single quotes
1073
  newText= replaceBoundingPattern(newText,"'''","b")
1074
 
1075
  ' em text: two single quotes
1076
  newText= replaceBoundingPattern(newText,"''","em")
1077
 
1078
  ' consolidate a series of trailing vbcrlf to just 2.
1079
  gRE.Pattern = "(\r\n){3,}$"
1080
  newText=gRE.Replace(newText, vbcrlf & vbcrlf)
1081
 
1082
  If  gDisableScripting = false Then
1083
    ' 2007.08.25 disable scripts
1084
    gRE.Pattern = "<([s|S][c|C][r|R][i|I][p|P][t|T])"
1085
    newText=gRE.Replace(newText, "&lt;$1")
1086
  End If
1087
 
1088
 
1089
  EmitDebug 11, 4, "xform-after(" &  newText & ")<br/>"
1090
 
1091
  newText = Replace(newText, "#@91;", "[")
1092
  newText = Replace(newText, "#@93;", "]")
1093
  newText = Replace(newText, "#@3A;", ":")
1094
  newText = Replace(newText, "#@3C;", "<")
1095
  newText = Replace(newText, "#@3E;", ">")
1096
 
1097
  xform = newText
1098
 
1099
End Function
1100
 
1101
 
1102
Function WalkWiki(isTeksten)
1103
    Dim myText
1104
    myText = isTeksten
1418 dpurdie 1105
    WalkWiki = myText
1405 dpurdie 1106
 
1107
End Function
1108
 
1109
function RemoveBrackets(s)
1110
  Dim ts
1111
  ts = replace( s, "[","")
1112
  ts = replace( ts, "]","")
1113
  RemoveBrackets = ts
1114
end function
1115
 
1116
function RemoveSpaces(s)
1117
  Dim ts
1118
  ts = replace( s, " ","")
1119
  RemoveSpaces = ts
1120
end function
1121
 
1122
 
1123
 
1124
Sub EmitDebug(sig,lvl,arg)
1125
  If gDebug >= lvl Then Response.Write("debug:" & sig & " " & arg & vbcrlf)
1126
End Sub
1127
 
1128
 
1129
'----------------------------------------------------
1130
' This function builds and returns the connection
1131
' string, based on input provided from the web form.
1132
'
1133
function ConnStr(includeMode)
1134
  dim localDs
1135
  ' Map MDB database to physical path
1136
   if len(gDocRootDir) > 0 then
1137
      localDs = gDataSource
1138
   else
1139
      localDs = Server.MapPath(gDataSource)
1140
   end if
1141
 
1142
  ConnStr= "Provider=" & gProvider & ";Data Source=" & localDs & ";"
1143
  if (includeMode) then
1144
      ConnStr=   ConnStr & "mode= Share Deny None"
1145
  end if
1146
  EmitDebug 20, 3, "ConnStr= (" &  ConnStr & ")<br/>"
1147
end function
1148
 
1149
 
1150
 
1151
sub CheckDbErrors
1152
  if  gDataConn.errors.count> 0 then
1153
    dim counter
1154
    response.write "<br/><b>Database Errors Occurred" & "</b><br/>" & vbcrlf
1155
    for counter= 0 to gDataConn.errors.count
1156
      response.write "Error #" & gDataConn.errors(counter).number & vbcrlf & "<br/>"
1157
      response.write "  Description(" & gDataConn.errors(counter).description & ")" & vbcrlf & "<br/>"
1158
    next
1159
  else
1160
    response.write "<br/><b>No Database Errors Occurred" & "</b><br/>" & vbcrlf
1161
  end if
1162
end sub
1163
 
1164
 
1165
' Elrey Ronald  2/21/05
1166
sub VerifyWikiTableNoAdoxComponent
1167
  on error resume next
1168
  gDataConn.Open ConnStr(0)
1169
  on error goto 0
1170
 
1171
  on error resume next
1172
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1173
  on error goto 0
1174
 
1175
end sub
1176
 
1177
'----------------------------------------------------------------------------
1178
' VerifyWikiTable
1179
' This routine:
1180
' (a) verifies the existence of the target database (dbname) at the given
1181
'     ADO connection.  If necessary, this routine creates that
1182
'     database.
1183
' (b) verifies the existence of the table in that database.  If necessary,
1184
'     this routine will create the required table, and build the table
1185
'     structure.  The columns in the target table are determined by the
1186
'     fields in the source record set (sourceRs).   Two additional
1187
'     columns are also added. (in fact we do not use the entire recordset,
1188
'     but only the collection of fields in the recordset.
1189
'
1190
 
1191
sub VerifyWikiTable
1192
  if not gAutoCreateMdb then
1193
     Call VerifyWikiTableNoAdoxComponent
1194
     Exit Sub
1195
  End If
1196
  dim tbl, cat, dbname, fso
1197
  dim fsoErrMessage, adoxErrMessage, instructions
1198
 
1199
  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>"
1200
  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>"
1201
  instructions =   "<LI>You may have to <b>MANUALLY</b> create the folder/MsAccess file -> <b>" & gDataSource & " </b> </LI>"  & _
1202
                   "<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>" & _
1203
                   "<LI>You may modify 'gAutoCreateMdb' and set it to false to prevent creation of MDB and avoid this message." & _
1204
                   "<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>" & _
1205
                   "<BR><BR><B><i>Now trying to use default values to see if this would work...</i></B>"
1206
 
1207
  err.clear
1208
  ' Check if ADOX.Catalog component is available in this computer
1209
  on error resume next
1210
  set cat= CreateObject("ADOX.Catalog")
1211
  on error goto 0
1212
 
1213
  ' Check if FileSystemObject component is available in this computer
1214
  on error resume next
1215
  set fso = CreateObject("Scripting.FileSystemObject")
1216
  on error goto 0
1217
 
1218
  If Not IsObject(cat) or cat is nothing Then
1219
     Response.Write( adoxErrMessage)
1220
     Response.Write( instructions )
1221
     Call VerifyWikiTableNoAdoxComponent
1222
     Exit Sub
1223
  End If
1224
 
1225
  err.clear
1226
  If Not IsObject(fso)  Then
1227
     Response.Write( fsoErrMessage)
1228
     Response.Write( instructions )
1229
     Call VerifyWikiTableNoAdoxComponent
1230
     Exit Sub
1231
  End If
1232
 
1233
  if len (gDocRootDir) > 0 then
1234
    dbname = gDataSource
1235
  else
1236
    dbname = Server.MapPath(gDataSource)
1237
  end if
1238
 
1239
  '--------------------------------------------
1240
  ' step 0: check the directory, create if necessary
1241
  dim folder, f1
1242
  if len (gDocRootDir) > 0 then
1243
    f1 = gDocRootDir & "\" & gDataSourceDir
1244
  else
1245
    f1 = Server.MapPath(gDataSourceDir)
1246
  end if
1247
  if not fso.FolderExists(f1) then
1248
      on error resume next
1249
      Set folder = fso.CreateFolder(f1)
1250
      on error goto 0
1251
      If Not IsObject(folder) Then
1252
         Response.Write( "Unable to create [" & f1 & "].  Please modify DOCROOT and gDataSourceDir in the program. Consult your website settings." )
1253
         Response.End
1254
      End If
1255
      set folder = nothing
1256
  end if
1257
  set fso = nothing
1258
  '---- some security here
1259
 
1260
  If gDataSourceFile <> gDefaultHomePage Then
4044 dpurdie 1261
 
1262
    ' Expecting delVerified=1 for deletion confirmation
1263
    If Request.QueryString("dbCreate") <> "1" Then
1264
      Response.Write("<center><h2>Database Creation</h2></center><hr>")
1265
      Response.Write("<center>")
1266
      If gHideLogin Then
1267
          Response.Write("The Database --> <b>" &  gDataSource & "</b> <--- Cannot be created on this Server")
4052 dpurdie 1268
          Response.Write("<br><a href='" & gScript & "'><button>Return to Home</button></a>")
4044 dpurdie 1269
      ElseIf NOT gEnableEdit Then
1270
          Response.Write("The Database --> <b>" &  gDataSource & "</b> <--- Cannot be created until you enable editing")
4052 dpurdie 1271
          Response.Write("<br><a href='" & gScript & "'><button>Return to Home</button></a>")
4044 dpurdie 1272
      Else
1273
          Response.Write("<br><br><span style='border: solid 5px red; padding: 10px;display:inline-block'>")
1274
          response.write("Create Database --> <b>" &  gDataSource & "</b>  <---")
1275
          Response.Write("<p align=left>Folder: " & f1 & ".")
1276
          Response.Write("<br>DataBase: " & gDataSource & ".")
1277
          response.write("<p>Are your sure that you wish to continue!")
1278
          response.write( "<br><br><a href='" & gScriptURL & "&dbCreate=1'><button style='color:red'>Create Database.</button></a>" )
1279
          response.write( "&nbsp;&nbsp;<a href='" & gScript & "'><button>No,  don't create it.</button></a>" )
1280
          response.write( "</span>" )
1281
      End If
1282
      Response.Write("</center>")
1283
      Response.End
1405 dpurdie 1284
    End If
1285
  End If
4044 dpurdie 1286
 
1405 dpurdie 1287
  '--------------------------------------------
1288
  ' step 1: create the new db catalog, if necessary
1289
  Err.Clear
1290
  EmitDebug 21, 2, vbcrlf & " creating db " & dbname & "<br/>"
4044 dpurdie 1291
  on error resume next
1405 dpurdie 1292
  cat.Create ConnStr(0)
1293
  on error goto 0
1294
  EmitDebug 22, 2, ">> error(" & err.Number & "," & err.Description &  ")<br/>"
1295
  'EmitDebug 23, 2, vbcrlf & " catConnErrorCount(" & _
1296
  '    cat.ActiveConnection.errors.count  & ")<br/>"
1297
 
1298
  if not (err.Number = 0) then
1299
    if not (err.Description = "Database already exists." ) then
1300
      dim sError
1301
      sError = ">> error(" & err.Number & "," & err.Description & ")" & _
1302
          "(EXPECTED ""Database already exists"")..." & "<br/>"
1303
      EmitDebug 24, 2, sError
1304
      Response.Write( "<span style='color:red'>Fatal error creating db: " & err.Number & " " & err.description & "</span>")
1305
    else
1306
      EmitDebug 25, 2, ">> Database already exists..." & "<br/>"
1307
      cat.ActiveConnection= ConnStr(0)
1308
    end if
1309
  else
1310
    EmitDebug 26, 2, ">> Database has just been created..." & "<br/>"
1311
  end if
1312
  EmitDebug 27, 2, " Database now exists..." & "<br/>"
1313
 
1314
 
1315
  '--------------------------------------------
1316
  ' step 2: create the new table, with columns, if necessary
1317
  Err.Clear
1318
  EmitDebug 28, 2, " verifying presence of table(" & gDbTableName & ")<br/>"
1319
  'if not isNothing(gDataConn) then set gDataConn = nothing
1320
  on error resume next
1321
  set gDataConn = Server.CreateObject("ADODB.Connection")
1322
  on error goto 0
1323
  If Not IsObject(gDataConn) Then
1324
    Response.Write ( "Unable to establish connection. Missing ADO object.")
1325
    Response.End
1326
  End If
1327
 
1328
  on error resume next
1329
  gDataConn.Open ConnStr(0)
1330
  on error goto 0
1331
 
1332
 
1333
  on error resume next
1334
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1335
  on error goto 0
1336
 
1337
  if (0 = gDataConn.errors.count) then
1338
      EmitDebug 29, 1, vbcrlf & "(no db errors, ergo table exists)"  & "<br/>"
1339
  elseif ((gDataConn.errors.count>0) and ( ADOERROR_NOTABLE = gDataConn.errors(0).number)) then
1340
      set gDataConn = nothing
1341
      ' error: table does not exist.
1342
      EmitDebug 30, 2, vbcrlf & " creating table " & gDbTableName  & "<br/>"
1343
      Dim idx 'As New ADOX.Index
1344
      set idx= CreateObject("ADOX.Index")
1345
      ' now, create a new table in the db:
1346
      set tbl= CreateObject("ADOX.Table")
1347
      With tbl
1348
      ' drop tbl into a MDB provider context; need to do this NOW
1349
      ' to be able to use autoIncrement, later.
1350
      set .ParentCatalog = cat
1351
 
1352
      ' Name the new table.
1353
      .Name = gDbTableName
1354
 
1355
      .Columns.Append "ID", 3
1356
      .Columns("ID").Properties("AutoIncrement") = True
1357
 
1358
      .Columns.Append "Title", 202, 127
1359
      .Columns.Append "PageData", 203
1360
      .Columns.Append "PrevPageData", 203
1361
      .Columns("PrevPageData").Properties("Jet OLEDB:Allow Zero Length") = True
1362
      .Columns("PrevPageData").Properties("Nullable") = True
1363
      .Columns.Append "LastUpdate", 7     ' timestamp
1364
      .Columns.Append "LastEditor", 202, 127
1365
 
1366
      ' create the Primary Key :
1367
      idx.Name = "RecordIndex"
1368
      idx.Columns.Append "ID"
1369
      idx.PrimaryKey = True
1370
      idx.Unique = True
1371
      .Indexes.Append idx
1372
 
1373
 
1374
 
1375
      End With
1376
 
1377
      ' this appends the table to the db catalog
1378
      cat.Tables.Append  tbl
1379
      EmitDebug 31, 2, vbcrlf & " post-append: catConnErrorCount(" & _
1380
      cat.ActiveConnection.errors.count  & ")<br/>"
1381
 
1382
      set idx= nothing
1383
 
1384
      ' insert the first record into the newly-created table
1385
      EmitDebug 32, 2,  ">> inserting into table(" & gDbTableName  & ")<br/>"
1386
 
1387
      set gDataConn = Server.CreateObject("ADODB.Connection")
1388
      gDataConn.Open ConnStr(1)
1389
 
1390
      dts = Now
1391
      EmitDebug 33, 2,  ">> the time is now(" & dts  & ")<br/>"
1392
 
1393
      DoInitialPageCreation(".")
1394
 
1395
  else
1396
      EmitDebug 34, 2,  ">> table " & tablename & " already exists?" & "<br/>"
1397
  end if
1398
 
1399
  set cat = nothing
1400
  set tbl = nothing
1401
  on error goto  0
1402
 
1403
end sub
1404
 
1405
 
1406
Function DoInitialPageCreation(folderspec)
1407
  Dim fso, f, f1, fc, s, dts, sPageData, fPage, stmnt
1408
  Set fso = CreateObject( "Scripting.FileSystemObject" )
1409
 
1410
  EmitDebug 35, 2,  ">> checking dir (" & Server.MapPath(folderspec) & ")<br/>"
1411
  Set f = fso.GetFolder(Server.MapPath(folderspec))
1412
  Set fc = f.Files
1413
  EmitDebug 36, 2,  ">> files counted (" & fc.Count & ")<br/>"
1414
  For Each f1 in fc
1415
    if (Right(f1.name, 4) = ".wik") then
1416
        s = Left(f1.name, Len(f1.name)-4)
1417
        EmitDebug 37, 2,  ">> found file  (" & s & ")<br/>"
1418
        on error resume next
1419
        set fPage= fso.OpenTextFile(Server.MapPath(f1.name),FOR_READING)
1420
        sPageData = fPage.ReadAll
1421
        on error goto 0
1422
        fPage.Close
1423
        set fPage = nothing
1424
        dts = Now  ' timestamp
1425
        EmitDebug 38, 2,  ">> inserting record (" & s & ")<br/>"
1426
 
1427
        stmnt = "INSERT INTO " & gDbTableName & " (Title,PageData,PrevPageData,LastUpdate,LastEditor) " & _
1428
        "VALUES ( '" & s & "','" & safeQuote(sPageData) & "', '--', '" & dts & "', '" & gScript & " (initial creation)');"
1429
        on error resume next
1430
        gDataConn.execute(stmnt)
1431
        on error goto 0
1432
        if gDebug>=1 then CheckDbErrors
1433
    end if
1434
  Next
1435
  set fso = nothing
1436
  set f = nothing
1437
  set fc = nothing
1438
 
1439
end Function
1440
 
1441
 
1442
 
1443
function theWhereClause(theStr)
1444
  dim result
1445
  result= ""
1446
  dim myArray
1447
  dim element
1448
  EmitDebug 39, 1, "whereClause(" & theStr & ")<br/>" & vbcrlf
1449
 
1450
  myArray = split(Trim(theStr), " ")
1451
  for each element in myArray
1452
    element = Trim(element)
1453
    if (result = "") then
1454
      result = " where "
1455
    else
1456
      result = result & " and "
1457
    end if
1458
    result= result &  " PageData like '%" & element & "%'"
1459
  next
1460
  EmitDebug 40, 1, "whereClause:result(" & result & ")<br/>" & vbcrlf
1461
  theWhereClause = result
1462
 
1463
end function
1464
 
1465
sub handleLogout
1466
    Dim url
1467
    url = gScriptURL & "&o=" & glsTopic
2365 dpurdie 1468
    gEnableEdit = false
1405 dpurdie 1469
    Session.Abandon
1470
    Response.Redirect(url)
1471
end sub
1472
 
2365 dpurdie 1473
sub handleLogin
1474
    Dim url
1475
    url = gScriptURL & "&o=" & glsTopic
1476
    gEnableEdit = true
1477
    Session("login") = 1
1478
    Response.Redirect(url)
1479
end sub
1480
 
1405 dpurdie 1481
sub handleEdit
2735 dpurdie 1482
    If NOT gEnableEdit Then
2365 dpurdie 1483
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed</h2></center>")
1484
        Response.End
1405 dpurdie 1485
        exit sub
1486
    End If
1487
 
1488
    If IsRemoteBlackListed Then
1489
 
1490
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Please send e-mail to this site's Web Master ASAP.</h2></center>")
1491
        Response.End
1492
        Exit Sub
1493
 
1494
    End If
1495
 
1496
      sqlQuery = "select PageData,Title, lastupdate, PrevPageData from " & gDbTableName & " where title='" & glsTopic & "'"
1497
      EmitDebug 41, 2, "Edit query(" & sqlQuery & ")<br/>" & vbcrlf
1498
 
1499
      'set rs = gDataConn.execute(sqlQuery)
1500
      set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1501
 
1502
 
1503
      dim strPageData, strTitle, strLastUpdate, strPrevPageData
1504
 
1505
      if not rs.eof then
1506
         'page exists
1507
          strTitle = rs("title")
1508
          strPageData = rs("pageData")
1509
          strLastUpdate = CStr(rs("lastupdate"))
1510
          strPrevPageData = rs("PrevPageData")
1511
      else
1512
          'page does not exist
1513
          strTitle = glsTopic
1514
          strPageData = ""
1515
          strLastUpdate = ""
1516
          strPrevPageData = ""
1517
      end if
1518
 
1519
     'If Not gHideWikiSource Then
1520
              response.write("<form id=form1 name=form1 method=""POST"" action=""" & gScript & """>" & vbcrlf)
4052 dpurdie 1521
              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 1522
              ' [MARKUS - replace virtual with hard]
4052 dpurdie 1523
              response.write("<textarea id=""pagetext""  name=""pagetext"" rows='" & giEditAreaRows & "'  cols='" & giEditAreaCols & _
1405 dpurdie 1524
                "'  style='width:100%'>"  & _
1525
                Server.HtmlEncode(strPageData) & _
1526
                "</textarea>" & vbcrlf & _
4052 dpurdie 1527
                "<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 1528
                "<br/></br/> "  & _
1529
                vbcrlf & "<input type=hidden name=lupdt value='" & strLastUpdate & "'>" & _
1530
                vbcrlf & "<input type=hidden name=o value='" & strTitle & "'>" & _
1531
                vbcrlf & "<input type=hidden name=db value='" & gDataSourceFile & "'>" & _
1532
                vbcrlf & "<input type=hidden name=hiddenInput value='errv2010'>" & _
1533
                vbcrlf & "<input type=hidden name=dbname value='" & gDataSourceName & "'>" & _
1534
                vbcrlf & "<input type=hidden name='a' value='save'>" & vbcrlf )
1535
 
1536
 
1537
 
1538
    'End If
1539
 
6324 dpurdie 1540
    Session("CurrentEditPage") = "# "  & strTitle 
1405 dpurdie 1541
    If gHideWikiSource then
1542
       exit sub
1543
    end if
1544
 
1545
    'History of changes
1546
    response.write("<br><br><br><br><br><h3>History of Changes:</h3><textarea readonly style='font-size:8pt; background:silver;' rows='" & giEditAreaRows & "' cols='" & giEditAreaCols & _
1547
    "'  style='width:100%'>" & strPrevPageData & "</textarea>")
1548
 
1549
    'Original Text
1550
    response.Write("<textarea name=""pagetextorig"" rows=0 cols=0 style='width:0;'>" & strPageData & "</textarea></form>" )
1551
    response.Write("<script language=javascript>form1.pagetext.rows=window.screen.height/26;</script>")
1552
 
1553
end sub
1554
 
1555
 
1556
sub handleSearch
1557
 
1558
  dim pageTitle, s
1559
  's= Request.QueryString("o")  BUG - Fri, 2002 jan 22 - Dan Shaw
1560
  s= glsTopic
1561
  if not isEmpty(s) then
1562
    EmitDebug 42, 2, "<br/>SEARCH(" & s & ")<br/>" & vbcrlf
1563
    pageTitle = "Search Results (" & s & ")"
1564
    dim myClause
1565
    myClause= theWhereClause(s)
1566
    sqlQuery="select ID, Title, LastUpdate , LastEditor from " & gDbTableName & myClause & " order by Title"
1567
  end if
1568
 
1569
  EmitTabularOutput pageTitle, ""
1570
 
1571
end sub
1572
 
1573
'ElreyRonald 4/2004
1574
Sub HandleDelete
4044 dpurdie 1575
    Dim sh
1576
    sh = "<br><a href='" & gScriptURL & "' >Click here proceed to home page</a>"
1577
 
1578
  ' Expecting delVerified=1 for deletion confirmation
1579
  Response.Write("<center><h2>Page Deletion</h2></center><hr>")
1580
  Response.Write("<center>")
1581
 
1582
  If Request.QueryString("delVerified") <> 1  Then
1583
    if gHideLogin Then
1584
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Cannot be created on this Server")
4052 dpurdie 1585
          Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
4044 dpurdie 1586
    ElseIf NOT gEnableEdit Then
1587
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Cannot be deleted until you enable editing")
4052 dpurdie 1588
          Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
4044 dpurdie 1589
    Else
1590
        Response.Write("<br><br><span style='border: solid 5px red; padding: 10px;display:inline-block'>")
4052 dpurdie 1591
        response.write("Deletion of the page --> <b>" &  glsTopic & "</b>  <--- cannot be undone")
4044 dpurdie 1592
        response.write("<br>Are your sure that you wish to continue!")
1593
        response.write( "<br><br><a href='" & gScriptURL & "&a=del&delVerified=1&o=" & glsTopic & "'><button style='color:red'>Delete this page.</button></a>" )
1594
        response.write( "&nbsp;&nbsp;<a href='" & gScriptURL & "'><button>No,  don't delete it.</button></a>" )
1595
        response.write( "</span>" )
1596
    End If
1405 dpurdie 1597
  Else
4044 dpurdie 1598
 
1599
      Dim topic
1600
      topic = Request.QueryString("o") ' Topic to delete
1601
      If IsNull(topic) or topic = "" Then
1602
        Response.Write( "Specify page name to delete i.e.  &o=MyPage" & sh)
1603
        Response.End
1604
      End If
1605
 
1606
      Dim stmnt
1607
      stmnt = "delete from WikiData where Title='" & topic & "'"
1608
      Set gDataConn = Server.CreateObject("ADODB.Connection")
1609
      on error resume next
1610
      gDataConn.Open ConnStr(1)
1611
      on error goto 0
1612
      on error resume next
1613
      gDataConn.execute(stmnt)
1614
      on error goto 0
1615
      If  gDataConn.errors.count = 0 then
1616
        Response.Write( "<b>" & topic & " </b> was successfully deleted. " )
1617
      Else
1618
        Response.Write( "<b>" & topic & " </b>  was not deleted due to some errors. " )
1619
      End if
1620
      Set gDataConn = nothing
1621
      Response.write  sh
1622
    End If
1623
    Response.Write("</center>")
1624
    Response.End
1405 dpurdie 1625
end sub
1626
 
4052 dpurdie 1627
Sub HandleConfig
1628
  Dim showSessionData
1629
 
1630
  Response.Write("<center><h2>Edit Configuration</h2></center><hr>")
1631
 
1632
  if gHideLogin Then
1633
      Response.Write("Configuration not available on this server")
1634
      Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1635
  ElseIf NOT gEnableEdit Then
1636
      Response.Write("Configuration not available until you enable editing")
1637
      Response.Write("<br><a href='" & gScriptURL & "'><button>Return to Home</button></a>")
1638
  Else
1639
      select case (glsTopic)
1640
          case "bde"
1641
              Session("BulkDelete") = 1
1642
              gBulkDelete = true
1643
 
1644
          case "bdd"
1645
              Session.Contents.Remove("BulkDelete")
1646
              gBulkDelete = false
1647
 
1648
          case "ssv"
1649
                showSessionData = true
1650
      end select
1651
 
1652
      response.write( "<br><a href='" & gScriptURL & "&a=config&o=ssv'><button>Show Session Variables</button></a>" )
1653
      If not gBulkDelete Then
1654
        response.write( "<br><a href='" & gScriptURL & "&a=config&o=bde'><button>Enable Bulk Delete</button></a>" )
1655
      Else
1656
        response.write( "<br><a href='" & gScriptURL & "&a=config&o=bdd'><button>Disable Bulk Delete</button></a>" )
1657
      End If
1658
      response.write( "<br><form action="&gScriptURL&"&a=config&o=cdb>"&_
1659
                            "<input type=submit value='Create New Wiki Database'>"&_
1660
                            "<input type=text name=db>"&_
1661
                            "<input type=hidden name=a value=config>"&_
1662
                            "<input type=hidden name=aa value=cdb>"&_
1663
                            "</form>" )
1664
      response.write( "<br><a href='" & gScriptURL & "'><button>Return to Wiki.</button></a>" )
1665
  End If
1666
 
1667
  If showSessionData Then WriteSessionData
1668
 
1669
  Response.End
1670
end sub
1671
 
1672
 
1405 dpurdie 1673
'ElreyRonald 4/2004
1674
sub handleRss
1675
 
1676
  dim pageTitle, initialRow, s, sSortOrder
1677
  dim modifiedUrl
1678
 
1679
  sqlQuery="select top " & giNumRecentFiles & " ID, LastEditor, Title,PageData,PrevPageData, LastUpdate from " & gDbTableName & " order by LastUpdate DESC"
1680
 
1681
  sqlQuery = sqlQuery & sSortOrder
1682
 
1683
  set gDataConn = Server.CreateObject("ADODB.Connection")
1684
 
1685
  on error resume next
1686
  gDataConn.Open ConnStr(1)
1687
  on error goto 0
1688
 
1689
  if not (0 = gDataConn.errors.count) then
1690
    if (ADOERROR_NOFILE = gDataConn.errors(0).number) then
1691
      EmitDebug 54, 1, "<br/>ErrorCount(" & gDataConn.errors.count & ")<br/>" & vbcrlf
1692
      EmitDebug 55, 1, "<br/>Error(" & gDataConn.errors(0).number &") desc(" &_
1693
      gDataConn.errors(0).description & ")<br/>" & vbcrlf
1694
      VerifyWikiTable
1695
    end if
1696
  end if
1697
 
1698
  'set rs= gDataConn.execute(sqlQuery)
1699
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1700
 
1701
 
1702
  modifiedUrl = Replace(gScriptURL, "&", "&amp;")
1703
  if not rs.eof then
1704
    response.ContentType = "text/xml"
1705
    response.Write("<?xml version=""1.0"" encoding=""ISO-8859-1"" ?>")
1706
    response.Write(gRssStyle)
1707
    response.Write("<rss version=""2.0"">")
1708
    response.Write("<channel>")
1709
    response.Write("<title>" & SpaceName(gHomeTopic) & "</title> ")
1710
    response.Write("<link>" & gHttpDomain & "/" & modifiedUrl &  "&amp;a=rss</link> ")
1711
    Response.Write("<ttl>1000</ttl>")
1712
    response.Write("<description>Latest changes and postings for the topic:" & SpaceName(gHomeTopic) & ". </description> ")
1713
    response.Write("<copyright>Copyright (C)2003  Elrey Ronald Vel. All rights reserved.</copyright> ")
1714
    response.Write("<generator> WikiAsp RSS Generator by Elrey </generator> ")
1715
    Response.Write("<webMaster>lambda326@hotmail.com</webMaster>")
1716
    response.Write("<image><width>80</width><height>40</height>")
1717
    response.Write("<title>" & SpaceName(gHomeTopic) & "</title> ")
1718
    response.Write("<link>" & gHttpDomain & "/" & modifiedUrl & "</link> ")
1719
    If  left(gIconName,4) = "http" Then
1720
      response.Write("<url>" &  gIconName &" </url></image>")
1721
    Else
1722
      response.Write("<url>" & gHttpDomain & "/" & gIconName &" </url></image>")
1723
    End If
1724
 
1725
    Do while Not rs.eof
4052 dpurdie 1726
      Response.Write("<item>")
1727
      Response.Write("<title>" & SpaceName(rs("Title"))&  "</title>")
1728
      Response.Write("<link>" & gHttpDomain & "/" & modifiedUrl & "&amp;o=" & rs("Title") & "</link> ")
1729
      Response.Write("<category>" & SpaceName(gHomeTopic) & "</category>")
1730
      Response.Write("<author>user@" & rs("LastEditor")& "</author>")
1731
      Response.Write("<description>")
1732
      Response.Write( "<![CD" & "ATA[ ")
1733
      If gHighlightFlag Then
1734
          Response.Write(  ProcessRssItem(rs) )
1735
      Else
1736
          Response.Write WalkWiki(xform(  rs("PageData")  ))
1405 dpurdie 1737
      End If
4052 dpurdie 1738
      Response.Write("]]></description>")
1739
      Response.Write("<pubDate>" & GetRFC822date(rs("LastUpdate")) & "</pubDate> ")
1740
      Response.Write("</item>")
1405 dpurdie 1741
      rs.MoveNext
1742
      i= i+1
1743
    Loop
1744
 
1745
    response.Write( "</channel></rss>")
1746
  end if
1747
  Set gDataConn = nothing
1748
  Set rs = nothing
1749
end sub
1750
 
1751
 
1752
'Get the nth page in History
1753
'ElreyRonald
1754
Function GetPrevData(rs, n)
1755
   Dim arrD, tmpStr, i, cnt, getFlag
1756
   Dim prevData
1757
   prevData = rs("PrevPageData")
1758
   If    IsNull(prevData) Then
1759
      GetPrevData   = ""
1760
   Else
1761
 
1762
      arrD    =  Split( rs("PrevPageData"), vbCRLF)
1763
      cnt     = 0
1764
      getFlag = 0
1765
      tmpSTr  = ""
1766
      For i = 1 to UBound(arrD)
1767
         If left(arrD(i), 8) = "--------"   Then
1768
            cnt = cnt + 1
1769
            if getFlag = 1 Then Exit For
1770
            if  n =  cnt Then
1771
               getFlag = 1
1772
            end if
1773
         End If
1774
         If getFlag = 1 and left(arrD(i), 8) <> "--------" Then
1775
            tmpStr = tmpStr & arrD(i) & vbCRLF
1776
         End If
1777
 
1778
      Next
1779
      GetPrevData = tmpStr
1780
   End If
1781
End Function
1782
 
1783
 
1784
'Process the current record (rs) for RSS
1785
'ElreyRonald
1786
Function    ProcessRssItem(rs)
1787
   Dim currData, prevData, markedStr
1788
   Dim beginMark, endMark, tmpS
1789
   beginMark = "###s###"
1790
   endMark  = "###e###"
1791
   currData = rs("PageData")
1792
   prevData = GetPrevData( rs, 1 )
1793
   markedStr =  MarkWhatWasAdded( prevData, currData, beginMark , endMark)
1794
   tmpS = WalkWiki(xform(markedStr))
1795
   tmpS = Replace( tmpS, beginMark, "<U style='background:yellow' >")
1796
   tmpS = Replace( tmpS, endMark,   "</U>")
1797
   ProcessRssItem = tmpS
1798
End Function
1799
 
1800
Function MarkWhatWasAdded( prevData, currData, st, en)
1801
Dim arrCurrData, arrPrevData
1802
Dim currMaxIndex
1803
Dim prevMaxIndex, i
1804
arrCurrData  = Split( currData, vbCRLF)
1805
arrPrevData  = Split( prevData, vbCRLF)
1806
currMaxIndex =  UBound( arrCurrData )
1807
prevMaxIndex =  UBound( arrPrevData )
1808
If  prevMaxIndex <  0 Then
1809
  MarkWhatWasAdded = currData
1810
  Exit Function
1811
End If
1812
 
1813
Dim marked, prevPtr, started
1814
marked =    0
1815
prevPtr = 0
1816
started = 0
1817
'Search delta forward
1818
For i = 0 to prevMaxIndex
1819
   If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For
1820
Next
1821
prevPtr = i  'start here
1822
For i   = 0 to currMaxIndex
1823
   If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then
1824
 
1825
   Else
1826
      Started = 1
1827
      If    prevPtr <=  prevMaxIndex Then
1828
         If arrCurrData(i)  <>  arrPrevData( prevPtr) Then
1829
            if ( i > 0 ) then
1830
               if arrCurrData(i-1) = "" Then
1831
                 arrCurrData(i-1)   =  vbCRLF & arrCurrData(i-1) & st
1832
               else
1833
                 arrCurrData(i-1)   = arrCurrData(i-1) & st
1834
               end if
1835
            else
1836
               arrCurrData(i)   = st &   vbCRLF & arrCurrData(i)
1837
            end if
1838
            marked =    1
1839
            Exit For
1840
         End If
1841
         prevPtr = prevPtr + 1
1842
         if prevPtr >  prevMaxIndex and i < currMaxIndex then
1843
            arrCurrData(i)  = arrCurrData(i+1) & st
1844
            marked = 1
1845
            exit for
1846
         end if
1847
      End If
1848
   End If
1849
Next
1850
 
1851
If  marked =    0 Then
1852
   MarkWhatWasAdded = currData
1853
   exit function
1854
End If
1855
 
1856
'Search delta Backwards
1857
For i = prevMaxIndex to 0 step -1
1858
   If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For
1859
Next
1860
Dim pi
1861
pi  = i
1862
started = 0
1863
For i   = currMaxIndex  to  0 step -1
1864
  If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then
1865
     ' do nothing
1866
  Else
1867
    Started  = 1
1868
    If  pi  >= 0 Then
1869
      'Response.Write "backward Compare " & Cstr(i) & "-" & Cstr(pi) &" [" &arrCurrData(i) & "]=["& arrPrevData(pi) & "] " &    vbCRLF
1870
      If    arrCurrData(i)  <>  arrPrevData(pi) Then
1871
         arrCurrData(i) = arrCurrData(i) & en
1872
         Exit For
1873
      End If
1874
      pi    = pi - 1
1875
      if pi < 0 and i > 0 then
1876
         arrCurrData(i-1)   = arrCurrData(i-1) & en
1877
         exit for
1878
      End if
1879
    End If
1880
  End If
1881
Next
1882
 
1883
Dim sres
1884
sres = ""
1885
For i   = 0 to currMaxIndex
1886
   sres = sres  & arrCurrData(i) & vbCRLF
1887
Next
1888
MarkWhatWasAdded = sres
1889
 
1890
End Function
1891
 
1892
 
1893
 
1894
 
1895
sub handleList
1896
 
1897
  dim pageTitle, initialRow, s, sDirection, sSortOrder, sNextDirectionTitle, sNextDirectionDate
1898
  ' Request.ServerVariables("HTTP_REFERER")
1899
 
1900
  initialRow= ""
1901
  s = Request.QueryString("o")
1902
  EmitDebug 43, 2, "<br/>" & s & "<br/>" & vbcrlf
1903
  if (s = "recent") then
1904
    pageTitle = "Recently Modified Topics"
1905
    sqlQuery="select top " & giNumRecentFiles & " ID, Title, LastUpdate, LastEditor from " & gDbTableName & " order by LastUpdate DESC"
1906
  else
1907
    pageTitle = "List of All Topics"
1908
    sqlQuery= "select ID, Title, LastUpdate , LastEditor from " & gDbTableName & " order by "
1909
    sDirection = Request.QueryString("d")
1910
 
1911
    if (s = "ByDate") then
1912
      sqlQuery = sqlQuery & "LastUpdate "
1913
      if (sDirection = "down") then
1914
    sSortOrder = ""  ' the reverse natural sort order (oldest first)
1915
    sNextDirectionDate= ""
1916
      else
1917
    sSortOrder = "DESC"  ' the natural sort order (most recent first)
1918
    sNextDirectionDate= "&d=down"
1919
      end if
1920
    elseif (s = "ByTitle") then
1921
      sqlQuery = sqlQuery & "Title "
1922
      if (sDirection = "down") then
1923
    sSortOrder = "DESC"   ' the reverse natural sort order (alphabetic)
1924
    sNextDirectionTitle = ""
1925
      else
1926
    sSortOrder = ""   ' the natural sort order (alphabetic)
1927
    sNextDirectionTitle = "&d=down"
1928
      end if
1929
    end if
1930
 
1931
    sqlQuery = sqlQuery & sSortOrder
1932
 
1933
 
1934
    '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>"
1935
    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>"
1936
 
1937
 
1938
  end if
1939
 
1940
  EmitTabularOutput pageTitle, initialRow
1941
 
1942
end sub
1943
 
1944
 
1945
 
1946
sub EmitTabularOutput(pageTitle, initialRow)
1947
 
1948
  EmitDebug 44, 2, "<br/>query(" & sqlQuery & ")<br/>" & vbcrlf
1949
 
1950
  'set rs= gDataConn.execute(sqlQuery)
1951
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
1952
 
2365 dpurdie 1953
  Call WriteBanner(pageTitle,"")
1954
 
1405 dpurdie 1955
  if not rs.eof  then
2365 dpurdie 1956
'    Response.write("<h2>" & pageTitle & ":</h2>)
1957
    Response.write("<table cellpadding=5  cellspacing=0 border=0 >" & vbcrlf)
1405 dpurdie 1958
    i = 1
1959
    if not isEmpty(initialRow) then
1960
      Response.write initialRow & vbcrlf
1961
    end if
1962
    Do while (Not rs.eof )
1963
      if (i mod 2 = 0) then
1964
          Response.Write("<tr style=""background-color:whitesmoke;"">")
1965
      else
1966
          Response.Write("<tr style=""background-color:lightcyan;"">")
1967
      end if
1968
 
1969
      Dim deleteColumn
1970
      deleteColumn = ""
1971
 
4044 dpurdie 1972
      ' Allow bulk deletion
1973
      If (gBulkDelete)  Then
1974
          deleteColumn = "<td class='tabular'><a href=""" & gScriptURL & "&o=" & rs("Title")&"&a=del&delVerified=1" & """>[Delete Page]</td>"
1405 dpurdie 1975
      End If
1976
 
4052 dpurdie 1977
      Response.Write("<td class='tabular'>" & i & ".</td><td class='tabular'><a href=""" &_
1978
                  gScriptURL & "&o=" & rs("Title") & """>" & rs("Title") & "</a></td> <td class='tabular'>" & _
5639 dpurdie 1979
                  GetRFC822date(rs("LastUpdate")) & " by " & rs("LastEditor")& "</td>" &  deleteColumn & _
4052 dpurdie 1980
                  "</tr>" &  vbcrlf)
1981
      i= i+1
1405 dpurdie 1982
      rs.MoveNext
1983
    Loop
1984
    Response.write("</table>" & vbcrlf)
1985
  else
2365 dpurdie 1986
'    Response.write("<h2>" & pageTitle & ":</h2>)
1987
    Response.write("<table style='border: 1px solid gainsboro'>" & vbcrlf)
1405 dpurdie 1988
    Response.write("<tr><td>This topic is not mentioned on any other page! </td></tr>" & vbcrlf)
1989
    Response.write("</table>" & vbcrlf)
1990
  end if
1991
 
2365 dpurdie 1992
   Call WriteFooter("","",""  )
1405 dpurdie 1993
end sub
1994
 
1995
 
1996
sub handleSave
1997
  if gDisableSave = "yes" then
1998
    exit sub
1999
  end if
2000
 
2001
  dim sText, dts, sLupdt
2002
  dim sChanges, sTextOrig
2003
  sText=request.Form("pagetext")
2004
  sTextOrig=request.Form("pagetextorig")
2005
  sLupdt=request.Form("lupdt")  ' last update (ElreyRonald)
2006
 
2007
 
2008
  Dim lastPageEdited
2009
  if IsEmpty (Session("CurrentEditPage") ) Then
2010
        lastPageEdited = "*"
2011
        Exit Sub
2012
  else
2013
    lastPageEdited =Session("CurrentEditPage")
2014
  end if
2015
 
2016
  If not IsRequestFromWikiASPPage Then
2017
     response.write("1:>" & remoteIPHost & " - " & remoteIPAddr  )
2018
     response.end
2019
     exit sub
2020
  End if
2021
 
2022
  If IsRemoteAdressBlackListedRE Then
2023
     response.write("2:>" & remoteIPHost & " - " & remoteIPAddr  )
2024
     exit sub
2025
  End if
2026
 
2027
  If IsRemoteBlackListed Then
2028
     response.write("3:>" & remoteIPHost & " - " & remoteIPAddr  )
2029
     exit sub
2030
  End if
2031
 
2032
  sqlQuery = "select Title,PageData, lastupdate , PrevPageData, LastEditor from " & gDbTableName & " where title='" & glsTopic & "'"
2033
  EmitDebug 45, 2, "<br/>save-check query(" & sqlQuery & ")<br/>" & vbcrlf
2034
 
2035
 
2036
  'set rs = gDataConn.execute(sqlQuery)
2037
  set rs = WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007          
2038
 
2039
  dts = Now
2040
 
2041
  'update record
2042
  if not rs.eof then
2043
 
2044
 
2045
 
2046
      EmitDebug 46, 2, "Record already exists....<br/>" & vbcrlf
2047
 
2048
      ' check if someone has updated the record while you were editing (ElreyRonald)
2049
      if  Trim(Cstr( rs("lastupdate"))) <> Trim(sLupdt) then
2050
        response.write("<html><head></head><body>")
5639 dpurdie 2051
        Response.Write(  "["& Trim(Cstr( GetRFC822date(rs("lastupdate")))) & "]["& Trim(sLupdt)& "]<br>" )
1405 dpurdie 2052
        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>" )
2053
 
2054
        response.write( "<br><br> <a href='" & gScriptURL & "&a=edit&o=" & glsTopic & "'>Click here to re-edit the page. </a>" )
2055
        response.end
2056
      else
2057
 
2058
      ' consolidate a series of trailing vbcrlf to just 2.
2059
      gRE.Pattern = "(\r\n){3,}$"
2060
      sText=gRE.Replace(sText, vbcrlf & vbcrlf)
2061
 
2062
      ' replace 8 spaces with tab (ElreyRonald)
2063
      sText = replace(sText, vbcrlf & "        *", vbcrlf & chr(9) & "*" )
2064
      sText = replace(sText, vbcrlf & chr(9) & " :        ", vbcrlf & chr(9)& " :" & chr(9) )
2065
 
2066
      If abs( len(sText) - len(sTextOrig) ) > 10 Then
2067
        sChanges =  vbcrlf & vbcrlf & "@@@@@@@@@@@@@@@@" & rs("lastupdate") & " : " & _
2068
          rs("lasteditor") & "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" & vbcrlf & vbcrlf &  rs("PageData")  & rs("PrevPageData")
2069
        sChanges =  left(sChanges, 15000)
2070
      else
2071
        sChanges = rs("PrevPageData")
2072
      End if
2073
 
2074
      sqlQuery = "UPDATE " & gDbTableName & " SET PageData='" &_
2075
      safeQuote(sText) & "',PrevPageData='" & safeQuote(  sChanges   ) &_
2076
      "',LastUpdate='" & dts & "', LastEditor='" & remoteIPHost  &_
2077
      "'  WHERE title='" & rs("title") & "'"
2078
 
2079
 
2080
      EmitDebug 47, 1, "update sqlQuery(" & sqlQuery & ")<br/>"
2081
 
2082
      'gDataConn.execute(sqlQuery)
2083
 
2084
      call WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
2085
 
2086
 
2087
      end if
2088
      ' new record
2089
  else
2090
 
2091
 
2092
      EmitDebug 48, 2, "Record does not exist, inserting...." & vbcrlf
2093
      sqlQuery = "INSERT INTO " & gDbTableName & " (Title,PageData,LastEditor,LastUpdate) " & _
2094
      "VALUES ('" & glsTopic   & "', '" & safeQuote(sText) & "', '" & remoteIPHost   &_
2095
       "', '" & dts & "')"
2096
      EmitDebug 49, 1, "<br/>sqlQuery(" & sqlQuery & ")<br/>"
2097
 
2098
      'gDataConn.execute(sqlQuery)
2099
 
2100
      call WrappedQueryExecute( gDataConn, sqlQuery )  ' ERV 3/2007        
2101
 
2102
 
2103
  end if
2104
 
2105
  ' direct to the newly saved page :
2106
  'Response.Redirect gScript & "?" & glsTopic
2107
  Response.Redirect gScriptURL & "&o=" & glsTopic
2108
 
2109
end sub
2110
 
2365 dpurdie 2111
Sub WriteBanner(title,search)
1405 dpurdie 2112
      Dim iconPart, bannerPart, bannerTextPart
2113
      iconPart = "<a  href='" & gScriptURL & "'><img src='" & gIconName & "' border='0' alt='Go to Start Page'></a>"
2114
 
2365 dpurdie 2115
      if search <> "" then
2116
         bannerTextPart = "<a  title='Search for references to " & title & "' href='" & gScriptURL & "&a=search&o=" & search & "'>" &  SpaceName(title) & "</a>"
2117
      else
2118
         bannerTextPart = SpaceName(title)
2119
      end if
1405 dpurdie 2120
 
2121
      If gBannerTemplate = "" Then
2122
         bannerPart = ""
2123
         bannerPart =  bannerPart &  "<a href='" & gScriptURL & "'>Wiki Home</a>"
2124
         bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=list&o=ByTitle' title='this may take a loooong time'>List all pages</a>"
2735 dpurdie 2125
         if ( NOT gHideLogin ) Then
2365 dpurdie 2126
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2127
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<span style='color: #FF0000;font-weight: bold;'>Development Web Server</span>"
2128
            if (search <> "") AND (gEnableEdit) then
2129
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=edit&o=" & search & "'>Edit page</a>"
2130
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=del&o=" & search & "'>Del page</a>"
2131
            end if
2132
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ReleaseNotes&o=TextFormattingRules'>Formatting Rules</a>"
2133
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ReleaseNotes'>Release Notes</a>"
4044 dpurdie 2134
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScript & "?db=ImplementationNotes'>"& gDevNotePrefix &" Dev Notes</a>"
2365 dpurdie 2135
            if gEnableEdit Then
4052 dpurdie 2136
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=config&o='>Config</a>"
4044 dpurdie 2137
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=logout&o=" & search & "'>Disable Editing</a>"
2365 dpurdie 2138
            Else
4044 dpurdie 2139
                bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=login&o=" & search & "'>Enable Editing</a>"
2365 dpurdie 2140
            End If
2141
         End If
1405 dpurdie 2142
         bannerPart =  bannerPart &  "<hr>"
2143
 
2144
         bannerPart =  bannerPart &  " <table class='cssBannerTable' id='idBannerTable' cellSpacing='0' cellPadding='0' border='0'>"
2145
         bannerPart =  bannerPart &  "    </tr>"
2146
         bannerPart =  bannerPart &  "    <tr class='cssBannerRow' id='idBannerRow'> "
2147
         bannerPart =  bannerPart &  "          <td class='cssBannerCellIcon' id='idBannerCellIcon' valign='top'> $$icon$$</td>"
2148
         bannerPart =  bannerPart &  "          <td width=90% class='cssBannerCellText' id='idBannerCellText' valign='bottom' align='left' >"
2149
         bannerPart =  bannerPart &  "            <h1 class='cssBannerSpanText' id='idBannerSpanText'>$$banner_text$$</h1>"
2150
         bannerPart =  bannerPart &  "          </td>"
2151
         bannerPart =  bannerPart &  "          <td>"
2152
         bannerPart =  bannerPart &  "          <td class='cssTopSearch'id='idTopSearch' >"         	
2153
         If not gHideTopSearch Then
2154
             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;"
2155
         End If
2156
         bannerPart =  bannerPart &  "          </td><td>&nbsp;&nbsp;&nbsp;</d>"
2157
         bannerPart =  bannerPart &  "    </tr>"
2158
         bannerPart =  bannerPart &  " </table>"
2159
 
2160
      Else
2161
 
2162
         bannerPart = gBannerTemplate
2163
      End if
2164
 
2165
      bannerPart = Replace( bannerPart, "$$icon$$", iconPart)
2166
      bannerPart = Replace( bannerPart, "$$banner_text$$", bannerTextPart)
2167
 
2168
 
2169
      Response.Write ( bannerPart )
2170
 
2365 dpurdie 2171
End Sub
1405 dpurdie 2172
 
2365 dpurdie 2173
Sub WriteFooter(hideScript,lastUpdate,lastEditor)
1405 dpurdie 2174
      If Not gHideWikiFooter Then
2175
          response.write "<div id=wikifooter class=footer ><form method='POST' action=""" & gScript & """ id=""formFooter"" name=""formFooter""><br>"
2176
          response.write "<hr size=1 noshade=true>"
2365 dpurdie 2177
 
1405 dpurdie 2178
          If Not gHideLastEditor Then
2365 dpurdie 2179
            if lastUpdate <> "" Then
5639 dpurdie 2180
                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 2181
            End If
1405 dpurdie 2182
          end if
2183
          response.write "<font size=-1>Domain: " & gHttpDomain & "</font><br>"
2184
 
2365 dpurdie 2185
'          response.write "<a href='" & gScriptURL & "' title='GO TO START PAGE'>Home</a> | "
2186
'          if  Not gHideLogin Then
2187
'            response.write "<a href='" & gScriptURL & "&a=edit&o=" & rs("title") & "'>Edit page</a> | "
2188
'          end if
2189
'          response.write "<a href='" & gScriptURL & "&a=logout&o=" & rs("title") & "'>Log out</a> | "
2190
'          response.write "<a href='" & gScriptURL & "&a=list&o=ByTitle'>List pages</a> |  "
2191
'          response.write "<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2192
'          If gHttpDomain <> "" Then
2193
'            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>"
2194
'          End If
2195
'
2196
'          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> "
2197
 
2198
          response.write "<font size='-1'>WikiAsp Engine version:  " & gEngineVersion & "</font>" & vbcrlf
3616 dpurdie 2199
'          response.write "<br><font size='-1'>gScriptURL:  " & gScriptURL & "</font>" & vbcrlf
1405 dpurdie 2200
          response.write "</div>"
2201
      End If
4052 dpurdie 2202
End Sub
2365 dpurdie 2203
 
4052 dpurdie 2204
Sub WriteSessionData
2205
    Dim name
2206
    If 0 Then
2207
        ' Display all the Server Request Variables
2208
        %>
2209
        <h1>Server Request Variables</h1>
2210
        <div align="left">
2211
        <table border="0" cellpadding="0" cellspacing="0" width="850">
2212
        <tr>
2213
        <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2214
        <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2215
        </tr>
2216
        <%
2217
        for each name in request.servervariables
2218
            %>
2219
            <tr>
2220
            <td valign="top" align="left" width="250">
2221
            <font face="Arial" size="1" color="#FF0000">
2222
            <%= name %></font></td>
2223
            <td valign="top" align="left" width="600">
2224
            <font face="Arial" size="1"><%= request.servervariables(name) %></font></td>
2225
            </tr>
2226
            <%
2227
        Next
2228
        %>
2229
        </table>
2230
        </div>
2231
        <%
2232
    End If
2233
    ' Display all the Contents of the Session Variable
2234
    %>
2235
    <h1>Session Variables</h1>
2236
    <div align="left">
2237
    <table border="0" cellpadding="0" cellspacing="0" width="850">
2238
    <tr>
2239
    <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2240
    <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2241
    </tr>
2242
    <%for each name in Session.Contents%>
2243
    <tr>
2244
    <td valign="top" align="left" width="250">
2245
    <font face="Arial" size="1" color="#FF0000"><%= name %></font></td>
2246
    <td valign="top" align="left" width="600">
2247
    <%If VarType(Session(name)) < 100 Then %>
2248
    <font face="Arial" size="1">[<%=TypeName(Session(name))%>:<%=VarType(Session(name))%>]&nbsp;<%=Session(name) %></font></td>
2249
    <%Else%>
2250
    <font face="Arial" size="1">[<%=TypeName(Session(name))%>:<%=VarType(Session(name))%>]</font></td>
2251
    <%End If%>
2252
    </tr>
2253
    <%Next%>
2254
    <tr>
2255
    <td><font face="Arial" size="1" color="#FF0000">Timeout</font></td>
2256
    <td><font face="Arial" size="1"><%=Session.Timeout%></font></td>
2257
 
2258
    <tr>
2259
    <td><font face="Arial" size="1" color="#FF0000">SessionId</font></td>
2260
    <td><font face="Arial" size="1"><%=Session.SessionId%></font></td>
2261
    </table>
2262
    </div>
2263
 
2264
    <%
2265
    ' Display all the Contents of the Application Variable
2266
    %>
2267
    <h1>Application Variables</h1>
2268
    <div align="left">
2269
    <table border="0" cellpadding="0" cellspacing="0" width="850">
2270
    <tr>
2271
    <td valign="top" align="left" width="250"><font face="Arial" size="2" color="#FF0000"><b>Variable Name</b></font></td>
2272
    <td valign="top" align="left" width="600"><font face="Arial" size="2"><b>Value</font></b></td>
2273
    </tr>
2274
    <%
2275
    for each name in Application.Contents
2276
    %>
2277
    <tr>
2278
    <td valign="top" align="left" width="250">
2279
    <font face="Arial" size="1" color="#FF0000">
2280
    <%= name %></font></td>
2281
    <td valign="top" align="left" width="600">
2282
    <font face="Arial" size="1"><%= Application(name) %></font></td>
2283
    </tr>
2284
    <%
2285
    Next
2286
    %>
2287
    </table>
2288
    </div>
2289
    <%
2365 dpurdie 2290
End Sub
2291
 
2292
Sub HandleBrowse
2293
 
2294
  sqlQuery = "select PageData,Title,LastEditor,LastUpdate from " & gDbTableName & " where title='" & glsTopic & "'"
2295
  EmitDebug 50, 2, "Browse query(" & sqlQuery & ")<br/>" & vbcrlf
2296
 
2297
  set rs = gDataConn.execute(sqlQuery)
2298
 
2299
  if rs.eof=true then
2300
        Response.Write("<center><h2>Page Creation</h2><hr>")
2301
    if gHideLogin Then
2302
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Does not exit and it cannot be created on this Server")
2735 dpurdie 2303
    ElseIf NOT gEnableEdit Then
4044 dpurdie 2304
        Response.Write("The page --> <b>" &  glsTopic & "</b> <--- Does not exit and it cannot be created until you enable editing")
2365 dpurdie 2305
    Else
4044 dpurdie 2306
        Response.Write("<br><br><span style='border: solid 2px black; padding: 10px;display:inline-block'>")
2307
        response.write("The page --> <b>" &  glsTopic & "</b>  <--- does not exist.")
2308
        response.write("<br><br><a href='" & gScriptURL & "&a=edit&o=" & glsTopic & "'><button style='color:red'>Create this page.</button></a>" )
2309
        response.write("&nbsp;&nbsp;<a href='" & gScriptURL & "'><button>Don't create page.</button></a>" )
2310
        Response.Write("</span>")
2365 dpurdie 2311
    End If
2312
        Response.Write("</center>")
2313
 
2314
  else
2315
      EmitDebug 51, 3, "found...(" & rs("PageData") & ")<br/>" & vbcrlf
2316
 
2735 dpurdie 2317
      If gEnableEdit Then
2365 dpurdie 2318
        response.write" <body ondblclick=" & chr(34) & "document.location.href='" & _
2319
            gScriptURL & "&a=edit&o=" & glsTopic    & "'" & chr(34) &">"
2320
      Else
2321
         response.write" <body >"
2322
 
2323
      End If
2324
 
2325
      Call WriteBanner(rs("title"),rs("title"))
2326
      response.write " <div class='wikibody'>" & WalkWiki(  xform( "<span id=bodyPrefix>" & vbcrlf & gWikiBodyPrefix & VbCrLF & "</span>" & VbCrLF &  rs("PageData")))  ' Elrey - xform func now removes html
2327
      response.write "</b></i></font></u></strong></font>"
2328
 
2329
 
2330
      dim hideScript
2331
      hideScript = "var div1=document.getElementById('wikifooter'); if (div1) {div1.style.display='none';}"
2332
      hideScript = hideScript & "div1=document.getElementById('bodyPrefix'); if (div1) {div1.style.display='none';}"
2333
      hideScript = hideScript & "div1=document.getElementById('idTopSearch'); if (div1) {div1.style.display='none';}"
2334
 
2335
      Call WriteFooter(hideScript, rs("LastUpdate"), rs("LastEditor")  )
2336
  end if
2337
 
1405 dpurdie 2338
end sub
2339
 
2340
 
2341
 
2342
sub handleCreate
2365 dpurdie 2343
    If gHideLogin Then
2344
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed</h2></center>")
2345
        Response.End
2346
        exit sub
2347
    End If
2348
 
2735 dpurdie 2349
    If NOT gEnableEdit Then
2350
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed until logged in</h2></center>")
2351
        Response.End
2352
        exit sub
2353
    End If
2354
 
1405 dpurdie 2355
  on error resume next
2356
  VerifyWikiTable
2357
  on error goto 0
2358
  Response.Redirect gScriptURL
2359
end sub
2360
 
2361
 
2362
'Intercept RSS request here
2363
if ( glsMode = "rss" ) then
2364
  If ( gHttpDomain = "" ) then
2365
    response.write("RSS is not enabled")
2366
  Else
2367
    handleRss
2368
  End If
2369
  response.End
2370
end if
2371
 
2372
'********************************************************************
2373
'*********************************************************************
1413 dpurdie 2374
'<?xml version="1.0" encoding="UTF-8" ?>
2375
'<!DOCTYPE html
2376
'     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
2377
'     "DTD/xhtml1-transitional.dtd">
2378
'
3616 dpurdie 2379
 
2380
    Response.Buffer=TRUE
1405 dpurdie 2381
%>
2382
<html>
2383
    <head>
2384
        <meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
2385
        <title>
3616 dpurdie 2386
<%
2387
        if not isEmpty(glsMode) and glsMode <> "browse" then
2388
            response.write(glsMode & " ")
2389
        end if
5357 dpurdie 2390
        response.write(SpaceName(glsTopic))
3616 dpurdie 2391
%>
1405 dpurdie 2392
        </title>
1413 dpurdie 2393
        <LINK REL="StyleSheet" HREF="<%=gStyleSheet%>" TYPE="text/css" >
1405 dpurdie 2394
<%
2395
       Response.Write(gHtmlHeadStr)
2396
%>
5357 dpurdie 2397
    <link rel="shortcut icon" href="<%=gFavIcon%>"/>
1405 dpurdie 2398
    </head>
2399
    <body>
2400
 
3616 dpurdie 2401
    <%
1405 dpurdie 2402
 
2403
      if  Session("Hits") = "" then
2404
    Session("Hits")= 1
2405
      else
2406
    Session("Hits")= Session("Hits") + 1
2407
      end if
2408
 
2409
      EmitDebug 52, 1, "debug(" & gDebug & ")<br/>" & vbcrlf
2410
      EmitDebug 53, 1, "<br/>QueryString = (" & Request.QueryString & ")<br/>" & _
2411
    "Hits(" & Session("Hits") & ")<br/>" & _
2412
    "mode(" & glsMode & ")<br/>" & _
2413
    "topic(" & glsTopic & ")<br/>"
2414
 
2415
      set gDataConn = Server.CreateObject("ADODB.Connection")
2416
 
2417
      ' 21 nov - need resume next to catch "no file" error
2418
      on error resume next
2419
      gDataConn.Open ConnStr(1)
2420
      on error goto 0
2421
 
2422
      if not (0 = gDataConn.errors.count) then
2423
    if (ADOERROR_NOFILE = gDataConn.errors(0).number) then
2424
      EmitDebug 54, 1, "<br/>ErrorCount(" & gDataConn.errors.count & ")<br/>" & vbcrlf
2425
      EmitDebug 55, 1, "<br/>Error(" & gDataConn.errors(0).number &") desc(" &_
2426
        gDataConn.errors(0).description & ")<br/>" & vbcrlf
2427
      VerifyWikiTable
2428
    end if
2429
      end if
2430
 
4044 dpurdie 2431
    select case (glsMode)
2432
        case "edit"    handleEdit
2433
        case "list"    handleList
2434
        case "search"  handleSearch
2435
        case "create"  handleCreate
2436
        case "save"    handleSave
2437
        case "browse"  handleBrowse
2438
        case "logout"  handleLogout
2439
        case "login"   handleLogin
2440
        case "del"     handleDelete
4052 dpurdie 2441
        case "config"  handleConfig
4044 dpurdie 2442
        case else
2443
    end select
1405 dpurdie 2444
 
4044 dpurdie 2445
    EmitDebug 56, 2, "<br/>done...<br/>" & vbcrlf
2446
    gDataConn.Close()
2447
    set gDataConn = nothing
1405 dpurdie 2448
    %>
2449
 
2450
<% Response.Write(gFooterHtml) %>
2451
<% Response.Flush  %>
4044 dpurdie 2452