一个的无组件上传的ASP代码 -pc6资讯

您的位置：首页 → 网页设计 → ASP实例 → 一个的无组件上传的ASP代码

一个的无组件上传的ASP代码 时间：2004/11/7 3:00:00来源：本站整理作者：蓝点我要评论(0): <%

    Response.write "上传文件至当前文件夹"

    Response.Write ""

'**Start Encode**

Action=Request("A")

If Action="UL" Then

        DoUpload Request.Cookies("DAZHOU.NET")("nowpath") & "\"

        'CheckDiskSpace

'        Response.redirect "fileman.asp"

Else

    ShowUploadForm

End If

Set fso=Nothing

'========================

SUB ShowUploadForm

'========================

    Response.write "

"

    If Request("n")<>"" AND IsNumeric(Request("n")) Then Session("NumUploadFields")=CInt(Request("n"))

    For i=1 to 5

        Response.Write "
"

    Next

    Response.Write "
   "

    Response.Write ""

End SUB

'========================

SUB DoUpload(Dir)

'========================

    'If NOT Application("Debugging") Then On Error resume next

    StartTime=Now

    RequestBin=Request.BinaryRead(Request.TotalBytes)

    Set UploadRequest=CreateObject("Scripting.Dictionary")

    BuildUploadRequest RequestBin, UploadRequest

    keys=UploadRequest.Keys

    For i=0 to UploadRequest.Count - 1

        curKey=keys(i)

        fName=UploadRequest.Item(curKey).Item("FileName")

        If fso.FileExists(Dir & fName) Then fso.deletefile Dir & fName

        If fName<>"" AND NOT fso.FileExists(Dir & fName) Then

            value=UploadRequest.Item(curKey).Item("Value")

            valueBeg=UploadRequest.Item(curKey).Item("ValueBeg")

            valueLen=UploadRequest.Item(curKey).Item("ValueLen")

            TotalULSize=TotalULSize + valueLen

            Set strm1=Server.CreateObject("ADODB.Stream")

            Set strm2=Server.CreateObject("ADODB.Stream")

            strm1.Open

            strm1.Type=1 'Binary

            strm2.Open

            strm2.Type=1 'Binary

            strm1.Write RequestBin

            strm1.Position=ValueBeg

            strm1.CopyTo strm2,ValueLen

            strm2.SaveToFile Dir & fName,2

            Set strm1=Nothing

            Set strm2=Nothing

        End If

     Next

    If Now>StartTime Then Response.Write("

上传成功！
速度: " & Round(TotalULSize/1024/DateDiff("s",StartTime,Now)) &" 千字节/秒" )

    Set UploadRequest=Nothing

End SUB

'========================

Sub BuildUploadRequest(RequestBin, UploadRequest)

'========================

    'Get the boundary

    PosBeg=1

    PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))

    boundary=MidB(RequestBin,PosBeg,PosEnd-PosBeg)

    boundaryPos=InstrB(1,RequestBin,boundary)

    'Get all data inside the boundaries

    Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))

        'Members variable of objects are put in a dictionary object

        Dim UploadControl

        Set UploadControl=CreateObject("Scripting.Dictionary")

        'Get an object name

        Pos=InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))

        Pos=InstrB(Pos,RequestBin,getByteString("name="))

        PosBeg=Pos+6

        PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))

        Name=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

        PosFile=InstrB(BoundaryPos,RequestBin,getByteString("filename="))

        PosBound=InstrB(PosEnd,RequestBin,boundary)

        'Test if object is of file type

        If PosFile<>0 AND (PosFile
            'Get Filename, content-type and content of file

            PosBeg=PosFile + 10

            PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))

            FileName=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

            FileName=Mid(FileName,InStrRev(FileName,"\")+1)

            'Add filename to dictionary object

            UploadControl.Add "FileName", FileName

            Pos=InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))

            PosBeg=Pos+14

            PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))

            'Add content-type to dictionary object

            ContentType=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

            UploadControl.Add "ContentType",ContentType

            'Get content of object

            PosBeg=PosEnd+4

            PosEnd=InstrB(PosBeg,RequestBin,boundary)-2

            Value=FileName

            ValueBeg=PosBeg-1

            ValueLen=PosEnd-Posbeg

        Else

            'Get content of object

            Pos=InstrB(Pos,RequestBin,getByteString(chr(13)))

            PosBeg=Pos+4

            PosEnd=InstrB(PosBeg,RequestBin,boundary)-2

            Value=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

            ValueBeg=0

            ValueEnd=0

        End If

        UploadControl.Add "Value" , Value

        UploadControl.Add "ValueBeg" , ValueBeg

        UploadControl.Add "ValueLen" , ValueLen

        UploadRequest.Add name, UploadControl

        BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)

    Loop

End Sub

'====================================

Function getByteString(StringStr)

'====================================

    For i=1 to Len(StringStr)

         char=Mid(StringStr,i,1)

        getByteString=getByteString & chrB(AscB(char))

    Next

End Function

'====================================

Function getString(StringBin)

'====================================

    getString =""

    For intCount=1 to LenB(StringBin)

        getString=getString & chr(AscB(MidB(StringBin,intCount,1)))

    Next

End Function

%>