[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