欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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