Subversion Repositories DevTools

Rev

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

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