asked on

httpQueryInfo function not working in VBA

Hi,

I have been trying to get some status information from a http request I made using Wininet in VBA and no matter what flags I use it does not seem to work.

First I tried to get the status code, and after declaring the variables and obtaining a valid handle from httpOpenRequest I always get a zero status code when calling HttpQueryInfo.
Here is my code, the URL was cracked into server/path/port.
The server needs password authentication.

Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, _
ByVal lInfoLevel As Long, _
ByRef sBuffer As Any, _
ByRef lBufferLength As Long, _
ByRef lIndex As Long) As Boolean
Const ERROR_INSUFFICIENT_BUFFER = 122
Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Const HTTP_QUERY_STATUS_CODE = 19
Const HTTP_QUERY_FLAG_NUMBER = &H20000000
Const STR_APP_NAME As String = "Uploader"
Dim hOpen As Long
Dim hConnection As Long
Dim hOpenRequest As Long
Dim dwStatusLng As Long
Dim dwStatusStr As String
Dim dwStatusSize As Long

hOpen = InternetOpen(STR_APP_NAME, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) 'returns handle<>0 and Err.LastDllError=0

hConnection = InternetConnect(hOpen, sHttpServer, lHttpPort, username, password, INTERNET_SERVICE_HTTP, 0, 0) 'returns handle<>0 and Err.LastDllError=0

hOpenRequest = HttpOpenRequest(hConnection, "POST", sUploadPage, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0) 'returns handle<>0 and Err.LastDllError=0

dwStatusSize = Len(dwStatusLng)
HttpQueryInfo(hOpenRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, dwStatusLng, dwStatusSize, 0)

Since the buffer is declared byRef, if I do not enforce byVal in the call, then the function fails but no error is raised: Err.LastDllError=122, dwStatusLng=0, dwStatusSize=4

If I pass the buffer byVal (as was suggested on some website) then the function fails with error 122 ERROR_INSUFFICIENT_BUFFER.
How do I resize a variable of type Long? This is to me mindblowing.
How do I get a valid status code (as a number) from this function in VB?

On the other hand, if I try to retrieve the headers, then the buffer seems to be too small even though I declared it as string.

dwStatusSize = Len(dwStatusStr)
If Not (HttpQueryInfo(hOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF, dwStatusStr, dwStatusSize, 0)) Then
If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
dwStatusStr = String(dwStatusSize, 0)
End If
Else
End If

First time always fails so I resize the buffer.
if I call the function again with the resized buffer, excel will crash (similar to the situation of declaring Dim dwStatusStr As String * 1024, in which case it will crash at first call)

Bottom line: if the buffer and bufferLenght are declared byRef, then:
if buffer is of type Long, why does the size not suffice?
if the buffer is of type string, why resizing causes excel to crash?

Any help would be much appreciated.

Thanks guys!

jkr

That concept of passing a buffer size by reference is most commonly used on Windows platforms to allo the call to return the required buffer size by initially providing a zero-length buffer. Try the snippet from http://www.activevb.de/tipps/vb6tipps/tipp0484.html - i.e.

Option Explicit

Private hInternetSession As Long
Private hInternetConnect As Long
Private hHttpOpenRequest As Long

Private Sub Command1_Click()
    Dim strHost As String
    Dim RawHeadersCrLf As String, RawHeaders As String
    Dim StatusText As String, StatusCode As String, Server As String
    Dim iRetVal As Long
    
    strHost = Left$(Text1.Text, InStr(Text1.Text, "/") - 1)
    Debug.Print strHost
    Debug.Print Right(Text1.Text, Len(Text1.Text) - InStr(Text1.Text, "/") + 1)
    
    hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, _
        vbNullString, vbNullString, 0)
        
    If CBool(hInternetSession) Then
    
        hInternetConnect = InternetConnect(hInternetSession, strHost, _
            INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, _
            INTERNET_SERVICE_HTTP, 0, 0)
            
        If hInternetConnect > 0 Then
        
            hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "HEAD", Right( _
                Text1.Text, Len(Text1.Text) - InStr(Text1.Text, "/") + 1), _
                "HTTP/1.1", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
                
            If CBool(hHttpOpenRequest) Then
            
                ' "Host: " & strHost, Len(strHost)
                iRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, 0, 0)
                If iRetVal Then
                
                    StatusCode = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE)
                    StatusText = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_TEXT)
                    RawHeaders = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS)
                    
                    RawHeadersCrLf = GetQueryInfo(hHttpOpenRequest, _
                        HTTP_QUERY_RAW_HEADERS_CRLF)
                        
                    Text2.Text = RawHeadersCrLf
                    
                End If
            End If
        End If
    End If
    
    InternetCloseHandle (hHttpOpenRequest)
    InternetCloseHandle (hInternetSession)
    InternetCloseHandle (hInternetConnect)
End Sub

Private Function GetQueryInfo(ByVal hHttpRequest As Long, ByVal iInfoLevel As Long) As String
    Dim sBuffer         As String * 1024
    Dim lBufferLength   As Long
    
    lBufferLength = Len(sBuffer)
    HttpQueryInfo hHttpRequest, iInfoLevel, ByVal sBuffer, lBufferLength, 0
    GetQueryInfo = Left$(sBuffer, lBufferLength)
