FSO操作文件系统

实现功能：
文件(夹)目录列表 提供了查阅目录下面的文件和文件夹
文件 写,创,删 提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件 针对创建文件夹(文件)而设置.
上传文件 您可以模拟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