Subversion Repositories DevTools

Rev

Rev 1442 | Rev 1465 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1405 dpurdie 1
<% @LANGUAGE = VBScript %>
2
<%
3
'+----------------------------------------------------------------------------+
4
'| Description:                                                               |
5
'|    WikiAsp is a derivative of AspWiki, a wiki program written in ASP.      |
6
'|    WikiAsp will run on Windows with IIS, MDAC v2.5. WikiAsp will           |
7
'|    automatically create MS Access DB on first time use.                    |
8
'|                                                                            |
9
'|    The following are the dlls to make mdb creation work.                   |
10
'|    1. Program Files\Common Files\System\ado\msadox.dll                     |
11
'|    2. WINDOWS\System32\scrrun.dll                                          |
12
'|                                                                            |
13
'| Credits:                                                                   |
14
'|    Elrey Ronald Velicaria. - Author of WikiAsp. (lambda326@hotmail.com)    |
15
'|    Dino Chiesa - AspWiki author.                                           |
16
'|    Contributors: Bjarne D, Julian Tosh                                     |
17
'|                                                                            |
18
'| Websites:                                                                  |
19
'|    http://www.c2.com/cgi/wiki,  http://www.c2.com/cgi/wiki?WikiAsp         |
20
'+----------------------------------------------------------------------------+
21
'| Please retain the above credits on any future versions of this program     |
22
'+----------------------------------------------------------------------------+
23
 
24
Option Explicit
25
Response.CacheControl  = "no-cache"
26
Response.Expires       = -1
27
Response.AddHeader "Pragma", "no-cache"
28
 
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).
1442 dpurdie 54
gIsOpenWiki        =  true                            ' Allow editing or Password Protect Editing?
1405 dpurdie 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
1442 dpurdie 63
gDefaultIcon       = "icon"                           ' This default. Maybe overridden if your site has icon.gif, icon.jpg or xxxx.gif and if FSO is working.
1405 dpurdie 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
 
1452 dpurdie 126
' Can only Edit on the Test / Development System not on the Live System
127
If (Not IsEmpty(Application("TestSystem"))) Then
128
    gHideLogin = false
1405 dpurdie 129
    gHideWikiFooter = false
130
End If
131
 
132
'set destination URL
133
gScriptURL    = gScript & "?db=" & gDataSourceFile  ' removed & "&dbname=" & server.urlencode(gDataSourceName)
134
gHomeTopic    = gDataSourceFile  ' default home topic is the same as ms access db name unless overwritten by .ini
135
gStyleSheet   = "wiki.css"
136
 
137
 
138
Call GetHomeTopic 'Get the topic from wiki.ini if it exists
139
 
140
gIconName = gDefaultIcon
141
 
142
Call GetIconName   'Get the real icon name
143
 
144
Dim rs, dts, i, sqlQuery
145
 
146
Const ADOERROR_NOFILE  = -2147467259  ' cannot find file (*.mdb)
147
Const ADOERROR_NOTABLE = -2147217865  ' Cannot find output table
148
Const FOR_READING      = 1
149
Const FOR_WRITING      = 2
150
 
151
' Determine the action mode (edit/browse/save/list/search) or browse
152
glsMode = ""
153
If Not isEmpty(request("a")) Then
154
   glsMode = request("a")
155
Else
156
   glsMode = "browse"
157
End If
158
 
159
' Determine the topic otherwise use home topic.
160
glsTopic = "WikiAsp"
161
If Not isEmpty(request("o")) Then
162
   glsTopic = request("o")
163
Else
164
   glsTopic = gHomeTopic
165
End If
166
 
167
' Determine if RSS contains highlighting or not
168
If Not isEmpty(request("h")) then
169
   gHighlightFlag = true
170
Else
171
   gHighlightFlag = false
172
End If
173
 
174
' Initialize the Regular Expression object variable
175
Set gRE=server.createobject("VBScript.Regexp")
176
gRE.IgnoreCase  = False
177
gRE.Global      = True
178
 
179
dim httpReferer
180
httpReferer= Request.ServerVariables("HTTP_REFERER")
181
 
182
 
183
' Get remote addresses globally
184
dim remoteIPHost
185
remoteIPHost = Request.ServerVariables("REMOTE_HOST")
186
 
187
dim remoteIPAddr
188
remoteIPAddr = Request.ServerVariables("REMOTE_ADDR")
189
 
190
If IsNull( remoteIPHost) Then
191
  remoteIPHost = "0.0.0.0"
192
End If
193
 
194
If IsNull( remoteIPHost) Then
195
  remoteIPAddr = "0.0.0.0"
196
End If
197
 
198
If  not IsEmpty(   Session("pwd") ) Then
199
    If  Session("pwd") = gPassword  Then
200
      remoteIPHost = "Editor"
201
      remoteIPAddr = ""
202
    End If
203
End If
204
 
205
'-- Let us get he IP first 3 numbers
206
dim remoteIPHost3numbers
207
Dim DotPos 
208
DotPos = InStrRev(remoteIPHost,".")
209
remoteIPHost3numbers= mid(remoteIPHost,1,DotPos)
210
 
211
 
212
 
213
'------------------------------------------------------------------------------------------------------------
214
'                                        SUBROUTINES AND FUNCTIONS
215
'------------------------------------------------------------------------------------------------------------
216
 
217
Sub GetHomeTopic
218
    '-----------------------------------------------------------------------
219
    ' This looks for the Home Topic Name from the 1-line file wiki.ini file.
220
    '-----------------------------------------------------------------------
221
    Dim objFSO
222
    err.Clear
223
    On Error Resume Next
224
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
225
    On Error GoTo 0
226
    If Not IsObject(objFSO) Then
227
        Exit Sub
228
    End If
229
 
230
    'Open the ini file whch should be at same dir as access db file
231
    Dim objTextStream
232
    Dim strIniFile
233
 
234
    if len(gDocRootDir) > 0 then
235
       strIniFile= gDocRootDir & "\" & gDataSourceDir & "\" & gDataSourceFile & ".ini"
236
    else
237
       strIniFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".ini")
238
    end if
239
 
240
    If objFSO.FileExists(strIniFile) Then
241
        Set objTextStream = objFSO.OpenTextFile(strIniFile, FOR_READING)
242
        gHomeTopic = objTextStream.ReadLine()
243
        objTextStream.Close
244
    End If
245
 
246
    '
247
    ' Check For db specific style sheet if any. First look CSS at the roo
248
    ' If it is not there, look in the DB Folder.  If not again there don't
249
    ' Override the default  (which is Wiki.css).
250
    '
251
    Dim strCss
252
    strCss= Server.MapPath( gDataSourceFile & ".css")
253
    If objFSO.FileExists(strCss) Then
254
        gStyleSheet = gDataSourceFile & ".css"
255
    Else
256
        Dim strCssFile
257
        strCssFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".css")
258
        If objFSO.FileExists(strCssFile) Then
259
            gStyleSheet =  gDataSourceDir & "\" & gDataSourceFile & ".css"
260
        End If
261
    End If
262
 
263
    Set objTextStream = Nothing
264
    Set objFSO = Nothing
265
 
266
End Sub
267
 
268
Function DayName (intDay)
269
  '------------------------------------------
270
  ' Returns Abbreviated Day of Week
271
  '------------------------------------------
272
  select case intDay
273
      case 1
274
          DayName = "Sun"
275
      case 2
276
          DayName = "Mon"
277
      case 3
278
          DayName = "Tue"
279
      case 4
280
          DayName = "Wed"
281
      case 5
282
          DayName = "Thu"
283
      case 6
284
          DayName = "Fri"
285
      case 7
286
          DayName = "Sat"
287
  end select
288
end function
289
 
290
function MonthName(intMonth)
291
  '-----------------------------------------
292
  ' Returns Abbreviated Month Name
293
  '-----------------------------------------
294
  select case intMonth
295
      case 1
296
         MonthName = "Jan"
297
      case 2
298
         MonthName = "Feb"
299
      case 3
300
         MonthName = "Mar"
301
      case 4
302
         MonthName = "Apr"
303
      case 5
304
         MonthName = "May"
305
      case 6
306
         MonthName = "Jun"
307
      case 7
308
         MonthName = "Jul"
309
      case 8
310
         MonthName = "Aug"
311
      case 9
312
         MonthName = "Sep"
313
      case 10
314
         MonthName = "Oct"
