<% '### '# this file does NOT have error checking - if bad values are submitted the kaos news script may break '# it is intended to be used alongside ui_scriptoptions.asp (which has javascript checks) by the script admin only '# '# this file simply takes the script options given and generates the appropriate files for use by the kaos news script '### zobjConn.Close 'close conn... not used again after checking login Set zobjConn = Nothing If z1_AccessLevel <> 3 Then Response.Redirect "ui_index.asp?msg=You naughty monkey, you shouldnt be trying to use that page" End If Sub setUpdateOption(formvar,constvar) If Request.Form(formvar) = "yes" Then zobjTS.WriteLine "Const " & constvar & " = True" Else zobjTS.WriteLine "Const " & constvar & " = False" End If End Sub Sub setDisplayOption(formvar,constvar) zobjTS.WriteLine "If " & constvar & " = """" Then" zobjTS.WriteLine " " & constvar & " = " & Request.Form(formvar) zobjTS.WriteLine "End If" End Sub Dim zobjFSO,zobjTS Set zobjFSO = CreateObject("Scripting.FileSystemObject") If Not zobjFSO.FolderExists(Server.MapPath("/kaos/generated")) Then 'creates folder for generated files if isnt there zobjFSO.CreateFolder(Server.MapPath("/kaos/generated")) End If '# adminUpdate.asp generation # Set zobjTS = zobjFSO.CreateTextFile(Server.MapPath("adminUpdate.asp")) 'page header, news/ comment zobjTS.WriteLine chr(60) & chr(37) & vbcrlf & "'-- news --" Call setUpdateOption("language0","News_UseLanguageFilter") Call setUpdateOption("ubb0","News_AllowUBB") Call setUpdateOption("smilies0","News_AllowSmilies") Call setUpdateOption("img0","News_AllowImages") 'comments/ comment zobjTS.WriteLine vbcrlf & "'-- comments --" Call setUpdateOption("language1","Comments_UseLanguageFilter") Call setUpdateOption("ubb1","Comments_AllowUBB") Call setUpdateOption("smilies1","Comments_AllowSmilies") Call setUpdateOption("img1","Comments_AllowImages") 'swearwords/ comment zobjTS.WriteLine vbcrlf & "'-- swearword filter - enclose words in dblquotes, comma delimited with no spaces --" zobjTS.WriteLine "Const Naughty_Words = " & chr(34) & Request.Form("languagewords") & chr(34) 'file gen/comment zobjTS.WriteLine vbcrlf & "'-- file autogeneration on posting new stuff --" Call setUpdateOption("filenews","AutoGenerateFile") Call setUpdateOption("fileheadlines","AutoGenerateHeadlines") 'page footer zobjTS.Write chr(37) & chr(62) zobjTS.Close '# adminDisplay.asp generation # Set zobjTS = zobjFSO.CreateTextFile(Server.MapPath("adminDisplay.asp")) 'page header, display options comment zobjTS.WriteLine chr(60) & chr(37) & vbcrlf & "'# the if.thens are so that these defaults can be easily overrided on page" & vbcrlf & "'-- news page display options --" & vbcrlf & "'* set to 0 gives no limit, other integer is limit for that parameter" 'display options Call setDisplayOption("postsperpage","PostsPerPage") Call setDisplayOption("daysperpage","DaysPerPage") zobjTS.WriteLine "'* set to -1 turns expandable comments off, 0 gives no limit, other integer is the limit" Call setDisplayOption("commentsperpost","CommentsPerPost") 'index options zobjTS.WriteLine "'-- post index --" & vbcrlf & "'* 0 is no limit, +ive integer is limit" Call setDisplayOption("indexheadlines","PostsPerIndex") zobjTS.WriteLine "'* 0 is no skip, +ive integer is the number of posts skipped, -1 only displays posts after those on current page" Call setDisplayOption("indexskip","PostSkipInIndex") 'page footer zobjTS.Write chr(37) & chr(62) zobjTS.Close '# adminFileGen.asp generation # Set zobjTS = zobjFSO.CreateTextFile(Server.MapPath("adminFileGen.asp")) 'page header zobjTS.WriteLine chr(60) & chr(37) & vbcrlf & "'-- file auto-generation --" & vbcrlf & "'* must be lowercase. either ""xml"", ""html"" or ""html, xml""" 'set options zobjTS.WriteLine "Const AutoFileTypes = """ & Request.Form("filetype") & chr(34) zobjTS.WriteLine "'* the numerical reference for the category. enclose in quotes. seperate with comma and space- ', '" zobjTS.WriteLine "Const AutoFileCategory = """ & Request.Form("filecategories") & chr(34) zobjTS.WriteLine "'* alpha-numerics and underscore character only, no extension" zobjTS.WriteLine "Const AutoFileName = """ & Request.Form("filename") & chr(34) zobjTS.WriteLine "'* 0 is no limit, +ive integer is value" zobjTS.WriteLine "Const AutoNoOfPosts = " & Request.Form("fileposts") zobjTS.WriteLine "Const AutoDaysPerPage = " & Request.Form("filedays") zobjTS.WriteLine "'* -1 is none, 0 is no limit, +ive integer is value" zobjTS.WriteLine "Const AutoNoOfComments = " & Request.Form("filecomments") & vbcrlf zobjTS.WriteLine "'-- headlines file gen --" zobjTS.WriteLine "'* full url to the appropriate display .asp file" zobjTS.WriteLine "Const HeadlineURL = """ & Request.Form("fileheaddisplayname") & chr(34) zobjTS.WriteLine "'* the numerical reference for the category. enclose in quotes. seperate with comma and space- ', '" zobjTS.WriteLine "Const HeadlineCategory = """ & Request.Form("fileheadcategories") & chr(34) zobjTS.WriteLine "'* 0 is no limit, +ive integer is value" zobjTS.WriteLine "Const HeadlinePosts = " & Request.Form("fileheadposts") zobjTS.WriteLine "Const HeadlineDays = " & Request.Form("fileheaddays") 'footer zobjTS.Write chr(37) & chr(62) zobjTS.Close '# zFilter_key.asp generation # Dim zstrcodes,zstrreplace,zobjRegExp Set zobjRegExp = New RegExp zobjRegExp.Pattern = "(, )+" zobjRegExp.Global = True zstrcodes = zobjRegExp.Replace(Request.Form("smile_orig"),", ") 'removes extra commas from beginning/middle string zstrreplace = zobjRegExp.Replace(Request.Form("smile_new"),", ") If Left(zstrcodes,2) = ", " Then 'removes extra commas from beginning zstrcodes = Right(zstrcodes,(Len(zstrcodes) - 2)) End If If Left(zstrreplace,2) = ", " Then 'removes extra commas from beginning zstrreplace = Right(zstrreplace,(Len(zstrreplace) - 2)) End If If Right(zstrcodes,2) = ", " Then 'removes extra commas from end zstrcodes = Left(zstrcodes,(Len(zstrcodes) - 2)) End If If Right(zstrreplace,2) = ", " Then 'removes extra commas from end zstrreplace = Left(zstrreplace,(Len(zstrreplace) - 2)) End If zstrcodes = Server.HTMLEncode(zstrcodes) 'it will be swapping stuff already encoded, so code the text set by user too zstrcodes = Split(zstrcodes,", ") zstrreplace = Split(zstrreplace,", ") If UBound(zstrcodes) = UBound(zstrreplace) Then Set zobjTS = zobjFSO.CreateTextFile(Server.MapPath("zFilter_key.asp")) zobjTS.WriteLine chr(60) & chr(37) & vbcrlf & "Dim zFilter_Key" & vbcrlf & "Set zFilter_Key = CreateObject(""Scripting.Dictionary"")" Dim i,ii ii = UBound(zstrcodes) For i = 0 To ii zobjTS.WriteLine "zFilter_Key.Add " & chr(34) & zstrcodes(i) & chr(34) & ", " & chr(34) & zstrreplace(i) & chr(34) Next zobjTS.Write chr(37) & chr(62) zobjTS.Close End If 'closedown Set zobjTS = Nothing Set zobjFSO = Nothing Response.Redirect "ui_index.asp?msg=script settings changed" %>