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&nbsp;= 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 

%> 
[Ctrl+A 全部选择 然后拷贝] 

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 =&nbsp;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 
       &nbsp;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 
%> 
[Ctrl+A 全部选择 然后拷贝]