>I hope I didnt give you the impression that I didn't appreciate your post
Not at all. I just thought that you perhaps found the library a little intimidating and not perhaps the direction you wanted to go. But, since you seem interested, and since I've already written an example with a working timeout ...
Let's just start with some background.
Firstly, as MintJulep's post focussed on the wrong parameter of the URLDownloadToFile API declaration. The one of real interest is
· lpfnCB
Address of the caller's IBindStatusCallback interface. URLDownloadToFile calls this interface's IBindStatusCallback::OnProgress method on a connection activity, including the arrival of data. IBindStatusCallback::OnDataAvailable is never called. Implementing IBindStatusCallback::OnProgress allows a caller to implement a user interface or other progress monitoring functionality. It also allows the download operation to be canceled by returning E_ABORT from the IBindStatusCallback::OnProgress call. This can be set to NULL.
Ignoring the gobbledegook for now, we can see that this seems to be talking about a callback. And a callback is where a function that you have called can in turn call a function that you nominate (and provide the code for). In many ways it is like a COM event. Indeed, callbacks used in COM components are often presented to the outside world as events.
And that is what is happening here. A number of callback functions are being presented as events on the IBindStatusCallback interface (which you can consider to be an object).
The big problem is that IBindStatusCallback is not a class that VBA understands, so you won't find it under References.
The Type Library simply wraps a definition around the IBindStatusCallback interface (and many others that we don't care about) so that VBA understands it
So, step 1 is to download the library, and then extract olelib.tlb and olelib.odl preferably into your System32 (or SysWOW64 if Vista or Windows 7) folder - although you can actually put them where you like.
Now we can add this library (the tlb) to our application through References. It won't appear (initially) as an item you can tick to select, so you'll have to Browse to it and choose it. Now it should appear as a ticked item in your references called "Edanmo's OLE interfaces and functions v1.81"
Splendid. So now we just need to implement that interface ... add a code module and simply add
Implements olelib.IBindStatusCallback
and then add an empty function for each of the methods exposed by the interface (you can find their prototypes i the IDE's Object Browser). 4 of them need an actual implementation (i.e need to have some code in them), the others can be void. The only one we're going to add anything beyond a DoEvents t is OnProgress.
You also want to wrap the URLFileDownload function into the class, and tell it which class (itself) implements the IBindStatusCallback interface that we are using ...
So here's a short, not very useful version of that class (a rather boring Class1):
Code:
[blue]Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
'Let our class Implement the IBindStatusCallback interface
Implements olelib.IBindStatusCallback
Public Function DownloadFile(ByVal URL As String, ByVal LocalFile As String) As Long
Dim lngResult As Long
'Start downloading
DownloadFile = olelib.URLDownloadToFile(Nothing, URL, LocalFile, 0, Me)
'Success / Error message
'DownloadFile = lngResult
End Function
Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As olelib.BINDF, pbindinfo As olelib.BINDINFO)
DoEvents
End Sub
Private Function IBindStatusCallback_GetPriority() As Long
End Function
Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As olelib.BSCF, ByVal dwSize As Long, pformatetc As olelib.FORMATETC, pStgmed As olelib.STGMEDIUM)
End Sub
Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)
End Sub
Private Sub IBindStatusCallback_OnObjectAvailable(riid As olelib.UUID, ByVal pUnk As stdole.IUnknown)
End Sub
Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As olelib.BINDSTATUS, ByVal szStatusText As Long)
Debug.Print Format((ulProgress / ulProgressMax), "0.00%")
'ulProgress: current progress
'ulProgressMax: max progress
'ulStatusCode: code for the current operation
'szStatusText: memory address of string with extended information
End Sub
Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As olelib.IBinding)
DoEvents
End Sub
Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)
DoEvents
End Sub
[/blue]
And here's an example of how you might call it:
Code:
[blue]Public Sub test()
Dim fred As Class1
Dim result As Long
Set fred = New Class1
DeleteUrlCacheEntry "[URL unfurl="true"]http://www.lottolab.org/downloads/bees/bee1.mov"[/URL] ' for purpose of example we don't want to be using a cached version
result = fred.DownloadFile("[URL unfurl="true"]http://www.lottolab.org/downloads/bees/bee1.mov",[/URL] "d:\temp\test2.mov")
Select Case result
Case S_OK
MsgBox "File transferred"
Case E_ABORT
MsgBox "Aborted: don't know why"
Case Else
MsgBox "Um - dunno, something else went wrong ..."
End Select
End Sub[/blue]
The problem is that there doesn't appear to be an obvious way of aborting the download even with these callbacks. However, a quick peruse of the documentation for IBindStatusCallback on MSDN suggests that we can abort a download simply by returning E_ABORT from any of the callbacks ... ah ...hmm ... all the callbacks in the IBindStatusCallback interface are documented as functions - but our library defines them as Subs, so we cannot return a value (this is historical: Edanmo Morcello implemented most of the stuff in his library as Subs originally and then slowly upated those where it was necessary to functions in each new release of the library. And then he stopped, and moved on to VB.NET before he had updated all of the prototypes. Sadly IBindStatusCallback is one of the ones he did not complete).
So, does that mean we are stuck?
Not quite ... more reading of the documentation tells us that there is at least one more Interface associated with the 'Binding' that IBindStatusCallback provides the Status for - IBinding itself ...
And the IBinding interface has an Abort method. SO, how do we get the IBind interface? Well, happily it is provided to us in the OnStartBinding event. So, here's a longer version that implements an abort when a specified time is exceeded. This only necessitates adding a small amount of code. This is the new class (I happen to have called it URL):
Code:
[blue]Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private mTimeOut As Long ' time out in milliseconds
Private mStartTime As Long
Private mBinding As IBinding
Private mFlagTimeOut As Boolean
'Let our class Implement the IBindStatusCallback interface
Implements olelib.IBindStatusCallback
Public Property Let TimeOut(msecs As Long)
mTimeOut = msecs
End Property
Public Property Get TimeOut() As Long
TimeOut = mTimeOut
End Property
Public Property Get TimedOut() As Boolean
TimedOut = mFlagTimeOut
End Property
Public Function DownloadFile(ByVal URL As String, ByVal LocalFile As String) As Long
Dim lngResult As Long
mFlagTimeOut = False
mStartTime = GetTickCount
'Start downloading
DownloadFile = olelib.URLDownloadToFile(Nothing, URL, LocalFile, 0, Me) 'Me tells the function that this class will provide the callback implementation
End Function
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
Set mBinding = Nothing
End Sub
Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As olelib.BINDF, pbindinfo As olelib.BINDINFO)
DoEvents
End Sub
Private Function IBindStatusCallback_GetPriority() As Long
End Function
Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As olelib.BSCF, ByVal dwSize As Long, pformatetc As olelib.FORMATETC, pStgmed As olelib.STGMEDIUM)
End Sub
Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)
End Sub
Private Sub IBindStatusCallback_OnObjectAvailable(riid As olelib.UUID, ByVal pUnk As stdole.IUnknown)
End Sub
Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As olelib.BINDSTATUS, ByVal szStatusText As Long)
If mTimeOut > 0 And GetTickCount - mStartTime < mTimeOut Then
'ulProgress: current progress
'ulProgressMax: max progress
'ulStatusCode: code for the current operation
'szStatusText: memory address of string with extended information
ElseIf mTimeOut > 0 Then
mBinding.Abort ' abandon ship here ...
mFlagTimeOut = True
End If
End Sub
Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As olelib.IBinding)
Set mBinding = pib ' grab the IBinding interface
End Sub
Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)
DoEvents
End Sub[/blue]
And the following is an example of how to call it:
Code:
[blue]Option Explicit
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Sub example()
Dim fred As URL
Dim result As Long
Set fred = New URL
fred.TimeOut = 1000
DeleteUrlCacheEntry "[URL unfurl="true"]http://www.lottolab.org/downloads/bees/bee1.mov"[/URL] ' for purpose of example we don't want to be using a cached version
result = fred.DownloadFile("[URL unfurl="true"]http://www.lottolab.org/downloads/bees/bee1.mov",[/URL] "d:\temp\test2.mov")
Select Case result
Case S_OK
MsgBox "File transferred"
Case E_ABORT
If fred.TimedOut Then
MsgBox "Timed out after " & fred.TimeOut & " milliseconds"
Else
MsgBox "Aborted" ' we can't know why for certain
End If
Case Else
MsgBox "Um - dunno, something else went wrong ..."
End Select
End Sub[/blue]
So there you have it. A method of implementing URLDownloadToFile with a user configurable timeout ...