315
      case 11
316
         MonthName = "Nov"
317
      case 12
318
          MonthName = "Dec"
319
  end select
320
end function
321
 
322
Function GetRFC822date(dateVar)
323
   '----------------------------------------------
324
   ' Returns standard format date for RSS feeds
325
   '----------------------------------------------
326
   GetRFC822date =  DayName (WeekDay(dateVar)) & ", " & _
327
                    Day(dateVar) & " " & MonthName(Month(dateVar)) & " " & _
328
                    Year(dateVar) & " " & FormatDateTime(dateVar, 4) &":00 " & gTimeZoneOffset
329
End Function
330
 
331
 
332
Function WrappedQueryExecute( connObject, queryString )  
333
   '----------------------------------------------
334
   ' If something is wrong with db connection redirect to URL
335
   '----------------------------------------------
336
  Dim rsResult
337
  If gRedirectURL = "" Then
338
      set rsResult = connObject.execute(queryString)
339
  Else
340
      on error resume next
341
      set rsResult = connObject.execute(queryString)
342
      on error goto 0
343
 
344
      If  isEmpty(rsResult) then
345
	       Response.Redirect gRedirectURL
346
         Response.End
347
      End If
348
  End If
349
  Set WrappedQueryExecute = rsResult
350
End Function
351
 
352
 
353
Function AnyFileExistsIn( objFSO, extensions, baseFilename)
354
 
355
    Dim arrIconExts, sIconPathFile, sIconFile, element
356
 
357
    AnyFileExistsIn = false
358
    arrIconExts = Split(extensions, ",")
359
 
360
    For Each element In arrIconExts
361
 
362
        sIconFile =  baseFilename & element
363
        sIconPathFile= Server.MapPath( sIconFile)
364
 
365
        If objFSO.FileExists(sIconPathFile) Then
366
           gIconName = sIconFile
367
           AnyFileExistsIn = true
368
           Exit For
369
        End If
370
 
371
    Next
372
 
373
 
374
End Function
375
 
376
 
377
Sub GetIconName
378
    '-------------------------------------------------
379
    ' Get the icon file name. gif first then jpg
380
    ' Now it look a various places to guarantee an icon
381
    '-------------------------------------------------
382
    Dim objFSO, sIconPathFile, sIconFile
383
    err.Clear
384
    On Error Resume Next
385
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
386
    On Error GoTo 0
387
    If Not IsObject(objFSO)  Then
388
        Exit Sub
389
    End If
390
 
391
    ' look for <msaccessdb>.xxx icon file
392
 
393
    Dim iconSearchOrder 
394
    iconSearchOrder = ".gif,.jpg,.png"
395
 
396
    ' first look at the db directory, then on root , then for icon.xxx, otherwise default to the c2 icon
397
 
398
    If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceDir & "/" & gDataSourceFile ) Then
399
        If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceFile ) Then
1442 dpurdie 400
            If not AnyFileExistsIn( objFSO, iconSearchOrder , gIconName ) Then
1405 dpurdie 401
                gIconName = "http://c2.com/sig/wiki.gif"
402
            End If
403
        End If
404
    End If
405
    Set objFSO = Nothing
406
End Sub
407
 
408
Function SpaceName(strX)
409
   '------------------------------------------------------------
410
   ' This function splits up a string into words by inserting a
411
   ' space before each upper case letter. Ignores numbers and .
412
   '------------------------------------------------------------
413
   Dim i, strY
414
   i = 1
415
   strY = ""
416
   Do While i <= len(strX)
417
     If UCase(mid(strX,i,1)) = mid(strX,i,1) Then
418
       if  (( mid(strX,i,1) < "0" ) OR ( mid(strX,i,1) > "9")) AND ( mid(strX,i,1) <> ".")then
419
        strY = strY & " "
420
       end if
421
     End If
422
     strY = strY & mid(strX,i,1)
423
     i = i + 1
424
   Loop
425
   EmitDebug 9,  2, "Original string: " & strX & " ... Spaced out string: " & strY & "<br/>"
426
   SpaceName = strY
427
End Function
428
 
429
 
430
Function removeHTML(txt)
431
  removeHTML=server.htmlencode(txt)
432
End Function
433
 
434
Function safeQuote(txt)
435
  If IsNull(txt) Then
436
     txt = ""
437
  End If
438
  safeQuote=replace(txt,"'","''")
439
End Function
440
 
441
 
442
Function replaceBoundingPattern(txt, pattern, tag)
443
  Dim workingText
444
  workingText = txt
445
  gRE.Pattern = pattern & "([^\n]{0,}?)" & pattern    ' kgreiner
446
  workingText= gRE.Replace(workingText, "<" & tag & ">$1</" & tag & ">")
447
  replaceBoundingPattern = workingText
448
End Function
449
 
450
' Elrey Ronald
451
Function replaceTableColumnPattern(txt)
452
  Dim workingText
453
  Dim aryLines, aryLinesCount
454
  Dim i
455
  workingText = txt
456
 
457
  aryLines = Split(workingText,vbCRLF)
458
  aryLinesCount = UBound(aryLines)
459
 
460
  For i = 0 To aryLinesCount
461
           If left(aryLines(i), 6 ) = "_tmp_0"  Then
462
               aryLines(i) = Replace(aryLines(i), "_tmp_0", "<tr><td valign=top class=TableCell>")
463
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
464
           End If
465
           If left(aryLines(i), 6 ) = "_tmp_1"  Then
466
               aryLines(i) = Replace(aryLines(i), "_tmp_1", "<tr class=TableRow1><td  valign=top class=TableCell>")
467
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
468
           End If
469
           If left(aryLines(i), 6 ) = "_tmp_2"  Then
470
               aryLines(i) = Replace(aryLines(i), "_tmp_2", "<tr class=TableRow2><td  valign=top class=TableCell>")
471
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
472
           End If
473
           If left(aryLines(i), 6 ) = "_tmp_3"  Then
474
               aryLines(i) = Replace(aryLines(i), "_tmp_3", "<tr class=TableRow3><td  valign=top class=TableCell>")
475
               aryLines(i) = Replace(aryLines(i), "||", "</td><td  valign=top class=TableCell>")
476
           End If
477
  Next
478
  replaceTableColumnPattern= Join(aryLines,vbCRLF)
479
End Function
480
 
481
Function AddAnchors(txt)
482
  Dim workingText
483
  Dim aryLines, aryLinesCount
484
  Dim i
485
  Dim tocText
486
  workingText = txt
487
 
488
  dim toc(100)
489
  dim tocIndex: tocIndex = 0
490
 
491
  aryLines = Split(workingText,vbCRLF)
492
  aryLinesCount = UBound(aryLines)
493
 
494
  For i = 0 To aryLinesCount
495
           If left(aryLines(i), 3 ) = "== "  Then
496
               toc(tocIndex) = "<a href=""#Section_"& tocIndex &""">" & Mid(aryLines(i), 3) &"</a>"
1408 dpurdie 497
               aryLines(i) = "<a name=""Section_"& tocIndex &"""></a>" & vbCRLF & aryLines(i)
1405 dpurdie 498
               tocIndex = tocIndex + 1
499
           End If
500
  Next
501
 
502
  if ( tocIndex > 0 ) then
503
      Dim ii
504
      Dim Text
505
      For ii = 0 to tocIndex -1
506
          Text = Text & vbcrlf & " *" & toc(ii)
507
      Next
508
      tocText = Text & vbcrlf & tocText
509
  end if
510
 
511
  ' Look for the spot to drop the TOC
512
  ' [[TOC]]
513
  For i = 0 To aryLinesCount
514
           If left(aryLines(i), 7 ) = "[[TOC]]"  Then
515
            aryLines(i) = tocText & vbCRLF' & aryLines(i)
516
           End If
517
  Next
518
 
519
 
520
  AddAnchors = Join(aryLines,vbCRLF)
521
End Function
522
 
523
 
524
 
525
'Elrey 3/06
526
Function RandomInteger(HighValue , LowValue )
527
     Rnd -1
528
     Randomize (time)
529
     RandomInteger = Int((HighValue - Lowvalue + 1) * Rnd() + Lowvalue)
530
End Function
531
 
532
 
533
Function replaceListPattern(txt, wikiPattern, topPattern, bottomPattern, startLinePattern, endLinePattern)
534
  '
535
  ' Search through the text, creating numbered lists
