upload.inc

使用asp+sql编写的的各种程序案例

<%

'********************************************************************************
'变量声明
'********************************************************************************
const ForReading   = 1  '读文件
const ForWriting   = 2  '写文件
const ForAppending = 3  '添加文件

dim FileCount  '上载的文件数量
dim FieldCount '表单的数量
dim Path       '保存文件的路径
dim Dict       '保存数据的字典对象

Path        = Server.mappath(".") & "\"  '设定路径，为当前服务器跟目录
FileCount   = 0
FieldCount  = 0
Dict        = Null


'**********************************************************************************************
'Methods
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'Init - 根据上载的二进制数据创建dictionary对象
'        参数
'                pServer  [in] - 指向asp的server对象
'               pRequest [in] - 指向asp的request对象
'
'       init函数返回一个包含数据的dictionary对象
'----------------------------------------------------------------------------------------------
Function Init()

    Dim tBytes
    Dim binData
    Dim scrDict

    tBytes      = Request.TotalBytes  '获得总字节
    RequestBin  = Request.BinaryRead(tBytes)  '读入数据

    Set scrDict = Server.CreateObject("Scripting.Dictionary")  '创建字典对象

    PosBeg      = 1
    '查找回车符号
    PosEnd      = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))

    If PosEnd < 2 Then  '如果没有数据，则返回空字典对象
        Set Dict = Server.CreateObject("Scripting.Dictionary")
        Exit Function
    End If

    boundary    = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
    BoundaryPos = InStrB(1, RequestBin, boundary)
    
	'根据文件上载的原理分离各个文件的数据以及各个字段的数据
	'文件上载的原理参照文件上载那一章的详细介绍
    Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))
        Dim UploadControl
        Set UploadControl = Server.CreateObject("Scripting.Dictionary")
        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)

        If PosFile <> 0 And (PosFile < PosBound) Then
            FileCount = FileCount + 1
            PosBeg    = PosFile + 10
            PosEnd    = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
            FileName  = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
            UploadControl.Add "FileName", FileName
            Pos       = InStrB(PosEnd, RequestBin, getByteString("Content-Type:"))
            PosBeg    = Pos + 14
            PosEnd    = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))
            ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
            UploadControl.Add "ContentType", ContentType
            PosBeg    = PosEnd + 4
            PosEnd    = InStrB(PosBeg, RequestBin, boundary) - 2
            Value     = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
        Else
            FieldCount = FieldCount + 1
            Pos        = InStrB(Pos, RequestBin, getByteString(Chr(13)))
            PosBeg     = Pos + 4
            PosEnd     = InStrB(PosBeg, RequestBin, boundary) - 2
            Value      = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
        End If

        UploadControl.Add "Value", Value
        scrDict.Add Name, UploadControl  '添加到字典对象中
        BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)
    Loop

    Set Dict = scrDict
    Set scrDict = Nothing

End Function


'----------------------------------------------------------------------------------------------
'saveAs - 将上载的文件保存成用户指定的文件名
'        参数
'                sHTMLFormField    [in] - 保存新文件的路径和名称
'                              如果为空，则使用当前路径以及原始的文件名
'        如果文件保存成功，saveAs 返回true
'----------------------------------------------------------------------------------------------
Function saveAs( sHTMLFormField, sNewFile)

    If Dict.Exists(sHTMLFormField) And Len(getFileName(sHTMLFormField)) > 0 Then

        binData = Dict.Item( sHTMLFormField).Item("Value")
        binData = getString( binData)

        Dim sFilePath
        sFilePath = Path & "/" & getFileName(sHTMLFormField)
        If Len( sNewFile) <> 0 Then        sFilePath = sNewFile

        Set oFSO = Server.CreateObject( "Scripting.FileSystemObject")  '- 创建文件处理对象  ...

        Set oTextStream = oFSO.CreateTextFile(Server.MapPath(sFilePath), True)       ' 创建一个二进制读写文件
        oTextStream.Write( binData)                                    '- 将二进制数据写入文件
        oTextStream.Close                                              '- 关闭文件

        saveAs = True

     Else

        Response.Write( "File associated with HTML &lt;FORM&gt; field name &lt;INPUT NAME=" & sHTMLFormField & "&gt; not found!")
        saveAs = False

     End If

End Function


'----------------------------------------------------------------------------------------------
'getData -从Scripting.Dictionary对象中获取数据
'        参数
'                sHTMLFormField [in] -表单名称
'
'        返回保存在字典对象中的html表单数据
'----------------------------------------------------------------------------------------------
Function getData(sHTMLFormField)

    If Dict.Exists(sHTMLFormField) Then
        getData = Dict.Item( sHTMLFormField).Item("Value")
    Else
        getData = ""
    End If
End Function


'----------------------------------------------------------------------------------------------
'getFileName - 获取文件名称
'        参数
'                sHTMLFormField [in] - name of the item to retreive data for
'
'        返回文件名称
'----------------------------------------------------------------------------------------------
Function getFileName(sHTMLFormField)

    Dim strHTMLFormField
    If Dict.Exists(sHTMLFormField) Then
        strHTMLFormField = Dict.Item( sHTMLFormField).Item("FileName")
    Else
        strHTMLFormField = ""
    End If

    Dim tPos
    Dim strRtn
    strRtn = ""
    tPos = InStrRev(strHTMLFormField, "\")
    If tPos = 0 Or IsNull(tPos) Then
        strRtn = strHTMLFormField
    Else
        strRtn = Right(strHTMLFormField, Len(strHTMLFormField) - tPos)
    End If

    getFileName = strRtn

End Function


'----------------------------------------------------------------------------------------------
'getContentType - 获得上传文件的类型
'        参数
'                sHTMLFormField [in] - 表单控件名称
'
'        返回文件类型
'----------------------------------------------------------------------------------------------
Function getContentType(sHTMLFormField)
    If Dict.Exists(sHTMLFormField) Then
        getContentType = Dict.Item( sHTMLFormField).Item("ContentType")
    Else
        getContentType = ""
    End If
End Function



'**********************************************************************************************
'Private Functions
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'getString -从数据中分离出字符串
'        参数
'                StringBin [in] -        保存分离出来的字符串.
'        返回字符串数组.
'----------------------------------------------------------------------------------------------
Function getString(StringBin)
    Dim strRtn
    strRtn = ""
    For intCount = 1 To LenB(StringBin)
        strRtn = strRtn & Chr(AscB(MidB(StringBin, intCount, 1)))
    Next
    getString = strRtn
End Function


'----------------------------------------------------------------------------------------------
'getByteString - 将字符串转化成二进制数据
'        参数
'                StringStr [in] -       保存转化成二进制的字符串.
'        Returns byte data from a string.
'----------------------------------------------------------------------------------------------
Function getByteString(StringStr)
    Dim strRtn
    strRtn = ""
    For i = 1 To Len(StringStr)
        Char   = Mid(StringStr, i, 1)
        strRtn = strRtn & ChrB(AscB(Char))
    Next
    getByteString = strRtn
End Function

%>