Subversion Repositories DevTools

Rev

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

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