536
  ' where so indicated by the pattern occurances.
537
  '
538
  ' To indicate a numbered list, the pattern must always
539
  ' appear at the very beginning of a line.
540
  '
541
  Dim workingText,replaceText
542
  Dim aryLines,aryLinesCount
543
  Dim nPatternLength,bInsidePattern
544
  Dim i
545
 
546
  'Elrey  - added multiple pattern
547
  Dim aPatterns
548
  Dim aPatternsCount
549
  Dim aPatternLength
550
  aPatterns = Split(wikiPattern,"^")
551
  aPatternsCount = UBound(aPatterns)
552
  Dim patternFound, j
553
 
554
  Dim aStartPattern
555
  aStartPattern = Split(startLinePattern,"^")
556
 
557
  workingText = txt
558
  nPatternLength = len(wikiPattern)
559
  bInsidePattern = False
560
  aryLines = Split(workingText,vbCRLF)
561
  aryLinesCount = UBound(aryLines)
562
 
563
  For i = 0 To aryLinesCount
564
         ' Elrey
565
         patternFound = 0
566
         For j = 0 to aPatternsCount
567
             aPatternLength = len( aPatterns(j) )
568
             If  left( aryLines(i), aPatternLength ) = aPatterns(j) Then
569
                patternFound = 1
570
                Exit For
571
             End If
572
         Next
573
 
574
    If patternFound = 1 Then
575
        If Not bInsidePattern Then
576
            replaceText = topPattern & vbCRLF & aStartPattern (j)
577
 
578
            bInsidePattern = True
579
        Else
580
            replaceText = aStartPattern (j)
581
        End If
582
        aryLines(i) = replaceText & right(aryLines(i),len(aryLines(i)) - aPatternLength ) & endLinePattern
583
    Else
584
        If bInsidePattern Then
585
            aryLines(i) = bottomPattern & vbCRLF & aryLines(i)
586
            bInsidePattern = False
587
        End If
588
    End If
589
  Next
590
 
591
  replaceListPattern = Join(aryLines,vbCRLF)
592
 
593
End Function
594
 
595
 
596
Function imageize(txt)
597
  ' Include a tag like img:http://www.brinkster.com/images/brinksterlogo.gif
598
  ' to get an inlined-image. <img src="foo">
599
  Dim workingText
600
  workingText = txt
601
 
602
  ' referencing local images  Elrey Ronald 1/2006
603
  gRE.IgnoreCase = True
604
  gRE.Pattern = "(\s)(image:local|img:local):([^ \t\n\r]+)"
605
  workingText=gRE.Replace(workingText,"$1<img src='$3'  >")
606
 
607
  gRE.IgnoreCase = True
608
  gRE.Pattern = "(\s)(imageleft:local|imgleft:local):([^ \t\n\r]+)"
609
  workingText=gRE.Replace(workingText,"$1<img src='$3' align='left' style='margin-right:15pt'>")
610
 
611
  gRE.IgnoreCase = True
612
  gRE.Pattern = "(\s)(imageright:local|imgright:local):([^ \t\n\r]+)"
613
  workingText=gRE.Replace(workingText,"$1<img src='$3' align='right' style='margin-left:15pt'>")
614
 
615
  gRE.IgnoreCase = True
616
  gRE.Pattern = "(\s)(imgcenter:local|imagecenter:local|imgmiddle:local|imagemiddle:local):([^ \t\n\r]+)"
617
  workingText=gRE.Replace(workingText,"$1<p align=center><img src='$3' align='middle'></p>" )
618
 
619
 
620
  gRE.IgnoreCase = True
621
  gRE.Pattern = "(\s)(img|image):([^ \t\n\r]+)"
622
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3'>")
623
 
624
  gRE.Pattern = "(\s)(imgleft|imageleft):([^ \t\n\r]+)"
625
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3' align='left' style='margin-right:15pt'>")
626
 
627
  gRE.Pattern = "(\s)(imgright|imageright):([^ \t\n\r]+)"
628
  workingText=gRE.Replace(workingText,"$1<img title='$3' src='$3' align='right' style='margin-left:15pt'>")
629
 
630
  gRE.Pattern = "(\s)(imgcenter|imagecenter|imgmiddle|imagemiddle):([^ \t\n\r]+)"
631
  workingText=gRE.Replace(workingText,"$1<p align=center><img title='$3' src='$3' align='middle' ></p>")
632
 
633
  ' local links
634
  gRE.IgnoreCase = True
635
  gRE.Pattern = "(\s)(local):([^ \t\n\r]+)"
636
  workingText=gRE.Replace(workingText,"$1<a href='$3' >$3</a>")
637
 
638
 
639
  gRE.IgnoreCase = False
640
  imageize = workingText
641
 
642
End Function
643
 
644
Function isbnize(txt)
645
  ' include a tag like isbn:0000000000
646
  ' to get a link to a book on Amazon <a href="amazonURL?isbn=0000">0000</a>
647
  Dim workingText
648
  workingText = txt
649
 
650
  gRE.IgnoreCase = True
651
  gRE.Pattern = "(\s)(isbn|ISBN):(\d{9}[\dX])"
652
  workingText=gRE.Replace(workingText,"$1<a  title='Amazon $3' href='http://www.amazon.com/exec/obidos/ISBN=$3'>ISBN:$3</a>")
653
 
654
  gRE.IgnoreCase = False  ' switch it back
655
  isbnize = workingText
656
 
657
End Function
658
 
659
Function IsRequestFromWikiASPPage
660
 
661
  dim sHidden
662
  sHidden = Request.Form("hiddenInput")
663
 
664
  If IsEmpty(sHidden) Then
665
     response.write "hmmm empty"
666
     IsRequestFromWikiASPPage = False
667
  End if
668
 
669
  If sHidden <> "errv2010" Then
670
     response.write "hmmm=" & sHidden
671
     IsRequestFromWikiASPPage = False
672
  End if
673
 
674
  IsRequestFromWikiASPPage = True
675
 
676
End Function
677
 
678
' Regular expression version ---------------------------
679
Function IsRemoteAdressBlackListedRE
680
 
681
  If Trim(gBlackListedIpsRE  ) = "" Then
682
     IsRemoteAdressBlackListedRE = False
683
  else
684
     gRE.Pattern = gBlackListedIpsRE  
685
 
686
     IsRemoteAdressBlackListedRE = gRE.Test( remoteIPHost)
687
  End If
688
End Function
689
 
690
' Non RE version (Exact)--------------------------------
691
Function IsRemoteBlackListed 
692
 
693
    IsRemoteBlackListed = False
694
 
695
    Dim pos
696
 
697
    pos =  InStr(gBlackListedIps, remoteIPHost3numbers) ' Leading 3 digits. Set IP list as ~1.2.3.~4.5.3~
698
 
699
    If Not IsNull(pos) and pos > 0 Then
700
       IsRemoteBlackListed = True
701
    End If
702
 
703
End Function
704
 
705
 
706
Function hyperlink(txt)
707
  Dim workingText
708
  Dim matches
709
  Dim nHits
710
  Dim thisMatchBefore, thisMatchAfter
711
 
712
  workingText = txt
713
 
714
 
715
  'pattern with no spaces:
716
  'gRE.Pattern = "(http|https)://[^ \t\n\r]+"
717
  'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]]+)"
718
 
719
  'ElreyRonald 8/03  Bjarne 10/31
720
  gRE.Pattern = "([^\[])\[([^\|\]]+)\|((http://|https://|ftp://|mailto:|news:|file:)[^\]\r\n\t]+)\]"
721
  workingText=gRE.Replace(workingText,"$1<a href='$3'>$2</a>")
722
 
723
  'ElreyRonald  local links inside [ | ]
724
  gRE.Pattern = "([^\[])\[([^\|\]]+)\|(local):([^ \t\n\r]+)\]"
725
  workingText=gRE.Replace(workingText,"$1<a href='$4'>$2</a>")
726
 
727
 
728
  'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]\r\n\t]+)"
729
  'Bjarne
730
  gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:|file:)[^\s\<\>\(\)\[\]\r\n\t]+)"
731
  workingText=gRE.Replace(workingText,"$1<a href=""$2"">$2</a>")
732
 
733
 
734
   'This is new  5/2006 see [/Drop]
735
  '[Drop#001##Test]
736
            '       1    [    2      ::              3            ]
