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!
stoicolAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

jkrCommented:
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

stoicolAuthor Commented:
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.
jkrCommented:
Stupid question: Are you sure the server sends a valid non-empty response?
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

stoicolAuthor Commented:
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
jkrCommented:
>>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)
stoicolAuthor Commented:
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.
jkrCommented:
OK, what do you get if you connect manually, e.g. using

telnet server.com 80

and then typing

GET / HTTP/1.1 (type'Enter' twics then)

For e.g. Google.com, the response should be something like




HTTP/1.1 302 Found
Cache-Control: private
Content-Type: text/html; charset=UTF-8
Location: http://www.google.com/?gfe_rd=cr&ei=Y_QaVbP-OIGD-wag9ICQBw
Content-Length: 258
Date: Tue, 31 Mar 2015 19:24:19 GMT
Server: GFE/2.0
Alternate-Protocol: 80:quic,p=0.5
[that's the headers, followed by HTML]

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
stoicolAuthor Commented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.