Subversion Repositories DevTools

Rev

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