737
  gRE.Pattern = "([^\[])\[Drop\#(\S+)\#\#([^\<\>\(\)\=\r\n\t\]]+)\]"
738
  workingText=gRE.Replace(workingText,   _
739
   "$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'> " )
740
 
741
 
742
 
743
  ' interwiki  by Elrey
744
  ' example:  [Sample One=CpOrders::SampleOne]
745
            '       1    [     2    =   3      ::               4            ]
746
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^=\]]+)\:\:([^\s\<\>\(\)\=\r\n\t\]]+)\]"
747
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$3&o=$4'>$2</a>")
748
 
749
  ' interwiki  by Elrey
750
  ' example:  [Sample One=CpOrders::]
751
            '       1    [     2    =   3      ::    ]
752
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^=\]]+)\:\:\]"
753
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$3'>$2</a>")
754
 
755
 
756
 
757
  ' intern link by Bernd Michalke 9/15/2005
758
  ' [anything geht=WikiASP]
759
 
760
  gRE.Pattern = "([^\[])\[([^=\]]+)\=([^\s\<\>\(\)\=\r\n\t\]]+)\]"
761
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$3'>$2</a>")
762
 
763
  ' intern link by Elrey 3/2006
764
  ' [=WikiASP]
765
  '              (--1--)   (-2----)
766
  gRE.Pattern = "([^\[])\[=([^\]]+)\]"
767
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$2'>$2</a>")
768
 
769
' intern link by Elrey 3/2006
770
  ' [[WikiAS P topic]]
771
  '              (--1--)    (---2--)
772
  gRE.Pattern = "([^\[])\[\[([^\]]+)\]\]"
773
  workingText=gRE.Replace(workingText,"$1<a href='"& gScriptURL & "&o=$2'>$2</a>")
774
 
775
 
776
  ' interwiki  by Elrey
777
  ' example:  [CpOrders::SampleOne]
778
            '       1    [     2   ::   3         ]
779
  gRE.Pattern = "([^\[])\[([^=\]]+)\:\:([^\s\<\>\(\)\=\r\n\t\]]+)\]"
780
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$2&o=$3'>$3</a>")
781
 
782
  ' interwiki  by Elrey
783
  ' example:  [CpOrders::]
784
            '       1    [    2  ::    ]
785
  gRE.Pattern = "([^\[])\[([^=\]]+)\:\:\]"
786
  workingText=gRE.Replace(workingText,"$1<a href='" & gScript & "?db=$2'>$2</a>")
787
 
788
 
789
  hyperlink = workingText
790
 
791
End Function
792
 
793
 
794
 
795
Function PreHack(isTeksten)
796
    Dim arr
797
    Dim element
798
    Dim preOn
799
    Dim newText
800
 
801
    preOn = False
802
    arr = Split(isTeksten, vbCrLf)
803
 
804
    For Each element In arr
805
    If newtext <> "" Then
806
        newtext = newtext & vbCrLf
807
    End If
808
    ' line begins with a space
809
    If left(element, 1) = " " Then
810
        ' start pre tag
811
        If preOn = False Then
812
        preon = true
813
        newText = newtext & "<pre>" & vbcrlf & element
814
        ' already in pre tag
815
        else
816
        newtext = newtext & element
817
        end if
818
    ' empty line
819
    elseif element = "" then
820
        newtext = newtext & vbcrlf
821
    ' line begins with something besides a space
822
    else
823
        ' turn pre off
824
        if preon then
825
        newText = newtext & "</pre>" & vbcrlf & element
826
        preon = false
827
        ' just append element
828
        else
829
        newtext = newtext & element
830
        end if
831
    end if
832
    next
833
    if preon then
834
    newtext = newtext & "</pre>"
835
    preon = false
836
    end if
837
    prehack = newtext
838
end function
839
 
840
 
841
 
842
function xform(isTeksten)
843
  ' this is the transformation routine, in which all the markup
844
  ' is transformed into HTML.
845
  '
846
  ' ordering of the stages is important.
847
  '
848
  dim newText
849
  newText = vbcrlf & isTeksten ' need a space to deal with first-line wikiname
850
 
851
  'Elrey - move HTML removal into here
852
  If gRemoveHtml Then
853
     newText = removeHTML(newText)
854
  End If
855
 
856
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey
857
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:80pt;"">")
858
  newText=replace(newText,vbcrlf & "&gt;&gt;&gt;",vbcrlf & "<p style=""margin-left:60pt;"">")
859
  newText=replace(newText,vbcrlf & "&gt;&gt;",vbcrlf & "<p style=""margin-left:40pt;"">")
860
  newText=replace(newText,vbcrlf & "&gt;",vbcrlf & "<p style=""margin-left:20pt;"">")
861
 ' Elrey 3/2007
862
 newText=replace(newText,vbcrlf & ">>>>>>>>>*",vbcrlf & "<p style=""margin-left:135pt;margin-top:2pt;"">&#9827;&nbsp;")
863
 newText=replace(newText,vbcrlf & ">>>>>>>>*",vbcrlf & "<p style=""margin-left:120pt;margin-top:2pt;"">&#8574;&nbsp;")
864
 newText=replace(newText,vbcrlf & ">>>>>>>*",vbcrlf & "<p style=""margin-left:105pt;margin-top:2pt;"">&#959;&nbsp;")
865
 newText=replace(newText,vbcrlf & ">>>>>>*",vbcrlf & "<p style=""margin-left:90pt;margin-top:2pt;"">&#8226;&nbsp;")
866
 newText=replace(newText,vbcrlf & ">>>>>*",vbcrlf & "<p style=""margin-left:75pt;margin-top:2pt;"">&#9830;&nbsp;")
867
 newText=replace(newText,vbcrlf & ">>>>*",vbcrlf & "<p style=""margin-left:60pt;margin-top:2pt;"">&#8594;&nbsp;")
868
 newText=replace(newText,vbcrlf & ">>>*",vbcrlf & "<p style=""margin-left:45pt;margin-top:2pt;"">&#9674;&nbsp;")
869
 newText=replace(newText,vbcrlf & ">>*",vbcrlf & "<p style=""margin-left:30pt;margin-top:2pt;"">&#959;&nbsp;")
870
 newText=replace(newText,vbcrlf & ">*",vbcrlf & "<p style=""margin-left:15pt;margin-top:2pt;"">&#8226;&nbsp;")
871
 
872
 
873
 
874
  ' indented paragraph second level using '>' (  '|' is now used with Tables - Elrey  updated 3/2007
875
  newText=replace(newText,vbcrlf & ">>>>>>>>>",vbcrlf & "<p style=""margin-left:135pt;margin-top:2pt;"">")
876
  newText=replace(newText,vbcrlf & ">>>>>>>>",vbcrlf & "<p style=""margin-left:120pt;margin-top:2pt;"">")
877
  newText=replace(newText,vbcrlf & ">>>>>>>",vbcrlf & "<p style=""margin-left:105pt;margin-top:2pt;"">")
878
  newText=replace(newText,vbcrlf & ">>>>>>",vbcrlf & "<p style=""margin-left:90pt;margin-top:2pt;"">")
879
  newText=replace(newText,vbcrlf & ">>>>>",vbcrlf & "<p style=""margin-left:75pt;margin-top:2pt;"">")
880
  newText=replace(newText,vbcrlf & ">>>>",vbcrlf & "<p style=""margin-left:60pt;margin-top:2pt;"">")
881
  newText=replace(newText,vbcrlf & ">>>",vbcrlf & "<p style=""margin-left:45pt;margin-top:2pt;"">")
882
  newText=replace(newText,vbcrlf & ">>",vbcrlf & "<p style=""margin-left:30pt;margin-top:2pt;"">")
883
  newText=replace(newText,vbcrlf & ">",vbcrlf & "<p style=""margin-left:15pt;margin-top:2pt;"">")
884
 
885
 
886
 
887
 
888
  ' newlines: three newlines = a blank line
889
  newText=replace(newText,vbcrlf & vbcrlf & vbcrlf,vbcrlf & "<br/>&nbsp;<br/></p><p>" & vbcrlf )
890
 
891
  ' newlines: two newlines = a hard return
892
  newText=replace(newText,vbcrlf & vbcrlf,vbcrlf & "<br/></p><p>" & vbcrlf )
893
 
894
 
895
  EmitDebug 10, 4, "xform-before(" &  newText & ")<br/>"
