[Lazarus] WinINet STDCALL callback crash

[matthew at accordancebible.com]

Ludo, 

Thank you very much for your most informative posting.  I have spent the week trying to implement the msdn examples in pure Pascal and in Pascal-DLL hybrids.  Success in non-threaded asynchrosity eludes me though.  

Your example (http://www.lazarus.freepascal.org/index.php?topic=18506.15#msg105226) using URLMON's URLDownloadToFile works perfectly.  However, the example is synchronous whilst we need asynchronous.  Research indicates that URLOpenPullStream is the more relevant function in our case (because we download asynchronously to both memory streams and files, depending on what flags the user sets and can track the progress of the download).  The problem is that URLOpenPullStream and URLDownloadToFile (which I am using as an intermediate coding step) both require a variable of a type that implements the IBindStatusCallback interface, which in turn requires declaration of the IBinding interface.  I have tried doing so without success; I share my code below.  

Is there a way to access the UrlMon.dll's definition of IBindStatus and IBinding so that these interfaces are available within Lazarus?  Currently, the only option I see is to define these interfaces myself.  Alternatively, is there an example of a Lazarus definition of these interfaces?

FYI, after the program segfaults, the assembler window points within urlmon!ZonesReInit

Thank you for any help you might provide.

Matthew

-------------------------------Top (Global) Level-------------------------------------------------------

INTERFACE

TYPE
	PIUnknown = ^IUnknown;

	BINDINFO = RECORD
	  cbSize: ULONGLONG;
	  szExtraInfo: LPWSTR;
	  stgmedData: STGMEDIUM;
	  grfBindInfoF: DWORD;
	  dwBindVerb: DWORD;
	  szCustomVerb: LPWSTR;
	  cbStgmedData: DWORD;
	  dwOptions: DWORD;
	  dwOptionsFlags: DWORD;
	  dwCodePage: DWORD;
	  securityAttributes: SECURITY_ATTRIBUTES;
	  iid1: GUID;
	  pUnk: PIUnknown;
	  dwReserved: DWORD;
	END;

	IBinding = INTERFACE (IUnknown)
		FUNCTION Abort(): HRESULT;
		FUNCTION GetBindResult(VAR pclsidProtocol: CLSID; VAR pdwResult: CLSID;
														VAR pszResult: LPOLESTR; VAR pdwReserved: DWORD): HRESULT;
		FUNCTION GetPriority(VAR pnPriority: LongInt): HRESULT;
		FUNCTION Resume(): HRESULT;
		FUNCTION SetPriority(nPriority: LongInt): HRESULT;
		FUNCTION Suspend(): HRESULT;
	END;

	PIBinding = ^IBinding;

  IBindStatusCallback = INTERFACE(IUnknown)
		{ // IUnknown members }
		Function QueryInterface(constref iid: tguid; out obj): longint stdcall; //Object Pascal--needs modification
		{ //Function IUnknown.QueryInterface(constref iid: tguid; VAR obj: Object): longint stdcall; //possible modification }
		Function _AddRef: longint stdcall;
		Function _Release: longint stdcall;

		FUNCTION GetBindInfo(VAR grfBINDF: DWORD; VAR bindinfo: BINDINFO): HRESULT; STDCALL;
		FUNCTION GetPriority(VAR pnPriority: LongInt): HRESULT; STDCALL;
		FUNCTION OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; pformatetc: PFORMATETC; pstgmed: PSTGMEDIUM): HRESULT; STDCALL;
		PROCEDURE OnLowResource(); STDCALL;
		FUNCTION OnObjectAvailable(riid: REFIID; punk: PIUnknown): HRESULT; STDCALL;
		FUNCTION OnProgress(ulProgress: ULONGLONG; ulProgressMax: ULONGLONG; ulStatusCode: ULONGLONG; szStatusText: LPCWSTR): HRESULT; STDCALL;
		FUNCTION OnStartBinding(dwReserved: DWORD; pib: PIBinding): HRESULT; STDCALL;
		FUNCTION OnStopBinding(hresult1: HRESULT; szError: LPCWSTR): HRESULT; STDCALL;
	END;


{----------------------- IBindStatusCallback stuff -----------------------}
		TBindStatusCallback = CLASS(IBindStatusCallback)
			PUBLIC
				{ // IUnknown members }
				Function QueryInterface(constref iid: tguid; out obj): longint stdcall; //Object Pascal--needs modification
				{ //Function IUnknown.QueryInterface(constref iid: tguid; VAR obj: Object): longint stdcall; //possible modification }
				Function _AddRef: longint stdcall;
				Function _Release: longint stdcall;

				{ IBindStatusCallback members }
				FUNCTION GetBindInfo(VAR grfBINDF: DWORD; VAR bindinfo: BINDINFO): HRESULT; STDCALL;
				FUNCTION GetPriority(VAR pnPriority: LongInt): HRESULT; STDCALL;
				FUNCTION OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; pformatetc: PFORMATETC; pstgmed: PSTGMEDIUM): HRESULT; STDCALL;
				PROCEDURE OnLowResource(); STDCALL;
				FUNCTION OnObjectAvailable(riid: REFIID; punk: PIUnknown): HRESULT; STDCALL;
				FUNCTION OnProgress(ulProgress: ULONGLONG; ulProgressMax: ULONGLONG; ulStatusCode: ULONGLONG; szStatusText: LPCWSTR): HRESULT; STDCALL;
				FUNCTION OnStartBinding(dwReserved: DWORD; pib: PIBinding): HRESULT; STDCALL;
				FUNCTION OnStopBinding(hresult1: HRESULT; szError: LPCWSTR): HRESULT; STDCALL;
			END;

VAR
		gBindStatusCallback: TBINDSTATUSCALLBACK; {TBINDSTATUSCALLBACK;}

IMPLEMENTATION

FUNCTION TBindStatusCallback.QueryInterface(constref iid: tguid; out obj): longint stdcall;
BEGIN
	QueryInterface := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback._AddRef: longint stdcall;
BEGIN
	_AddRef := E_NOTIMPL;
END;

Function TBindStatusCallback._Release: longint stdcall;
BEGIN
	_Release := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback.GetBindInfo(VAR grfBINDF: DWORD; VAR bindinfo: BINDINFO): HRESULT; STDCALL;
BEGIN
	GetBindInfo := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback.GetPriority(VAR pnPriority: LongInt): HRESULT; STDCALL;
BEGIN
	GetPriority := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; pformatetc: PFORMATETC; pstgmed: PSTGMEDIUM): HRESULT; STDCALL;
		VAR
			breakpoint: INT;
BEGIN
	breakpoint := 4;
END;

PROCEDURE TBindStatusCallback.OnLowResource(); STDCALL;
BEGIN
	;
END;

FUNCTION TBindStatusCallback.OnObjectAvailable(riid: REFIID; punk: PIUnknown): HRESULT; STDCALL;
BEGIN
	OnObjectAvailable := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback.OnProgress(ulProgress: ULONGLONG; ulProgressMax: ULONGLONG; ulStatusCode: ULONGLONG; szStatusText: LPCWSTR): HRESULT; STDCALL;
		VAR
			breakpoint: INT;
BEGIN
	breakpoint := 5;
END;

FUNCTION TBindStatusCallback.OnStartBinding(dwReserved: DWORD; pib: PIBinding): HRESULT; STDCALL;
BEGIN
	OnStartBinding := E_NOTIMPL;
END;

FUNCTION TBindStatusCallback.OnStopBinding(hresult1: HRESULT; szError: LPCWSTR): HRESULT; STDCALL;
BEGIN
	OnStopBinding := E_NOTIMPL;
END;



	PROCEDURE DownloadURL (theURLString: Str;
				outputStream: TMemoryStream;
				toFile: TFile;
				outputFile, name, pass: Str);
        BEGIN
		dest:='C:\Windows\temp\data.txt';
		IF URLDownloadToFile(NIL, PChar(theURLString), PChar(Dest), 0, @gBindStatusCallback)=0 THEN

       END;






-----Original Message-----
From: "Ludo Brands" <ludo.brands at free.fr>
Sent: Sunday, February 24, 2013 5:04am
To: lazarus at lists.lazarus.freepascal.org
Subject: Re: [Lazarus] WinINet STDCALL callback crash

On 02/23/2013 09:49 PM, matthew at accordancebible.com wrote:
> 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
  conditio
n 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.  
> 

You are trying to read the complete HTTP reply inside the callback which
will not work. ERROR_IO_PENDING just means that the data for the next
buffer is not there yet. The callback function is called for every
buffer you receive from the server and you should have only one
InternetReadFile per INTERNET_STATUS_REQUEST_COMPLETE. So when the HTTP
reply takes many buffers you will get many callbacks and in every
callback you are supposed to read the buffer received with one single
InternetReadFile,

Take a look at this example on how to set up async processing:
http://msdn.microsoft.com/en-us/library/windows/desktop/cc185684(v=vs.85).aspx.
You'll notice the AcquireRequestHandle function that uses a
EnterCriticalSection to lock the context. In your code you are not
locking anything and your "recursive" entry in the callback is just
using the same context which is the probable cause of your crash.

STDCALL callbacks are used commonly in Freepascal and are not a problem
at all.

If you just want to download an url to file the easy way using the
windows framework take a look at this post
http://www.lazarus.freepascal.org/index.php?topic=18506.15#msg105226

Ludo

--
_______________________________________________
Lazarus mailing list
Lazarus at lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus