Subversion Repositories DevTools

Rev

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

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