<% Dim contentfolder contentfolder = "/generator/assets/" Dim contentfile contentfile = Server.MapPath(contentfolder + "content.asp") Dim fso, file Set fso = CreateObject("Scripting.FileSystemObject") Set file = fso.GetFile(contentfile) Set ts = file.OpenAsTextStream(1, -2) Dim oArray, wholeContent wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) ts.close Dim settings(100) Dim check check =0 Dim i i = 0 For Each retstring in oArray If Left(retstring,3) = "<+>" Then check = 0 End If If check = 1 And UBound(Split(retstring, ":=")) > 0 Then settings(i) = retstring i = i + 1 End If If Left(retstring,3) = "<*>" Then check = 1 End If Next Dim allowed_domain_names allowed_domain_names = getSetting("allowedDomains") Dim domain_error_message domain_error_message = getSetting("domainFailureMessage") Sub getContent(pagename) 'checkDomain Dim retstring, tempstring Dim check check = 0 For Each tempstring in oArray On Error Resume Next retstring = Split(tempstring, "|")(0) If check = 1 Then If Left(tempstring, 3) <> "" then response.write stripSlashes(tempstring) + vbNewLine else exit For end if End If If LCase(retstring) = "" + LCase(pagename) then check = 1 End if Next End Sub Sub displayContentSub(pagename) 'checkDomain Dim result result = "" Dim retstring, tempstring Dim check check = 0 For Each tempstring in oArray On Error Resume Next retstring = Split(tempstring, "|")(0) If check = 1 Then If Left(tempstring, 3) <> "" then response.write stripSlashes(tempstring) + vbNewLine else exit For end if End If If LCase(retstring) = "" + LCase(pagename) then check = 1 End if Next If check = 0 Then Response.write "

No entry exists for this secondary page area.

" End If End Sub Function displayContent(pagename) checkDomain End Function Sub addKey(keyname) Dim doit doit=true For i=0 To getKeyListCount - 1 If LCase(getKey(i)) = LCase(keyname) Then doit = false End If Next If doit = true Then Set tsa = file.OpenAsTextStream(8, -2) tsa.write "" + keyname + "||" + vbNewLine + vbNewLine tsa.close End If End Sub Sub deleteKey(keyname) Dim tsw Dim check, wcheck, content, tempstring check = 0 wcheck = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each tempstring in oArray If Left(tempstring,3) <> "" And wcheck = 0 And Left(tempstring,3) <> "<->" And Left(tempstring,3) <> "<*>" And Left(tempstring,3) <> "<+>" Then If check = 1 Then wcheck = 1 Else tsw.writeline tempstring End If ElseIf Left(tempstring,3) = "" Or Left(tempstring,3) = "<->" Or Left(tempstring,3) = "<*>" Or Left(tempstring,3) = "<+>" Then If LCase(Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(0)) = LCase(keyname) Then check = 1 Else check = 0 tsw.writeline tempstring End If wcheck = 0 End If Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Sub setContent(keyname, newcontent) Dim tsw Dim check, wcheck, content, tempstring check = 0 wcheck = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each tempstring in oArray If Left(tempstring,3) <> "" And wcheck = 0 And Left(tempstring,3) <> "<->" And Left(tempstring,3) <> "<*>" And Left(tempstring,3) <> "<+>" Then If check = 1 Then If Right(newcontent,4) = vbNewLine+vbNewLine Then tsw.write newcontent ElseIf Right(newcontent,2) = vbNewLine Then tsw.write newcontent + vbNewLine Else tsw.write newcontent + vbNewLine + vbNewLine End If wcheck = 1 Else tsw.writeline tempstring End If ElseIf Left(tempstring,3) = "" Or Left(tempstring,3) = "<->" Or Left(tempstring,3) = "<*>" Or Left(tempstring,3) = "<+>" Then If LCase(Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(0)) = LCase(keyname) Then check = 1 Else check = 0 End If tsw.writeline tempstring wcheck = 0 End If Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Sub renameKey(oldname, newname) Dim doit doit=true For i=0 To getKeyListCount - 1 If LCase(getKey(i)) = LCase(newname) Then doit = false End If Next If doit = true Then Dim tsw Dim check, wcheck, content, tempstring check = 0 wcheck = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each tempstring in oArray If Left(tempstring, 3) <> "" Then tsw.writeline tempstring ElseIf Left(tempstring, 3) = "" Then If LCase(Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(0)) = LCase(oldname) Then tsw.writeline "" + newname + "|" + Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(1) + "|" + Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(2) Else tsw.writeline tempstring End If End If Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End If response.write "" End Sub Function getKey(keyid) count = 0 key = "" tempstring = "" For Each retstring in oArray If Left(retstring,3) = "" Then If keyid = count then key = Split(Replace(retstring, "", ""), "|")(0) End If count = count + 1 End if Next getKey = key End Function Function getKeyListCount() count = 0 For Each retstring in oArray If Left(retstring,3) = "" Then count = count + 1 End if Next getKeyListCount = count End Function Function isRecordExist(pagename) count = 0 Result = False For Each retstring in oArray If Left(retstring,3) = "" Then If LCase(pagename) = LCase(Split(Trim(Right(retstring, Len(retstring) - 3)), "|")(0)) Then Result = True End If End if Next isRecordExist = Result End Function Function getUser() username = "" Dim check check = 0 For Each retstring in oArray If check = 1 Then username = Replace(retstring, "<+>", "") Exit For End If If Left(retstring,3) = "<+>" Then check = 1 End if Next getUser = username End Function Function getPassword() pass = "" Dim check check = 0 For Each retstring in oArray If check = 2 Then pass = Replace(retstring, "<+>", "") Exit For End If If check = 1 Then check = 2 End If If Left(retstring,3) = "<+>" Then check = 1 End if Next getPassword = pass End Function Sub setPassword(password) Dim tsw Dim check, wcheck, content, retstring check = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each retstring in oArray If Left(retstring,3) = "<+>" And check = 0 Then tsw.writeline retstring check = 1 ElseIf check = 1 Then tsw.writeline retstring check = 2 ElseIf check = 2 Then tsw.writeline password check = 0 Else tsw.writeline retstring End if Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Sub setUser(user) Dim tsw Dim check, wcheck, content, retstring check = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each retstring in oArray If Left(retstring,3) = "<+>" And check = 0 Then tsw.writeline retstring check = 1 ElseIf check = 1 Then tsw.writeline user check = 0 Else tsw.writeline retstring End if Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Sub getLost() Response.Cookies("Authenticated") = "0" Session.Abandon response.write "
Unauthorized access.
" End Sub Function getPageName() getPageName = Right(Request.ServerVariables("SCRIPT_NAME"), Len(Request.ServerVariables("SCRIPT_NAME"))-1) End function Sub checkDomain Dim iCoun, sDomain iCount = 0 sDomain = "" if Request.ServerVariables("SERVER_NAME") <> "" then sDomain = Request.ServerVariables("SERVER_NAME") elseif Request.ServerVariables("HTTP_HOST") <> "" then sDomain = Request.ServerVariables("HTTP_HOST") else response.write domain_error_message end if Dim sDomainTwo, present present = false for each sDomainTwo in Split(allowed_domain_names, ",") if sDomainTwo = sDomain then present = true end if next if allowed_domain_names <> "" and present = false then response.write domain_error_message end if End Sub Function stripSlashes(content) StripSlashes = Replace(Replace(content, "\""", """"), "\'", "'") End Function Sub displayContent(pagename, pagepath) checkDomain Dim retstring, tempstring Dim check check = 0 If fso.FileExists(contentfile) = False Then response.write "

