Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

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