FSO操作文件系统_数据库相关_

<%'On Error Resume Next%>
 @import url("admin.css");
<%
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 "基本路径查找失败,返回"

                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("空文件,请返回")
            response.End
            End If 
        'F_FileType = Ucase(F_File.FileExt)
        'IF F_File.FileSize > 90000 Then
        '    Response.Write("大小超过限制")
        'exit sub
        IF IsvalidFileName(F_FileName) = False Then
            Response.Write("名称有误")
        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("文件已经存在,已经被删除;")
            F_File.SaveToFile path&F_FileName
            Response.Write("点击这里继续上传:"&path&F_FileName&"")
            ElseIf FileIsExists=True  And  mode=1 Then
            Response.Write("文件已经存在,您选择了不覆盖")
            Else
            F_File.SaveToFile path&F_FileName
            Response.Write("点击这里继续上传:"&path&F_FileName&"")
            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("选择: ")
    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

%>

<%
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
       

提示： 本文由神整理自网络，如有侵权请联系本站删除！
本站声明：
1、本站所有资源均来源于互联网，不保证100%完整、不提供任何技术支持；
2、本站所发布的文章以及附件仅限用于学习和研究目的;不得将用于商业或者非法用途；否则由此产生的法律后果，本站概不负责！