[Lazarus] WinINet STDCALL callback crash
matthew at accordancebible.com
matthew at accordancebible.com
Sat Feb 23 21:49:45 CET 2013
Hello Lazarus Community,
I am implementing asynchronous file download using WinINet's STDCALL callback. However, when the callback function recursively calls itself, it generates a crash around fpc_popaddrstack. I hypothesize that Pascal does not understand how to handle callbacks that use the stdcall convention (which I must use since the callback interfaces with the Win32 API and is itself set via the Win32 WinINet procedure InternetSetStatusCallback).
I was wondering if anyone might graciously offer guidance on how to implement asynchronous download to file using the Win32 API or associated libraries only. Note that I have tried WinHTTP and a different implementation of WinINet using InternetConnect/InternetOpenRequest/InternetSendRequest/InternetReadFile). In the previous two implementations I have encountered the same segmentation fault around fpc_popaddrstack. Based on my experience with the below code and other STDCALL implementations, I do not think that Free Pascal can handle the case where a STDCALL function interrupts itself recursively. In the STDCALL convention, the callee is responsible for cleaning up the stack upon function exit. However, because the function in question (HttpCallback) has been interrupted by a second call to it from the Windows API, it has not had a chance to clean up the stack (because it has not had a chance to exit and thereby execute the epilogue code that cleans up the stack). The condition that causes the callback to interrupt itself is when InternetReadFile errors out with ERROR_IO_PENDING. In this circumstance, InternetReadFile also sends back an INTERNET_STATUS_REQUEST_COMPLETE message which interrupts the currently executing HttpCallback function.
To state the exact circumstance of the crash: when not stepping through, InternetReadFile below errors out frequently with ERROR_IO_PENDING. This is fine except that InternetReadFile ALSO recursively triggers the callback, which after the second recursive call causes a crash.
My current code is as follows. I've added inline comments around the parts that seem to crash. Thank you very much for any asssistance you can provide.
<PRE>
PROCEDURE HttpCallback(hInternet: HINTERNET;
dwContext: DWORD_PTR;
dwInternetStatus: DWORD;
lpvStatusInformation: LPVOID;
dwStatusInformationLength: DWORD); STDCALL;
TYPE
PMAIN_CONTEXT = ^MAIN_CONTEXT;
PAPP_CONTEXT = ^APP_CONTEXT;
VAR
dwError, dwBytes, dwBytesRead, dwStructType: DWORD ;
pDwStructType: DWORD_PTR;
pMainContext: PMAIN_CONTEXT;
pAppContext: PTR;
bQuit: BOOLEAN;
mainContext: MAIN_CONTEXT;
appContext: APP_CONTEXT;
handlePtr: LongWord;
internetAsyncResult1: INTERNET_ASYNC_RESULT;
responseString: Str;
statusCode, length, lpdwIndex: DWORD;
success: BOOLEAN;
breakpoint: INT;
hasError: BOOLEAN;
BEGIN
dwBytes := 0;
bQuit := FALSE;
dwStructType := Ptr(dwContext)^;
IF dwStructType = STRUCT_TYPE_MAIN_CONTEXT THEN
BEGIN
mainContext := PMAIN_CONTEXT(dwContext)^
END
ELSE
BEGIN
appContext := PAPP_CONTEXT(dwContext)^;
END;
CASE dwInternetStatus OF
INTERNET_STATUS_HANDLE_CREATED:
BEGIN
{Verify we've a valid pointer}
IF lpvStatusInformation <> NIL THEN
BEGIN
internetAsyncResult1 := INTERNET_ASYNC_RESULT(Pointer(lpvStatusInformation)^);
IF (dwStructType = STRUCT_TYPE_MAIN_CONTEXT) THEN
BEGIN
IF mainContext.hConnect = NIL THEN
BEGIN
mainContext.hConnect := Ptr(internetAsyncResult1.dwResult);
{ This saves the hConnect handle to the global gNetworkStream.mainContext variable. }
PMAIN_CONTEXT(dwContext)^.hConnect := Ptr(internetAsyncResult1.dwResult);
END;
END;
END;
END; { end CASE dwInternetStatus of INTERNET_STATUS_HANDLE_CREATED }
INTERNET_STATUS_REQUEST_COMPLETE:
BEGIN
internetAsyncResult1 := INTERNET_ASYNC_RESULT(Pointer(lpvStatusInformation)^);
IF internetAsyncResult1.dwError = ERROR_SUCCESS THEN
BEGIN
ZeroMemory(@gABuffer, sizeof(gABuffer));
dwError := ERROR_SUCCESS;
dwBytes := sizeof(gABuffer);
dwBytesRead := 0;
success := InternetReadFile(gNetworkStream.mainContext.hConnect,
@gABuffer,
dwBytes,
dwBytesRead);
IF success THEN
BEGIN
gNetworkStream.theOutputFile.PosWriteFile(@gABuffer,
kTFileAtMark,
dwBytesRead, { nBytes: LONGINT; }
TRUE, { showIOErrAlert: BOOLEAN; }
hasError);
WHILE success AND (dwBytesRead > 0) AND (NOT hasError) DO
BEGIN
{ When not stepping through, InternetReadFile below errors out frequently with
ERROR_IO_PENDING. This is fine except that InternetReadFile ALSO recursively
triggers the callback, which after the second recursive call causes a crash }
success := InternetReadFile(gNetworkStream.mainContext.hConnect,
@gABuffer,
dwBytes,
dwBytesRead);
IF success THEN
BEGIN
gNetworkStream.theOutputFile.PosWriteFile(@gABuffer,
kTFileAtMark,
dwBytesRead, { nBytes: LONGINT; }
TRUE, { showIOErrAlert: BOOLEAN; }
hasError);
END
ELSE
BEGIN
dwError := GetLastError;
breakpoint := 2;
IF dwError = ERROR_IO_PENDING THEN
BEGIN
{ breakpoint to make the code stop here so we can verify that dwError is ERROR_IO_PENDING }
breakpoint := 3;
END;
END;
END;
breakpoint := 3;
{ the below case (bytes read = 0 and no dwError) means the file has finished downloading }
IF (dwBytesRead = 0) AND (dwError = ERROR_SUCCESS) THEN
BEGIN
breakpoint := 4;
END;
END; { end first IF success }
END; { END IF internetAsyncResult1.dwError = ERROR_SUCCESS }
END; { end CASE dwInternetStatus of INTERNET_STATUS_REQUEST_COMPLETE }
END; { end CASE dwInternetStatus }
END;
//snippet of code from the program that sets up the download session and callback
PROCEDURE DownloadURL (theURLString: Str; { Helper function, use DownloadURLTo___ instead. }
outputStream: TMemoryStream;
toFile: TFile;
outputFile, name, pass: Str);
CONST
kPOSTTypeGET = 'GET';
kPOSTTypePOST = 'POST';
kPOSTTypeHEAD = 'HEAD';
VAR
thePOSTType: Str;
hasError: BOOLEAN;
dwError : DWORD;
dwFlags: DWORD;
cbStatusCode: DWORD;
lpdwIndex: DWORD;
status: Integer;
acceptTypesArray: ARRAY[0..1] OF Str;
BEGIN (* DownloadURL *)
gTheBytesRead := 0;
hasError := FALSE;
acceptTypesArray[0] := '*/*';
acceptTypesArray[1] := '';
gNetworkStream.hRequest := Nil;
dwError := ERROR_SUCCESS;
gTheStream := outputStream;
thePOSTType := kPOSTTypeGET;
{ Create Session handle and specify Async Mode }
gNetworkStream.mainContext.hSession := InternetOpen('WinInet HTTP Async Session', { User Agent }
dwOpenType, { Preconfig or Proxy }
g_proxy, { g_proxy name }
NIL, { g_proxy bypass, do not bypass any address }
INTERNET_FLAG_ASYNC); { 0 for Synchronous }
IF gNetworkStream.mainContext.hSession = Nil THEN
BEGIN
dwError := GetLastError();
GOTO quit;
END;
{ Set the dwStatus callback for the handle to the Callback function }
httpCallbackPtr := InternetSetStatusCallback(gNetworkStream.mainContext.hSession,
INTERNET_STATUS_CALLBACK( HttpCallBack ));
IF httpCallbackPtr = INTERNET_INVALID_STATUS_CALLBACK THEN
BEGIN
dwError := GetLastError();
GOTO quit;
END;
IF CrackHostAndPath(theURLString, g_hostName, g_resource) <> ERROR_SUCCESS THEN
BEGIN
dwError := GetLastError();
GOTO quit;
END;
IF toFile <> NIL THEN
BEGIN
OpenTFile(toFile, hasError);
IF NOT hasError THEN
SetFilePosition(toFile, 0, fsFromStart, hasError);
gNetworkStream.theOutputFile := toFile;
END;
{ Create Connection handle and provide context for async operations }
InternetOpenUrl(gNetworkStream.mainContext.hSession,
PCHAR(theURLString),
NIL, { do not provide additional Headers }
0, { dwHeadersLength }
INTERNET_FLAG_RELOAD OR INTERNET_FLAG_PRAGMA_NOCACHE OR INTERNET_FLAG_NO_CACHE_WRITE,
DWORD_PTR(@gNetworkStream.mainContext)); {Provide the context to be used during the callbacks}
</PRE>
More information about the Lazarus
mailing list