当前页面位置: » 丰搜网 » 文档中心 » 详细内容
fso操作文件系统
谢绝转载
1：请尊重我的劳动成果，贴出以下代码只帮助个人欣赏或者学习，请直接copy不要用于商业用途。
2： 这是我从我写的某系统里面剔出的程序，当时水平差（现在也是），程序绝非产品级的代码，但绝非无价值的。
实现功能：
文件(夹)目录列表 提供了查阅目录下面的文件和文件夹
文件 写,创,删 提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件 针对创建文件夹(文件)而设置.
上传文件 您可以模拟ftp上传,文件大小,类型不受限制.
有兴趣的自己体验，出现任何问题我均不承担任何后果，在此说，我没多少时间上网，经常也顾不过来，是看到最近经常有人问这方面的问题，就发上来，希望有所帮助。
upfso.asp //控制上传的文件
代码拷贝框
[ctrl+a 全部选择 然后拷贝]
upload.asp // 上传类
代码拷贝框
[ctrl+a 全部选择 然后拷贝]
核心函数
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