896
 
897
  If right(newText,2) <> vbcrlf Then
898
    newText = newText & vbcrlf
899
  End If
900
 
901
  'David Purdie
902
  newText=replace(newText, "$Page$", glsTopic )
903
  newText=replace(newText, "$image$", "local:images/page_" + glsTopic )
904
  newText=replace(newText, "$domain$", gHttpDomain )
905
 
906
  ' toc david
907
  newText = AddAnchors(newText)
908
 
909
  'Elrey Ronald
910
  newText=replaceListPattern(newText, "        *", "<ul>", "</ul>", "<li> ", "</li>")
911
  newText=replaceListPattern(newText, "        :*", "<ol>", "</ol>", "<li> ", "</li>")
912
  newText=replaceListPattern(newText, "        1.", "<ol>", "</ol>", "<li> ", "</li>")
913
 
914
  'Elrey Ronald - more convenient bullet list
915
  newText=replaceListPattern(newText, " *", "<ul>", "</ul>", "<li> ", "</li>")
916
  newText=replaceListPattern(newText, " :*", "<ol>", "</ol>", "<li> ", "</li>")
917
  newText=replaceListPattern(newText, " 1.", "<ol>", "</ol>", "<li> ", "</li>")
918
 
919
  'Elrey Ronald - Table Pattern
920
  newText=replaceListPattern(newText, "||^!|^|!^!!", "<table border=1 class=TableClass>", "</table>", "_tmp_0^_tmp_1^_tmp_2^_tmp_3", "</td></tr>")
921
 
922
  newText=replaceTableColumnPattern(newText)
923
 
924
  ' leading space rule
925
  newText = PreHack(newText)
926
 
927
' outline ( ElreyRonald )
928
 
929
  gRE.Pattern = "\r\n\[(\d+)\]======([^\r\n]+)"
930
  newText=gRE.Replace(newText,"<h6>[<a name='$1' href='#fn_$1'>$1</a>] $2</h6>")
931
  gRE.Pattern = "\r\n\[(\d+)\]=====([^\r\n]+)"
932
  newText=gRE.Replace(newText,"<h5>[<a name='$1' href='#fn_$1'>$1</a>] $2</h5>")
933
  gRE.Pattern = "\r\n\[(\d+)\]====([^\r\n]+)"
934
  newText=gRE.Replace(newText,"<h4>[<a name='$1' href='#fn_$1'>$1</a>] $2</h4>")
935
  gRE.Pattern = "\r\n\[(\d+)\]===([^\r\n]+)"
936
  newText=gRE.Replace(newText,"<h3>[<a name='$1' href='#fn_$1'>$1</a>] $2</h3>")
937
  gRE.Pattern = "\r\n\[(\d+)\]==([^\r\n]+)"
938
  newText=gRE.Replace(newText,"<h2>[<a name='$1' href='#fn_$1'>$1</a>] $2</h2>")
939
 
940
  ' footnote ( ElreyRonald )
941
 
942
  gRE.Pattern = "\r\n\[(\d+)\]\r\n"    ' blank footnote will just be an anchor (ElreyRonald)
943
  newText=gRE.Replace(newText,  "<a name='$1' href='#fn_$1'><hr size=1></a>" & vbcrlf)
944
 
945
  gRE.Pattern = "\r\n\[(\d+)\]"
946
  newText=gRE.Replace(newText,  "<br>[<a name='$1' href='#fn_$1'>$1</a>]")
947
 
948
  gRE.Pattern = "\[(\d+)\]"
949
  newText=gRE.Replace(newText, "[<a href='#$1' name='fn_$1'>$1</a>]")
950
 
951
  ' topic line (ElreyRonald)
952
  gRE.Pattern = "\r\n======([^\r\n]+)"
953
  newText=gRE.Replace(newText,"<h6>$1</h6>")
954
  gRE.Pattern = "\r\n=====([^\r\n]+)"
955
  newText=gRE.Replace(newText,"<h5>$1</h5>")
956
  gRE.Pattern = "\r\n====([^\r\n]+)"
957
  newText=gRE.Replace(newText,"<h4>$1</h4>")
958
  gRE.Pattern = "\r\n===([^\r\n]+)"
959
  newText=gRE.Replace(newText,"<h3>$1</h3>")
960
  gRE.Pattern = "\r\n==([^\r\n]+)"
961
  newText=gRE.Replace(newText,"<h2>$1</h2>")
962
 
963
  ' horizontal rule
964
  gRE.Pattern = "\r\n-{4,}"
965
  newText=gRE.Replace(newText,vbCrLf & "<hr size=1 noshade=false />" & vbcrlf)
966
 
967
  ' special case for dash and a-umlaut - MARKUS
968
  'newText=replace(newText,"-", "&minus;")  ' this change breaks image URLs that include dashes
969
  newText=replace(newText,"", "&auml;")
970
 
971
  ' removed by ElreyRonald, use "|"
972
  ' newText=replace(newText,chr(9) & " :" & chr(9),"<p style=""margin-left:20pt;"">")
973
 
974
  ' Removed by ElreyRonald, use "|"
975
  ' newText=replace(newText,vbcrlf & chr(9) & "]",vbcrlf & "<p style=""margin-left:20pt;"">")
976
 
977
 
978
  '[MARKUS] Underline neu hinzugefgt - -_ irgendwas _-
979
  newText=replace(newText,"-_", "<u>")
980
  newText=replace(newText,"_-","</u>")
981
 
982
  '[Markus] LEERSTELLEN werden in HTML-Leerstellen umgewandelt
983
  'newText=replace(newText," ","&nbsp;")  ' this change screws up images.  Why necessary?   dinoch Thu, 17 Oct 2002
984
 
985
  ' bulleted lists: tab-star
986
  'newText=replace(newText,chr(9) & "*","<li> ")
987
  newText=replaceListPattern(newText, chr(9) & "*", "<ul>", "</ul>", "<li> ", "</li>")
988
 
989
  ' numbered lists: tab-colon-star
990
  newText=replaceListPattern(newText, chr(9) & ":*", "<ol>", "</ol>", "<li> ", "</li>")
991
 
992
  ' numbered lists: Changed to use 1. to conform with http://www.c2.com/cgi/wiki?TextFormattingRules
993
  newText=replaceListPattern(newText, chr(9) & "1.", "<ol>", "</ol>", "<li> ", "</li>")
994
 
995
  ' COLORS: (german and english)- german removed (ElreyRonald)
996
  'SCHRIFTFARBEN {schwarz} {braun} {grn} {blau} {gelb} {rot} {orange}
997
  '{farbe} {/farbe}
998
  newText=replace(newText,"{black}","<font color=black>")
999
  newText=replace(newText,"{/black}","</font>")
1000
  newText=replace(newText,"{green}","<font color=darkgreen>")
1001
  newText=replace(newText,"{/green}","</font>")
1002
  newText=replace(newText,"{blue}","<font color=darkblue>")
1003
  newText=replace(newText,"{/blue}","</font>")
1004
  newText=replace(newText,"{sienna}","<font color=sienna>")
1005
  newText=replace(newText,"{/sienna}","</font>")
1006
  newText=replace(newText,"{red}","<font color=firebrick>")
1007
  newText=replace(newText,"{/red}","</font>")
1008
  newText=replace(newText,"{pink}","<font color=deeppink>")
1009
  newText=replace(newText,"{/pink}","</font>")
1010
 
1011
  ' 5/2006
1012
  newText=replace(newText,"[/Drop]","</div></div>")
1013
 
1014
  '
1015
  newText=replace(newText,"{italic}","<I>")
1016
  newText=replace(newText,"{/italic}","</I>")
1017
  newText=replace(newText,"{bold}","<strong>")
1018
  newText=replace(newText,"{/bold}","</strong>")
1019
 
1020
  ' CHANGE SIZE / SCHRIFTGRSSE
1021
  'SMALLER / KLEINER
1022
  newText=replace(newText,"{small}","<font size='-1'>")
1023
  newText=replace(newText,"{/small}","</font>")
1024
  newText=replace(newText,"{smaller}","<font size='-2'>")
1025
  newText=replace(newText,"{/smaller}","</font>")
1026
  newText=replace(newText,"{smallest}","<font size='-3'>")
1027
  newText=replace(newText,"{/smallest}","</font>")
1028
  'LARGER / GRSSER
