Here's the source from microsoft:
https://msdn.microsoft.com/en-us/librar ... s.85).aspx
And here's my PB Code:
Update 20180630:
# didn't work properly in thread-safe mode: GetLastError_() has to be called directly after the previous windows-api function in order to return the correct error (that is required to work correctly)
# fixed a memory problem in SendRequestWithBody: it's necessary to allocate *BuffersIn with AllocateStructure because it's used async
Code: Select all
; https://msdn.microsoft.com/en-us/library/windows/desktop/cc185684(v=vs.85).aspx
EnableExplicit
#BUFFER_LEN=4096
#ERR_MSG_LEN=512
#METHOD_NONE=0
#METHOD_GET =1
#METHOD_POST=2
#REQ_STATE_SEND_REQ =0
#REQ_STATE_SEND_REQ_WITH_BODY =1
#REQ_STATE_POST_GET_DATA =2
#REQ_STATE_POST_SEND_DATA =3
#REQ_STATE_POST_COMPLETE =4
#REQ_STATE_RESPONSE_RECV_DATA =5
#REQ_STATE_RESPONSE_WRITE_DATA =6
#REQ_STATE_COMPLETE =7
#DEFAULT_TIMEOUT =2 * 60 * 1000 ; Two minutes
#DEFAULT_HOSTNAME ="www.microsoft.com"
#DEFAULT_RESOURCE ="/"
#DEFAULT_OUTPUT_FILE_NAME ="response.htm"
#SPIN_COUNT =4000
#INTERNET_STATUS_COOKIE_SENT=320
#INTERNET_STATUS_COOKIE_RECEIVED=321
#INTERNET_STATUS_COOKIE_HISTORY=327
#INTERNET_STATUS_CLOSING_CONNECTION=50
#INTERNET_STATUS_CONNECTED_TO_SERVER=21
#INTERNET_STATUS_CONNECTING_TO_SERVER=20
#INTERNET_STATUS_CONNECTION_CLOSED=51
#INTERNET_STATUS_HANDLE_CLOSING=70
#INTERNET_STATUS_HANDLE_CREATED=60
#INTERNET_STATUS_INTERMEDIATE_RESPONSE=120
#INTERNET_STATUS_RECEIVING_RESPONSE=40
#INTERNET_STATUS_RESPONSE_RECEIVED=41
#INTERNET_STATUS_REDIRECT=110
#INTERNET_STATUS_REQUEST_COMPLETE=100
#INTERNET_STATUS_REQUEST_SENT=31
#INTERNET_STATUS_DETECTING_PROXY=80
#INTERNET_STATUS_RESOLVING_NAME=10
#INTERNET_STATUS_NAME_RESOLVED=11
#INTERNET_STATUS_SENDING_REQUEST=30
#INTERNET_STATUS_STATE_CHANGE=200
#INTERNET_STATUS_P3P_HEADER=325
Import ""
InitializeCriticalSectionAndSpinCount(*lpCriticalSection.CRITICAL_SECTION, dwSpincount.i)
; BOOL WINAPI InitializeCriticalSectionAndSpinCount(
; _Out_ LPCRITICAL_SECTION lpCriticalSection,
; _In_ DWORD dwSpinCount
; );
EndImport
; Structure To store configuration in that was gathered from passed in arguments
Structure CONFIGURATION
Method.i ; DWORD // Method, GET or POST
HostName.s ; LPWSTR // Host to connect to
ResourceOnServer.s ; LPWSTR // Resource to get from the server
InputFileName.s ; LPWSTR // File containing data to post
OutputFileName.s ; LPWSTR // File to write the data received from the server
UseProxy.i ; BOOL // Flag to indicate the use of a proxy
ProxyName.s ; LPWSTR // Name of the proxy to use
IsSecureConnection.i ; BOOL // Flag to indicate the use of SSL
UserTimeout.i ; DWORD // Timeout for the async operations
EndStructure
; Structure used For storing the context For the asynchronous calls
Structure REQUEST_CONTEXT
RequestHandle.i ; HINTERNET
ConnectHandle.i ; HINTERNET
CompletionEvent.i ; HANDLE
CleanUpEvent.i ; HANDLE
*OutputBuffer ; LPSTR
DownloadedBytes.i ; DWORD
WrittenBytes.i ; DWORD
ReadBytes.i ; DWORD
UploadFile.i ; HANDLE
FileSize.i ; DWORD
DownloadFile.i ; HANDLE
Method.i ; DWORD
State.i ; DWORD
CriticalSection.CRITICAL_SECTION ; CRITICAL_SECTION
CritSecInitialized.i ; BOOL
; Synchronized by CriticalSection
HandleUsageCount.i ; DWORD // Request object is in use(not safe to close handle)
Closing.i ; BOOL // Request is closing(don't use handle)
EndStructure
Structure InternetCookieHistory
fAccepted.i ; BOOL
fLeashed.i ; BOOL
fDowngraded.i ; BOOL
fRejected.i ; BOOL
EndStructure
Structure INTERNET_ASYNC_RESULT
*dwResult ; DWORD_PTR
dwError.i ; DWORD
EndStructure
;- DECLARE
Declare CallBack(hInternet.i, dwContext.i, dwInternetStatus.i, lpvStatusInformation.i, dwStatusInformationLength.i)
Declare.i AllocateAndInitializeRequestContext(SessionHandle.i, *Configuration.CONFIGURATION, *ReqContext.REQUEST_CONTEXT)
Declare.i ProcessRequest(*ReqContext.REQUEST_CONTEXT, Error.i)
Declare WaitForRequestCompletion(*ReqContext.REQUEST_CONTEXT, Timeout.i)
Declare CleanUpRequestContext(*ReqContext.REQUEST_CONTEXT)
Declare CleanUpSessionHandle(SessionHandle.i)
Declare.i SendRequest(*ReqContext.REQUEST_CONTEXT)
Declare.i SendRequestWithBody(*ReqContext.REQUEST_CONTEXT)
Declare.i GetDataToPost(*ReqContext.REQUEST_CONTEXT)
Declare.i PostDataToServer(*ReqContext.REQUEST_CONTEXT, *Eof.INTEGER)
Declare.i CompleteRequest(*ReqContext.REQUEST_CONTEXT)
Declare.i RecvResponseData(*ReqContext.REQUEST_CONTEXT)
Declare.i WriteResponseData(*ReqContext.REQUEST_CONTEXT, *Eof.INTEGER)
Declare.i OpenFiles(*ReqContext.REQUEST_CONTEXT, Method.i, InputFilename.s, OutputFilename.s)
Declare.i CreateWininetHandles(*ReqContext.REQUEST_CONTEXT, SessionHandle.i, HostName.s, Resource.s, IsSecureConnection.i)
Declare.i CloseRequestHandle(*ReqContext.REQUEST_CONTEXT)
Declare.i AcquireRequestHandle(*ReqContext.REQUEST_CONTEXT)
Declare.i ReleaseRequestHandle(*ReqContext.REQUEST_CONTEXT)
Declare ShowUsage()
#INTERNET_INVALID_STATUS_CALLBACK=-1
Procedure ParseArguments(*Configuration.CONFIGURATION)
; __in int argc,
; __in_ecount(argc) LPWSTR *argv,
; __inout PCONFIGURATION Configuration
; Routine Description:
; This routine is used To Parse command line arguments. Flags are
; Case sensitive.
;
; Arguments:
; argc - Number of arguments
; argv - Pointer To the argument vector
; Configuration - pointer To configuration struct To write configuration
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected i.i
For i=0 To CountProgramParameters()-1
If (Left(ProgramParameter(i), 1)<>"-")
PrintN("Invalid switch >"+ProgramParameter(i)+"<")
Continue
Else
Select Mid(ProgramParameter(i), 2, 1)
Case "p"
*Configuration\UseProxy=1
If (i < (CountProgramParameters()-1))
i+1
*Configuration\ProxyName = ProgramParameter(i)
EndIf
Case "h"
If (i < (CountProgramParameters()-1))
i+1
*Configuration\HostName = ProgramParameter(i)
EndIf
Case "o"
If (i < (CountProgramParameters()-1))
i+1
*Configuration\ResourceOnServer = ProgramParameter(i)
EndIf
Case "r"
If (i < (CountProgramParameters()-1))
i+1
*Configuration\InputFileName = ProgramParameter(i)
EndIf
Case "w"
If (i < (CountProgramParameters()-1))
i+1
*Configuration\OutputFileName = ProgramParameter(i)
EndIf
Case "m"
If (i < (CountProgramParameters()-1))
If LCase(ProgramParameter(i+1))="get"
*Configuration\Method = #METHOD_GET
ElseIf LCase(ProgramParameter(i+1))="post"
*Configuration\Method = #METHOD_POST
EndIf
EndIf
i+1
Case "s"
*Configuration\IsSecureConnection = #True
Case "t"
If (i < (CountProgramParameters()-1))
i+1
*Configuration\UserTimeout = Val( ProgramParameter(i) )
EndIf
Default
Error = #ERROR_INVALID_PARAMETER
EndSelect
EndIf
Next
If (Error = #ERROR_SUCCESS)
If (*Configuration\UseProxy And *Configuration\ProxyName = "")
Print(~"No proxy server name provided!\n\n")
Error = #ERROR_INVALID_PARAMETER
Goto Exit
EndIf
If (*Configuration\HostName = "")
PrintN("Defaulting hostname to: "+#DEFAULT_HOSTNAME)
*Configuration\HostName = #DEFAULT_HOSTNAME
EndIf
If (*Configuration\Method = #METHOD_NONE)
PrintN("Defaulting method to: GET")
*Configuration\Method = #METHOD_GET
EndIf
If (*Configuration\ResourceOnServer = "")
PrintN("Defaulting resource to: "+#DEFAULT_RESOURCE)
*Configuration\ResourceOnServer = #DEFAULT_RESOURCE
EndIf
If (*Configuration\UserTimeout = 0)
PrintN("Defaulting timeout to: "+#DEFAULT_TIMEOUT)
*Configuration\UserTimeout = #DEFAULT_TIMEOUT
EndIf
If (*Configuration\InputFileName = "" And *Configuration\Method = #METHOD_POST)
PrintN("Error: File to post not specified")
Error = #ERROR_INVALID_PARAMETER
Goto Exit
EndIf
If (*Configuration\OutputFileName = "")
PrintN("Defaulting output file to: "+#DEFAULT_OUTPUT_FILE_NAME)
*Configuration\OutputFileName = #DEFAULT_OUTPUT_FILE_NAME
EndIf
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure wmain()
Protected Error.i
Protected OpenType.i = #INTERNET_OPEN_TYPE_PRECONFIG ; Use pre-configured options as default
Protected Configuration.CONFIGURATION
Protected ReqContext.REQUEST_CONTEXT
Protected SessionHandle.i
; Callback function
Protected CallbackPointer.i ; INTERNET_STATUS_CALLBACK
; // Parse the command line arguments
; Error = ParseArguments(argc, argv, &Configuration);
Error=ParseArguments(@Configuration)
If (Error <> #ERROR_SUCCESS)
ShowUsage()
Goto Exit
EndIf
If (Configuration\UseProxy)
OpenType = #INTERNET_OPEN_TYPE_PROXY
EndIf
; Create Session handle And specify async Mode
SessionHandle = InternetOpen_("WinInet HTTP Async Sample", ; User Agent
OpenType, ; Preconfig Or Proxy
Configuration\ProxyName, ; Proxy name
#Null, ; Proxy bypass, do Not bypass any address
#INTERNET_FLAG_ASYNC) ; 0 for Synchronous
If (SessionHandle = #Null)
PrintN("ERROR! InternetOpen >"+GetLastError_()+"<")
Goto Exit
EndIf
; Set the status callback For the handle To the Callback function
CallbackPointer = InternetSetStatusCallback_(SessionHandle, @CallBack())
If (CallbackPointer = #INTERNET_INVALID_STATUS_CALLBACK)
PrintN("ERROR! InternetSetStatusCallback failed With INTERNET_INVALID_STATUS_CALLBACK")
Goto Exit
EndIf
; Initialize the ReqContext To be used in the asynchronous calls
Error = AllocateAndInitializeRequestContext(SessionHandle,
@Configuration,
@ReqContext)
If (Error <> #ERROR_SUCCESS)
Goto Exit
EndIf
; Send out request And receive response
ProcessRequest(@ReqContext, #ERROR_SUCCESS)
; Wait For request completion Or timeout
WaitForRequestCompletion(@ReqContext, Configuration\UserTimeout);
Exit:
; Clean up the allocated resources
CleanUpRequestContext(@ReqContext)
CleanUpSessionHandle(SessionHandle)
If (Error <> #ERROR_SUCCESS)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure CallBack(hInternet.i, *dwContext, dwInternetStatus.i, *lpvStatusInformation, dwStatusInformationLength.i)
; __in HINTERNET hInternet,
; __in DWORD_PTR dwContext,
; __in DWORD dwInternetStatus,
; __in_bcount(dwStatusInformationLength) LPVOID lpvStatusInformation,
; __in DWORD dwStatusInformationLength
; Routine Description:
; Callback routine For asynchronous WinInet operations
;
; Arguments:
; hInternet - The handle For which the callback function is called.
; dwContext - Pointer To the application defined context.
; dwInternetStatus - Status code indicating why the callback is called.
; lpvStatusInformation - Pointer To a buffer holding callback specific Data.
; dwStatusInformationLength - Specifies size of lpvStatusInformation buffer.
;
; Return Value:
; None.
Protected *cookieHistory.InternetCookieHistory
Protected *ReqContext.REQUEST_CONTEXT
Protected *StatusInformation.INTERNET_ASYNC_RESULT
*ReqContext=*dwContext
; UNREFERENCED_PARAMETER(dwStatusInformationLength);
Select dwInternetStatus
Case #INTERNET_STATUS_COOKIE_SENT
PrintN("Status: Cookie found And will be sent With request")
Case #INTERNET_STATUS_COOKIE_RECEIVED
PrintN("Status: Cookie Received")
Case #INTERNET_STATUS_COOKIE_HISTORY
PrintN("Status: Cookie History")
; ASYNC_ASSERT(lpvStatusInformation)
; ASYNC_ASSERT(dwStatusInformationLength == SizeOf(InternetCookieHistory))
*cookieHistory = *lpvStatusInformation
If (*cookieHistory\fAccepted)
PrintN("Cookie Accepted")
EndIf
If (*cookieHistory\fLeashed)
PrintN("Cookie Leashed")
EndIf
If (*cookieHistory\fDowngraded)
PrintN("Cookie Downgraded")
EndIf
If (*cookieHistory\fRejected)
PrintN("Cookie Rejected")
EndIf
Case #INTERNET_STATUS_CLOSING_CONNECTION
PrintN("Status: Closing Connection")
Case #INTERNET_STATUS_CONNECTED_TO_SERVER
PrintN("Status: Connected to Server")
Case #INTERNET_STATUS_CONNECTING_TO_SERVER
PrintN("Status: Connecting to Server")
Case #INTERNET_STATUS_CONNECTION_CLOSED
PrintN("Status: Connection Closed")
Case #INTERNET_STATUS_HANDLE_CLOSING
PrintN("Status: Handle Closing")
; // Signal the cleanup routine that it is
; // safe To cleanup the request context
; ASYNC_ASSERT(ReqContext);
SetEvent_(*ReqContext\CleanUpEvent)
Case #INTERNET_STATUS_HANDLE_CREATED
; ASYNC_ASSERT(lpvStatusInformation)
*StatusInformation=*lpvStatusInformation
PrintN("Handle "+*StatusInformation\dwResult+" created") ; ((LPINTERNET_ASYNC_RESULT)lpvStatusInformation)->dwResult)
Case #INTERNET_STATUS_INTERMEDIATE_RESPONSE
PrintN("Status: Intermediate response")
Case #INTERNET_STATUS_RECEIVING_RESPONSE
PrintN("Status: Receiving Response")
Case #INTERNET_STATUS_RESPONSE_RECEIVED
; ASYNC_ASSERT(lpvStatusInformation)
; ASYNC_ASSERT(dwStatusInformationLength == SizeOf(DWORD))
PrintN("Status: Response Received ("+PeekI(*lpvStatusInformation)+" Bytes)")
Case #INTERNET_STATUS_REDIRECT
PrintN("Status: Redirect")
Case #INTERNET_STATUS_REQUEST_COMPLETE
PrintN("Status: Request complete")
; ASYNC_ASSERT(lpvStatusInformation)
*StatusInformation=*lpvStatusInformation
ProcessRequest(*ReqContext, *StatusInformation\dwError)
Case #INTERNET_STATUS_REQUEST_SENT
; ASYNC_ASSERT(lpvStatusInformation)
; ASYNC_ASSERT(dwStatusInformationLength == SizeOf(DWORD))
PrintN("Status: Request sent ("+PeekI(*lpvStatusInformation)+" Bytes)") ;, *((LPDWORD)lpvStatusInformation));
Case #INTERNET_STATUS_DETECTING_PROXY
PrintN("Status: Detecting Proxy")
Case #INTERNET_STATUS_RESOLVING_NAME
PrintN("Status: Resolving Name")
Case #INTERNET_STATUS_NAME_RESOLVED
PrintN("Status: Name Resolved")
Case #INTERNET_STATUS_SENDING_REQUEST
PrintN("Status: Sending request")
Case #INTERNET_STATUS_STATE_CHANGE
PrintN("Status: State Change")
Case #INTERNET_STATUS_P3P_HEADER
PrintN("Status: Received P3P header")
Default
PrintN("Status: Unknown >"+dwInternetStatus+"<")
EndSelect
EndProcedure
Procedure.i ProcessRequest(*ReqContext.REQUEST_CONTEXT, Error.i)
; __inout PREQUEST_CONTEXT ReqContext,
; __in DWORD Error
; Routine Description:
; Process the request context - Sending the request And
; receiving the response
;
; Arguments:
; ReqContext - Pointer To request context Structure
; Error - error returned from last asynchronous call
;
; Return Value:
; None.
Protected Eof.i=#False
While (Error=#ERROR_SUCCESS And *ReqContext\State <> #REQ_STATE_COMPLETE)
Select *ReqContext\State
Case #REQ_STATE_SEND_REQ
; Debug "#REQ_STATE_SEND_REQ"
*ReqContext\State = #REQ_STATE_RESPONSE_RECV_DATA
Error = SendRequest(*ReqContext)
Case #REQ_STATE_SEND_REQ_WITH_BODY
; Debug "#REQ_STATE_SEND_REQ_WITH_BODY"
*ReqContext\State = #REQ_STATE_POST_GET_DATA
Error = SendRequestWithBody(*ReqContext)
Case #REQ_STATE_POST_GET_DATA
; Debug "#REQ_STATE_POST_GET_DATA"
*ReqContext\State = #REQ_STATE_POST_SEND_DATA
Error = GetDataToPost(*ReqContext)
Case #REQ_STATE_POST_SEND_DATA
; Debug "#REQ_STATE_POST_SEND_DATA"
*ReqContext\State = #REQ_STATE_POST_GET_DATA
Error = PostDataToServer(*ReqContext, @Eof)
If(Eof)
; ASYNC_ASSERT(Error == ERROR_SUCCESS)
*ReqContext\State = #REQ_STATE_POST_COMPLETE
EndIf
Case #REQ_STATE_POST_COMPLETE
; Debug "#REQ_STATE_POST_COMPLETE"
*ReqContext\State = #REQ_STATE_RESPONSE_RECV_DATA
Error = CompleteRequest(*ReqContext)
Case #REQ_STATE_RESPONSE_RECV_DATA
; Debug "#REQ_STATE_RESPONSE_RECV_DATA"
*ReqContext\State = #REQ_STATE_RESPONSE_WRITE_DATA
Error = RecvResponseData(*ReqContext)
Case #REQ_STATE_RESPONSE_WRITE_DATA
; Debug "#REQ_STATE_RESPONSE_WRITE_DATA"
*ReqContext\State = #REQ_STATE_RESPONSE_RECV_DATA;
Error = WriteResponseData(*ReqContext, @Eof)
If(Eof)
; ASYNC_ASSERT(Error == ERROR_SUCCESS);
*ReqContext\State = #REQ_STATE_COMPLETE
EndIf
Default
; Debug #PB_Compiler_Procedure+" - Default >"+*ReqContext\State+"< >"+*ReqContext\DownloadedBytes+"<"
; ASYNC_ASSERT(FALSE);
EndSelect
Wend
If (Error <> #ERROR_IO_PENDING)
; // Everything has been procesed Or has failed.
; // In either Case, the signal processing has
; // completed
SetEvent_(*ReqContext\CompletionEvent)
EndIf
EndProcedure
Procedure.i AllocateAndInitializeRequestContext(SessionHandle.i, *Configuration.CONFIGURATION, *ReqContext.REQUEST_CONTEXT)
; Routine Description:
; Allocate the request context And initialize it values
;
; Arguments:
; ReqContext - Pointer To Request context Structure
; Configuration - Pointer To configuration Structure
; SessionHandle - Wininet session handle To use when creating
; connect handle
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected Success.i
*ReqContext\RequestHandle = #Null
*ReqContext\ConnectHandle = #Null
*ReqContext\DownloadedBytes = 0
*ReqContext\WrittenBytes = 0
*ReqContext\ReadBytes = 0
*ReqContext\UploadFile = #INVALID_HANDLE_VALUE
*ReqContext\DownloadFile = #INVALID_HANDLE_VALUE
*ReqContext\FileSize = 0
*ReqContext\HandleUsageCount = 0
*ReqContext\Closing = #False
*ReqContext\Method = *Configuration\Method
*ReqContext\CompletionEvent = #Null
*ReqContext\CleanUpEvent = #Null
*ReqContext\OutputBuffer = #Null
If (*ReqContext\Method=#METHOD_GET)
*ReqContext\State = #REQ_STATE_SEND_REQ
Else
*ReqContext\State = #REQ_STATE_SEND_REQ_WITH_BODY
EndIf
*ReqContext\CritSecInitialized = #False
; initialize critical section
Success = InitializeCriticalSectionAndSpinCount(@*ReqContext\CriticalSection, #SPIN_COUNT)
If (Not Success)
Error = GetLastError_()
PrintN("ERROR InitializeCriticalSectionAndSpinCount >"+Error+"<")
Goto Exit
EndIf
*ReqContext\CritSecInitialized = #True
*ReqContext\OutputBuffer = AllocateMemory(#BUFFER_LEN)
If (Not *ReqContext\OutputBuffer)
Error = #ERROR_NOT_ENOUGH_MEMORY
Goto Exit
EndIf
; // create events
*ReqContext\CompletionEvent = CreateEvent_(#Null, ;// Sec attrib
#False, ;// Auto reset
#False, ;// Initial state unsignalled
#Null) ; // Name
If (*ReqContext\CompletionEvent = #Null)
Error = GetLastError_()
PrintN("ERROR CreateEvent CompletionEvent >"+Error+"<")
Goto Exit
EndIf
; // create events
*ReqContext\CleanUpEvent = CreateEvent_(#Null, ;// Sec attrib
#False, ;// Auto reset
#False, ;// Initial state unsignalled
#Null) ; // Name
If (*ReqContext\CleanUpEvent = #Null)
Error = GetLastError_()
PrintN("ERROR CreateEvent CleanUpEvent >"+Error+"<")
Goto Exit
EndIf
; // Open the file To dump the response entity body And
; // If required the file With the Data To post
Error = OpenFiles(*ReqContext,
*Configuration\Method,
*Configuration\InputFileName,
*Configuration\OutputFileName)
If (Error <> #ERROR_SUCCESS)
PrintN("ERROR OpenFiles failed With >"+Error+"<")
Goto Exit
EndIf
; // Verify If we've opened a file to post and get its size
If (*ReqContext\UploadFile <> #INVALID_HANDLE_VALUE)
*ReqContext\FileSize = GetFileSize_(*ReqContext\UploadFile, #Null)
If(*ReqContext\FileSize = #INVALID_FILE_SIZE)
Error = GetLastError_()
PrintN("ERROR GetFileSize >"+Error+"<")
Goto Exit
EndIf
EndIf
Error = CreateWininetHandles(*ReqContext,
SessionHandle,
*Configuration\HostName,
*Configuration\ResourceOnServer,
*Configuration\IsSecureConnection)
If (Error <> #ERROR_SUCCESS)
PrintN("ERROR CreateWininetHandles failed With >"+Error+"<")
Goto Exit
EndIf
Exit:
If (Error <> #ERROR_SUCCESS)
CleanUpRequestContext(*ReqContext)
EndIf
ProcedureReturn Error
EndProcedure
Procedure WaitForRequestCompletion(*ReqContext.REQUEST_CONTEXT, Timeout.i)
; __in PREQUEST_CONTEXT ReqContext,
; __in DWORD Timeout
; Routine Description:
; Wait For the request To complete Or timeout To occur
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; None.
Protected SyncResult.i ; DWORD SyncResult;
Protected iError.i
; // The preferred method of doing timeouts is To
; // use the timeout options through InternetSetOption,
; // but this overall timeout is being used To show
; // the correct way To abort And close a request.
SyncResult = WaitForSingleObject_(*ReqContext\CompletionEvent, Timeout) ; Wait until we receive the completion
Select (SyncResult)
Case #WAIT_OBJECT_0
PrintN("Done!")
Case #WAIT_TIMEOUT
PrintN("Timeout while waiting for completion event (request will be cancelled)")
Case #WAIT_FAILED:
iError=GetLastError_()
PrintN("Wait failed with Error "+iError+" While waiting For completion Event (request will be cancelled)")
Default ; Not expecting any other error codes
EndSelect
EndProcedure
Procedure CleanUpRequestContext(*ReqContext.REQUEST_CONTEXT)
; __inout_opt PREQUEST_CONTEXT ReqContext
; Routine Description:
; Used To cleanup the request context before exiting.
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; None.
If (*ReqContext\RequestHandle)
CloseRequestHandle(*ReqContext)
; // Wait For the closing of the handle To complete
; // (waiting For all async operations To complete)
; //
; // This is the only safe way To get rid of the context
WaitForSingleObject_(*ReqContext\CleanUpEvent, #INFINITE)
EndIf
If (*ReqContext\ConnectHandle)
; // Remove the callback from the ConnectHandle since
; // we don't want the closing notification
; // The callback was inherited from the session handle
InternetSetStatusCallback_(*ReqContext\ConnectHandle, #Null)
InternetCloseHandle_(*ReqContext\ConnectHandle)
EndIf
If (*ReqContext\UploadFile <> #INVALID_HANDLE_VALUE)
CloseHandle_(*ReqContext\UploadFile)
EndIf
If (*ReqContext\DownloadFile <> #INVALID_HANDLE_VALUE)
CloseHandle_(*ReqContext\DownloadFile)
EndIf
If (*ReqContext\CompletionEvent)
CloseHandle_(*ReqContext\CompletionEvent)
EndIf
If (*ReqContext\CleanUpEvent)
CloseHandle_(*ReqContext\CleanUpEvent)
EndIf
If(*ReqContext\CritSecInitialized)
DeleteCriticalSection_(*ReqContext\CriticalSection)
EndIf
EndProcedure
Procedure CleanUpSessionHandle(SessionHandle.i)
; __in HINTERNET SessionHandle
; Routine Description:
; Used To cleanup session before exiting.
;
; Arguments:
; SessionHandle - Wininet session handle
;
; Return Value:
; None.
If (SessionHandle)
; // Remove the callback from the SessionHandle since
; // we don't want the closing notification
InternetSetStatusCallback_(SessionHandle, #Null)
; // Call InternetCloseHandle And do Not wait For the closing notification
; // in the callback function
InternetCloseHandle_(SessionHandle)
EndIf
EndProcedure
Procedure.i SendRequest(*ReqContext.REQUEST_CONTEXT)
; __in PREQUEST_CONTEXT ReqContext
; Routine Description:
; Send the request using HttpSendRequest
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; Error code For the operation.
Protected Success.i
Protected Error.i=#ERROR_SUCCESS
Success = AcquireRequestHandle(*ReqContext)
If Not Success
Error = #ERROR_OPERATION_ABORTED
Goto Exit
EndIf
Success = HttpSendRequest_(*ReqContext\RequestHandle,
#Null, ;do Not provide additional Headers
0, ;dwHeadersLength
#Null, ;Do Not send any Data
0) ;dwOptionalLength
ReleaseRequestHandle(*ReqContext)
If Not Success
Error = GetLastError_()
If(Error <>#ERROR_IO_PENDING)
PrintN("ERROR HttpSendRequest >"+Error+"<")
EndIf
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Structure INTERNET_BUFFERS
dwStructSize.l ; DWORD ;
*Next ; _INTERNET_BUFFERS ;
lpcszHeader.l ; LPCTSTR ;
dwHeadersLength.l ; DWORD ;
dwHeadersTotal.l ; DWORD ;
lpvBuffer.l ; LPVOID ;
dwBufferLength.l ; DWORD ;
dwBufferTotal.l ; DWORD ;
dwOffsetLow.l ; DWORD ;
dwOffsetHigh.l ; DWORD ;
EndStructure
Procedure.i SendRequestWithBody(*ReqContext.REQUEST_CONTEXT)
; __in PREQUEST_CONTEXT ReqContext
; Routine Description:
; Send the request With entity-body using HttpSendRequestEx
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; Error code For the operation.
Protected Success.i
Protected *BuffersIn.INTERNET_BUFFERS
Protected Error.i=#ERROR_SUCCESS
; // HttpSendRequest can also be used also To post Data To a server,
; // To do so, the Data should be provided using the lpOptional
; // parameter And it's size on dwOptionalLength.
; // Here we decided To depict the use of HttpSendRequestEx function.
; //Prepare the Buffers To be passed To HttpSendRequestEx
*BuffersIn=AllocateStructure(INTERNET_BUFFERS)
*BuffersIn\dwStructSize = SizeOf(INTERNET_BUFFERS)
*BuffersIn\lpvBuffer = #Null
*BuffersIn\dwBufferLength = 0
*BuffersIn\dwBufferTotal = *ReqContext\FileSize; // content-length of data to post
Success = AcquireRequestHandle(*ReqContext)
If (Not Success)
Error = #ERROR_OPERATION_ABORTED
Goto Exit
EndIf
Success = HttpSendRequestEx_(*ReqContext\RequestHandle,
*BuffersIn,
#Null, ; // Do Not use output buffers
0, ; // dwFlags reserved
*ReqContext)
Error = GetLastError_()
ReleaseRequestHandle(*ReqContext)
If (Not Success)
Error = GetLastError_()
If (Error <> #ERROR_IO_PENDING)
PrintN("ERROR HttpSendRequestEx >"+Error+"<")
EndIf
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i GetDataToPost(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; Reads Data from a file
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; Error code For the operation.
Protected Error = #ERROR_SUCCESS
Protected Success.i
; // ReadFile is done inline here assuming that it will Return quickly
; // I.E. the file is on disk
; //
; // If you plan To do blocking/intensive operations they should be
; // queued To another thread And Not block the callback thread
Success = ReadFile_(*ReqContext\UploadFile,
*ReqContext\OutputBuffer,
#BUFFER_LEN,
@*ReqContext\ReadBytes,
#Null)
If (Not Success)
Error = GetLastError_()
PrintN("ERROR ReadFile >"+Error+"<")
EndIf
ProcedureReturn Error
EndProcedure
Procedure.i PostDataToServer(*ReqContext.REQUEST_CONTEXT, *Eof.INTEGER)
; __inout PREQUEST_CONTEXT ReqContext,
; __out PBOOL Eof
; Routine Description:
; Post Data in the http request
;
; Arguments:
; ReqContext - Pointer To request context Structure
; Eof - Done posting Data To server
;
; Return Value:
; Error code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected Success.i
*Eof\i = #False
If (*ReqContext\ReadBytes = 0)
*Eof\i = #True
Goto Exit
EndIf
Success = AcquireRequestHandle(*ReqContext)
If (Not Success)
Error = #ERROR_OPERATION_ABORTED
Goto Exit
EndIf
; // The lpdwNumberOfBytesWritten parameter will be
; // populated on async completion, so it must exist
; // Until INTERNET_STATUS_REQUEST_COMPLETE.
; // The same is true of lpBuffer parameter.
Success = InternetWriteFile_(*ReqContext\RequestHandle,
*ReqContext\OutputBuffer,
*ReqContext\ReadBytes,
@*ReqContext\WrittenBytes)
ReleaseRequestHandle(*ReqContext)
If (Not Success)
Error = GetLastError_()
If (Error = #ERROR_IO_PENDING)
PrintN("Waiting For InternetWriteFile To complete")
Else
PrintN("ERROR InternetWriteFile >"+Error+"<")
EndIf
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i CompleteRequest(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; Perform completion of asynchronous post.
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected Success.i
Success = AcquireRequestHandle(*ReqContext)
If (Not Success)
Error = #ERROR_OPERATION_ABORTED
Goto Exit
EndIf
Success = HttpEndRequest_(*ReqContext\RequestHandle, #Null, 0, 0)
ReleaseRequestHandle(*ReqContext)
If (Not Success)
Error = GetLastError_()
If (Error = #ERROR_IO_PENDING)
PrintN("Waiting for HttpEndRequest to complete")
Else
PrintN("ERROR HttpEndRequest >"+Error+"<")
Goto Exit
EndIf
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i RecvResponseData(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; Receive response
;
; Arguments:
; ReqContext - Pointer To request context Structure
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected Success.i
Success = AcquireRequestHandle(*ReqContext)
If (Not Success)
Error = #ERROR_OPERATION_ABORTED
Goto Exit
EndIf
; // The lpdwNumberOfBytesRead parameter will be
; // populated on async completion, so it must exist
; // Until INTERNET_STATUS_REQUEST_COMPLETE.
; // The same is true of lpBuffer parameter.
; //
; // InternetReadFile will block Until the buffer
; // is completely filled Or the response is exhausted.
Success = InternetReadFile_(*ReqContext\RequestHandle,
*ReqContext\OutputBuffer,
#BUFFER_LEN,
@*ReqContext\DownloadedBytes)
ReleaseRequestHandle(*ReqContext)
If (Not Success)
Error = GetLastError_()
If(Error = #ERROR_IO_PENDING)
PrintN("Waiting for InternetReadFile to complete")
Else
PrintN("ERROR InternetReadFile >"+Error+"<")
EndIf
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i WriteResponseData(*ReqContext.REQUEST_CONTEXT, *Eof.INTEGER)
; __in PREQUEST_CONTEXT ReqContext,
; __out PBOOL Eof
; Routine Description:
; Write response To a file
;
; Arguments:
; ReqContext - Pointer To request context Structure
; Eof - Done With response
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected BytesWritten.i = 0
Protected Success.i
*Eof\i = #False
; // Finished receiving response
If (*ReqContext\DownloadedBytes = 0)
*Eof\i = #True
Goto Exit
EndIf
; // WriteFile is done inline here assuming that it will Return quickly
; // I.E. the file is on disk
; //
; // If you plan To do blocking/intensive operations they should be
; // queued To another thread And Not block the callback thread
Success = WriteFile_(*ReqContext\DownloadFile,
*ReqContext\OutputBuffer,
*ReqContext\DownloadedBytes,
@BytesWritten,
#Null)
If (Not Success)
Error = GetLastError_()
PrintN("ERROR WriteFile >"+Error+"<")
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i OpenFiles(*ReqContext.REQUEST_CONTEXT, Method.i, InputFilename.s, OutputFilename.s)
; __inout PREQUEST_CONTEXT ReqContext,
; __in DWORD Method,
; __in LPWSTR InputFileName,
; __in LPWSTR OutputFileName
; Routine Description:
; This routine opens files, one To post Data from, And
; one To write response into
;
; Arguments:
; ReqContext - Pointer To request context Structure
; Method - GET Or POST - do we need To open the input file
; InputFileName - Input file name
; OutputFileName - output file name
;
; Return Value:
; Error Code For the operation.
Protected Error.i=#ERROR_SUCCESS
If (Method = #METHOD_POST)
; // Open input file
*ReqContext\UploadFile = CreateFile_(InputFileName,
#GENERIC_READ,
#FILE_SHARE_READ,
#Null, ;// handle cannot be inherited
#OPEN_ALWAYS, ;// If file exists, open it
#FILE_ATTRIBUTE_NORMAL,
#Null) ; // No template file
If (*ReqContext\UploadFile = #INVALID_HANDLE_VALUE)
Error = GetLastError_()
PrintN("ERROR CreateFile for input file >"+InputFilename+"< Error >"+Error+"<")
Goto Exit
EndIf
EndIf
;// Open output file
*ReqContext\DownloadFile = CreateFile_(OutputFileName,
#GENERIC_WRITE,
0, ;// Open exclusively
#Null, ;// handle cannot be inherited
#CREATE_ALWAYS, ;// If file exists, delete it
#FILE_ATTRIBUTE_NORMAL,
#Null); // No template file
If (*ReqContext\DownloadFile = #INVALID_HANDLE_VALUE)
Error = GetLastError_()
PrintN("ERROR CreateFile for output file >"+OutputFilename+"< Error >"+Error+"<")
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i CreateWininetHandles(*ReqContext.REQUEST_CONTEXT, SessionHandle.i, HostName.s, Resource.s, IsSecureConnection.i)
; __inout PREQUEST_CONTEXT ReqContext,
; __in HINTERNET SessionHandle,
; __in LPWSTR HostName,
; __in LPWSTR Resource,
; __in BOOL IsSecureConnection
; Routine Description:
; Create connect And request handles
;
; Arguments:
; ReqContext - Pointer To Request context Structure
; SessionHandle - Wininet session handle used To create
; connect handle
; HostName - Hostname To connect
; Resource - Resource To get/post
; IsSecureConnection - SSL?
;
; Return Value:
; Error Code For the operation.
Protected Error.i = #ERROR_SUCCESS
Protected ServerPort = #INTERNET_DEFAULT_HTTP_PORT
Protected RequestFlags = 0
Protected Verb.s
; // Set the correct server port If using SSL
; // Also set the flag For HttpOpenRequest
If (IsSecureConnection)
ServerPort = #INTERNET_DEFAULT_HTTPS_PORT
RequestFlags = #INTERNET_FLAG_SECURE
EndIf
; // Create Connection handle And provide context For async operations
*ReqContext\ConnectHandle = InternetConnect_(SessionHandle,
HostName, ;// Name of the server To connect To
ServerPort, ;// HTTP (80) Or HTTPS (443)
#Null, ;// Do Not provide a user name For the server
#Null, ;// Do Not provide a password For the server
#INTERNET_SERVICE_HTTP,
0, ;// Do Not provide any special flag
*ReqContext) ; // Provide the context to be used during the callbacks
; // For HTTP InternetConnect returns synchronously because it does Not
; // actually make the connection.
; //
; // For FTP InternetConnect connects the control channel, And therefore
; // can be completed asynchronously. This sample would have To be
; // changed, so that the InternetConnect's asynchronous completion
; // is handled correctly To support FTP.
If (*ReqContext\ConnectHandle = #Null)
Error = GetLastError_()
PrintN("ERROR InternetConnect >"+Error+"<")
Goto Exit
EndIf
; // Set the Verb depending on the operation To perform
If (*ReqContext\Method = #METHOD_GET)
Verb = "GET"
Else
; ASYNC_ASSERT(ReqContext->Method == METHOD_POST);
Verb = "POST"
EndIf
; // We're overriding WinInet's Default behavior.
; // Setting these flags, we make sure we get the response from the server And Not the cache.
; // Also ask WinInet Not To store the response in the cache.
; //
; // These flags are Not performant And are only used To show Case WinInet's Async I/O.
; // A real WinInet application would Not want To use this flags.
RequestFlags = RequestFlags | #INTERNET_FLAG_RELOAD | #INTERNET_FLAG_NO_CACHE_WRITE
; // Create a Request handle
*ReqContext\RequestHandle = HttpOpenRequest_(*ReqContext\ConnectHandle,
Verb, ;// GET Or POST
Resource, ;// root "/" by Default
#Null, ;// Use Default HTTP/1.1 As the version
#Null, ;// Do Not provide any referrer
#Null, ;// Do Not provide Accept types
RequestFlags,
*ReqContext)
If (*ReqContext\RequestHandle = #Null)
Error = GetLastError_()
PrintN("ERROR HttpOpenRequest >"+Error+"<")
Goto Exit
EndIf
Exit:
ProcedureReturn Error
EndProcedure
Procedure.i CloseRequestHandle(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; Safely close the request handle by synchronizing
; With all threads using the handle.
;
; When this function returns no more calls can be made With the
; handle.
;
; Arguments:
; ReqContext - Pointer To Request context Structure
; Return Value:
; None.
Protected Close = #False
EnterCriticalSection_(*ReqContext\CriticalSection)
; // Current implementation only supports the main thread
; // kicking off the request handle close
; //
; // To support multiple threads the lifetime
; // of the request context must be carefully controlled
; // (most likely guarded by refcount/critsec)
; // so that they are Not trying To abort a request
; // where the context has already been freed.
; ASYNC_ASSERT(ReqContext->Closing == FALSE);
*ReqContext\Closing = #True
If (*ReqContext\HandleUsageCount = 0)
Close = #True
EndIf
LeaveCriticalSection_(*ReqContext\CriticalSection)
If (Close)
; // At this point there must be the guarantee that all calls
; // To wininet With this handle have returned With some value
; // including ERROR_IO_PENDING, And none will be made after
; // InternetCloseHandle.
InternetCloseHandle_(*ReqContext\RequestHandle)
EndIf
EndProcedure
Procedure.i AcquireRequestHandle(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; Acquire use of the request handle To make a wininet call
; Arguments:
; ReqContext - Pointer To Request context Structure
; Return Value:
; TRUE - Success
; FALSE - Failure
Protected Success.i = #True
EnterCriticalSection_(@*ReqContext\CriticalSection)
If(*ReqContext\Closing = #True)
Success = #False
Else
*ReqContext\HandleUsageCount+1
EndIf
LeaveCriticalSection_(@*ReqContext\CriticalSection)
ProcedureReturn Success
EndProcedure
Procedure.i ReleaseRequestHandle(*ReqContext.REQUEST_CONTEXT)
; __inout PREQUEST_CONTEXT ReqContext
; Routine Description:
; release use of the request handle
; Arguments:
; ReqContext - Pointer To Request context Structure
; Return Value:
; None.
Protected Close.i = #False
EnterCriticalSection_(*ReqContext\CriticalSection)
; ASYNC_ASSERT(ReqContext->HandleUsageCount > 0)
*ReqContext\HandleUsageCount-1
If (*ReqContext\Closing = #True And *ReqContext\HandleUsageCount = 0)
Close = #True
EndIf
LeaveCriticalSection_(*ReqContext\CriticalSection)
If (Close)
; // At this point there must be the guarantee that all calls
; // To wininet With this handle have returned With some value
; // including ERROR_IO_PENDING, And none will be made after
; // InternetCloseHandle.
InternetCloseHandle_(*ReqContext\RequestHandle)
EndIf
EndProcedure
Procedure ShowUsage()
; Routine Description:
; Shows the usage of the application.
;
; Arguments:
; None.
;
; Return Value:
; None.
PrintN("Usage: async [-m {GET|POST}] [-h <hostname>] [-o <resourcename>] [-s] [-p <proxyname>] [-w <output filename>] [-r <file to post>] [-t <userTimeout>]\n")
PrintN("Option Semantics:")
PrintN(~"-m : Specify method (Default: \"GET\")")
PrintN(~"-h : Specify hostname (Default: \""+#DEFAULT_HOSTNAME+~"\"")
PrintN(~"-o : Specify resource name on the server (Default: \""+#DEFAULT_RESOURCE+~"\")")
PrintN("-s : Use secure connection - https");
PrintN("-p : Specify proxy");
PrintN(~"-w : Specify file to write output to (Default: \""+#DEFAULT_OUTPUT_FILE_NAME+~"\")")
PrintN("-r : Specify file to post data from")
PrintN("-t : Specify time to wait in ms for operation completion (Default: "+#DEFAULT_TIMEOUT+")")
EndProcedure
If OpenConsole("MS Async Example")
wmain()
PrintN("Press return to close console")
Input()
CloseConsole()
EndIf