WinHTTP (mit SSL) für Memory, String und File Download

[mback2k]

Hallo Leute,

nach einiger Zeit poste ich hier mal wieder einige Zeilen um die WinHTTP API zu nutzen. Sie ist offizieller Nachfolger der HTTP Funktionen der WinINET API und wird weiterentwickelt. Außerdem kann man sie auch in Programmen nutzen, die als Service laufen sollen.

Code: Alles auswählen

Import "winhttp.lib"
  WinHttpOpen(pwszUserAgent.p-unicode, dwAccessType.l, *pwszProxyName, *pwszProxyBypass, dwFlags.l)
  WinHttpConnect(hSession, pswzServerName.p-unicode, nServerPort.l, dwReserved.l)
  WinHttpSetOption(hInternet, dwOption.l, *lpBuffer, dwBufferLength.l)
  WinHttpSetCredentials(hInternet, AuthTargets.l, AuthScheme.l, pwszUserName.p-unicode, pwszPassword.p-unicode, *pAuthParams)
  WinHttpOpenRequest(hConnect, pwszVerb.p-unicode, pwszObjectName.p-unicode, *pwszVersion, *pwszReferrer, *ppwszAcceptTypes, dwFlags.l)
  WinHttpSendRequest(hRequest, pwszHeaders.p-unicode, dwHeadersLength.l, *lpOptional, dwOptionalLength.l, dwTotalLength.l, dwContext.l)
  WinHttpReceiveResponse(hRequest, *lpReserved)
  WinHttpAddRequestHeaders(hRequest, pwszHeaders.p-unicode, dwHeadersLength.l, dwModifiers.l)
  WinHttpQueryHeaders(hRequest, dwInfoLevel.l, *pwszName, *lpBuffer, *lpdwBufferLength, *lpdwIndex)
  WinHttpQueryDataAvailable(hRequest, *lpdwNumberOfBytesAvailable)
  WinHttpReadData(hRequest, *lpBuffer, dwNumberOfBytesToRead.l, *lpdwNumberOfBytesRead)
  WinHttpCrackUrl(pwszUrl.p-unicode, dwUrlLength.l, dwFlags.l, *lpUrlComponents)
  WinHttpCloseHandle(hInternet)
EndImport

Enumeration
  #INTERNET_SCHEME_HTTP                   = 1
  #INTERNET_SCHEME_HTTPS                  = 2
  #INTERNET_DEFAULT_HTTP_PORT             = 80
  #INTERNET_DEFAULT_HTTPS_PORT            = 443
  
  #WINHTTP_NO_PROXY_NAME                  = 0
  #WINHTTP_NO_PROXY_BYPASS                = 0
  #WINHTTP_NO_REFERER                     = 0
  #WINHTTP_NO_HEADER_INDEX                = 0
  #WINHTTP_DEFAULT_ACCEPT_TYPES           = 0
  #WINHTTP_ACCESS_TYPE_DEFAULT_PROXY      = 0
  #WINHTTP_HEADER_NAME_BY_INDEX           = 0
  
  #WINHTTP_AUTH_TARGET_SERVER             = 0
  #WINHTTP_AUTH_TARGET_PROXY              = 1
  
  #WINHTTP_AUTH_SCHEME_BASIC              = 1
  #WINHTTP_AUTH_SCHEME_NTLM               = 2
  #WINHTTP_AUTH_SCHEME_PASSPORT           = 4
  #WINHTTP_AUTH_SCHEME_DIGEST             = 8
  #WINHTTP_AUTH_SCHEME_NEGOTIATE          = 16
  
  #WINHTTP_OPTION_REDIRECT_POLICY                         = 88
  #WINHTTP_OPTION_REDIRECT_POLICY_NEVER                   = 0
  #WINHTTP_OPTION_REDIRECT_POLICY_DISALLOW_HTTPS_TO_HTTP  = 1
  #WINHTTP_OPTION_REDIRECT_POLICY_ALWAYS                  = 2
  
  #WINHTTP_QUERY_STATUS_CODE              = 19
  #WINHTTP_QUERY_RAW_HEADERS_CRLF         = 22
  #WINHTTP_QUERY_CONTENT_ENCODING         = 29
  #WINHTTP_QUERY_LOCATION                 = 33
  #WINHTTP_QUERY_FLAG_NUMBER              = $20000000
  
  #WINHTTP_OPTION_USERNAME                = $1000
  #WINHTTP_OPTION_PASSWORD                = $1001
  
  #WINHTTP_FLAG_REFRESH                   = $00000100
  #WINHTTP_FLAG_SECURE                    = $00800000
  
  #WINHTTP_ADDREQ_FLAG_ADD                = $20000000
