Subversion Repositories DevTools

Rev

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

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