1029
  newText=replace(newText,"{big}","<font size='+1'>")
1030
  newText=replace(newText,"{/big}","</font>")
1031
  newText=replace(newText,"{bigger}","<font size='+2'>")
1032
  newText=replace(newText,"{/bigger}","</font>")
1033
  newText=replace(newText,"{biggest}","<font size='+3'>")
1034
  newText=replace(newText,"{/biggest}","</font>")
1035
 
1036
  ' this is were you can insert your own bracket comands...
1037
  newText=replace(newText,"{br}","<br/>")
1038
 
1039
 
1040
  ' images:
1041
  newText= imageize(newText)
1042
 
1043
  ' isbns:
1044
  newText= isbnize(newText)
1045
 
1046
  ' auto-hyperlinks
1047
  newText= hyperlink(newText)
1048
 
1049
  ' bold text: three single quotes
1050
  newText= replaceBoundingPattern(newText,"'''","b")
1051
 
1052
  ' em text: two single quotes
1053
  newText= replaceBoundingPattern(newText,"''","em")
1054
 
1055
  ' consolidate a series of trailing vbcrlf to just 2.
1056
  gRE.Pattern = "(\r\n){3,}$"
1057
  newText=gRE.Replace(newText, vbcrlf & vbcrlf)
1058
 
1059
  If  gDisableScripting = false Then
1060
    ' 2007.08.25 disable scripts
1061
    gRE.Pattern = "<([s|S][c|C][r|R][i|I][p|P][t|T])"
1062
    newText=gRE.Replace(newText, "&lt;$1")
1063
  End If
1064
 
1065
 
1066
  EmitDebug 11, 4, "xform-after(" &  newText & ")<br/>"
1067
 
1068
  newText = Replace(newText, "#@91;", "[")
1069
  newText = Replace(newText, "#@93;", "]")
1070
  newText = Replace(newText, "#@3A;", ":")
1071
  newText = Replace(newText, "#@3C;", "<")
1072
  newText = Replace(newText, "#@3E;", ">")
1073
 
1074
  xform = newText
1075
 
1076
End Function
1077
 
1078
 
1079
Function WalkWiki(isTeksten)
1080
    Dim myText
1081
    myText = isTeksten
1416 dpurdie 1082
    WalkWiki = myText
1405 dpurdie 1083
 
1084
End Function
1085
 
1086
function RemoveBrackets(s)
1087
  Dim ts
1088
  ts = replace( s, "[","")
1089
  ts = replace( ts, "]","")
1090
  RemoveBrackets = ts
1091
end function
1092
 
1093
function RemoveSpaces(s)
1094
  Dim ts
1095
  ts = replace( s, " ","")
1096
  RemoveSpaces = ts
1097
end function
1098
 
1099
 
1100
 
1101
Sub EmitDebug(sig,lvl,arg)
1102
  If gDebug >= lvl Then Response.Write("debug:" & sig & " " & arg & vbcrlf)
1103
End Sub
1104
 
1105
 
1106
'----------------------------------------------------
1107
' This function builds and returns the connection
1108
' string, based on input provided from the web form.
1109
'
1110
function ConnStr(includeMode)
1111
  dim localDs
1112
  ' Map MDB database to physical path
1113
   if len(gDocRootDir) > 0 then
1114
      localDs = gDataSource
1115
   else
1116
      localDs = Server.MapPath(gDataSource)
1117
   end if
1118
 
1119
  ConnStr= "Provider=" & gProvider & ";Data Source=" & localDs & ";"
1120
  if (includeMode) then
1121
      ConnStr=   ConnStr & "mode= Share Deny None"
1122
  end if
1123
  EmitDebug 20, 3, "ConnStr= (" &  ConnStr & ")<br/>"
1124
end function
1125
 
1126
 
1127
 
1128
sub CheckDbErrors
1129
  if  gDataConn.errors.count> 0 then
1130
    dim counter
1131
    response.write "<br/><b>Database Errors Occurred" & "</b><br/>" & vbcrlf
1132
    for counter= 0 to gDataConn.errors.count
1133
      response.write "Error #" & gDataConn.errors(counter).number & vbcrlf & "<br/>"
1134
      response.write "  Description(" & gDataConn.errors(counter).description & ")" & vbcrlf & "<br/>"
1135
    next
1136
  else
1137
    response.write "<br/><b>No Database Errors Occurred" & "</b><br/>" & vbcrlf
1138
  end if
1139
end sub
1140
 
1141
 
1142
' Elrey Ronald  2/21/05
1143
sub VerifyWikiTableNoAdoxComponent
1144
  on error resume next
1145
  gDataConn.Open ConnStr(0)
1146
  on error goto 0
1147
 
1148
  on error resume next
1149
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1150
  on error goto 0
1151
 
1152
end sub
1153
 
1154
'----------------------------------------------------------------------------
1155
' VerifyWikiTable
1156
' This routine:
1157
' (a) verifies the existence of the target database (dbname) at the given
1158
'     ADO connection.  If necessary, this routine creates that
1159
'     database.
1160
' (b) verifies the existence of the table in that database.  If necessary,
1161
'     this routine will create the required table, and build the table
1162
'     structure.  The columns in the target table are determined by the
1163
'     fields in the source record set (sourceRs).   Two additional
1164
'     columns are also added. (in fact we do not use the entire recordset,
1165
'     but only the collection of fields in the recordset.
1166
'
1167
 
1168
sub VerifyWikiTable
1169
  if not gAutoCreateMdb then
1170
     Call VerifyWikiTableNoAdoxComponent
1171
     Exit Sub
1172
  End If
1173
  dim tbl, cat, dbname, fso
1174
  dim fsoErrMessage, adoxErrMessage, instructions
1175
 
1176
  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>"
1177
  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>"
1178
  instructions =   "<LI>You may have to <b>MANUALLY</b> create the folder/MsAccess file -> <b>" & gDataSource & " </b> </LI>"  & _
1179
                   "<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>" & _
1180
                   "<LI>You may modify 'gAutoCreateMdb' and set it to false to prevent creation of MDB and avoid this message." & _
1181
                   "<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>" & _
1182
                   "<BR><BR><B><i>Now trying to use default values to see if this would work...</i></B>"
1183
 
1184
  err.clear
1185
  ' Check if ADOX.Catalog component is available in this computer
1186
  on error resume next
1187
  set cat= CreateObject("ADOX.Catalog")
1188
  on error goto 0
1189
 
1190
  ' Check if FileSystemObject component is available in this computer
1191
  on error resume next
1192
  set fso = CreateObject("Scripting.FileSystemObject")
1193
  on error goto 0
1194
 
1195
  If Not IsObject(cat) or cat is nothing Then
1196
     Response.Write( adoxErrMessage)
1197
     Response.Write( instructions )
1198
     Call VerifyWikiTableNoAdoxComponent
1199
     Exit Sub
1200
  End If
1201
 
1202
  err.clear
1203
  If Not IsObject(fso)  Then
1204
     Response.Write( fsoErrMessage)
1205
     Response.Write( instructions )
1206
     Call VerifyWikiTableNoAdoxComponent
1207
     Exit Sub
1208
  End If
1209
 
1210
  if len (gDocRootDir) > 0 then
1211
    dbname = gDataSource
1212
  else
1213
    dbname = Server.MapPath(gDataSource)
1214
  end if
1215
 
1216
  '--------------------------------------------
1217
  ' step 0: check the directory, create if necessary
1218
  dim folder, f1
1219
  if len (gDocRootDir) > 0 then
1220
    f1 = gDocRootDir & "\" & gDataSourceDir
1221
  else
1222
    f1 = Server.MapPath(gDataSourceDir)
1223
  end if
1224
  if not fso.FolderExists(f1) then
1225
      on error resume next
1226
      Set folder = fso.CreateFolder(f1)
1227
      on error goto 0
1228
      If Not IsObject(folder) Then
1229
         Response.Write( "Unable to create [" & f1 & "].  Please modify DOCROOT and gDataSourceDir in the program. Consult your website settings." )
1230
         Response.End
1231
      End If
1232
      set folder = nothing
1233
  end if
1234
  set fso = nothing
1235
  '---- some security here
1236
 
1237
  If gDataSourceFile <> gDefaultHomePage Then
1238
    Dim pwd
1239
    If Request.QueryString("pw") <> gPassword Then
1240
        Response.Write("Sorry but the Database (db) requested does not exist.  Correct password must be sent to create it.")
