Code: Select all
; ----------------------------------------------------------------------------
;
; Asyncronous download with Callback
;
; by Timo Harter
;
; ----------------------------------------------------------------------------
;
; Usage:
;
; DownloadFile(Url$, SaveTo$, WindowID, Callback)
;
; Url$ Source Url to download from
; SaveTo$ Target File on disk
; WindowID ID of any window, that will stay open until the download finishes
; (used for internal communication)
; Callback Address of a callback function to receive status information
;
; Callback Procedure:
;
; Procedure.l DownloadCallback(Url$, Progress.l, FileSize.l, StatusCode.l, StatusMessage$)
;
; ProcedureReturn 1
; EndProcedure
;
; Url$ Url of the current download
; Progress Bytes downloaded
; If download finished successfully, #DOWNLOAD_OK is returned (-1)
; If download failed, or was aborted, #DOWNLOAD_FAILED is returned (-2)
; FileSize Total size of file (may change during download)
; StatusCode Information code on download status. For more info go here:
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wceurlmn/html/cerefbindstatus.asp
; StatusMessage$ Additional Information on StatusCode
;
;
; Return a nonzero value to continue the download, or zero to abort it.
;
; Note: Any number of downloads can be started simultanously, each can
; have it's own callback, or they can also use the same if you want. The Url$
; parameter can then be used to find out to which file the information belongs.
;
; ----------------------------------------------------------------------------
#DOWNLOAD_OK = -1
#DOWNLOAD_FAILED = -2
#WM_DOWNLOADPROGRESS = #WM_USER + 1
#WM_DOWNLOADEND = #WM_USER + 2
Enumeration 1
#BINDSTATUS_FINDINGRESOURCE
#BINDSTATUS_CONNECTING
#BINDSTATUS_REDIRECTING
#BINDSTATUS_BEGINDOWNLOADDATA
#BINDSTATUS_DOWNLOADINGDATA
#BINDSTATUS_ENDDOWNLOADDATA
#BINDSTATUS_BEGINDOWNLOADCOMPONENTS
#BINDSTATUS_INSTALLINGCOMPONENTS
#BINDSTATUS_ENDDOWNLOADCOMPONENTS
#BINDSTATUS_USINGCACHEDCOPY
#BINDSTATUS_SENDINGREQUEST
#BINDSTATUS_CLASSIDAVAILABLE
#BINDSTATUS_MIMETYPEAVAILABLE
#BINDSTATUS_CACHEFILENAMEAVAILABLE
#BINDSTATUS_BEGINSYNCOPERATION
#BINDSTATUS_ENDSYNCOPERATION
#BINDSTATUS_BEGINUPLOADDATA
#BINDSTATUS_UPLOADINGDATA
#BINDSTATUS_ENDUPLOADINGDATA
#BINDSTATUS_PROTOCOLCLASSID
#BINDSTATUS_ENCODING
#BINDSTATUS_VERFIEDMIMETYPEAVAILABLE
#BINDSTATUS_CLASSINSTALLLOCATION
#BINDSTATUS_DECODING
#BINDSTATUS_LOADINGMIMEHANDLER
#BINDSTATUS_CONTENTDISPOSITIONATTACH
#BINDSTATUS_FILTERREPORTMIMETYPE
#BINDSTATUS_CLSIDCANINSTANTIATE
#BINDSTATUS_IUNKNOWNAVAILABLE
#BINDSTATUS_DIRECTBIND
#BINDSTATUS_RAWMIMETYPE
#BINDSTATUS_PROXYDETECTING
#BINDSTATUS_ACCEPTRANGES
EndEnumeration
Structure IBindStatusCallback_Functions
QueryInterface.l
AddRef.l
Release.l
OnStartBinding.l
GetPriority.l
OnLowResource.l
OnProgress.l
OnStopBinding.l
GetBindInfo.l
OnDataAvailable.l
OnObjectAvailable.l
EndStructure
Structure StatusObject
*IBindStatusCallback.IBindStatusCallback_Functions
Url.s
SaveTo.s
Callback.l
CallWindow.l
Progress.l
ProgressMax.l
StatusCode.l
*StatusText
ObjectCount.l
EndStructure
Global IBindStatusCallback_Functions.IBindStatusCallback_Functions
Global NewList StatusObject.StatusObject()
Procedure.l StatusObject_QueryInterface(*THIS.StatusObject, *iid.IID, *Object.Long)
If CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IBindStatusCallback, SizeOf(IID))
*Object\l = *THIS
ProcedureReturn #S_OK
Else
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure.l StatusObject_AddRef(*THIS.StatusObject)
*THIS\ObjectCount + 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure.l StatusObject_Release(*THIS.StatusObject)
*THIS\ObjectCount - 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure.l StatusObject_OnStartBinding(*THIS.StatusObject, reserved.l, *IB.IBinding)
ProcedureReturn #S_OK
EndProcedure
Procedure.l StatusObject_GetPriority(*THIS.StatusObject, *Priority.Long)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l StatusObject_OnLowResource(*THIS.StatusObject)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l StatusObject_OnProgress(*THIS.StatusObject, Progress.l, ProgressMax.l, StatusCode.l, szStatusText.l)
*THIS\Progress = Progress
*THIS\ProgressMax = ProgressMax
*THIS\StatusCode = StatusCode
length = WideCharToMultiByte_(#CP_ACP, 0, szStatusText, -1, 0, 0, 0, 0)
*String = HeapAlloc_(GetProcessHeap_(), 0, length)
WideCharToMultiByte_(#CP_ACP, 0, szStatusText, -1, *String, length, 0, 0)
*THIS\StatusText = *String
Result = SendMessage_(*THIS\CallWindow, #WM_DOWNLOADPROGRESS, 0, *THIS)
HeapFree_(GetProcessHeap_(), 0, *String)
If Result = #False
ProcedureReturn #E_ABORT
Else
ProcedureReturn #S_OK
EndIf
EndProcedure
Procedure.l StatusObject_OnStopBinding(*THIS.StatusObject, Result.l, szError.l)
ProcedureReturn #S_OK
EndProcedure
Procedure.l StatusObject_GetBindInfo(*THIS.StatusObject, BINDF.l, *bindinfo)
ProcedureReturn #S_OK
EndProcedure
Procedure.l StatusObject_OnDataAvailable(*THIS.StatusObject, BSCF.l, Size.l, *formatec, *stgmed)
ProcedureReturn #S_OK
EndProcedure
Procedure.l StatusObject_OnObjectAvailable(*THIS.StatusObject, *iid.IID, *UNK.IUnknown)
ProcedureReturn #S_OK
EndProcedure
IBindStatusCallback_Functions\QueryInterface = @StatusObject_QueryInterface()
IBindStatusCallback_Functions\AddRef = @StatusObject_AddRef()
IBindStatusCallback_Functions\Release = @StatusObject_Release()
IBindStatusCallback_Functions\OnStartBinding = @StatusObject_OnStartBinding()
IBindStatusCallback_Functions\GetPriority = @StatusObject_GetPriority()
IBindStatusCallback_Functions\OnLowResource = @StatusObject_OnLowResource()
IBindStatusCallback_Functions\OnProgress = @StatusObject_OnProgress()
IBindStatusCallback_Functions\OnStopBinding = @StatusObject_OnStopBinding()
IBindStatusCallback_Functions\GetBindInfo = @StatusObject_GetBindInfo()
IBindStatusCallback_Functions\OnDataAvailable = @StatusObject_OnDataAvailable()
IBindStatusCallback_Functions\OnObjectAvailable = @StatusObject_OnObjectAvailable()
Procedure Download_Thread(*THIS.StatusObject)
Result.l = UrlDownloadToFile_(0, *THIS\Url, *THIS\SaveTo, 0, *THIS)
SendMessage_(*THIS\CallWindow, #WM_DOWNLOADEND, Result, *THIS)
EndProcedure
Procedure Download_WindowCallback(Window.l, message.l, wParam.l, lParam.l)
If message = #WM_DOWNLOADPROGRESS
*THIS.StatusObject = lParam
ProcedureReturn CallFunctionFast(*THIS\Callback, *THIS\Url, *THIS\Progress, *THIS\ProgressMax, *THIS\StatusCode, PeekS(*THIS\StatusText))
ElseIf message = #WM_DOWNLOADEND
If wParam = #S_OK
*THIS.StatusObject = lParam
CallFunctionFast(*THIS\Callback, *THIS\Url, #DOWNLOAD_OK, 0, 0, "")
Else
*THIS.StatusObject = lParam
CallFunctionFast(*THIS\Callback, *THIS\Url, #DOWNLOAD_FAILED, 0, 0, "")
EndIf
ChangeCurrentElement(StatusObject(), *THIS)
DeleteElement(StatusObject())
EndIf
ProcedureReturn CallWindowProc_(GetWindowLong_(Window, #GWL_USERDATA), Window, message, wParam, lParam)
EndProcedure
Procedure DownloadFile(Url.s, SaveTo.s, WindowID.l, Callback.l)
AddElement(StatusObject())
StatusObject()\IBindStatusCallback = IBindStatusCallback_Functions
StatusObject()\Url = Url
StatusObject()\SaveTo = SaveTo
StatusObject()\CallWindow = WindowID
StatusObject()\Callback = Callback
If GetWindowLong_(WindowID, #GWL_WNDPROC) <> @Download_WindowCallback()
SetWindowLong_(WindowID, #GWL_USERDATA, GetWindowLong_(WindowID, #GWL_WNDPROC))
SetWindowLong_(WindowID, #GWL_WNDPROC, @Download_WindowCallback())
EndIf
CreateThread(@Download_Thread(), @StatusObject())
EndProcedure
DataSection
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IBindStatusCallback:
Data.l $79EAC9C1
Data.w $BAF9, $11CE
Data.b $8C, $82, $00, $AA, $00, $4B, $A9, $0B
EndDataSection
; ////////////////////////////////////////////////////////////
; Window Constants
;
Enumeration
#DownloadWindow
EndEnumeration
; Gadget Constants
;
Enumeration
#Gadget_1
#Gadget_2
#Gadget_Url
#Gadget_SaveTo
#Gadget_ChooseFile
#Gadget_Status
#Gadget_Progress
#Gadget_Start
#Gadget_Stop
#Gadget_Close
#Gadget_StatusText
EndEnumeration
Procedure Open_DownloadWindow()
If OpenWindow(#DownloadWindow, 414, 385, 447, 230, "File download:", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(#DownloadWindow))
TextGadget(#Gadget_1, 5, 10, 60, 20, "Url:", #PB_Text_Right)
TextGadget(#Gadget_2, 5, 35, 60, 20, "SaveTo:", #PB_Text_Right)
StringGadget(#Gadget_Url, 70, 5, 320, 20, "")
StringGadget(#Gadget_SaveTo, 70, 30, 320, 20, "")
ButtonGadget(#Gadget_ChooseFile, 395, 30, 50, 20, "...")
ListViewGadget(#Gadget_Status, 5, 55, 385, 120)
ProgressBarGadget(#Gadget_Progress, 5, 180, 385, 20, 0, 100)
ButtonGadget(#Gadget_Start, 395, 80, 50, 20, "Start")
ButtonGadget(#Gadget_Stop, 395, 105, 50, 20, "Abort")
ButtonGadget(#Gadget_Close, 395, 205, 50, 20, "Close")
TextGadget(#Gadget_StatusText, 5, 205, 385, 20, "", #PB_Text_Center | #PB_Text_Border)
EndIf
EndIf
EndProcedure
; ---------------------------------------------------------
;
Global Abort.l
Declare DownloadCallback(Url$, Progress.l, FileSize.l, StatusCode.l, StatusText$)
Open_DownloadWindow()
DisableGadget(#Gadget_Stop, #True)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow: End
Case #PB_Event_Gadget
Select EventGadget()
Case #Gadget_Close: End
Case #Gadget_ChooseFile
File.s = SaveFileRequester("Save File to...", GetGadgetText(#Gadget_SaveTo), "All Files|*.*", 0)
If File <> "": SetGadgetText(#Gadget_SaveTo, File): EndIf
Case #Gadget_Start
Abort = #False
DisableGadget(#Gadget_Start, #True)
DisableGadget(#Gadget_Stop, #False)
SetGadgetState(#Gadget_Progress, 0)
ClearGadgetItemList(#Gadget_Status)
Url$ = GetGadgetText(#Gadget_Url)
SaveTo$ = GetGadgetText(#Gadget_SaveTo)
DownloadFile(Url$, SaveTo$, WindowID(#DownloadWindow), @DownloadCallback()) ; download command
Case #Gadget_Stop
Abort = #True
EndSelect
EndSelect
ForEver
; download callback:
Procedure DownloadCallback(Url$, Progress.l, FileSize.l, StatusCode.l, StatusText$)
If Progress = #DOWNLOAD_OK ; download sucessfull
MessageRequester("","Download complete")
DisableGadget(#Gadget_Start, #False)
DisableGadget(#Gadget_Stop, #True)
ElseIf Progress = #DOWNLOAD_FAILED ; download failed or aborted
MessageRequester("","Download failed!")
DisableGadget(#Gadget_Start, #False)
DisableGadget(#Gadget_Stop, #True)
Else ; download in progress...
; progress bar
If FileSize = 0
SetGadgetState(#Gadget_Progress, 0)
Else
SetGadgetState(#Gadget_Progress, (Progress*100)/FileSize)
EndIf
; size info
SetGadgetText(#Gadget_StatusText, Str(Progress) + " of "+Str(FileSize) + " Bytes complete.")
; info box
Select StatusCode
Case #BINDSTATUS_FINDINGRESOURCE: Text$ = "Finding "+StatusText$
Case #BINDSTATUS_CONNECTING: Text$ = "Connecting to "+StatusText$
Case #BINDSTATUS_REDIRECTING: Text$ = "Resolved to "+StatusText$
Case #BINDSTATUS_BEGINDOWNLOADDATA: Text$ = "Downloading "+StatusText$
Case #BINDSTATUS_ENDDOWNLOADDATA: Text$ = "Finished downloading "+StatusText$
Case #BINDSTATUS_USINGCACHEDCOPY: Text$ = "Receiving file from cache."
Case #BINDSTATUS_MIMETYPEAVAILABLE: Text$ = "MIME Type is "+StatusText$
Case #BINDSTATUS_PROXYDETECTING: Text$ = "A Proxy Server was detected"
Default: Text$ = ""
EndSelect
If Text$ <> ""
AddGadgetItem(#Gadget_Status, -1, Text$)
SetGadgetState(#Gadget_Status, CountGadgetItems(#Gadget_Status)-1)
EndIf
EndIf
; result is important!
If Abort = #False
ProcedureReturn #True ; continue
Else
ProcedureReturn #False ; stop download
EndIf
EndProcedure
It seems to work (find proxy, connecting, downloading, finished downloading, download complete) but no file created !?