[VB6] Using WinInet to post binary file

Here are a couple of VB6 functions that can be used to upload a zip file through an http post request.

Using ready-made Microsoft.XMLHTTP or WinHttp.WinHttpRequest.5.1

First the easy one, using XMLHTTP to do the actual work

Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String

    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile
    '--- prepare body
    sPostData = "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"
    '--- post
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", sUrl, bAsync
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
        .Send pvToByteArray(sPostData)
        If Not bAsync Then
            pvPostFile = .ResponseText
        End If
    End With
End Function

Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

The biggest benefit of using XMLHTTP is the async option. MSXML spawns a worker thread that sends the request even if the last reference to the object is set to nothing.

Instead of Microsoft.XMLHTTP one can use WinHttp.WinHttpRequest.5.1 but setting the last object reference to nothing cancels the async request. Edit: Not true! It turned out Microsoft.XMLHTTP seems to get corrupted more often in the wild due to bad installers. We are now using WinHttp.WinHttpRequest.5.1 exclusively for our uploads.

Another caveat is the pvToByteArray function. It turns out send method can not handle “byref” byte arrays, so for instance passing baBuffer will fail, as VB6 sets up VT_BYREF bit of the type of the variant parameter.

Using wininet.dll API

Here is the hard-core API version. Biggest drawback is that it’s syncronous by nature.

Private Const INTERNET_AUTODIAL_FORCE_ONLINE As Long = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 0
Private Const INTERNET_DEFAULT_HTTP_PORT    As Long = 80
Private Const INTERNET_SERVICE_HTTP         As Long = 3
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
Private Const HTTP_ADDREQ_FLAG_REPLACE      As Long = &H80000000
Private Const HTTP_ADDREQ_FLAG_ADD          As Long = &H20000000

Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long