1241
        Response.End
1242
    End If
1243
  End If
1244
  '--------------------------------------------
1245
  ' step 1: create the new db catalog, if necessary
1246
  Err.Clear
1247
  EmitDebug 21, 2, vbcrlf & " creating db " & dbname & "<br/>"
1248
on error resume next
1249
  cat.Create ConnStr(0)
1250
  on error goto 0
1251
  EmitDebug 22, 2, ">> error(" & err.Number & "," & err.Description &  ")<br/>"
1252
  'EmitDebug 23, 2, vbcrlf & " catConnErrorCount(" & _
1253
  '    cat.ActiveConnection.errors.count  & ")<br/>"
1254
 
1255
  if not (err.Number = 0) then
1256
    if not (err.Description = "Database already exists." ) then
1257
      dim sError
1258
      sError = ">> error(" & err.Number & "," & err.Description & ")" & _
1259
          "(EXPECTED ""Database already exists"")..." & "<br/>"
1260
      EmitDebug 24, 2, sError
1261
      Response.Write( "<span style='color:red'>Fatal error creating db: " & err.Number & " " & err.description & "</span>")
1262
    else
1263
      EmitDebug 25, 2, ">> Database already exists..." & "<br/>"
1264
      cat.ActiveConnection= ConnStr(0)
1265
    end if
1266
  else
1267
    EmitDebug 26, 2, ">> Database has just been created..." & "<br/>"
1268
  end if
1269
  EmitDebug 27, 2, " Database now exists..." & "<br/>"
1270
 
1271
 
1272
  '--------------------------------------------
1273
  ' step 2: create the new table, with columns, if necessary
1274
  Err.Clear
1275
  EmitDebug 28, 2, " verifying presence of table(" & gDbTableName & ")<br/>"
1276
  'if not isNothing(gDataConn) then set gDataConn = nothing
1277
  on error resume next
1278
  set gDataConn = Server.CreateObject("ADODB.Connection")
1279
  on error goto 0
1280
  If Not IsObject(gDataConn) Then
1281
    Response.Write ( "Unable to establish connection. Missing ADO object.")
1282
    Response.End
1283
  End If
1284
 
1285
  on error resume next
1286
  gDataConn.Open ConnStr(0)
1287
  on error goto 0
1288
 
1289
 
1290
  on error resume next
1291
  gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2")
1292
  on error goto 0
1293
 
1294
  if (0 = gDataConn.errors.count) then
1295
      EmitDebug 29, 1, vbcrlf & "(no db errors, ergo table exists)"  & "<br/>"
1296
  elseif ((gDataConn.errors.count>0) and ( ADOERROR_NOTABLE = gDataConn.errors(0).number)) then
1297
      set gDataConn = nothing
1298
      ' error: table does not exist.
1299
      EmitDebug 30, 2, vbcrlf & " creating table " & gDbTableName  & "<br/>"
1300
      Dim idx 'As New ADOX.Index
1301
      set idx= CreateObject("ADOX.Index")
1302
      ' now, create a new table in the db:
1303
      set tbl= CreateObject("ADOX.Table")
1304
      With tbl
1305
      ' drop tbl into a MDB provider context; need to do this NOW
1306
      ' to be able to use autoIncrement, later.
1307
      set .ParentCatalog = cat
1308
 
1309
      ' Name the new table.
1310
      .Name = gDbTableName
1311
 
1312
      .Columns.Append "ID", 3
1313
      .Columns("ID").Properties("AutoIncrement") = True
1314
 
1315
      .Columns.Append "Title", 202, 127
1316
      .Columns.Append "PageData", 203
1317
      .Columns.Append "PrevPageData", 203
1318
      .Columns("PrevPageData").Properties("Jet OLEDB:Allow Zero Length") = True
1319
      .Columns("PrevPageData").Properties("Nullable") = True
1320
      .Columns.Append "LastUpdate", 7     ' timestamp
1321
      .Columns.Append "LastEditor", 202, 127
1322
 
1323
      ' create the Primary Key :
1324
      idx.Name = "RecordIndex"
1325
      idx.Columns.Append "ID"
1326
      idx.PrimaryKey = True
1327
      idx.Unique = True
1328
      .Indexes.Append idx
1329
 
1330
 
1331
 
1332
      End With
1333
 
1334
      ' this appends the table to the db catalog
1335
      cat.Tables.Append  tbl
1336
      EmitDebug 31, 2, vbcrlf & " post-append: catConnErrorCount(" & _
1337
      cat.ActiveConnection.errors.count  & ")<br/>"
1338
 
1339
      set idx= nothing
1340
 
1341
      ' insert the first record into the newly-created table
1342
      EmitDebug 32, 2,  ">> inserting into table(" & gDbTableName  & ")<br/>"
1343
 
1344
      set gDataConn = Server.CreateObject("ADODB.Connection")
1345
      gDataConn.Open ConnStr(1)
1346
 
1347
      dts = Now
1348
      EmitDebug 33, 2,  ">> the time is now(" & dts  & ")<br/>"
1349
 
1350
      DoInitialPageCreation(".")
1351
 
1352
  else
1353
      EmitDebug 34, 2,  ">> table " & tablename & " already exists?" & "<br/>"
1354
  end if
1355
 
1356
  set cat = nothing
1357
  set tbl = nothing
1358
  on error goto  0
1359
 
1360
end sub
1361
 
1362
 
1363
Function DoInitialPageCreation(folderspec)
1364
  Dim fso, f, f1, fc, s, dts, sPageData, fPage, stmnt
1365
  Set fso = CreateObject( "Scripting.FileSystemObject" )
1366
 
1367
  EmitDebug 35, 2,  ">> checking dir (" & Server.MapPath(folderspec) & ")<br/>"
1368
  Set f = fso.GetFolder(Server.MapPath(folderspec))
1369
  Set fc = f.Files
1370
  EmitDebug 36, 2,  ">> files counted (" & fc.Count & ")<br/>"
1371
  For Each f1 in fc
1372
    if (Right(f1.name, 4) = ".wik") then
1373
        s = Left(f1.name, Len(f1.name)-4)
1374
        EmitDebug 37, 2,  ">> found file  (" & s & ")<br/>"
1375
        on error resume next
1376
        set fPage= fso.OpenTextFile(Server.MapPath(f1.name),FOR_READING)
1377
        sPageData = fPage.ReadAll
1378
        on error goto 0
1379
        fPage.Close
1380
        set fPage = nothing
1381
        dts = Now  ' timestamp
1382
        EmitDebug 38, 2,  ">> inserting record (" & s & ")<br/>"
1383
 
1384
        stmnt = "INSERT INTO " & gDbTableName & " (Title,PageData,PrevPageData,LastUpdate,LastEditor) " & _
1385
        "VALUES ( '" & s & "','" & safeQuote(sPageData) & "', '--', '" & dts & "', '" & gScript & " (initial creation)');"
1386
        on error resume next
1387
        gDataConn.execute(stmnt)
1388
        on error goto 0
1389
        if gDebug>=1 then CheckDbErrors
1390
    end if
1391
  Next
1392
  set fso = nothing
1393
  set f = nothing
1394
  set fc = nothing
1395
 
1396
end Function
1397
 
1398
 
1399
 
1400
function theWhereClause(theStr)
1401
  dim result
1402
  result= ""
1403
  dim myArray
1404
  dim element
1405
  EmitDebug 39, 1, "whereClause(" & theStr & ")<br/>" & vbcrlf
1406
 
1407
  myArray = split(Trim(theStr), " ")
1408
  for each element in myArray
1409
    element = Trim(element)
1410
    if (result = "") then
1411
      result = " where "
1412
    else
1413
      result = result & " and "
1414
    end if
1415
    result= result &  " PageData like '%" & element & "%'"
1416
  next
1417
  EmitDebug 40, 1, "whereClause:result(" & result & ")<br/>" & vbcrlf
1418
  theWhereClause = result
1419
 
1420
end function
1421
 
1422
sub handleLogout
1423
    Dim url
1424
    url = gScriptURL & "&o=" & glsTopic
1425
    Session.Abandon
1426
    Response.Redirect(url)
1427
end sub
1428
 
1429
sub handleEdit
1430
    If gHideLogin Then
1452 dpurdie 1431
        Response.Write("<br/><br/><br/><br/><br/><center><h2>Editing is not allowed</h2></center>")