EndEnumeration

Prototype ReceiveHTTPStart(CallbackID, hRequest)
Prototype ReceiveHTTPProgress(CallbackID, lBytesReceived, lSize, lElapsedTime)
Prototype ReceiveHTTPEnd(CallbackID, lRetVal, lBytesReceived, lSize, lElapsedTime)

Procedure ReceiveHTTPMemory(URL$, RequestType$ = "GET", ReturnHeader = #False, Username$ = "", Password$ = "", HeaderData$ = "", OptionalData$ = "", UserAgent$ = "WinHTTP - PureBasic", CallbackID = 0, CallbackStart.ReceiveHTTPStart = 0, CallbackProgress.ReceiveHTTPProgress = 0, CallbackEnd.ReceiveHTTPEnd = 0)
  Protected lpUrlComponents.URL_COMPONENTS\dwStructSize = SizeOf(URL_COMPONENTS)
  Protected lStatusCode.l, lContentLen.l, lRedirectPolicy.l = #WINHTTP_OPTION_REDIRECT_POLICY_ALWAYS, lLongSize.l = SizeOf(Long)
  Protected hInternet, hConnect, hRequest, lRetVal, lBytesRead, lReadUntilNow, lBufSize, lStartTime, lResult
  Protected lPort, lFlags, sDomain$, sPath$, sQuery$, *OptionalBuffer, OptionalLength, *MemoryBuffer, MemoryLength
  Static hSession
  
  lStartTime = ElapsedMilliseconds()
  lpUrlComponents\dwSchemeLength = -1
  lpUrlComponents\dwHostNameLength = -1
  lpUrlComponents\dwUrlPathLength = -1
  lpUrlComponents\dwExtraInfoLength = -1
  
  If WinHttpCrackUrl(URLEncoder(URL$), #Null, #Null, @lpUrlComponents)
    Select lpUrlComponents\nScheme
      Case #INTERNET_SCHEME_HTTP
        lPort = #INTERNET_DEFAULT_HTTP_PORT
        lFlags = #WINHTTP_FLAG_REFRESH
      Case #INTERNET_SCHEME_HTTPS
        lPort = #INTERNET_DEFAULT_HTTPS_PORT
        lFlags = #WINHTTP_FLAG_REFRESH | #WINHTTP_FLAG_SECURE
    EndSelect
    
    If lPort And lFlags
      If lpUrlComponents\lpszHostName And lpUrlComponents\dwHostNameLength
        sDomain$ = PeekS(lpUrlComponents\lpszHostName, lpUrlComponents\dwHostNameLength, #PB_Unicode)
      EndIf
      If lpUrlComponents\lpszUrlPath And lpUrlComponents\dwUrlPathLength
        sPath$ = PeekS(lpUrlComponents\lpszUrlPath, lpUrlComponents\dwUrlPathLength, #PB_Unicode)
      EndIf
      If lpUrlComponents\lpszExtraInfo And lpUrlComponents\dwExtraInfoLength
        sQuery$ = PeekS(lpUrlComponents\lpszExtraInfo, lpUrlComponents\dwExtraInfoLength, #PB_Unicode)
      EndIf
      
      If sDomain$ And sPath$
        If Not hSession
          hSession = WinHttpOpen(UserAgent$, #WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, #WINHTTP_NO_PROXY_NAME, #WINHTTP_NO_PROXY_BYPASS, 0)
        EndIf
        If hSession
          hInternet = WinHttpConnect(hSession, sDomain$, lPort, #Null)
          If hInternet
            hRequest = WinHttpOpenRequest(hInternet, RequestType$, sPath$+sQuery$, #Null, #WINHTTP_NO_REFERER, #WINHTTP_DEFAULT_ACCEPT_TYPES, lFlags)
            If hRequest
              If StringByteLength(OptionalData$, #PB_UTF8)
                *OptionalBuffer = AllocateMemory(StringByteLength(OptionalData$, #PB_UTF8)+1)
              EndIf
              If *OptionalBuffer
                OptionalLength = MemorySize(*OptionalBuffer)
                PokeS(*OptionalBuffer, OptionalData$, OptionalLength, #PB_UTF8)
                OptionalLength - 1
              EndIf
              If lpUrlComponents\nScheme = #INTERNET_SCHEME_HTTP
                WinHttpSetOption(hRequest, #WINHTTP_OPTION_REDIRECT_POLICY, @lRedirectPolicy, SizeOf(Long))
              EndIf
              If Len(Username$)
                WinHttpSetCredentials(hRequest, #WINHTTP_AUTH_TARGET_SERVER, #WINHTTP_AUTH_SCHEME_BASIC, Username$, Password$, #Null)
              EndIf
              If WinHttpAddRequestHeaders(hRequest, "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"+#CRLF$, -1, #WINHTTP_ADDREQ_FLAG_ADD)
                WinHttpAddRequestHeaders(hRequest, "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7"+#CRLF$, -1, #WINHTTP_ADDREQ_FLAG_ADD)
                WinHttpAddRequestHeaders(hRequest, "Accept-Language: en-us,en-gb;q=0.9,en;q=0.8,*;q=0.7"+#CRLF$, -1, #WINHTTP_ADDREQ_FLAG_ADD)
              EndIf
              If RequestType$ = "POST"
                WinHttpAddRequestHeaders(hRequest, "Content-Type: application/x-www-form-urlencoded"+#CRLF$, -1, #WINHTTP_ADDREQ_FLAG_ADD)
              EndIf
              If CallbackStart
                CallbackStart(CallbackID, hRequest)
              EndIf
              If WinHttpSendRequest(hRequest, HeaderData$, Len(HeaderData$), *OptionalBuffer, OptionalLength, OptionalLength, CallbackID)
                If WinHttpReceiveResponse(hRequest, #Null)
                  If WinHttpQueryHeaders(hRequest, #WINHTTP_QUERY_FLAG_NUMBER | #WINHTTP_QUERY_STATUS_CODE, #WINHTTP_HEADER_NAME_BY_INDEX, @lStatusCode, @lLongSize, #WINHTTP_NO_HEADER_INDEX)
                    If lStatusCode = 200
                      lResult = WinHttpQueryDataAvailable(hRequest, @lContentLen)
                    Else
                      lResult = #True
                      lContentLen = 0
                    EndIf
                    If lResult
                      *MemoryBuffer = AllocateMemory(16384)
                      If *MemoryBuffer
                        MemoryLength = MemorySize(*MemoryBuffer)-2
                        If ReturnHeader
                          If WinHttpQueryHeaders(hRequest, #WINHTTP_QUERY_RAW_HEADERS_CRLF, #WINHTTP_HEADER_NAME_BY_INDEX, *MemoryBuffer, @MemoryLength, #WINHTTP_NO_HEADER_INDEX)
                            lRetVal = ReAllocateMemory(*MemoryBuffer, MemoryLength)
                          EndIf
                        ElseIf lContentLen
                          Repeat
                            If MemoryLength-lReadUntilNow <= lContentLen
                              *MemoryBuffer = ReAllocateMemory(*MemoryBuffer, MemoryLength+lContentLen+1)
                              If *MemoryBuffer
                                MemoryLength = MemorySize(*MemoryBuffer)
                              Else
                                Break
                              EndIf
                            EndIf
                            If WinHttpReadData(hRequest, *MemoryBuffer+lReadUntilNow, lContentLen, @lBytesRead)
                              If lBytesRead
                                lReadUntilNow + lBytesRead
                              Else
                                Break
                              EndIf
                              If CallbackProgress
                                CallbackProgress(CallbackID, lReadUntilNow, lContentLen, (ElapsedMilliseconds() - lStartTime) / 1000)
                              EndIf
                            Else
                              Break
                            EndIf
                            If Not WinHttpQueryDataAvailable(hRequest, @lContentLen)
                              Break
                            EndIf
                          ForEver
                          If lReadUntilNow >= lContentLen
                            lRetVal = ReAllocateMemory(*MemoryBuffer, lReadUntilNow)
                          EndIf
                        EndIf
                      EndIf
                    EndIf
                  EndIf
                EndIf
              EndIf
              If *OptionalBuffer
                FreeMemory(*OptionalBuffer)
              EndIf
              If CallbackEnd
                CallbackEnd(CallbackID, lRetVal, lReadUntilNow, lContentLen, (ElapsedMilliseconds() - lStartTime) / 1000)
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  
  If hRequest
    WinHttpCloseHandle(hRequest)
  EndIf
  If hInternet
    WinHttpCloseHandle(hInternet)
  EndIf
  ; If hSession
  ;   WinHttpCloseHandle(hSession)
  ; EndIf
  
  ProcedureReturn lRetVal
EndProcedure

Procedure.s ReceiveHTTPString(URL$, RequestType$ = "GET", ReturnHeader = #False, Username$ = "", Password$ = "", HeaderData$ = "", OptionalData$ = "", UserAgent$ = "WinHTTP - PureBasic", CallbackID = 0, CallbackStart.ReceiveHTTPStart = 0, CallbackProgress.ReceiveHTTPProgress = 0, CallbackEnd.ReceiveHTTPEnd = 0)
  Protected Result$, *MemoryBuffer
  *MemoryBuffer = ReceiveHTTPMemory(URL$, RequestType$, ReturnHeader, Username$, Password$, HeaderData$, OptionalData$, UserAgent$, CallbackID, CallbackStart.ReceiveHTTPStart, CallbackProgress.ReceiveHTTPProgress, CallbackEnd.ReceiveHTTPEnd)
  If *MemoryBuffer
    If ReturnHeader
      Result$ = PeekS(*MemoryBuffer, MemorySize(*MemoryBuffer), #PB_Unicode)
    Else
      Result$ = PeekS(*MemoryBuffer, MemorySize(*MemoryBuffer), #PB_UTF8)
    EndIf
    FreeMemory(*MemoryBuffer)
  EndIf
  ProcedureReturn Result$
EndProcedure

Procedure ReceiveHTTPFileEx(URL$, Filename$, RequestType$ = "GET", Username$ = "", Password$ = "", HeaderData$ = "", OptionalData$ = "", UserAgent$ = "WinHTTP - PureBasic", CallbackID = 0, CallbackStart.ReceiveHTTPStart = 0, CallbackProgress.ReceiveHTTPProgress = 0, CallbackEnd.ReceiveHTTPEnd = 0)
  Protected File, *MemoryBuffer
  *MemoryBuffer = ReceiveHTTPMemory(URL$, RequestType$, #False, Username$, Password$, HeaderData$, OptionalData$, UserAgent$, CallbackID, CallbackStart.ReceiveHTTPStart, CallbackProgress.ReceiveHTTPProgress, CallbackEnd.ReceiveHTTPEnd)
  If *MemoryBuffer
    File = CreateFile(#PB_Any, Filename$)
    If File
      WriteData(File, *MemoryBuffer, MemorySize(*MemoryBuffer))
      CloseFile(File)
      FreeMemory(*MemoryBuffer)
      ProcedureReturn #True
    EndIf
    FreeMemory(*MemoryBuffer)
  EndIf
  ProcedureReturn #False
EndProcedure

Benutzername und Passwort werden als Parameter übergeben, da ich schlechte Erfahrung mit der @-URL Notation gemacht habe, vorallem wenn Sonderzeichen in den Benutzerdaten sind.

[ts-soft]

Wo bekomme ich die "winhttp.lib" her?
In welchen Bedingungen existiert die DLL?

Ein paar mehr Infos wären schon hilfreich, weil so funktioniert es nicht

[mback2k]

Ups, ja. Daran habe ich gerade nicht gedacht. Also die winhttp.lib ist Bestandteil der Windows SDK, ich habe sie aus der Version 6.0.

WinHTTP Versions

Users of Microsoft Windows HTTP Services (WinHTTP) should use the latest version of the technology, version 5.1.
Version 5.1

WinHTTP 5.1 offers improvements over version 5.0; for more information about new features, see What's New in WinHTTP 5.1.

With version 5.1, WinHTTP is now an operating-system component of the following operating systems:

* Windows 2000, Service Pack 3 and later (except Datacenter Server)
* Windows XP Service Pack 1 (SP1) and later
* Windows Server 2003 Service Pack 1 (SP1) and later

For Windows Server 2003 SP1, WinHTTP is a system side-by-side assembly. For more information, see Side-by-side Assemblies.

Redistribution of WinHTTP 5.1 outside of these operating systems is not supported; for example, WinHTTP 5.1 is not supported on Windows NT 4.0.
Version 5.0

The WinHTTP 5.0 redistributable, "winhttp5.dll", runs on Windows 2000 or later, or Windows NT 4.0 with Microsoft Internet Explorer 5.01 or later.

Important With the release of WinHTTP Version 5.1, the WinHTTP 5.0 download is no longer available. As of October 1, 2004, Microsoft has removed the WinHTTP 5.0 SDK download from MSDN and has terminated product support for version 5.0.

Zusammengefasst: Die aktuelle WinHTTP DLL gibts ab Windows 2000 und aufwärts. Sie ist Bestandteil von Windows und wird über Windows Update als KB ausgeliefert, somit ist sie auf aktualisierten Rechnern installiert.

[ts-soft]

Grundfunktionen getestet, läuft gut, auch unter x64

Gruß
Thomas

[mback2k]

Grundfunktionen getestet, läuft gut, auch unter x64

Gruß
Thomas

Schön zu hören. Ich habe die Funktionen in 2 verbreiteten Anwendungen im Einsatz, deshalb bin ich mir eigentlich ziemlich sicher, dass der Code sehr stabil ist.

[Falko]

Habt ihr hierzu noch ein paar Beispiele parat, wie man diese Funktionen anspricht?

Login nur mit pw=Password ( ohne Benutzer) Ist für ein Webinterface
Werte auslesen, bzw. Formulare ausfüllen?
Leider findet man zu PB fast keine Beispiele dazu.


Gruß, Falko

[jpeg61]

Hi,
I do not understand how to call this procedure from Visual Basic 6 using the callback?

With PB, I've converted the proceedings in ProcedureDll without significant change.
=> ProcedureDll ReceiveHTTPString( ... ) .../...
ProcedureReturn @Result$

With VB, if I use the following code without calling the callback function, it's all right.

Code: Alles auswählen

Public Declare Function ReceiveHTTPString Lib "myDll" (ByVal url As String, RequestType As String, ByVal ReturnHeader As String, ByVal Username As String, ByVal pwd As String, ByVal HeaderData As String, ByVal  OptionalData As String, byval UserAgent as string, ByVal lptrCallback As Long, ByVal dwStart As Long, ByVal dwProgres As Long, ByVal dwEnd As Long) As Long
ret = ReceiveHTTPString(s, "GET", "", "", "", "", "", "", 0, 0, 0, 0)

But when I use the callback

Code: Alles auswählen

Public Declare Function ReceiveHTTPString Lib "myDll" (ByVal url As String, RequestType As String, ByVal ReturnHeader As String, ByVal Username As String, ByVal pwd As String, ByVal HeaderData As String, ByVal  OptionalData As String, byval UserAgent as string, ByVal lptrCallback As Long, ByVal dwStart As Long, ByVal dwProgres As Long, ByVal dwEnd As Long) As Long
ret = ReceiveHTTPString(s, "GET", "", "", "", "", "", "", AddressOf CallBackHTTPProgress, 0, 1, 0)
'and

Private Function CallBackHTTPProgress(ByVal CallbackID As Long, ByVal lBytesReceived As Long, ByVal lSize As Long, ByVal lElapsedTime As Long) As Long
    Debug.Print "CallBack", CallbackID, lBytesReceived, lSize, lElapsedTime
    
    CallBackHTTPProgress = 1    '!
End Function

It's crash on calling «CallbackProgress(...)» in PB code !

An idea ?
Hand side problem VB6 or PB?


PS: Sorry for my poor English, German and PB langages - thanks Google lol
Understanding sought

Bonjour,
Je ne comprends pas comment appeler cette procedure depuis VB6 en utilisant le callback ?

Sous PB, j'ai converti la procedure en ProcedureDll sans modification importante.
Sous VB j'utilise le code suivant fonctionnel sans appel au callback.(1)
Quand j'active le callback(2)
j'ai un crash sur l'appel de CallbackProgress(...) !

Quelqu'un aurait-il une idée ?

Hallo,
Ich verstehe nicht, wie dieses Verfahren von VB mit dem Rückruf?

Am PB umgewandelt ich das Verfahren in ProcedureDLL ohne nennenswerte Änderung.
VB ich den folgenden Code verwenden, ohne den Aufruf der Callback-Funktion.(1)
Als ich ermöglichen den Rückruf(2)
Ich Absturz beim Aufruf CallbackProgress (...)!

Hat jemand eine Idee?

[jpeg61]

Am I clear?

Me suis-je fait comprendre ?

[ts-soft]

Code: Alles auswählen

Procedure CallBackHTTPProgress(CallbackID, lBytesReceived, lSize, lElapsedTime)
  ProcedureReturn 1
EndProcedure

ret = ReceiveHTTPString(s, "GET", "", "", "", "", "", "", @CallBackHTTPProgress(), 0, 1, 0)

[jpeg61]

Thanks
but I call the procedureDll ReceiveHTTPString since VB6
also I send the address of callback in VB6 by addressof CallBackHTTPProgress -
Procedure CallBackHTTPProgress is not in code PB.