Private Function pvPostFile(sUrl As String, sFileName As String) As Boolean
    Const STR_APP_NAME  As String = "Uploader"
    Dim hOpen           As Long
    Dim hConnection     As Long
    Dim hRequest        As Long
    Dim sHeader         As String
    Dim sBoundary       As String
    Dim nFile           As Integer
    Dim baData()        As Byte
    Dim sPostData       As String
    Dim sHttpServer     As String
    Dim lHttpPort       As Long
    Dim sUploadPage     As String

    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baData(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baData
        sPostData = StrConv(baData, vbUnicode)
    End If
    Close nFile
    '--- parse url
    sHttpServer = sUrl
    If InStr(sHttpServer, "://") > 0 Then
        sHttpServer = Mid$(sHttpServer, InStr(sHttpServer, "://") + 3)
    End If
    If InStr(sHttpServer, "/") > 0 Then
        sUploadPage = Mid$(sHttpServer, InStr(sHttpServer, "/"))
        sHttpServer = Left$(sHttpServer, InStr(sHttpServer, "/") - 1)
    End If
    If InStr(sHttpServer, ":") > 0 Then
        On Error Resume Next
        lHttpPort = CLng(Mid$(sHttpServer, InStr(sHttpServer, ":") + 1))
        On Error GoTo 0
        sHttpServer = Left$(sHttpServer, InStr(sHttpServer, ":") - 1)
    End If
    '--- prepare request
    If InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE, 0) = 0 Then
        GoTo QH
    End If
    hOpen = InternetOpen(STR_APP_NAME, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        GoTo QH
    End If
    hConnection = InternetConnect(hOpen, sHttpServer, IIf(lHttpPort <> 0, lHttpPort, INTERNET_DEFAULT_HTTP_PORT), vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
    If hConnection = 0 Then
        GoTo QH
    End If
    hRequest = HttpOpenRequest(hConnection, "POST", sUploadPage, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    If hRequest = 0 Then
        GoTo QH
    End If
    '--- prepare headers
    sBoundary = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    sHeader = "Content-Type: multipart/form-data; boundary=" & sBoundary & vbCrLf
    If HttpAddRequestHeaders(hRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD) = 0 Then
        GoTo QH
    End If
    '--- post data
    sPostData = "--" & sBoundary & vbCrLf & _
        "Content-Disposition: multipart/form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & sBoundary & "--"
    If HttpSendRequest(hRequest, vbNullString, 0, sPostData, Len(sPostData)) = 0 Then
        GoTo QH
    End If
    '--- success
    pvPostFile = True
QH:
    If hRequest <> 0 Then
        Call InternetCloseHandle(hRequest)
    End If
    If hConnection <> 0 Then
        Call InternetCloseHandle(hConnection)
    End If
    If hOpen <> 0 Then
        Call InternetCloseHandle(hOpen)
    End If
End Function

It’s not hard adding authentication to send request but I don’t need it so never implemented it. The binary nature ot the upload is set by Content-Type being application/octet-stream.

Note that you cannot use Content-Transfer-Encoding with http, it’s reserved for e-mail only, i.e. no base64 encoding is necessary. Binary file is sent directly in the http stream. Note: feel free to change the boundary (use uuidgen.exe to generate a guid or anything unique).

The server-side script

Here is a simple upload_errors.php script that can be used as a target of the post request

<?php
$base_dir = dirname( __FILE__ ) . '/../ErrorsUpload/' . $_GET["id"];
if(!is_dir($base_dir))
    mkdir($base_dir, 0777);
move_uploaded_file($_FILES["uploadfile"]["tmp_name"], $base_dir . '/' . $_FILES["uploadfile"]["name"]);
?>

Basicly it expects an id param in the url and an uploadfile param in the body. Id is used to create a sub-directory in an off-site (publicly not visible) directory ErrorsUpload where the uploaded zip file is stored.

Here as the caller code I’m using that accesses the above upload_errors.php

Private Sub Command1_Click()
    pvPostFile "http://{{your_server_here}}/upload_errors.php?id={A0AD2346-9849-4EF0-9A93-ACFE17910734}", "C:\TEMP\Errors_2011_07_11.zip"
End Sub

I’m preparing a zip file with the errors that are logged at the client site, then I’m using the client id in the url, posting the zip file.

Edit: JScript implementation

Turns out byte-array to string handling is not so straight-forward in JScript. Here is a sample implementation of postFile function extensively using ADODB.Stream to handle conversions:

function readBinaryFile(fileName) {
    var stream = WScript.CreateObject("ADODB.Stream");
    stream.Type = 1;
    stream.Open();
    stream.LoadFromFile(fileName);
    return stream.Read();
}

function toArray(str) {
    var stream = WScript.CreateObject("ADODB.Stream");
    stream.Type = 2;
    stream.Charset = "_autodetect";
    stream.Open()
    stream.WriteText(str);
    stream.Position = 0;
    stream.Type = 1;
    return stream.Read();
}

function postFile(url, fileName, async) {
    var STR_BOUNDARY = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113";

    // prepare post data
    var stream = WScript.CreateObject("ADODB.Stream");
    stream.Type = 1;
    stream.Open()
    stream.Write(toArray("--" + STR_BOUNDARY + "\r\n" +
        "Content-Disposition: form-data; name=\"uploadfile\"; filename=\"" + fileName.substr(fileName.lastIndexOf("\\") + 1, fileName.length) + "\"\r\n" +
        "Content-Type: application/octet-stream\r\n\r\n"));
    stream.Write(readBinaryFile(fileName));
    stream.Write(toArray("\r\n--" + STR_BOUNDARY + "--"));
    stream.Position = 0;
    // post request
    var xhr = WScript.CreateObject("Microsoft.XMLHTTP");
    xhr.Open("POST", url, async);
    xhr.SetRequestHeader("Content-Type", "multipart/form-data; boundary=" + STR_BOUNDARY);
    xhr.Send(stream.Read());
    if (async) WScript.Sleep(1);
}

Advertisement