Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0484: Response-Header auslesen (über WinInet)

VB 5/6-Tipp 0484: Response-Header auslesen (über WinInet)

 von Bernhard Döbler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: HttpOpenRequestA (HttpOpenRequest), HttpQueryInfoA (HttpQueryInfo), HttpSendRequestA (HttpSendRequest), InternetCloseHandle, InternetConnectA (InternetConnect), InternetOpenA (InternetOpen), InternetQueryOptionA (InternetQueryOption)

Download: Download des Beispielprojektes [3,36 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label1"
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

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------
Option Explicit

' Initializes an application's use of the Win32 Internet functions
Public 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
                        
' User agent constant.
Public Const scUserAgent = "http sample"

' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0

' Opens a HTTP session for a given site.
Public 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
                        
' Number of the TCP/IP port on the server to connect to.
Public Const INTERNET_DEFAULT_HTTP_PORT = 80

' Type of service to access.
Public Const INTERNET_SERVICE_HTTP = 3

' Opens an HTTP request handle.
Public 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
                        
' Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000

' Sends the specified request to the HTTP server.
Public Declare Function HttpSendRequest Lib "wininet.dll" _
                        Alias "HttpSendRequestA" ( _
                        ByVal hHttpRequest As Long, _
                        ByVal sHeaders As String, _
                        ByVal lHeadersLength As Long, _
                        sOptional As Any, _
                        ByVal lOptionalLength As Long) As Integer
                        
' Queries for information about an HTTP request.
Public 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 Integer
                        
' The possible values for the lInfoLevel parameter include:
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22

' Add this flag to the about flags to get request header.
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000

' Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib "wininet.dll" ( _
                        ByVal hInet As Long) As Integer
                        
' Queries an Internet option on the specified handle
Public Declare Function InternetQueryOption Lib "wininet.dll" _
                        Alias "InternetQueryOptionA" ( _
                        ByVal hInternet As Long, _
                        ByVal lOption As Long, _
                        ByRef sBuffer As Any, _
                        ByRef lBufferLength As Long) As Integer
                        

'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.