Function: displayContent; Error: Can't open database file " + contentfile + "

" Exit Sub End If Dim editorpath editorpath = pagepath + "default.asp?doc=" + pagename If pagename <> getPageName() Then Response.Cookies("womb") = request.ServerVariables("URL") Else Response.Cookies("womb") = "" End If response.write "" & vbNewLine For Each tempstring in oArray On Error Resume Next retstring = Split(tempstring, "|")(0) If check = 1 Then If Left(tempstring, 3) <> "" then response.write stripSlashes(tempstring) + vbNewLine else exit For end if End If If LCase(retstring) = "" + LCase(pagename) then check = 1 End if Next If check = 0 Then response.write "

No entry exists for this page area. Press Control-Y to log in and begin.

" End If response.write getSetting("poweredBy") End Sub Sub setLocalData(doc, name, password) Dim check, wcheck, content, retstring Dim tempString check =0 Set tsw = file.OpenAsTextStream(2, -2) For Each tempstring in oArray If Left(tempstring, 3) <> "" Then tsw.writeline tempstring ElseIf Left(tempstring, 3) = "" Then If LCase(Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(0)) = LCase(doc) Then tsw.writeline "" + doc + "|" + Trim(name) + "|" + Trim(password) Else tsw.writeline tempstring End If End If Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Function getLocalData(doc) Dim check, content, tempstring check = 0 content = "" tempstring = "" For Each tempstring in oArray If Left(tempstring, 3) = "" Then If LCase(Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|")(0)) = LCase(doc) Then getLocalData = Split(Trim(Right(tempstring, Len(tempstring) - 3)), "|") End If End If Next End Function Function checkLogin(typeq, doc) If Request.Cookies("Authenticated") = "1" Then CheckLogin = True Else Dim usr, pwd usr = "unauthorized" On Error Resume Next usr = getLocalData(doc)(1) On Error Resume Next pwd = getLocalData(doc)(2) If typeq <> "admin" And usr = Request.Cookies("usr") And pwd = Request.Cookies("pwd") And Request.Cookies("usr") <> "" And Request.Cookies("pwd") <> "" Then Response.Cookies("doc") = doc CheckLogin = True Exit Function End If CheckLogin = False End If End Function '---------------------- ' Deployer functions '---------------------- Function getDeployerUser() username = "" Dim check check = 0 For Each retstring in oArray If check = 1 Then username = Replace(retstring, "<->", "") Exit For End If If Left(retstring,3) = "<->" Then check = 1 End if Next getDeployerUser = username End Function Function getDeployerPassword() pass = "" Dim check check = 0 For Each retstring in oArray If check = 2 Then pass = Replace(retstring, "<->", "") Exit For End If If check = 1 Then check = 2 End If If Left(retstring,3) = "<->" Then check = 1 End if Next getDeployerPassword = pass End Function Sub setDeployerPassword(password) Dim tsw Dim check, wcheck, content, retstring check = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each retstring in oArray If Left(retstring,3) = "<->" And check = 0 Then tsw.writeline retstring check = 1 ElseIf check = 1 Then tsw.writeline retstring check = 2 ElseIf check = 2 Then tsw.writeline password check = 0 Else tsw.writeline retstring End if Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub Sub setDeployerUser(user) Dim tsw Dim check, wcheck, content, retstring check = 0 content = "" tempstring = "" Set tsw = file.OpenAsTextStream(2, -2) For Each retstring in oArray If Left(retstring,3) = "<->" And check = 0 Then tsw.writeline retstring check = 1 ElseIf check = 1 Then tsw.writeline user check = 0 Else tsw.writeline retstring End if Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) End Sub '---------------------- ' Setting functions '---------------------- Function getSetting(name) Dim exploded, retstring value = "" Dim check check =0 For Each retstring in settings If retstring <> "" Then If Split(retstring, ":=")(0) = name Then value = Split(retstring, ":=")(1) End If End If Next getSetting = value End Function Function encode(value) encode=Server.HTMLEncode(value) End Function Sub setSetting(name,value) Dim exploded, retstring Dim check check =0 Dim i i = 0 For Each retstring in settings If retstring <> "" Then If Split(retstring, ":=")(0) = name Then 'settings(i) = name + ":=" + Replace(Replace(value, """", "'"), vbNewLine, "") settings(i) = name + ":=" + Replace(value, vbNewLine, "") End If i = i + 1 End If Next End Sub Sub setSettingArray() Dim tsw Dim check, wcheck, content, retstring, setting Dim tempString check =0 Set tsw = file.OpenAsTextStream(2, -2) For Each retstring in oArray If Left(retstring,3) = "<+>" Then check = 0 tsw.writeline "" End If If check = 1 Then For Each setting in settings If setting <> "" and retstring <> "" Then If Split(retstring, ":=")(0) = Split(setting, ":=")(0) Then 'response.write "" + setting 'response.write "" + retstring + "
" tsw.writeline Split(setting, ":=")(0) + ":=" + Split(setting, ":=")(1) Else 'Exit For End If End If Next Else tsw.writeline retstring End If If Left(retstring,3) = "<*>" Then check = 1 End If Next tsw.close Set ts = file.OpenAsTextStream(1, -2) wholeContent = ts.Read(file.Size) wholeContent = Left(wholeContent, Len(wholeContent)-2) oArray = split(wholeContent,vbNewLine) Dim i i = 0 For Each retstring in oArray If Left(retstring,3) = "<+>" Then check = 0 End If If check = 1 And UBound(Split(retstring, ":=")) > 0 Then settings(i) = retstring i = i + 1 End If If Left(retstring,3) = "<*>" Then check = 1 End If Next End Sub Function getCheckboxValue(value) Dim result If value="true" Then result = "checked='checked'" End If getCheckboxValue = result End Function Function getLineBreak(name) If name="useDIV" And getSetting("useDIV")="true" And getSetting("useBR")="false" Then getLineBreak = "checked='checked'" ElseIf name="useBR" And getSetting("useDIV")="false" And getSetting("useBR")="true" Then getLineBreak = "checked='checked'" ElseIf name="useP" And getSetting("useDIV")="false" And getSetting("useBR")="false" Then getLineBreak = "checked='checked'" Else getLineBreak = "" End If End Function Sub setLineBreak() If Request("dep_useLineBreak") = "useDIV" Then setSetting "useDIV", "true" setSetting "useBR", "false" ElseIf Request("dep_useLineBreak") = "useBR" Then setSetting "useDIV", "false" setSetting "useBR", "true" ElseIf Request("dep_useLineBreak") = "useP" Then setSetting "useDIV", "false" setSetting "useBR", "false" End If End Sub Sub setCheckboxValue(name) If Request("dep_"+name) = "on" Then setSetting name, "true" Else setSetting name, "false" End If End Sub %>