Subversion Repositories DevTools

Rev

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