비주얼 베이직 6.0 멀티파트 관련 클래스 모듈

아래는 VB 6.0에서 작성된 멀티파트 관련 클래스 모듈입니다.

'-------------------------------------------------------------------------------------------------------------
'   이름: clsMultipart.cls
'   날짜: 2013/02/14
'
'   내용: 멀티파트 관련 클래스 모듈
'-------------------------------------------------------------------------------------------------------------

Dim WinHttp As New WinHttpRequest
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function MultipartFormDataPost(name As String, boundary As String, postUrl As String, userAgent As String, contentType As String, postParameters As Dictionary) As String
    Dim formDataBoundary As String: formDataBoundary = "----------" & boundary
    Dim contentsType As String: contentsType = "multipart/form-data; boundary=" & formDataBoundary
    Dim formData() As Byte: formData = GetMultipartFormData(name, postParameters, contentType, formDataBoundary)
    MultipartFormDataPost = PostForm(postUrl, userAgent, contentsType, formData)
End Function

Private Function PostForm(postUrl As String, userAgent As String, contentType As String, formData() As Byte) As String
    WinHttp.Open "POST", postUrl
    WinHttp.SetRequestHeader "Content-Type", contentType
    WinHttp.SetRequestHeader "User-Agent", userAgent
    WinHttp.SetRequestHeader "Content-Length", UBound(formData) + 1
    WinHttp.Send formData
    
    PostForm = WinHttp.ResponseText
End Function

Private Function GetMultipartFormData(name As String, postParameters As Dictionary, contentType As String, boundary As String) As Byte()
    Dim formData As String
    Dim needsCRLF As Boolean
    Dim ByteHeaderA() As Byte, ByteHeaderB() As Byte, ByteBinary() As Byte, Buffer() As Byte
    
    For i = 0 To postParameters.Count - 1
        If needsCRLF Then formData = formData & vbCrLf
        needsCRLF = True
        
        If postParameters.Keys(i) = name Then
            postData = "--" & boundary & vbCrLf & "Content-Disposition: form-data; name=""" & postParameters.Keys(i) & _
            """; filename=""" & getFileName(postParameters.Items(i)) & """;" & vbCrLf & "Content-Type: " & contentType & vbCrLf & vbCrLf
            formData = formData & postData
            ByteBinary = GetFileData(postParameters.Items(i))
        Else
            postData = "--" & boundary & vbCrLf & "Content-Disposition: form-data; name=""" & postParameters.Keys(i) & """" & vbCrLf & vbCrLf & postParameters.Items(i)
            formData = formData & postData
        End If
    Next
    
    Dim footer As String: footer = vbCrLf & "--" & boundary & "--" & vbCrLf
    ByteHeaderA = StrConv(formData, vbFromUnicode): ByteHeaderB = StrConv(footer, vbFromUnicode)
    SizeA = UBound(ByteHeaderA): SizeB = UBound(ByteHeaderB): SizeC = UBound(ByteBinary)
    ReDim Buffer(SizeA + SizeB + SizeC + 2)
    CopyMemory Buffer(0), ByteHeaderA(0), SizeA + 1
    CopyMemory Buffer(SizeA + 1), ByteBinary(0), SizeC + 1
    CopyMemory Buffer(SizeA + SizeC + 2), ByteHeaderB(0), SizeB + 1
    GetMultipartFormData = Buffer
End Function

Private Function GetFileData(ByVal Filename As String) As Byte()
    Dim f As Integer
    f = FreeFile
 
    Open Filename For Binary Access Read As #f
    ReDim GetFileData(0 To LOF(f) - 1)
    Get #f, , GetFileData
    Close #f
End Function

Private Function getFileName(path) As String
    getFileName = Mid(path, InStrRev(path, "\") + 1, Len(path))
End Function