<% @LANGUAGE = VBScript %> <% '+----------------------------------------------------------------------------+ '| Description: | '| WikiAsp is a derivative of AspWiki, a wiki program written in ASP. | '| WikiAsp will run on Windows with IIS, MDAC v2.5. WikiAsp will | '| automatically create MS Access DB on first time use. | '| | '| The following are the dlls to make mdb creation work. | '| 1. Program Files\Common Files\System\ado\msadox.dll | '| 2. WINDOWS\System32\scrrun.dll | '| | '| Credits: | '| Elrey Ronald Velicaria. - Author of WikiAsp. (lambda326@hotmail.com) | '| Dino Chiesa - AspWiki author. | '| Contributors: Bjarne D, Julian Tosh | '| | '| Websites: | '| http://www.c2.com/cgi/wiki, http://www.c2.com/cgi/wiki?WikiAsp | '+----------------------------------------------------------------------------+ '| Please retain the above credits on any future versions of this program | '+----------------------------------------------------------------------------+ Option Explicit Response.CacheControl = "no-cache" Response.Expires = -1 Response.AddHeader "Pragma", "no-cache" Dim gPassword, gDefaultIcon, gDefaultHomePage, gAutoCreateMdb Dim gHttpDomain , gDebug, gEngineVersion, gDbTableName Dim gProvider, gDataConn, gDataSource, gDataSourceName Dim gDocRootDir, gDataSourceDir, gDataSourceFile, gSpaceNames Dim gScript, gScriptURL, giEditAreaRows, giEditAreaCols, giNumRecentFiles Dim gHomeTopic, gStyleSheet, gIconName, gEditPassword, gIsOpenWiki Dim glsTopic, glsMode , gHideLastEditor, gLoginFlag, gRemoveHtml,gBlackListedIps Dim gRE, gHighlightFlag, gHideWikiSource, gHideWikiFooter, gHideLogin, gHtmlHeadStr Dim gDisableSave,gTimeZoneOffset, gRssStyle, gRedirectURL Dim gBannerTemplate, gWikiBodyPrefix, gHideTopSearch, gDisableScripting Dim gMdbExtension , gSearchLabel, gBlackListedIpsRE ,gDeletePassword , gPersistPassword Dim gPasswordLabel, gFooterHtml, gEnableEdit '+-----------------------------------------------------------------------------+ '| AN IMPORTANT NOTE: !!!!! | '| Enter your password below for creating new DB and for Delete. | '| Enter your URL inside quotes below e.g. http://www28.brinkster.com/site | '| Modify gDefaultIcon, gDefaultHomePage here is FSO objects is not installed | '+-----------------------------------------------------------------------------+ gAutoCreateMdb = true ' Create db automatically gDisableSave = false ' Set to true if you have to fully disable save. gBlackListedIps = "" ' List of IPs to reject. (Exact match 1st 3 digits of IP, delimit list by ~) gBlackListedIpsRE = "" ' List of IPs to reject (Regular ExpressionMatch) gRemoveHtml = false ' Set to true if HTML input in wiki will be enabled. gLoginFlag = "log" ' The default enable login flag ( must be overriden by config.asp). gIsOpenWiki = true ' Allow editing or Password Protect Editing? gHideWikiSource = false ' Allow viewing of unformatted wiki text when loggin in. gHideWikiFooter = false ' Show or Hide the whole wiki footer gHideLogin = false ' Enable/Disable double-click or Edit. This can be overriden by &log gHideLastEditor = false ' Show/Hide in the footer the info about last edit gDeletePassword = "passworddel" ' password for deleting gEditPassword = "password" ' password for editing the site gPassword = "password" ' password for editing and delete and db creation. gHttpDomain = "auto" ' URL for RSS links to work. Override in config.asp . Set to "" to remove rss footer links gDefaultIcon = "icon" ' This default. Maybe overridden if your site has icon.gif, icon.jpg or xxxx.gif and if FSO is working. gDefaultHomePage = "WikiAsp" ' modify your start page here. this may be overridden by .ini file. The .ini file is same dir as mdb file gDataSourceDir = "db" ' MSAccess folder. this is normally `db` gDocRootDir = "" ' physical absolute path of root (e.g. c:/dc2/mysite.com) make it blank if `gDataSourceDir` is relative to wiki.asp gTimeZoneOffset = "-0400" ' Put your serverTimezone offset here. East Coast is -0400 . gRssStyle = "" ' Example: "" gRedirectURL = "" gMdbExtension = ".mdb" gBannerTemplate = "" ' Banner html is now replaceable you need to remember $$icon$$, $$banner_text$$ variable though gWikiBodyPrefix = "" gHideTopSearch = false gDisableScripting = true gSearchLabel = " Search On:" gPersistPassword = true ' Remember password by default gPasswordLabel = " To edit, enter the password: " ' The prompt label to use when entering a password. 4/2010 gFooterHtml = "" ' Now you can customize the footer with your chosen html. Even remove ads gEnableEdit = false '+-----------------------------------------------------------------------------+ '| DO YOU WANT TO SEPARATE SOME CONFIG SETTINGS IN ANOTHER FILE? | '+-----------------------------------------------------------------------------+ '| IF yes,just uncomment line after this box (by removing single quote as | '| the first character. If you do this, BE SURE TO CREATE config.asp | '| which will override the same variable settings above this box | '+-----------------------------------------------------------------------------+ %><% gDebug = 0 ' 0 - no debug message 1-6 for verbose debug gEngineVersion = "v1.6.4 beta Elrey Ronald V." ' Engine Version gScript = "wiki.asp" ' Main ASP filename (this file) gProvider = "Microsoft.Jet.OLEDB.4.0" ' Db Provider giEditAreaRows = 30 ' Edit Rows giEditAreaCols = 115 ' Edit Columns giNumRecentFiles = 15 ' No. of wikipages to list in Recent files page gDbTableName = "WikiData" ' Table name in the database gSpaceNames = 1 ' 1 means put spaces in WikiNames, 0 - no spaces ' Elrey 3/06 Now Override the gHttpDomain with this!! If gHttpDomain = "auto" Then gHttpDomain = "http://" & Request.ServerVariables("HTTP_HOST") & _ Replace(Request.ServerVariables("URL"), "/" & gScript, "" ) End If 'check for database name If len(request("db")) > 0 Then gDataSourceFile = request("db") Else gDataSourceFile = gDefaultHomePage End If If len(gDocRootDir) > 0 Then gDataSource = gDocRootDir & "\" & gDataSourceDir & "\" & gDataSourceFile & gMdbExtension Else gDataSource = gDataSourceDir & "\" & gDataSourceFile & gMdbExtension End If 'check for database human-readable name If len(request("dbname")) > 0 Then gDataSourceName = request("dbname") Else gDataSourceName = "DefaultDb" End If ' Can only Edit on the Test / Development System not on the Live System If (IsEmpty(Application("LiveSystem"))) Then gHideLogin = false If (Session("login") <> 0) Then gHideWikiFooter = false gEnableEdit = true Session("login") = 1 End If gHideWikiFooter = NOT gEnableEdit Else gHideLogin = true gHideWikiFooter = true End If 'set destination URL gScriptURL = gScript & "?db=" & gDataSourceFile ' removed & "&dbname=" & server.urlencode(gDataSourceName) gHomeTopic = gDataSourceFile ' default home topic is the same as ms access db name unless overwritten by .ini gStyleSheet = "wiki.css" Call GetHomeTopic 'Get the topic from wiki.ini if it exists gIconName = gDefaultIcon Call GetIconName 'Get the real icon name Dim rs, dts, i, sqlQuery Const ADOERROR_NOFILE = -2147467259 ' cannot find file (*.mdb) Const ADOERROR_NOTABLE = -2147217865 ' Cannot find output table Const FOR_READING = 1 Const FOR_WRITING = 2 ' Determine the action mode (edit/browse/save/list/search) or browse glsMode = "" If Not isEmpty(request("a")) Then glsMode = request("a") Else glsMode = "browse" End If ' Determine the topic otherwise use home topic. glsTopic = "WikiAsp" If Not isEmpty(request("o")) Then glsTopic = request("o") Else glsTopic = gHomeTopic End If ' Determine if RSS contains highlighting or not If Not isEmpty(request("h")) then gHighlightFlag = true Else gHighlightFlag = false End If ' Initialize the Regular Expression object variable Set gRE=server.createobject("VBScript.Regexp") gRE.IgnoreCase = False gRE.Global = True dim httpReferer httpReferer= Request.ServerVariables("HTTP_REFERER") ' Get remote addresses globally dim remoteIPHost remoteIPHost = Request.ServerVariables("REMOTE_HOST") dim remoteIPAddr remoteIPAddr = Request.ServerVariables("REMOTE_ADDR") If IsNull( remoteIPHost) Then remoteIPHost = "0.0.0.0" End If If IsNull( remoteIPHost) Then remoteIPAddr = "0.0.0.0" End If If not IsEmpty( Session("pwd") ) Then If Session("pwd") = gPassword Then remoteIPHost = "Editor" remoteIPAddr = "" End If End If '-- Let us get he IP first 3 numbers dim remoteIPHost3numbers Dim DotPos DotPos = InStrRev(remoteIPHost,".") remoteIPHost3numbers= mid(remoteIPHost,1,DotPos) '------------------------------------------------------------------------------------------------------------ ' SUBROUTINES AND FUNCTIONS '------------------------------------------------------------------------------------------------------------ Sub GetHomeTopic '----------------------------------------------------------------------- ' This looks for the Home Topic Name from the 1-line file wiki.ini file. '----------------------------------------------------------------------- Dim objFSO err.Clear On Error Resume Next Set objFSO = Server.CreateObject("Scripting.FileSystemObject") On Error GoTo 0 If Not IsObject(objFSO) Then Exit Sub End If 'Open the ini file whch should be at same dir as access db file Dim objTextStream Dim strIniFile if len(gDocRootDir) > 0 then strIniFile= gDocRootDir & "\" & gDataSourceDir & "\" & gDataSourceFile & ".ini" else strIniFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".ini") end if If objFSO.FileExists(strIniFile) Then Set objTextStream = objFSO.OpenTextFile(strIniFile, FOR_READING) gHomeTopic = objTextStream.ReadLine() objTextStream.Close End If ' ' Check For db specific style sheet if any. First look CSS at the roo ' If it is not there, look in the DB Folder. If not again there don't ' Override the default (which is Wiki.css). ' Dim strCss strCss= Server.MapPath( gDataSourceFile & ".css") If objFSO.FileExists(strCss) Then gStyleSheet = gDataSourceFile & ".css" Else Dim strCssFile strCssFile= Server.MapPath( gDataSourceDir & "\" & gDataSourceFile & ".css") If objFSO.FileExists(strCssFile) Then gStyleSheet = gDataSourceDir & "\" & gDataSourceFile & ".css" End If End If Set objTextStream = Nothing Set objFSO = Nothing End Sub Function DayName (intDay) '------------------------------------------ ' Returns Abbreviated Day of Week '------------------------------------------ select case intDay case 1 DayName = "Sun" case 2 DayName = "Mon" case 3 DayName = "Tue" case 4 DayName = "Wed" case 5 DayName = "Thu" case 6 DayName = "Fri" case 7 DayName = "Sat" end select end function function MonthName(intMonth) '----------------------------------------- ' Returns Abbreviated Month Name '----------------------------------------- select case intMonth case 1 MonthName = "Jan" case 2 MonthName = "Feb" case 3 MonthName = "Mar" case 4 MonthName = "Apr" case 5 MonthName = "May" case 6 MonthName = "Jun" case 7 MonthName = "Jul" case 8 MonthName = "Aug" case 9 MonthName = "Sep" case 10 MonthName = "Oct" case 11 MonthName = "Nov" case 12 MonthName = "Dec" end select end function Function GetRFC822date(dateVar) '---------------------------------------------- ' Returns standard format date for RSS feeds '---------------------------------------------- GetRFC822date = DayName (WeekDay(dateVar)) & ", " & _ Day(dateVar) & " " & MonthName(Month(dateVar)) & " " & _ Year(dateVar) & " " & FormatDateTime(dateVar, 4) &":00 " & gTimeZoneOffset End Function Function WrappedQueryExecute( connObject, queryString ) '---------------------------------------------- ' If something is wrong with db connection redirect to URL '---------------------------------------------- Dim rsResult If gRedirectURL = "" Then set rsResult = connObject.execute(queryString) Else on error resume next set rsResult = connObject.execute(queryString) on error goto 0 If isEmpty(rsResult) then Response.Redirect gRedirectURL Response.End End If End If Set WrappedQueryExecute = rsResult End Function Function AnyFileExistsIn( objFSO, extensions, baseFilename) Dim arrIconExts, sIconPathFile, sIconFile, element AnyFileExistsIn = false arrIconExts = Split(extensions, ",") For Each element In arrIconExts sIconFile = baseFilename & element sIconPathFile= Server.MapPath( sIconFile) If objFSO.FileExists(sIconPathFile) Then gIconName = sIconFile AnyFileExistsIn = true Exit For End If Next End Function Sub GetIconName '------------------------------------------------- ' Get the icon file name. gif first then jpg ' Now it look a various places to guarantee an icon '------------------------------------------------- Dim objFSO, sIconPathFile, sIconFile err.Clear On Error Resume Next Set objFSO = Server.CreateObject("Scripting.FileSystemObject") On Error GoTo 0 If Not IsObject(objFSO) Then Exit Sub End If ' look for .xxx icon file Dim iconSearchOrder iconSearchOrder = ".gif,.jpg,.png" ' first look at the db directory, then on root , then for icon.xxx, otherwise default to the c2 icon If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceDir & "/" & gDataSourceFile ) Then If not AnyFileExistsIn( objFSO, iconSearchOrder, gDataSourceFile ) Then If not AnyFileExistsIn( objFSO, iconSearchOrder , gIconName ) Then gIconName = "http://c2.com/sig/wiki.gif" End If End If End If Set objFSO = Nothing End Sub Function SpaceName(strX) '------------------------------------------------------------ ' This function splits up a string into words by inserting a ' space before each upper case letter. Ignores numbers and . '------------------------------------------------------------ Dim i, strY i = 1 strY = "" Do While i <= len(strX) If UCase(mid(strX,i,1)) = mid(strX,i,1) Then if (( mid(strX,i,1) < "0" ) OR ( mid(strX,i,1) > "9")) AND ( mid(strX,i,1) <> ".")then strY = strY & " " end if End If strY = strY & mid(strX,i,1) i = i + 1 Loop EmitDebug 9, 2, "Original string: " & strX & " ... Spaced out string: " & strY & "
" SpaceName = strY End Function Function removeHTML(txt) removeHTML=server.htmlencode(txt) End Function Function safeQuote(txt) If IsNull(txt) Then txt = "" End If safeQuote=replace(txt,"'","''") End Function Function replaceBoundingPattern(txt, pattern, tag) Dim workingText workingText = txt gRE.Pattern = pattern & "([^\n]{0,}?)" & pattern ' kgreiner workingText= gRE.Replace(workingText, "<" & tag & ">$1") replaceBoundingPattern = workingText End Function ' Elrey Ronald Function replaceTableColumnPattern(txt) Dim workingText Dim aryLines, aryLinesCount Dim i workingText = txt aryLines = Split(workingText,vbCRLF) aryLinesCount = UBound(aryLines) For i = 0 To aryLinesCount If left(aryLines(i), 6 ) = "_tmp_0" Then aryLines(i) = Replace(aryLines(i), "_tmp_0", "") aryLines(i) = Replace(aryLines(i), "||", "") End If If left(aryLines(i), 6 ) = "_tmp_1" Then aryLines(i) = Replace(aryLines(i), "_tmp_1", "") aryLines(i) = Replace(aryLines(i), "||", "") End If If left(aryLines(i), 6 ) = "_tmp_2" Then aryLines(i) = Replace(aryLines(i), "_tmp_2", "") aryLines(i) = Replace(aryLines(i), "||", "") End If If left(aryLines(i), 6 ) = "_tmp_3" Then aryLines(i) = Replace(aryLines(i), "_tmp_3", "") aryLines(i) = Replace(aryLines(i), "||", "") End If Next replaceTableColumnPattern= Join(aryLines,vbCRLF) End Function Function AddAnchors(txt) Dim workingText Dim aryLines, aryLinesCount Dim i Dim tocText workingText = txt dim toc(100) dim tocIndex: tocIndex = 0 aryLines = Split(workingText,vbCRLF) aryLinesCount = UBound(aryLines) For i = 0 To aryLinesCount If left(aryLines(i), 3 ) = "== " Then toc(tocIndex) = "" & Mid(aryLines(i), 3) &"" aryLines(i) = "" & vbCRLF & aryLines(i) tocIndex = tocIndex + 1 End If Next if ( tocIndex > 0 ) then Dim ii Dim Text For ii = 0 to tocIndex -1 Text = Text & vbcrlf & " *" & toc(ii) Next tocText = Text & vbcrlf & tocText end if ' Look for the spot to drop the TOC ' [[TOC]] For i = 0 To aryLinesCount If left(aryLines(i), 7 ) = "[[TOC]]" Then aryLines(i) = tocText & vbCRLF' & aryLines(i) End If Next AddAnchors = Join(aryLines,vbCRLF) End Function 'Elrey 3/06 Function RandomInteger(HighValue , LowValue ) Rnd -1 Randomize (time) RandomInteger = Int((HighValue - Lowvalue + 1) * Rnd() + Lowvalue) End Function Function replaceListPattern(txt, wikiPattern, topPattern, bottomPattern, startLinePattern, endLinePattern) ' ' Search through the text, creating numbered lists ' where so indicated by the pattern occurances. ' ' To indicate a numbered list, the pattern must always ' appear at the very beginning of a line. ' Dim workingText,replaceText Dim aryLines,aryLinesCount Dim nPatternLength,bInsidePattern Dim i 'Elrey - added multiple pattern Dim aPatterns Dim aPatternsCount Dim aPatternLength aPatterns = Split(wikiPattern,"^") aPatternsCount = UBound(aPatterns) Dim patternFound, j Dim aStartPattern aStartPattern = Split(startLinePattern,"^") workingText = txt nPatternLength = len(wikiPattern) bInsidePattern = False aryLines = Split(workingText,vbCRLF) aryLinesCount = UBound(aryLines) For i = 0 To aryLinesCount ' Elrey patternFound = 0 For j = 0 to aPatternsCount aPatternLength = len( aPatterns(j) ) If left( aryLines(i), aPatternLength ) = aPatterns(j) Then patternFound = 1 Exit For End If Next If patternFound = 1 Then If Not bInsidePattern Then replaceText = topPattern & vbCRLF & aStartPattern (j) bInsidePattern = True Else replaceText = aStartPattern (j) End If aryLines(i) = replaceText & right(aryLines(i),len(aryLines(i)) - aPatternLength ) & endLinePattern Else If bInsidePattern Then aryLines(i) = bottomPattern & vbCRLF & aryLines(i) bInsidePattern = False End If End If Next replaceListPattern = Join(aryLines,vbCRLF) End Function Function imageize(txt) ' Include a tag like img:http://www.brinkster.com/images/brinksterlogo.gif ' to get an inlined-image. Dim workingText workingText = txt ' referencing local images Elrey Ronald 1/2006 gRE.IgnoreCase = True gRE.Pattern = "(\s)(image:local|img:local):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.IgnoreCase = True gRE.Pattern = "(\s)(imageleft:local|imgleft:local):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.IgnoreCase = True gRE.Pattern = "(\s)(imageright:local|imgright:local):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.IgnoreCase = True gRE.Pattern = "(\s)(imgcenter:local|imagecenter:local|imgmiddle:local|imagemiddle:local):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1

