FSO操作文件系统
程序员文章站
2022-03-25 20:25:08
实现功能: 文件(夹)目录列表 提供了查阅目录下面的文件和文件夹 文件 写,创,删 提供了编辑,删除文件(文件夹)的操作 创建文件夹/文件&n...
实现功能:
文件(夹)目录列表 提供了查阅目录下面的文件和文件夹
文件 写,创,删 提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件 针对创建文件夹(文件)而设置.
上传文件 您可以模拟ftp上传,文件大小,类型不受限制.
有兴趣的自己体验,出现任何问题我均不承担任何后果,在此说,我没多少时间上网,经常也顾不过来,是看到最近经常有人问这方面的问题,就发上来,希望有所帮助。
upfso.asp //控制上传的文件
复制代码 代码如下:
<!--#include file="upload.asp" -->
<%'on error resume next%>
<style type="text/css"> @import url("admin.css");</style>
<%
server.scripttimeout = 999
'up_filetype="rar,zip,swf,jpg,png,gif,doc,txt,chm,pdf,ace,jpg,mp3,wma,wmv,bmp"
if request.querystring("yes")="upload" then
path=trim(request("path"))
'response.write(path&"---")
'response.end
dim fso,fsoisok,f_filename,mode
f_filename=trim(request("nn"))
mode =killint(trim(request("mode")),0,0,2)
fsoisok=1
set fso=server.createobject("scripting.filesystemobject")
if err<>0 then
err.clear
fsoisok=0
end if
dim d_name,f_name
if fsoisok=1 then
if instr(1,path,":\")=0 then
path=replace(lcase(path),"\","/")
path = server.mappath(path)
path=replace(path&"/","//","/")
else
path=replace(lcase(path),"/","\")
path=replace(path&"\","\\","\")
end if
if not fso.folderexists(path) then
response.write "<a href=""javascript:history.back()""><font color='#000080'>基本路径查找失败,返回</font></a>"
response.end
end if
end if
set fso=nothing
dim fileup
set fileup=new upload_file
fileup.getdate(-1)
dim f_filetype, f_file
set f_file=fileup.file("file")
if len(f_filename)<2 then f_filename = f_file.filename
if len(f_filename)<2 then
response.write("<a href='javascript:history.go(-1);'><font color='#000080'>空文件,请返回</font></a>")
response.end
end if
'f_filetype = ucase(f_file.fileext)
'if f_file.filesize > 90000 then
' response.write("<a href='javascript:history.go(-1);'>大小超过限制</a>")
'exit sub
if isvalidfilename(f_filename) = false then
response.write("<a href='javascript:history.go(-1);'><font color='#000080'>名称有误</font></a>")
else
dim fileisexists
set fso=server.createobject("scripting.filesystemobject")
fileisexists=fso.fileexists(path&f_filename)
if fileisexists=true and mode<>1 then
fso.deletefile(path&f_filename)
response.write("<font color='#000080'>文件已经存在,已经被删除</b></a>;")
f_file.savetofile path&f_filename
response.write("<a href='upfso.asp?action=fso&path="&path&"'><b><font color='#000080'>点击这里继续上传:"&path&f_filename&"</font></b></a>")
elseif fileisexists=true and mode=1 then
response.write("<font color='#000080'>文件已经存在,您选择了不覆盖</font></b>")
else
f_file.savetofile path&f_filename
response.write("<a href='upfso.asp?action=fso&path="&path&"'><b><font color='#000080'>点击这里继续上传:"&path&f_filename&"</font></b></a>")
end if
end if
set f_file=nothing
set fileup=nothing
else
dim path,nn,mmode
nn=trim(request("nn"))
mmode=trim(request("mode"))
path=replace(request("path"),"//","/")
if path="" then path="../newup/"
response.write("<form enctype=""multipart/form-data"" method=""post"" action=""upfso.asp?yes=upload&path="&path&"&nn="&nn&"&mode="&mmode&""" class=""admin_fso_up"" onsubmit=""checkform()"" name='form'><label>选择:<input name=""file"" type=""file"" size=""20""/></label><label> <input type=""submit"" name=""submit"" class=""submit"" value="" 上传 "" /></label></form>")
end if
'效验名称
function isvalidfilename(file_name)
isvalidfilename = false
dim re,restr
set re=new regexp
re.ignorecase =true
re.global=true
re.pattern="[^_\.a-za-z\d]"
restr=re.replace(file_name,"")
if file_name = restr then isvalidfilename=true
set re=nothing
end function
%>
upload.asp // 上传类
复制代码 代码如下:
<%
dim oupfilestream
class upload_file
dim form,file,err
private sub class_initialize
err=-1
end sub
private sub class_terminate
'clear variables & objects
if err < 0 then
oupfilestream.close
form.removeall
file.removeall
set form=nothing
set file=nothing
set oupfilestream =nothing
end if
end sub
public sub getdate(retsize)
'define variables
dim requestbindate,sstart,bcrlf,sinfo,iinfostart,iinfoend,tstream,istart,ofileinfo
dim ifilesize,sfilepath,sfiletype,sformvalue,sfilename
dim ifindstart,ifindend
dim iformstart,iformend,sformname
if request.totalbytes < 1 then
err=1
exit sub
end if
if retsize > 0 then
if request.totalbytes > retsize then
err=2
exit sub
end if
end if
set form = server.createobject("scripting.dictionary")
form.comparemode = 1
set file = server.createobject("scripting.dictionary")
file.comparemode = 1
set tstream = server.createobject("adodb.stream")
set oupfilestream = server.createobject("adodb.stream")
oupfilestream.type = 1
oupfilestream.mode = 3
oupfilestream.open
oupfilestream.write request.binaryread(request.totalbytes)
oupfilestream.position=0
requestbindate = oupfilestream.read
iformend = oupfilestream.size
bcrlf = chrb(13) & chrb(10)
'get seperators
sstart = midb(requestbindate,1, instrb(1,requestbindate,bcrlf)-1)
istart = lenb (sstart)
iformstart = istart+2
'split items
do
iinfoend = instrb(iformstart,requestbindate,bcrlf & bcrlf)+3
tstream.type = 1
tstream.mode = 3
tstream.open
oupfilestream.position = iformstart
oupfilestream.copyto tstream,iinfoend-iformstart
tstream.position = 0
tstream.type = 2
tstream.charset = "utf-8"
sinfo = tstream.readtext
'get form item name
iformstart = instrb(iinfoend,requestbindate,sstart)-1
ifindstart = instr(22,sinfo,"name=""",1)+6
ifindend = instr(ifindstart,sinfo,"""",1)
sformname = mid (sinfo,ifindstart,ifindend-ifindstart)
'if it's a file
if instr (45,sinfo,"filename=""",1) > 0 then
set ofileinfo= new fileinfo
'get file attributes
ifindstart = instr(ifindend,sinfo,"filename=""",1)+10
ifindend = instr(ifindstart,sinfo,"""",1)
sfilename = mid (sinfo,ifindstart,ifindend-ifindstart)
ofileinfo.filename = mid (sfilename,instrrev (sfilename, "\")+1)
ofileinfo.filepath = left (sfilename,instrrev (sfilename, "\"))
ofileinfo.fileext = mid (sfilename,instrrev (sfilename, ".")+1)
ifindstart = instr(ifindend,sinfo,"content-type: ",1)+14
ifindend = instr(ifindstart,sinfo,vbcr)
ofileinfo.filetype = mid (sinfo,ifindstart,ifindend-ifindstart)
ofileinfo.filestart = iinfoend
ofileinfo.filesize = iformstart -iinfoend -2
ofileinfo.formname = sformname
file.add sformname,ofileinfo
else
'if it's form item
tstream.close
tstream.type = 1
tstream.mode = 3
tstream.open
oupfilestream.position = iinfoend
oupfilestream.copyto tstream,iformstart-iinfoend-2
tstream.position = 0
tstream.type = 2
tstream.charset = "utf-8"
sformvalue = tstream.readtext
if form.exists (sformname) then
form (sformname) = form (sformname) & ", " & sformvalue
else
form.add sformname,sformvalue
end if
end if
tstream.close
iformstart = iformstart+istart+2
'exit at end of file
loop until (iformstart+2) = iformend
requestbindate=""
set tstream = nothing
end sub
end class
'get file info
class fileinfo
dim formname,filename,filepath,filesize,filetype,filestart,fileext
private sub class_initialize
filename = ""
filepath = ""
filesize = 0
filestart= 0
formname = ""
filetype = ""
fileext = ""
end sub
'save file method
public function savetofile(fullpath)
dim ofilestream,errorchar,i
on error resume next
set ofilestream=createobject("adodb.stream")
ofilestream.type=1
ofilestream.mode=3
ofilestream.open
oupfilestream.position=filestart
oupfilestream.copyto ofilestream,filesize
ofilestream.savetofile fullpath,2
ofilestream.close
set ofilestream=nothing
end function
'get file content
public function getdate
oupfilestream.position =filestart
getdate=oupfilestream.read(filesize)
end function
end class
%>
核心函数
复制代码 代码如下:
dim theinstalledobjects(17)
theinstalledobjects(0) = "mswc.adrotator"
theinstalledobjects(1) = "mswc.browsertype"
theinstalledobjects(2) = "mswc.nextlink"
theinstalledobjects(3) = "mswc.tools"
theinstalledobjects(4) = "mswc.status"
theinstalledobjects(5) = "mswc.counters"
theinstalledobjects(6) = "iissample.contentrotator"
theinstalledobjects(7) = "iissample.pagecounter"
theinstalledobjects(8) = "mswc.permissionchecker"
theinstalledobjects(9) = "scripting.filesystemobject"
theinstalledobjects(10) = "adodb.connection"
theinstalledobjects(11) = "softartisans.fileup"
theinstalledobjects(12) = "softartisans.filemanager"
theinstalledobjects(13) = "jmail.smtpmail"
theinstalledobjects(14) = "cdonts.newmail"
theinstalledobjects(15) = "persits.mailsender"
theinstalledobjects(16) = "lyfupload.uploadfile"
theinstalledobjects(17) = "persits.upload.1"
dim fso
if isobjinstalled(theinstalledobjects(9)) then
set fso =server.createobject("scripting.filesystemobject")
end if
function isobjinstalled(strclassstring)
on error resume next
isobjinstalled = false
err = 0
dim xtestobj
set xtestobj = server.createobject(strclassstring)
if 0 = err then isobjinstalled = true
set xtestobj = nothing
err = 0
end function
'检查组件版本
public function getver(classstr)
on error resume next
dim xtestobj
set xtestobj = server.createobject(classstr)
if err then
getver=""
else
getver=xtestobj.version
end if
set xtestobj = nothing
end function
'效验名称
function isvalidfilename(file_name)
isvalidfilename = false
dim re,restr
set re=new regexp
re.ignorecase =true
re.global=true
re.pattern="[^_\.a-za-z\d]"
restr=re.replace(file_name,"")
if file_name = restr then isvalidfilename=true
set re=nothing
end function
'文件写入
function writeto(xmlfloder,xmlfile,content,mode)
writeto=false
if not isobjinstalled(theinstalledobjects(9)) then exit function
mode=killint(mode,0,0,2)
xmlfloder=server.mappath(xmlfloder)
set fso =server.createobject("scripting.filesystemobject")
if not fso.folderexists(xmlfloder) then
fso.createfolder(xmlfloder)
end if
xmlfile=replace(xmlfloder&"\","\\","\")&xmlfile
' response.write(warn_red(xmlfile))
dim fsoxml
if fso.fileexists(xmlfile) and mode=1 then '存在不写
exit function
elseif fso.fileexists(xmlfile) and mode=2 then '重写
set fsoxml=fso.opentextfile(xmlfile,2)
fsoxml.writeline(content)
fsoxml.close
writeto=true
elseif fso.fileexists(xmlfile) and mode=8 then '追加
set fsoxml=fso.opentextfile(xmlfile,8)
fsoxml.writeline(content)
fsoxml.close
writeto=true
elseif fso.fileexists(xmlfile) then
set fsoxml=fso.opentextfile(xmlfile,2)'重写
fsoxml.writeline(content)
fsoxml.close
writeto=true
else
set fsoxml=fso.createtextfile(xmlfile)'创建
fsoxml.writeline(content)
fsoxml.close
writeto=true
end if
end function
'删除文件
function delaspfile(x)
on error resume next
delaspfile=false
if not fileexitornot(x) then
exit function
else
fso.deletefile server.mappath(x)
delaspfile=true
end if
end function
'文件存在
function fileexitornot(file)
on error resume next
dim f_re_file
f_re_file=true
if not fso.fileexists(server.mappath(file)) then f_re_file=false
if err<>0 then f_re_file=false
fileexitornot=f_re_file
end function
'错误抑制,打印错误
function show_err(err)
on error resume next
if err.number <> 0 then
response.clear
dim err_mess
err_mess="<b>发生错误:</b><br/>错误 number: "& err.number&"<br/>错误信息:"&err.description&"<br/>出错文件:"&err.source&"<br/>出错行:"&err.line&"(不被支持)<br/>"& err
response.write(err_mess)
end if
end function
'警告:
function warn_red(mess)
warn_red="<font color=red><b>跟踪:"&mess&"</b></font><br/>"
end function
'fso文件目录
function showallfile(path)
'on error resume next
path=replace(path,"//","/")
set fso = createobject("scripting.filesystemobject")
dim uploadpath,uploadfolder,objsubfolders,allfiles,fileitem,objsubfolder,
sfilename
if instr(1,path,":\")=0 then
path=replace(path,"\","/")
uploadpath = server.mappath(path)
else
path=replace(path,"/","\")
uploadpath=path
end if
response.write(warn_red(uploadpath))
if not fso.folderexists(uploadpath) then
response.write warn_red("路径查找失败")
exit function
end if
set uploadfolder = fso.getfolder(uploadpath)
if uploadfolder.isrootfolder then
response.write("<b>根目录</b><br/>")
else
response.write("<b><font color=""#00008b"">父目录:</font><a href=""default.asp?action=fso&this=top&path="&uploadfolder.parentfolder&""">
"&uploadfolder.parentfolder&" </a></b><br/>")
end if
response.write("<b>目录大小:"&int(uploadfolder.size/1024)&" kb</b><br/>")
set objsubfolders=uploadfolder.subfolders
dim fso_mes
fso_mes="<ol>"
for each objsubfolder in objsubfolders
fso_mes=fso_mes& "<li><b><a href=""default.asp?action=fso&this=top&path="&path&"/"&objsubfolder.name&"""><font color=blue>" & objsubfolder.name & "</font></a></b></li>"
next
set allfiles = uploadfolder.files
for each fileitem in allfiles
fso_mes=fso_mes& "<li><a href=""default.asp?action=fso&this=file&path="&path&"/"&fileitem.name&""">" & fileitem.name & "</a></li>"
next
fso_mes=fso_mes&"</ol>"
response.write(fso_mes)
response.write deltext(uploadpath,1)
end function
'文件属性
function filepro(name)
name=replace(name,"//","/")
dim whichfile
if instr(1,name,":\")=0 then
name=replace(name,"\","/")
whichfile = server.mappath(name)
else
name=replace(name,"/","\")
whichfile=name
end if
set fso = createobject("scripting.filesystemobject")
if not fso.fileexists(whichfile) then
response.write(warn_red("文件不存在或者无访问权限"))
exit function
end if
dim f2,s_mess
set f2 = fso.getfile(whichfile)
s_mess = "<div class=""admin_post_form""><b><font color=""#00008b"">父目录:</font><a href=""default.asp?action=fso&this=top&path="&f2.parentfolder&""">"&f2.parentfolder&
"</a></b><br/>"
s_mess = s_mess & "文件名称:" & f2.name & "<br>"
s_mess = s_mess & "文件短路径名:" & f2.shortpath & "<br>"
s_mess = s_mess & "文件物理地址:" & f2.path & "<br>"
s_mess = s_mess & "文件属性:" & f2.attributes & "<br>"
s_mess = s_mess & "文件大小: " & f2.size & "<br>"
s_mess = s_mess & "文件类型: " & f2.type & "<br>"
s_mess = s_mess & "文件创建时间: " & f2.datecreated & "<br>"
s_mess = s_mess & "最近访问时间: " & f2.datelastaccessed & "<br>"
s_mess = s_mess & "最近修改时间: " & f2.datelastmodified&"<br/></div>"
response.write(s_mess)
if killint(trim(request("type")),0,0,2)<>0 then
showtext(whichfile)
end if
response.write deltext(whichfile,0)
end function
'
sub showtext(files)
dim istr,adostext,strasp
set adostext=server.createobject("adodb.stream")
adostext.mode=3
adostext.type=2
adostext.charset="gb2312"
'adostext.charset="big5"
adostext.open
if instr(1,files,":\")=0 then
files=replace(files,"\","/")
files = server.mappath(files)
else
files=replace(files,"/","\")
files=files
end if
adostext.loadfromfile (files)
strasp=adostext.readtext()
adostext.close
set adostext=nothing%>
<form method="post" class="admin_post_form" action="default.asp?action=fso&this=edit&mode=1">
<textarea id="txt" name="txt" rows="15" cols="60"><%=server.htmlencode(strasp)%></textarea>
<label> <input name="path" type="hidden" value="<%=trim(request("path"))%>"/><input type="submit" name="okedit" class="submit" value="确定编辑"> </label>
</form>
<%end sub
function deltext(file,mode)
dim deltext_mess
deltext_mess="<div class=""deltext"">"
select case killint(mode,0,0,2)
case 0:
deltext_mess=deltext_mess&"文件操作:<a href=""default.asp?action=fso&this=file&path="&file&""">属性</a><a onclick=""{if(confirm('警告,非文本请不要读取,否则文件无法读取了,你坚持点击确定么?劝你点击取消')){return true;} return false;}"" href=""default.asp?action=fso&this=file&path="&file&"&type=1""><font color=red><b>编辑</b></font></a><a href=""default.asp?action=fso&this=move&path="&file&""">移动</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=0"">复制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=0"">重命名</a><a onclick=""{if(confirm('警告,删除操作不能恢复,小心使用!!!')){return true;} return false;}"" href=""default.asp?action=fso&this=del&path="&file&"&mode=0""><font color=red><b>删除</b></font></a>"
case 1:
deltext_mess=deltext_mess&"文件夹操作:<a href=""default.asp?action=fso&this=top&path="&file&""">列表</a><a href=""default.asp?action=fso&this=add&path="&file&"&ff=1"">创建目录</a><a href=""default.asp?action=fso&this=add&path="&file&""">手建文件</a><a href=""default.asp?action=fso&this=up&path="&file&""">上传文件</a><a href=""default.asp?action=fso&this=move&path="&file&"&mode=1"">移动</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=1"">复制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=1"">重命名</a><a onclick=""{if(confirm('警告,删除操作不能恢复,以上列表的文件全部被删除,你坚持点击确定么?劝你点击取消')){return true;} return false;}"" href=""default.asp?action=fso&this=del&path="&file&"&mode=1""><font color=red><b>删除</b></font></a>"
end select
deltext_mess=deltext_mess&"</div>"
deltext=deltext_mess
end function
上一篇: [ASP]使用类,实现模块化
下一篇: Object对象的一些的隐藏函数介绍