1432
        Response.End
1405 dpurdie 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>"
1452 dpurdie 2085
         if ( Not IsEmpty(Application("TestSystem"))  ) Then
2086
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<span style='color: #FF0000;font-weight: bold;'>Development Web Server</span>"
2087
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2088
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=edit&o=" & rs("title") & "'>Edit page</a>"
2089
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&o=TextFormattingRules'>Text Formatting Rules</a>"
2090
            bannerPart =  bannerPart &  "&nbsp;|&nbsp;<a href='" & gScriptURL & "&a=logout&o=" & rs("title") & "'>Log out</a>"
2091
         End If
1405 dpurdie 2092
         bannerPart =  bannerPart &  "<hr>"
2093
 
2094
         bannerPart =  bannerPart &  " <table class='cssBannerTable' id='idBannerTable' cellSpacing='0' cellPadding='0' border='0'>"
2095
         bannerPart =  bannerPart &  "    </tr>"
2096
         bannerPart =  bannerPart &  "    <tr class='cssBannerRow' id='idBannerRow'> "
2097
         bannerPart =  bannerPart &  "          <td class='cssBannerCellIcon' id='idBannerCellIcon' valign='top'> $$icon$$</td>"
2098
         bannerPart =  bannerPart &  "          <td width=90% class='cssBannerCellText' id='idBannerCellText' valign='bottom' align='left' >"
2099
         bannerPart =  bannerPart &  "            <h1 class='cssBannerSpanText' id='idBannerSpanText'>$$banner_text$$</h1>"
2100
         bannerPart =  bannerPart &  "          </td>"
2101
         bannerPart =  bannerPart &  "          <td>"
2102
         bannerPart =  bannerPart &  "          <td class='cssTopSearch'id='idTopSearch' >"         	
2103
         If not gHideTopSearch Then
2104
             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;"
2105
         End If
2106
         bannerPart =  bannerPart &  "          </td><td>&nbsp;&nbsp;&nbsp;</d>"
2107
         bannerPart =  bannerPart &  "    </tr>"
2108
         bannerPart =  bannerPart &  " </table>"
2109
 
2110
      Else
2111
 
2112
         bannerPart = gBannerTemplate
2113
      End if
2114
 
2115
      bannerPart = Replace( bannerPart, "$$icon$$", iconPart)
2116
      bannerPart = Replace( bannerPart, "$$banner_text$$", bannerTextPart)
2117
 
2118
 
2119
      Response.Write ( bannerPart )
2120
 
2121
      response.write " <div class='wikibody'>" & WalkWiki(  xform( "<span id=bodyPrefix>" & vbcrlf & gWikiBodyPrefix & VbCrLF & "</span>" & VbCrLF &  rs("PageData")))  ' Elrey - xform func now removes html
2122
 
2123
      response.write "</b></i></font></u></strong></font>"
2124
 
2125
 
2126
      dim hideScript
2127
      hideScript = "var div1=document.getElementById('wikifooter'); if (div1) {div1.style.display='none';}"
2128
      hideScript = hideScript & "div1=document.getElementById('bodyPrefix'); if (div1) {div1.style.display='none';}"
2129
      hideScript = hideScript & "div1=document.getElementById('idTopSearch'); if (div1) {div1.style.display='none';}"
2130
 
2131
 
2132
      If Not gHideWikiFooter Then
2133
          response.write "<div id=wikifooter class=footer ><form method='POST' action=""" & gScript & """ id=""formFooter"" name=""formFooter""><br>"
2134
          response.write "<hr size=1 noshade=true>"
2135
          If Not gHideLastEditor Then
2136
            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/>"
2137
          end if
2138
          response.write "<font size=-1>Domain: " & gHttpDomain & "</font><br>"
2139
 
1452 dpurdie 2140
'          response.write "<a href='" & gScriptURL & "' title='GO TO START PAGE'>Home</a> | "
2141
'          if  Not gHideLogin Then
2142
'            response.write "<a href='" & gScriptURL & "&a=edit&o=" & rs("title") & "'>Edit page</a> | "
2143
'          end if
2144
'          response.write "<a href='" & gScriptURL & "&a=logout&o=" & rs("title") & "'>Log out</a> | "
2145
'          response.write "<a href='" & gScriptURL & "&a=list&o=ByTitle'>List pages</a> |  "
2146
'          response.write "<a href='" & gScriptURL & "&a=list&o=recent'>Recent pages</a>"
2147
'          If gHttpDomain <> "" Then
2148
'            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>"
2149
'          End If
2150
'
2151
'          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> "
1405 dpurdie 2152
          response.write "</div>"
2153
      End If
2154
  end if
2155
 
2156
end sub
2157
 
2158
 
2159
 
2160
sub handleCreate
2161
  on error resume next
2162
  VerifyWikiTable
2163
  on error goto 0
2164
  Response.Redirect gScriptURL
2165
end sub
2166
 
2167
 
2168
 
2169
'Intercept RSS request here
2170
if ( glsMode = "rss" ) then
2171
  If ( gHttpDomain = "" ) then
2172
    response.write("RSS is not enabled")
2173
  Else
2174
    handleRss
2175
  End If
2176
  response.End
2177
end if
2178
'Intercept delete request here
2179
if ( glsMode = "del") then
2180
  handleDelete
2181
  response.End
2182
end if
2183
 
2184
 
2185
'********************************************************************
2186
'*********************************************************************
1408 dpurdie 2187
'<?xml version="1.0" encoding="UTF-8" ?>
2188
'<!DOCTYPE html
2189
'     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
2190
'     "DTD/xhtml1-transitional.dtd">
2191
'
1405 dpurdie 2192
%>
2193
<html>
2194
    <head>
2195
        <meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
2196
        <title>
2197
            <%
2198
      if not isEmpty(glsMode) and glsMode <> "browse" then
2199
        response.write(glsMode & " ")
2200
      end if
2201
      response.write(SpaceName(glsTopic) & vbcrlf)
2202
    %>
2203
        </title>
1408 dpurdie 2204
        <LINK REL="StyleSheet" HREF="<%=gStyleSheet%>" TYPE="text/css" >
1405 dpurdie 2205
<%
2206
       Response.Write(gHtmlHeadStr)
2207
%>
2208
    </head>
2209
    <body>
2210
 
2211
        <%
2212
 
2213
      if  Session("Hits") = "" then
2214
    Session("Hits")= 1
2215
      else
2216
    Session("Hits")= Session("Hits") + 1
2217
      end if
2218
 
2219
      EmitDebug 52, 1, "debug(" & gDebug & ")<br/>" & vbcrlf
2220
      EmitDebug 53, 1, "<br/>QueryString = (" & Request.QueryString & ")<br/>" & _
2221
    "Hits(" & Session("Hits") & ")<br/>" & _
2222
    "mode(" & glsMode & ")<br/>" & _
2223
    "topic(" & glsTopic & ")<br/>"
2224
 
2225
      set gDataConn = Server.CreateObject("ADODB.Connection")
2226
 
2227
      ' 21 nov - need resume next to catch "no file" error
2228
      on error resume next
2229
      gDataConn.Open ConnStr(1)
2230
      on error goto 0
2231
 
2232
      if not (0 = gDataConn.errors.count) then
2233
    if (ADOERROR_NOFILE = gDataConn.errors(0).number) then
2234
      EmitDebug 54, 1, "<br/>ErrorCount(" & gDataConn.errors.count & ")<br/>" & vbcrlf
2235
      EmitDebug 55, 1, "<br/>Error(" & gDataConn.errors(0).number &") desc(" &_
2236
        gDataConn.errors(0).description & ")<br/>" & vbcrlf
2237
      VerifyWikiTable
2238
    end if
2239
      end if
2240
 
2241
      select case (glsMode)
2242
    case "edit"    handleEdit
2243
    case "list"    handleList
2244
    case "search"  handleSearch
2245
    case "create"  handleCreate
2246
    case "save"    handleSave
2247
    case "browse"  handleBrowse
2248
    case "logout"  handleLogout
2249
    case else
2250
      end select
2251
 
2252
      EmitDebug 56, 2, "<br/>done...<br/>" & vbcrlf
2253
      gDataConn.Close()
2254
      set gDataConn = nothing
2255
    %>
2256
 
2257
<% Response.Write(gFooterHtml) %>
2258
<% Response.Flush  %>