" ) gRE.IgnoreCase = True gRE.Pattern = "(\s)(img|image):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.Pattern = "(\s)(imgleft|imageleft):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.Pattern = "(\s)(imgright|imageright):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1") gRE.Pattern = "(\s)(imgcenter|imagecenter|imgmiddle|imagemiddle):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1

") ' local links gRE.IgnoreCase = True gRE.Pattern = "(\s)(local):([^ \t\n\r]+)" workingText=gRE.Replace(workingText,"$1$3") gRE.IgnoreCase = False imageize = workingText End Function Function isbnize(txt) ' include a tag like isbn:0000000000 ' to get a link to a book on Amazon 0000 Dim workingText workingText = txt gRE.IgnoreCase = True gRE.Pattern = "(\s)(isbn|ISBN):(\d{9}[\dX])" workingText=gRE.Replace(workingText,"$1ISBN:$3") gRE.IgnoreCase = False ' switch it back isbnize = workingText End Function Function IsRequestFromWikiASPPage dim sHidden sHidden = Request.Form("hiddenInput") If IsEmpty(sHidden) Then response.write "hmmm empty" IsRequestFromWikiASPPage = False End if If sHidden <> "errv2010" Then response.write "hmmm=" & sHidden IsRequestFromWikiASPPage = False End if IsRequestFromWikiASPPage = True End Function ' Regular expression version --------------------------- Function IsRemoteAdressBlackListedRE If Trim(gBlackListedIpsRE ) = "" Then IsRemoteAdressBlackListedRE = False else gRE.Pattern = gBlackListedIpsRE IsRemoteAdressBlackListedRE = gRE.Test( remoteIPHost) End If End Function ' Non RE version (Exact)-------------------------------- Function IsRemoteBlackListed IsRemoteBlackListed = False Dim pos pos = InStr(gBlackListedIps, remoteIPHost3numbers) ' Leading 3 digits. Set IP list as ~1.2.3.~4.5.3~ If Not IsNull(pos) and pos > 0 Then IsRemoteBlackListed = True End If End Function Function hyperlink(txt) Dim workingText Dim matches Dim nHits Dim thisMatchBefore, thisMatchAfter workingText = txt 'pattern with no spaces: 'gRE.Pattern = "(http|https)://[^ \t\n\r]+" 'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]]+)" 'ElreyRonald 8/03 Bjarne 10/31 gRE.Pattern = "([^\[])\[([^\|\]]+)\|((http://|https://|ftp://|mailto:|news:|file:)[^\]\r\n\t]+)\]" workingText=gRE.Replace(workingText,"$1$2") 'ElreyRonald local links inside [ | ] gRE.Pattern = "([^\[])\[([^\|\]]+)\|(local):([^ \t\n\r]+)\]" workingText=gRE.Replace(workingText,"$1$2") 'gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:)[^\s\<\>\(\)\[\]\r\n\t]+)" 'Bjarne gRE.Pattern = "([^A-Za-z0-9'])((http://|https://|ftp://|mailto:|news:|file:)[^\s\<\>\(\)\[\]\r\n\t]+)" workingText=gRE.Replace(workingText,"$1$2") 'This is new 5/2006 see [/Drop] '[Drop#001##Test] ' 1 [ 2 :: 3 ] gRE.Pattern = "([^\[])\[Drop\#(\S+)\#\#([^\<\>\(\)\=\r\n\t\]]+)\]" workingText=gRE.Replace(workingText, _ "$1
 + $3