End Function

Open in new window

stoicol

ASKER

I tried but to no success. All 3 variable return empty.
StatusCode = GetQueryInfo(hOpenRequest, HTTP_QUERY_STATUS_CODE)
StatusText = GetQueryInfo(hOpenRequest, HTTP_QUERY_STATUS_TEXT)
RawHeaders = GetQueryInfo(hOpenRequest, HTTP_QUERY_RAW_HEADERS)
RawHeadersCrLf = GetQueryInfo(hOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF)

As long as the handle from HttpOpenRequest is not zero, then why do I not get a status code of error or something? I simply do not get anything.

jkr

Stupid question: Are you sure the server sends a valid non-empty response?

stoicol

ASKER

As I said in the initial description, all handles are non-zero.
More specifically, the handle retrieved from HttpOpenRequest is greater than 0, does this answer your question?

Furthermore, after calling HttpQueryInfo I call for the error raised and it is zero for all values of iInfoLevel.

Private Function GetQueryInfo(ByVal hHttpRequest As Long, ByVal iInfoLevel As Long) As String
Dim sBuffer As String * 1024
Dim lBufferLength As Long
Dim lngErrorNumber As Long
' Get the last error
lBufferLength = Len(sBuffer)
HttpQueryInfo hHttpRequest, iInfoLevel, ByVal sBuffer, lBufferLength, 0
lngErrorNumber = Err.LastDllError <-----ALWAYS ZERO
GetQueryInfo = Left$(sBuffer, lBufferLength)
End Function

jkr

>>As I said in the initial description, all handles are non-zero.

That does not mean that the response is not just "\r\n" ;o)

stoicol

ASKER

as i understand from the specification of the httpOpenRequest, it did not:
Returns an HTTP request handle if successful, or NULL otherwise. To retrieve extended error information, call GetLastError.

As long as GetLastError returns no error(which is the case), then I assume the respond is valid, at least to the extent to which the handle can be passed to the httpQueryInfo function, where the status code could give indications of what went wrong with the request, right?

And this is the problem, the status code is always blank, nothing is returned.

ASKER CERTIFIED SOLUTION

jkr

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

stoicol

ASKER

please find below the code I've been testing and for which I get back nothing with the httpQuerryInfo function:
can you test it yourself and let me know if you get any response back?

Option Explicit

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 hInternet As Long, _
ByVal lpszServerName As String, _
ByVal nServerPort As Long, _
ByVal lpszUserName As String, _
ByVal lpszPassword As String, _
ByVal dwService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hConnect As Long, _
ByVal lpszVerb As String, _
ByVal lpszObjectName As String, _
ByVal lpszVersion As String, _
ByVal lpszReferrer As String, _
ByVal lplpszAcceptTypes As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, _
ByVal lInfoLevel As Long, _
ByRef sBuffer As Any, _
ByRef lBufferLength As Long, _
ByRef lIndex As Long) As Boolean
Private Declare Function GetLastError Lib "kernel32" () As Long

Sub test1()
Const scUserAgent = "Uploader"
Const server = "finance.yahoo.com"
Const path = "/q?s=^gspc"
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_DEFAULT_HTTP_PORT = 80
Const INTERNET_SERVICE_HTTP = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Const HTTP_QUERY_STATUS_CODE = 19
Const HTTP_QUERY_STATUS_TEXT = 20
Const HTTP_QUERY_RAW_HEADERS = 21
Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Dim hOpen As Long
Dim hConnection As Long
Dim hOpenRequest As Long
Dim RawHeadersCrLf As String
Dim RawHeaders As String
Dim StatusText As String
Dim StatusCode As String
Dim ErrNumber As Long
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
ErrNumber = GetLastError
hConnection = InternetConnect(hOpen, server, INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
ErrNumber = GetLastError
hOpenRequest = HttpOpenRequest(hConnection, "GET", path, vbNullString, vbNullString, vbNullString, INTERNET_FLAG_RELOAD, 0)
ErrNumber = GetLastError
StatusCode = GetQueryInfo(hOpenRequest, HTTP_QUERY_STATUS_CODE)
StatusText = GetQueryInfo(hOpenRequest, HTTP_QUERY_STATUS_TEXT)
RawHeaders = GetQueryInfo(hOpenRequest, HTTP_QUERY_RAW_HEADERS)
RawHeadersCrLf = GetQueryInfo(hOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF)
End Sub

Private Function GetQueryInfo(ByVal hHttpRequest As Long, ByVal iInfoLevel As Long) As String
Dim sBuffer As String * 1024
Dim lBufferLength As Long
Dim ErrNumber As Long
' Get the last error
lBufferLength = Len(sBuffer)
HttpQueryInfo hHttpRequest, iInfoLevel, ByVal sBuffer, lBufferLength, 0
ErrNumber = GetLastError
GetQueryInfo = Left$(sBuffer, lBufferLength)
End Function