Time limit for function execution 2

[flbos]

Hi all,

I'm using the function "URLDownloadToFile"
which I found here:

http://www.ex-designz.net/apidetail.asp?api_id=498

This works well but in some very rare cases a web page cannot be downloaded and Excel simply hangs when executing the function for that web page. The function doesn't seem to have an option to abort trying to download the page if it doesnt work after an X number of seconds so the code will hang forever in that case.

A solution I could think of would be to build in a timer that would measure how long the URLDownloadToFile function is already attempting to download a certain page. Then if for example a 60 second limit is reached, I would want to force to abort carrying out the URLDownloadToFile function and resuming in another point of my code.

Is something like this possible?

thanks!

 

[AnotherHiggins]

I'm pretty sure that will be impossible.

The problem is that the macro is hung on a single line of code. That means it will never move on to the next line to check the timer.

It's not a very elegant solution, but simply pressing [Esc] should stop the code - though it might take several seconds to respond to the command.

[tt][blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[flbos]

thanks for the reply! Well, pressing ESC is not really an option as the VBA routine I'm using is going through a long worksheet with a list of web pages so the routine should be able to go through the whole list without human input, you see?

Does everyone think it is impossible what I want? Maybe there are solutions someone can think of?

thanks

 

[mintjulep]

From the documentation where you found it:

Address of the controlling IUnknown interface of the calling Microsoft® ActiveX® component (if the caller is an ActiveX component). If the calling application is not an ActiveX component, this value can be set to NULL. Otherwise, the caller is a Component Object Model (COM) object that is contained in another component (such as an ActiveX control within the context of an HTML page). This parameter represents the outermost IUnknown of the calling component. bThe function attempts the download within the context of the ActiveX client framework and allows the caller's container to receive callbacks on the progress of the download.

 

[flbos]

hmm ok thanks for that info, I didn't notice that.

However, I'm afraid I'm also not sure how to implement these "callbacks". Would I be able to build this into my VBA routine?

If so, how would I do this? Maybe someone has an example?

 

[strongm]

>Would I be able to build this into my VBA routine?


Yep - but it isn't straightforward. For a start you'll need a type library:

http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip

 

[flbos]

hmm thanks ok this is not straightforward indeed.

Does someone have maybe an example of something that is comparable to what I need to implement here?

Of course I'm not asking for someone to do my programming work but a rough example of something that is comparable to the code I would need would be a big help!

 

[strongm]

Oh, I've knocked together an example of how to do it with URLDownloadToFile - but if the type library was offputting to you I didn't want to post it.

 

[flbos]

not sure what you mean now? I hope I didnt give you the impression that I didn't appreciate your post. What I meant was that I didn't really know how to get started with this type library you see?

With an example of how to use such a library, also in relation to URLDownloadToFile, I think I could manage to implement that in my own routine

 

[strongm]

>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):

[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:

[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):

[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:

[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 ...

 

[strongm]

Hello ...

 

[flbos]

Thank you very much for this very elaborate explanation!

Sorry that I respond a bit slow but I was stuck on some other things for a few days I will try this solution asap and post back if it indeed works, after reading this I do think that this would indeed solve the problem!

cheers

 

[strongm]

Got it working?

 

[flbos]

still working on it, I got started with it, couldnt get it to work but I should take a bit more time, thing is that I'm not programming normally so I have to fit it in somehow

will post again soon once I had more time to finish it and get it to work, assuming that I will succeed