") ' newText=replace(newText,"{italic}","") newText=replace(newText,"{/italic}","") newText=replace(newText,"{bold}","") newText=replace(newText,"{/bold}","") ' CHANGE SIZE / SCHRIFTGRSSE 'SMALLER / KLEINER newText=replace(newText,"{small}","") newText=replace(newText,"{/small}","") newText=replace(newText,"{smaller}","") newText=replace(newText,"{/smaller}","") newText=replace(newText,"{smallest}","") newText=replace(newText,"{/smallest}","") 'LARGER / GRSSER newText=replace(newText,"{big}","") newText=replace(newText,"{/big}","") newText=replace(newText,"{bigger}","") newText=replace(newText,"{/bigger}","") newText=replace(newText,"{biggest}","") newText=replace(newText,"{/biggest}","") ' this is were you can insert your own bracket comands... newText=replace(newText,"{br}","
") ' images: newText= imageize(newText) ' isbns: newText= isbnize(newText) ' auto-hyperlinks newText= hyperlink(newText) ' bold text: three single quotes newText= replaceBoundingPattern(newText,"'''","b") ' em text: two single quotes newText= replaceBoundingPattern(newText,"''","em") ' consolidate a series of trailing vbcrlf to just 2. gRE.Pattern = "(\r\n){3,}$" newText=gRE.Replace(newText, vbcrlf & vbcrlf) If gDisableScripting = false Then ' 2007.08.25 disable scripts gRE.Pattern = "<([s|S][c|C][r|R][i|I][p|P][t|T])" newText=gRE.Replace(newText, "<$1") End If EmitDebug 11, 4, "xform-after(" & newText & ")
" newText = Replace(newText, "#@91;", "[") newText = Replace(newText, "#@93;", "]") newText = Replace(newText, "#@3A;", ":") newText = Replace(newText, "#@3C;", "<") newText = Replace(newText, "#@3E;", ">") xform = newText End Function Function WalkWiki(isTeksten) Dim myText myText = isTeksten WalkWiki = myText End Function function RemoveBrackets(s) Dim ts ts = replace( s, "[","") ts = replace( ts, "]","") RemoveBrackets = ts end function function RemoveSpaces(s) Dim ts ts = replace( s, " ","") RemoveSpaces = ts end function Sub EmitDebug(sig,lvl,arg) If gDebug >= lvl Then Response.Write("debug:" & sig & " " & arg & vbcrlf) End Sub '---------------------------------------------------- ' This function builds and returns the connection ' string, based on input provided from the web form. ' function ConnStr(includeMode) dim localDs ' Map MDB database to physical path if len(gDocRootDir) > 0 then localDs = gDataSource else localDs = Server.MapPath(gDataSource) end if ConnStr= "Provider=" & gProvider & ";Data Source=" & localDs & ";" if (includeMode) then ConnStr= ConnStr & "mode= Share Deny None" end if EmitDebug 20, 3, "ConnStr= (" & ConnStr & ")
" end function sub CheckDbErrors if gDataConn.errors.count> 0 then dim counter response.write "
Database Errors Occurred" & "
" & vbcrlf for counter= 0 to gDataConn.errors.count response.write "Error #" & gDataConn.errors(counter).number & vbcrlf & "
" response.write " Description(" & gDataConn.errors(counter).description & ")" & vbcrlf & "
" next else response.write "
No Database Errors Occurred" & "
" & vbcrlf end if end sub ' Elrey Ronald 2/21/05 sub VerifyWikiTableNoAdoxComponent on error resume next gDataConn.Open ConnStr(0) on error goto 0 on error resume next gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2") on error goto 0 end sub '---------------------------------------------------------------------------- ' VerifyWikiTable ' This routine: ' (a) verifies the existence of the target database (dbname) at the given ' ADO connection. If necessary, this routine creates that ' database. ' (b) verifies the existence of the table in that database. If necessary, ' this routine will create the required table, and build the table ' structure. The columns in the target table are determined by the ' fields in the source record set (sourceRs). Two additional ' columns are also added. (in fact we do not use the entire recordset, ' but only the collection of fields in the recordset. ' sub VerifyWikiTable if not gAutoCreateMdb then Call VerifyWikiTableNoAdoxComponent Exit Sub End If dim tbl, cat, dbname, fso dim fsoErrMessage, adoxErrMessage, instructions fsoErrMessage = "ERROR: Directory or MS Access File can not be created! Automatic DB creation is not possible. Your server is missing the needed FileSystemObject component.
" adoxErrMessage = "ERROR: Database file can not be created! Some file actions are disabled. Your server is missing the needed ADOX.Catalog component.
" instructions = "
  • You may have to MANUALLY create the folder/MsAccess file -> " & gDataSource & "
  • " & _ "
  • You may modify 'gDefaultIcon', 'gDefaultHomePage' variables in the WikiAsp program to view your default icon and access the proper Ms Access file (mdb).
  • " & _ "
  • You may modify 'gAutoCreateMdb' and set it to false to prevent creation of MDB and avoid this message." & _ "
  • 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).
  • " & _ "

    Now trying to use default values to see if this would work..." err.clear ' Check if ADOX.Catalog component is available in this computer on error resume next set cat= CreateObject("ADOX.Catalog") on error goto 0 ' Check if FileSystemObject component is available in this computer on error resume next set fso = CreateObject("Scripting.FileSystemObject") on error goto 0 If Not IsObject(cat) or cat is nothing Then Response.Write( adoxErrMessage) Response.Write( instructions ) Call VerifyWikiTableNoAdoxComponent Exit Sub End If err.clear If Not IsObject(fso) Then Response.Write( fsoErrMessage) Response.Write( instructions ) Call VerifyWikiTableNoAdoxComponent Exit Sub End If if len (gDocRootDir) > 0 then dbname = gDataSource else dbname = Server.MapPath(gDataSource) end if '-------------------------------------------- ' step 0: check the directory, create if necessary dim folder, f1 if len (gDocRootDir) > 0 then f1 = gDocRootDir & "\" & gDataSourceDir else f1 = Server.MapPath(gDataSourceDir) end if if not fso.FolderExists(f1) then on error resume next Set folder = fso.CreateFolder(f1) on error goto 0 If Not IsObject(folder) Then Response.Write( "Unable to create [" & f1 & "]. Please modify DOCROOT and gDataSourceDir in the program. Consult your website settings." ) Response.End End If set folder = nothing end if set fso = nothing '---- some security here If gDataSourceFile <> gDefaultHomePage Then Dim pwd If Request.QueryString("pw") <> gPassword Then Response.Write("Sorry but the Database (db) requested does not exist, or may not be writable.
    Correct password must be sent to create it.") Response.Write("
    Hint. Add &pw=" & gPassword & " to the URL.") Response.Write("

    Folder:" & f1 & ".") Response.Write("
    DataBase:" & gDataSource & ".") Response.End End If End If '-------------------------------------------- ' step 1: create the new db catalog, if necessary Err.Clear EmitDebug 21, 2, vbcrlf & " creating db " & dbname & "
    " on error resume next cat.Create ConnStr(0) on error goto 0 EmitDebug 22, 2, ">> error(" & err.Number & "," & err.Description & ")
    " 'EmitDebug 23, 2, vbcrlf & " catConnErrorCount(" & _ ' cat.ActiveConnection.errors.count & ")
    " if not (err.Number = 0) then if not (err.Description = "Database already exists." ) then dim sError sError = ">> error(" & err.Number & "," & err.Description & ")" & _ "(EXPECTED ""Database already exists"")..." & "
    " EmitDebug 24, 2, sError Response.Write( "Fatal error creating db: " & err.Number & " " & err.description & "") else EmitDebug 25, 2, ">> Database already exists..." & "
    " cat.ActiveConnection= ConnStr(0) end if else EmitDebug 26, 2, ">> Database has just been created..." & "
    " end if EmitDebug 27, 2, " Database now exists..." & "
    " '-------------------------------------------- ' step 2: create the new table, with columns, if necessary Err.Clear EmitDebug 28, 2, " verifying presence of table(" & gDbTableName & ")
    " 'if not isNothing(gDataConn) then set gDataConn = nothing on error resume next set gDataConn = Server.CreateObject("ADODB.Connection") on error goto 0 If Not IsObject(gDataConn) Then Response.Write ( "Unable to establish connection. Missing ADO object.") Response.End End If on error resume next gDataConn.Open ConnStr(0) on error goto 0 on error resume next gDataConn.execute("select PageData, Title from " & gDbTableName & " where ID = 2") on error goto 0 if (0 = gDataConn.errors.count) then EmitDebug 29, 1, vbcrlf & "(no db errors, ergo table exists)" & "
    " elseif ((gDataConn.errors.count>0) and ( ADOERROR_NOTABLE = gDataConn.errors(0).number)) then set gDataConn = nothing ' error: table does not exist. EmitDebug 30, 2, vbcrlf & " creating table " & gDbTableName & "
    " Dim idx 'As New ADOX.Index set idx= CreateObject("ADOX.Index") ' now, create a new table in the db: set tbl= CreateObject("ADOX.Table") With tbl ' drop tbl into a MDB provider context; need to do this NOW ' to be able to use autoIncrement, later. set .ParentCatalog = cat ' Name the new table. .Name = gDbTableName .Columns.Append "ID", 3 .Columns("ID").Properties("AutoIncrement") = True .Columns.Append "Title", 202, 127 .Columns.Append "PageData", 203 .Columns.Append "PrevPageData", 203 .Columns("PrevPageData").Properties("Jet OLEDB:Allow Zero Length") = True .Columns("PrevPageData").Properties("Nullable") = True .Columns.Append "LastUpdate", 7 ' timestamp .Columns.Append "LastEditor", 202, 127 ' create the Primary Key : idx.Name = "RecordIndex" idx.Columns.Append "ID" idx.PrimaryKey = True idx.Unique = True .Indexes.Append idx End With ' this appends the table to the db catalog cat.Tables.Append tbl EmitDebug 31, 2, vbcrlf & " post-append: catConnErrorCount(" & _ cat.ActiveConnection.errors.count & ")
    " set idx= nothing ' insert the first record into the newly-created table EmitDebug 32, 2, ">> inserting into table(" & gDbTableName & ")
    " set gDataConn = Server.CreateObject("ADODB.Connection") gDataConn.Open ConnStr(1) dts = Now EmitDebug 33, 2, ">> the time is now(" & dts & ")
    " DoInitialPageCreation(".") else EmitDebug 34, 2, ">> table " & tablename & " already exists?" & "
    " end if set cat = nothing set tbl = nothing on error goto 0 end sub Function DoInitialPageCreation(folderspec) Dim fso, f, f1, fc, s, dts, sPageData, fPage, stmnt Set fso = CreateObject( "Scripting.FileSystemObject" ) EmitDebug 35, 2, ">> checking dir (" & Server.MapPath(folderspec) & ")
    " Set f = fso.GetFolder(Server.MapPath(folderspec)) Set fc = f.Files EmitDebug 36, 2, ">> files counted (" & fc.Count & ")
    " For Each f1 in fc if (Right(f1.name, 4) = ".wik") then s = Left(f1.name, Len(f1.name)-4) EmitDebug 37, 2, ">> found file (" & s & ")
    " on error resume next set fPage= fso.OpenTextFile(Server.MapPath(f1.name),FOR_READING) sPageData = fPage.ReadAll on error goto 0 fPage.Close set fPage = nothing dts = Now ' timestamp EmitDebug 38, 2, ">> inserting record (" & s & ")
    " stmnt = "INSERT INTO " & gDbTableName & " (Title,PageData,PrevPageData,LastUpdate,LastEditor) " & _ "VALUES ( '" & s & "','" & safeQuote(sPageData) & "', '--', '" & dts & "', '" & gScript & " (initial creation)');" on error resume next gDataConn.execute(stmnt) on error goto 0 if gDebug>=1 then CheckDbErrors end if Next set fso = nothing set f = nothing set fc = nothing end Function function theWhereClause(theStr) dim result result= "" dim myArray dim element EmitDebug 39, 1, "whereClause(" & theStr & ")
    " & vbcrlf myArray = split(Trim(theStr), " ") for each element in myArray element = Trim(element) if (result = "") then result = " where " else result = result & " and " end if result= result & " PageData like '%" & element & "%'" next EmitDebug 40, 1, "whereClause:result(" & result & ")
    " & vbcrlf theWhereClause = result end function sub handleLogout Dim url url = gScriptURL & "&o=" & glsTopic gEnableEdit = false Session.Abandon Response.Redirect(url) end sub sub handleLogin Dim url url = gScriptURL & "&o=" & glsTopic gEnableEdit = true Session("login") = 1 Response.Redirect(url) end sub sub handleEdit If NOT gEnableEdit Then Response.Write("




    Editing is not allowed

    ") Response.End exit sub End If Dim readonlyflag, disableflag readonlyflag = "" disableflag = "" ' If glsTopic = "TextFormattingRules" Then ' exit sub ' End If If IsRemoteBlackListed Then Response.Write("




    Please send e-mail to this site's Web Master ASAP.

    ") Response.End Exit Sub End If If glsTopic <> "WikiSandBox" _ and glsTopic <> "VwisitorsPage" _ and glsTopic <> "VisitorsPage" _ and ( not gIsOpenWiki or _ glsTopic = "TextFormattingRules" ) Then If Not IsEmpty(Request.Form("pwd")) Then Session("pwd") = Request.Form("pwd") If IsEmpty( Session("pwd") ) or _ ( Session("pwd") <> gEditpassword and _ Session("pwd") <> gPassword ) Then Response.Write "
    " & gPasswordLabel & "
    " ' "
    Send me an E-mail to get a password . For now, you can only click and edit WikiSandBox
    " readonlyflag = "readonly style='font-size:8pt; background:silver; border:solid 1px '" disableflag = " disabled " End If End If sqlQuery = "select PageData,Title, lastupdate, PrevPageData from " & gDbTableName & " where title='" & glsTopic & "'" EmitDebug 41, 2, "Edit query(" & sqlQuery & ")
    " & vbcrlf 'set rs = gDataConn.execute(sqlQuery) set rs = WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 dim strPageData, strTitle, strLastUpdate, strPrevPageData if not rs.eof then 'page exists strTitle = rs("title") strPageData = rs("pageData") strLastUpdate = CStr(rs("lastupdate")) strPrevPageData = rs("PrevPageData") else 'page does not exist strTitle = glsTopic strPageData = "" strLastUpdate = "" strPrevPageData = "" end if 'If Not gHideWikiSource Then response.write("
    " & vbcrlf) response.write "

    Edit:  " & SpaceName(strTitle) & "        

    " & vbcrlf ' [MARKUS - replace virtual with hard] response.write("" & vbcrlf & _ "
                    " & _ "

    " & _ vbcrlf & "" & _ vbcrlf & "" & _ vbcrlf & "" & _ vbcrlf & "" & _ vbcrlf & "" & _ vbcrlf & "" & vbcrlf ) 'End If If disableflag <> "" Then exit sub end if If gHideWikiSource then exit sub end if 'History of changes response.write("




    History of Changes:

    ") 'Original Text response.Write("
    " ) response.Write("") Session("CurrentEditPage") = "# " & strTitle end sub sub handleSearch dim pageTitle, s 's= Request.QueryString("o") BUG - Fri, 2002 jan 22 - Dan Shaw s= glsTopic if not isEmpty(s) then EmitDebug 42, 2, "
    SEARCH(" & s & ")
    " & vbcrlf pageTitle = "Search Results (" & s & ")" dim myClause myClause= theWhereClause(s) sqlQuery="select ID, Title, LastUpdate , LastEditor from " & gDbTableName & myClause & " order by Title" end if EmitTabularOutput pageTitle, "" end sub 'ElreyRonald 4/2004 Sub HandleDelete Dim pwd, topic, sh Response.Write("

    Page Deletion


    ") sh = "
    Click here proceed to home page" If Request.QueryString("pw") <> gDeletePassword Then Response.Write( "Authorization to delete failed. Try adding &pw=" & gDeletePassword & sh) Response.End End If topic = Request.QueryString("o") ' Topic to delete If IsNull(topic) or topic = "" Then Response.Write( "Specify page name to delete i.e. &o=MyPage" & sh) Response.End End If Dim stmnt stmnt = "delete from WikiData where Title='" & topic & "'" Set gDataConn = Server.CreateObject("ADODB.Connection") on error resume next gDataConn.Open ConnStr(1) on error goto 0 on error resume next gDataConn.execute(stmnt) on error goto 0 If gDataConn.errors.count = 0 then Response.Write( "" & topic & " was successfully deleted. " ) Else Response.Write( "" & topic & " was not deleted due to some errors. " ) End if Set gDataConn = nothing Response.write sh Response.End end sub 'ElreyRonald 4/2004 sub handleRss dim pageTitle, initialRow, s, sSortOrder dim modifiedUrl sqlQuery="select top " & giNumRecentFiles & " ID, LastEditor, Title,PageData,PrevPageData, LastUpdate from " & gDbTableName & " order by LastUpdate DESC" sqlQuery = sqlQuery & sSortOrder set gDataConn = Server.CreateObject("ADODB.Connection") on error resume next gDataConn.Open ConnStr(1) on error goto 0 if not (0 = gDataConn.errors.count) then if (ADOERROR_NOFILE = gDataConn.errors(0).number) then EmitDebug 54, 1, "
    ErrorCount(" & gDataConn.errors.count & ")
    " & vbcrlf EmitDebug 55, 1, "
    Error(" & gDataConn.errors(0).number &") desc(" &_ gDataConn.errors(0).description & ")
    " & vbcrlf VerifyWikiTable end if end if 'set rs= gDataConn.execute(sqlQuery) set rs = WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 modifiedUrl = Replace(gScriptURL, "&", "&") if not rs.eof then response.ContentType = "text/xml" response.Write("") response.Write(gRssStyle) response.Write("") response.Write("") response.Write("" & SpaceName(gHomeTopic) & " ") response.Write("" & gHttpDomain & "/" & modifiedUrl & "&a=rss ") Response.Write("1000") response.Write("Latest changes and postings for the topic:" & SpaceName(gHomeTopic) & ". ") response.Write("Copyright (C)2003 Elrey Ronald Vel. All rights reserved. ") response.Write(" WikiAsp RSS Generator by Elrey ") Response.Write("lambda326@hotmail.com") response.Write("8040") response.Write("" & SpaceName(gHomeTopic) & " ") response.Write("" & gHttpDomain & "/" & modifiedUrl & " ") If left(gIconName,4) = "http" Then response.Write("" & gIconName &" ") Else response.Write("" & gHttpDomain & "/" & gIconName &" ") End If Do while Not rs.eof If rs("Title") <> "RegisteredUsers" Then Response.Write("") Response.Write("" & SpaceName(rs("Title"))& "") Response.Write("" & gHttpDomain & "/" & modifiedUrl & "&o=" & rs("Title") & " ") Response.Write("" & SpaceName(gHomeTopic) & "") Response.Write("user@" & rs("LastEditor")& "") Response.Write("") Response.Write( "") Response.Write("" & GetRFC822date(rs("LastUpdate")) & " ") Response.Write("") End If rs.MoveNext i= i+1 Loop response.Write( "") end if Set gDataConn = nothing Set rs = nothing end sub 'Get the nth page in History 'ElreyRonald Function GetPrevData(rs, n) Dim arrD, tmpStr, i, cnt, getFlag Dim prevData prevData = rs("PrevPageData") If IsNull(prevData) Then GetPrevData = "" Else arrD = Split( rs("PrevPageData"), vbCRLF) cnt = 0 getFlag = 0 tmpSTr = "" For i = 1 to UBound(arrD) If left(arrD(i), 8) = "--------" Then cnt = cnt + 1 if getFlag = 1 Then Exit For if n = cnt Then getFlag = 1 end if End If If getFlag = 1 and left(arrD(i), 8) <> "--------" Then tmpStr = tmpStr & arrD(i) & vbCRLF End If Next GetPrevData = tmpStr End If End Function 'Process the current record (rs) for RSS 'ElreyRonald Function ProcessRssItem(rs) Dim currData, prevData, markedStr Dim beginMark, endMark, tmpS beginMark = "###s###" endMark = "###e###" currData = rs("PageData") prevData = GetPrevData( rs, 1 ) markedStr = MarkWhatWasAdded( prevData, currData, beginMark , endMark) tmpS = WalkWiki(xform(markedStr)) tmpS = Replace( tmpS, beginMark, "") tmpS = Replace( tmpS, endMark, "") ProcessRssItem = tmpS End Function Function MarkWhatWasAdded( prevData, currData, st, en) Dim arrCurrData, arrPrevData Dim currMaxIndex Dim prevMaxIndex, i arrCurrData = Split( currData, vbCRLF) arrPrevData = Split( prevData, vbCRLF) currMaxIndex = UBound( arrCurrData ) prevMaxIndex = UBound( arrPrevData ) If prevMaxIndex < 0 Then MarkWhatWasAdded = currData Exit Function End If Dim marked, prevPtr, started marked = 0 prevPtr = 0 started = 0 'Search delta forward For i = 0 to prevMaxIndex If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For Next prevPtr = i 'start here For i = 0 to currMaxIndex If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then Else Started = 1 If prevPtr <= prevMaxIndex Then If arrCurrData(i) <> arrPrevData( prevPtr) Then if ( i > 0 ) then if arrCurrData(i-1) = "" Then arrCurrData(i-1) = vbCRLF & arrCurrData(i-1) & st else arrCurrData(i-1) = arrCurrData(i-1) & st end if else arrCurrData(i) = st & vbCRLF & arrCurrData(i) end if marked = 1 Exit For End If prevPtr = prevPtr + 1 if prevPtr > prevMaxIndex and i < currMaxIndex then arrCurrData(i) = arrCurrData(i+1) & st marked = 1 exit for end if End If End If Next If marked = 0 Then MarkWhatWasAdded = currData exit function End If 'Search delta Backwards For i = prevMaxIndex to 0 step -1 If lTrim(rtrim(arrPrevData(i))) <> "" Then Exit For Next Dim pi pi = i started = 0 For i = currMaxIndex to 0 step -1 If lTrim(rtrim(arrCurrData(i))) = "" and started = 0Then ' do nothing Else Started = 1 If pi >= 0 Then 'Response.Write "backward Compare " & Cstr(i) & "-" & Cstr(pi) &" [" &arrCurrData(i) & "]=["& arrPrevData(pi) & "] " & vbCRLF If arrCurrData(i) <> arrPrevData(pi) Then arrCurrData(i) = arrCurrData(i) & en Exit For End If pi = pi - 1 if pi < 0 and i > 0 then arrCurrData(i-1) = arrCurrData(i-1) & en exit for End if End If End If Next Dim sres sres = "" For i = 0 to currMaxIndex sres = sres & arrCurrData(i) & vbCRLF Next MarkWhatWasAdded = sres End Function sub handleList dim pageTitle, initialRow, s, sDirection, sSortOrder, sNextDirectionTitle, sNextDirectionDate ' Request.ServerVariables("HTTP_REFERER") initialRow= "" s = Request.QueryString("o") EmitDebug 43, 2, "
    " & s & "
    " & vbcrlf if (s = "recent") then pageTitle = "Recently Modified Topics" sqlQuery="select top " & giNumRecentFiles & " ID, Title, LastUpdate, LastEditor from " & gDbTableName & " order by LastUpdate DESC" else pageTitle = "List of All Topics" sqlQuery= "select ID, Title, LastUpdate , LastEditor from " & gDbTableName & " order by " sDirection = Request.QueryString("d") if (s = "ByDate") then sqlQuery = sqlQuery & "LastUpdate " if (sDirection = "down") then sSortOrder = "" ' the reverse natural sort order (oldest first) sNextDirectionDate= "" else sSortOrder = "DESC" ' the natural sort order (most recent first) sNextDirectionDate= "&d=down" end if elseif (s = "ByTitle") then sqlQuery = sqlQuery & "Title " if (sDirection = "down") then sSortOrder = "DESC" ' the reverse natural sort order (alphabetic) sNextDirectionTitle = "" else sSortOrder = "" ' the natural sort order (alphabetic) sNextDirectionTitle = "&d=down" end if end if sqlQuery = sqlQuery & sSortOrder 'initialRow= " Sort Sort" initialRow= " Sort by Title Sort by Date" end if EmitTabularOutput pageTitle, initialRow end sub sub EmitTabularOutput(pageTitle, initialRow) EmitDebug 44, 2, "
    query(" & sqlQuery & ")
    " & vbcrlf 'set rs= gDataConn.execute(sqlQuery) set rs = WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 Call WriteBanner(pageTitle,"") if not rs.eof then ' Response.write("

    " & pageTitle & ":

    ) Response.write("" & vbcrlf) i = 1 if not isEmpty(initialRow) then Response.write initialRow & vbcrlf end if Do while (Not rs.eof ) if (i mod 2 = 0) then Response.Write("") else Response.Write("") end if Dim deleteColumn deleteColumn = "" ' gDelete is only passed on querystring If Request.QueryString("pw") = gDeletePassword Then deleteColumn = "" End If if rs("Title") <> "RegisteredUsers" then Response.Write("" & deleteColumn & _ "" & vbcrlf) i= i+1 end if rs.MoveNext Loop Response.write("
    del " & i & "." & rs("Title") & " " & _ rs("LastUpdate") & " by " & rs("LastEditor")& "
    " & vbcrlf) else ' Response.write("

    " & pageTitle & ":

    ) Response.write("" & vbcrlf) Response.write("" & vbcrlf) Response.write("
    This topic is not mentioned on any other page!
    " & vbcrlf) end if Call WriteFooter("","","" ) end sub sub handleSave if gDisableSave = "yes" then exit sub end if dim sText, dts, sLupdt dim sChanges, sTextOrig sText=request.Form("pagetext") sTextOrig=request.Form("pagetextorig") sLupdt=request.Form("lupdt") ' last update (ElreyRonald) Dim lastPageEdited if IsEmpty (Session("CurrentEditPage") ) Then lastPageEdited = "*" Exit Sub else lastPageEdited =Session("CurrentEditPage") end if If not IsRequestFromWikiASPPage Then response.write("1:>" & remoteIPHost & " - " & remoteIPAddr ) response.end exit sub End if If IsRemoteAdressBlackListedRE Then response.write("2:>" & remoteIPHost & " - " & remoteIPAddr ) exit sub End if If IsRemoteBlackListed Then response.write("3:>" & remoteIPHost & " - " & remoteIPAddr ) exit sub End if If not gPersistPassword Then Session("pwd") = "" End If sqlQuery = "select Title,PageData, lastupdate , PrevPageData, LastEditor from " & gDbTableName & " where title='" & glsTopic & "'" EmitDebug 45, 2, "
    save-check query(" & sqlQuery & ")
    " & vbcrlf 'set rs = gDataConn.execute(sqlQuery) set rs = WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 dts = Now 'update record if not rs.eof then EmitDebug 46, 2, "Record already exists....
    " & vbcrlf ' check if someone has updated the record while you were editing (ElreyRonald) if Trim(Cstr( rs("lastupdate"))) <> Trim(sLupdt) then response.write("") Response.Write( "["& Trim(Cstr( rs("lastupdate"))) & "]["& Trim(sLupdt)& "]
    " ) Response.Write("Sorry! That page is being edited by another user or is in the process of being saved.
    Your changes were not saved.
    " ) response.write( "

    Click here to re-edit the page. " ) response.end else ' consolidate a series of trailing vbcrlf to just 2. gRE.Pattern = "(\r\n){3,}$" sText=gRE.Replace(sText, vbcrlf & vbcrlf) ' replace 8 spaces with tab (ElreyRonald) sText = replace(sText, vbcrlf & " *", vbcrlf & chr(9) & "*" ) sText = replace(sText, vbcrlf & chr(9) & " : ", vbcrlf & chr(9)& " :" & chr(9) ) If abs( len(sText) - len(sTextOrig) ) > 10 Then sChanges = vbcrlf & vbcrlf & "@@@@@@@@@@@@@@@@" & rs("lastupdate") & " : " & _ rs("lasteditor") & "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" & vbcrlf & vbcrlf & rs("PageData") & rs("PrevPageData") sChanges = left(sChanges, 15000) else sChanges = rs("PrevPageData") End if sqlQuery = "UPDATE " & gDbTableName & " SET PageData='" &_ safeQuote(sText) & "',PrevPageData='" & safeQuote( sChanges ) &_ "',LastUpdate='" & dts & "', LastEditor='" & remoteIPHost &_ "' WHERE title='" & rs("title") & "'" EmitDebug 47, 1, "update sqlQuery(" & sqlQuery & ")
    " 'gDataConn.execute(sqlQuery) call WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 end if ' new record else EmitDebug 48, 2, "Record does not exist, inserting...." & vbcrlf sqlQuery = "INSERT INTO " & gDbTableName & " (Title,PageData,LastEditor,LastUpdate) " & _ "VALUES ('" & glsTopic & "', '" & safeQuote(sText) & "', '" & remoteIPHost &_ "', '" & dts & "')" EmitDebug 49, 1, "
    sqlQuery(" & sqlQuery & ")
    " 'gDataConn.execute(sqlQuery) call WrappedQueryExecute( gDataConn, sqlQuery ) ' ERV 3/2007 end if ' direct to the newly saved page : 'Response.Redirect gScript & "?" & glsTopic Response.Redirect gScriptURL & "&o=" & glsTopic end sub Sub WriteBanner(title,search) Dim iconPart, bannerPart, bannerTextPart iconPart = "Go to Start Page" if search <> "" then bannerTextPart = "" & SpaceName(title) & "" else bannerTextPart = SpaceName(title) end if If gBannerTemplate = "" Then bannerPart = "" bannerPart = bannerPart & "Wiki Home" bannerPart = bannerPart & " | List all pages" if ( NOT gHideLogin ) Then bannerPart = bannerPart & " | Recent pages" bannerPart = bannerPart & " | Development Web Server" if (search <> "") AND (gEnableEdit) then bannerPart = bannerPart & " | Edit page" bannerPart = bannerPart & " | Del page" end if bannerPart = bannerPart & " | Formatting Rules" bannerPart = bannerPart & " | Release Notes" bannerPart = bannerPart & " | PM Dev Notes" if gEnableEdit Then bannerPart = bannerPart & " | Log out" Else bannerPart = bannerPart & " | Log in" End If End If bannerPart = bannerPart & "
    " bannerPart = bannerPart & " " bannerPart = bannerPart & " " bannerPart = bannerPart & " " bannerPart = bannerPart & " " bannerPart = bannerPart & " " bannerPart = bannerPart & " " bannerPart = bannerPart & "
    $$icon$$" bannerPart = bannerPart & "

    $$banner_text$$

    " bannerPart = bannerPart & "
    " bannerPart = bannerPart & " " If not gHideTopSearch Then bannerPart = bannerPart & "
    " & gSearchLabel & "
        " End If bannerPart = bannerPart & "
       " bannerPart = bannerPart & "
    " Else bannerPart = gBannerTemplate End if bannerPart = Replace( bannerPart, "$$icon$$", iconPart) bannerPart = Replace( bannerPart, "$$banner_text$$", bannerTextPart) Response.Write ( bannerPart ) End Sub Sub WriteFooter(hideScript,lastUpdate,lastEditor) If Not gHideWikiFooter Then response.write " " response.write "WikiAsp Engine version: " & gEngineVersion & "" & vbcrlf ' response.write "
    gScriptURL: " & gScriptURL & "" & vbcrlf response.write "" End If End Sub Sub HandleBrowse ' Prevent this page from being viewed. if not IsEmpty(Request.Form("pwd")) then Session("pwd") = Request.Form("pwd") if glsTopic = "RegisteredUsers" then If IsEmpty( Session("pwd")) or Session("pwd") <> gPassword then exit sub End If end if sqlQuery = "select PageData,Title,LastEditor,LastUpdate from " & gDbTableName & " where title='" & glsTopic & "'" EmitDebug 50, 2, "Browse query(" & sqlQuery & ")
    " & vbcrlf set rs = gDataConn.execute(sqlQuery) if rs.eof=true then Response.Write("

    Page Creation


    ") if gHideLogin Then Response.Write("The page --> " & glsTopic & " <--- Does not exit and it cannot be created on this Server") ElseIf NOT gEnableEdit Then Response.Write("The page --> " & glsTopic & " <--- Does not exit and it cannot be created until you log in") Else response.write("Sorry! The page --> " & glsTopic & " <--- is not existing or it is a page that must be created ") response.write( "
    Click this link to create this page." ) response.write( "

    No, don't create it." ) End If Response.Write("
    ") else EmitDebug 51, 3, "found...(" & rs("PageData") & ")
    " & vbcrlf If gEnableEdit Then response.write" " Else response.write" " End If Call WriteBanner(rs("title"),rs("title")) response.write "
    " & WalkWiki( xform( "" & vbcrlf & gWikiBodyPrefix & VbCrLF & "" & VbCrLF & rs("PageData"))) ' Elrey - xform func now removes html response.write "" dim hideScript hideScript = "var div1=document.getElementById('wikifooter'); if (div1) {div1.style.display='none';}" hideScript = hideScript & "div1=document.getElementById('bodyPrefix'); if (div1) {div1.style.display='none';}" hideScript = hideScript & "div1=document.getElementById('idTopSearch'); if (div1) {div1.style.display='none';}" Call WriteFooter(hideScript, rs("LastUpdate"), rs("LastEditor") ) end if end sub sub handleCreate If gHideLogin Then Response.Write("




    Editing is not allowed

    ") Response.End exit sub End If If NOT gEnableEdit Then Response.Write("




    Editing is not allowed until logged in

    ") Response.End exit sub End If on error resume next VerifyWikiTable on error goto 0 Response.Redirect gScriptURL end sub 'Intercept RSS request here if ( glsMode = "rss" ) then If ( gHttpDomain = "" ) then response.write("RSS is not enabled") Else handleRss End If response.End end if 'Intercept delete request here if ( glsMode = "del") then handleDelete response.End end if '******************************************************************** '********************************************************************* ' ' ' Response.Buffer=TRUE %> <% if not isEmpty(glsMode) and glsMode <> "browse" then response.write(glsMode & " ") end if response.write(SpaceName(glsTopic) & vbcrlf) %> <% Response.Write(gHtmlHeadStr) %> <% if Session("Hits") = "" then Session("Hits")= 1 else Session("Hits")= Session("Hits") + 1 end if EmitDebug 52, 1, "debug(" & gDebug & ")
    " & vbcrlf EmitDebug 53, 1, "
    QueryString = (" & Request.QueryString & ")
    " & _ "Hits(" & Session("Hits") & ")
    " & _ "mode(" & glsMode & ")
    " & _ "topic(" & glsTopic & ")
    " set gDataConn = Server.CreateObject("ADODB.Connection") ' 21 nov - need resume next to catch "no file" error on error resume next gDataConn.Open ConnStr(1) on error goto 0 if not (0 = gDataConn.errors.count) then if (ADOERROR_NOFILE = gDataConn.errors(0).number) then EmitDebug 54, 1, "
    ErrorCount(" & gDataConn.errors.count & ")
    " & vbcrlf EmitDebug 55, 1, "
    Error(" & gDataConn.errors(0).number &") desc(" &_ gDataConn.errors(0).description & ")
    " & vbcrlf VerifyWikiTable end if end if select case (glsMode) case "edit" handleEdit case "list" handleList case "search" handleSearch case "create" handleCreate case "save" handleSave case "browse" handleBrowse case "logout" handleLogout case "login" handleLogin case else end select EmitDebug 56, 2, "
    done...
    " & vbcrlf gDataConn.Close() set gDataConn = nothing %> <% Response.Write(gFooterHtml) %> <% Response.Flush %>