; ---------------------------------------------------------
; Backrgound downloading with UrlDownloadToFile_()
; Tutorial for creating a COM object with PB
;
; 10/09/2003 by Timo 'Fr34k' Harter
; http://freak.purearea.net
; ---------------------------------------------------------
;
; First, I want to say, that not everything here came from
; my mind, i had some input from a C++ program found here:
; http://www.codeproject.com/internet/urlfile.asp
;
; This tutorial is a complete PB executable, that can be executed
; as it is, with hopefully enough comments for you to understand.
;
; Intro:
; Ok, much people know the UrlDownloadToFile_() Api, which is
; a very comfortable way to download a file, because you don't
; have to worry about the protocol you use, and reading headers
; and stuff with raw network commands.
; Now the problem with that command was, no easy way display the
; status of the download operation. This is possible by creating
; an own IBindStatusCallback Interface to handle this. Now actually
; you don't need any of PB's new Interface stuff to do this, as you
; can see in this code. Only till now i didn't have the knowledge how
; to do this.
; I will show here, how to create an object with a IBindStatusCallback
; Interface, and how to do a nice background downloaading with that.
;
; But that is unfortunately not all. UrlDownloadToFile_() stops the
; program flow, till the download is done, and we need a way around
; that. To do this, we put the function in a seperate thread. The
; problem then is, that the methods of our IBindStatusCallback
; Interface are then also called in this thread's conext, and so we
; can't update our user interface from there, as it is in a different
; thread. So, in order to communicate between the threads, we use
; SendMessage_() and send 2 userdefined messages.
;
; To get more info on UrlDownLoadToFile_(), go here:
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wceurlmn/html/cerefurldownloadtofile.asp
;
; Read more about the IBindStatusCallback Interface here:
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/guide_ppc/htm/urlmon1_rgqn.asp
;
; So much for the general way this program functions, let's get started...
;
; ---------------------------------------------------------
; These Global variables are used by the thread to start the download, and
; to post the messages, so they may only be manipulated BEFORE a download is
; started, changing them while a download is running may have unexpected
; results (most likely a crash)
Global Url.s, SaveTo.s, MainWindow.l
; Url is the Source address. May be something like "www.purebasic.com" or a direct file.
; SaveTo is the target filename on disk
; MainWindow is a WindowID() of an open Window, where the messages will be sent to
; This value is Global, but not used from the thread. We use it to indicate, that
; the download should be aborted (if it is #TRUE)
Global Abort.l
; This structure is used to communicate between the thread and the WindowCallback
Structure ProgressData
Progress.l ; bytes downloaded
ProgressMax.l ; bytes total (this value might change during the download)
StatusCode.l ; A code indicating what is happening
EndStructure
Structure IID ; Interface Identifier structure. a IID is a 16byte value, that uniquely
Data1.l ; identifys each interface.
Data2.w
Data3.w
Data4.b[8]
EndStructure
; Now these are the 2 messages we send. One to indicate a progress status
; and one to inbdicate the download end. Values above #WM_USER are free for use
; inside programs.
#WM_DOWNLOADPROGRESS = #WM_USER + 1
#WM_DOWNLOADEND = #WM_USER + 2
; these are the values that StatusCode.l of the ProgressData Structure might get.
; Note: as IBindStatusCallback can also be used for other things than downloads,
; some of these values may never occur with UrlDownloadToFile_()
; Go here for more info on those values:
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wceurlmn/html/cerefBINDSTATUS.asp
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
; ---------------------------------------------------------
; StatusObject
; ---------------------------------------------------------
; Ok, now we implement our IBindStatusCallback Interface. The
; object we create it in i call 'StatusObject'.
;
; Let's first discuss how such an object looks like. Basically, it
; is a structure containing pointers to other structures (which represent
; the interfaces), which themselves contain pointers To functions.
; (which are the methods of this interface)
;
; It is not as complicated as it sounds, let's take it step by step:
; First we need to know how the Interface we want looks like. There will
; be a comfortable InterfaceViewer soon, but for now, you have to peek in
; in the *.pb files at http://cvs.purebasic.com (/Residents/Windows/Interface)
; The important thing is to get the order of the methods right (methods are
; simply the functions of a interface)
;
; IBindStatusCallback looks like this:
;
; Interface IBindStatusCallback
; QueryInterface(a.l, b.l)
; AddRef()
; Release()
; OnStartBinding(a.l, b.l)
; GetPriority(a.l)
; OnLowResource(a.l)
; OnProgress(a.l, b.l, c.l, d.l)
; OnStopBinding(a.l, b.l)
; GetBindInfo(a.l, b.l)
; OnDataAvailable(a.l, b.l, c.l, d.l)
; OnObjectAvailable(a.l, b.l)
; EndInterface
; Now first, we need a Structure, that can hold pointers to all our
; functions for this interface, this looks almost the same then:
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
; let's make a structured variable out of it. We will fill the pointers in,
; after we created the functions.
IBindStatusCallback_Functions.IBindStatusCallback_Functions
; This is called the Virtual Table, it is where the caller to our Interface
; will find the addresses of the method (function) he want's to call.
; Now an interface is always part of an object. An object can contain multiple
; interfaces, or just one. The object is again a structure, that then contains
; the pointer to the virtual table of our interface:
Structure StatusObject
*IBindStatusCallback.IBindStatusCallback_Functions
EndStructure
; We have only one interface in there. Well actually 2, because IBindStatusCallback
; has the IUnknown interface inside. The structure can also hold extra data fields,
; that our functions can access to store data for this object, but we don't need
; that now.
; Let's make also a structured variable for our object. We can pass the pointer to
; that variable to everybody who want's to call our interface then. It has to be
; Global, so it is also known inside the thread.
Global StatusObject.StatusObject
; set the pointer to the virtual table of our interface:
StatusObject\IBindStatusCallback = IBindStatusCallback_Functions
; ---------------------------------------------------------
; Now we can create the methods for our interface.
; Note: It is quite simple: We create one Procedure for each method, with the
; arguments the method needs (look at the description of the Interface), with the
; only addition that each Procedure has a *THIS.MyObject pointer as first value.
; There it always get's the pointer to the object on which it is called. In the
; documentation by MS for eaxample, this is never mentioned, because in other
; languages, this parameter is hidden, but it is always there.
; For what the method should do and return, see the documentation.
; QueryInterface is a method that comes from the IUnknown interface, and is called,
; in order to get different interfaces on one object. We need to check the IID that
; is provided, and return the right pointer. As we only have one Interface with
; an IUnknown inside, this is quite simple:
Procedure.l StatusObject_QueryInterface(*THIS.StatusObject, *iid.IID, *Object.LONG)
; compare the IID to the IID's in our DataSection
If CompareMemory(*iid, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*iid, ?IID_IBindStatusCallback, SizeOf(IID))
; return the object itself. See this is why this *THIS pointer is usefull
*Object\l = *THIS
ProcedureReturn #S_OK
Else
; Ok, the caller requests an interface we don't have, so let's tell him:
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
; In AddRef we just have to increase a counter, of how much references exist to
; our object, and return that number:
Procedure.l StatusObject_AddRef(*THIS.StatusObject)
Shared StatusObject_Count.l
StatusObject_Count + 1
ProcedureReturn StatusObject_Count
EndProcedure
; Release is the same the other way around:
Procedure.l StatusObject_Release(*THIS.StatusObject)
Shared StatusObject_Count.l
StatusObject_Count - 1
ProcedureReturn StatusObject_Count
EndProcedure
; ---------------------------------------------------------
; Ok, now for the IBindStatusCallback specific methods:
; We basically only need the OnProgress method, so we just return
; #S_OK everywhere we don't need to take any action, and #E_NOTIMPL, where
; we would need to do something (to tell that we didn't implement the method)
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
; Now we come to the interresting part: OnProgress
; Remember: this is called from inside the second thread, so we can't use
; any Strings in there for example. We basically just pass on every information
; to the main thread via SendMessage, and do nothing else here:
Procedure.l StatusObject_OnProgress(*THIS.StatusObject, Progress.l, ProgressMax.l, StatusCode.l, szStatusText.l)
; Make a ProgressData structure, fill it with the information we have:
ProgressData.ProgressData
ProgressData\Progress = Progress
ProgressData\ProgressMax = ProgressMax
ProgressData\StatusCode = StatusCode
; szStatusText contains additional information, unfortunately, in UNICODE format.
; So we have to convert it. For more information on that, search the forum, there
; are several examples for UNICODE strings.
; get length of string
Length = WideCharToMultiByte_(#CP_ACP, 0, szStatusText, - 1, 0, 0, 0, 0)
; now we allocate some memory for that string, we can't use AllocateMemory(), because
; it requeres a fixed number, we don't want to use.
*String = HeapAlloc_(GetProcessHeap_(), 0, Length)
; convert string
WideCharToMultiByte_(#CP_ACP, 0, szStatusText, - 1, *String, Length, 0, 0)
; we use SendMessage to send the information, the address of the ProgressData
; structure as wParam, and the address of the string as lParam.
; SendMessage waits until the WindowCallback of the main thread has processed
; the message, so the threads are syncronized like that, and we can destroy our
; string afterwards.
Result = SendMessage_(MainWindow, #WM_DOWNLOADPROGRESS, @ProgressData, *String)
; free the string
HeapFree_(GetProcessHeap_(), 0, *String)
; From the Windowcallback, we return the value of the Global 'Abort' variable. If it
; is #TRUE, we return #E_ABORT here, to stop the download:
If Result = #TRUE
ProcedureReturn #E_ABORT
Else
ProcedureReturn #S_OK
EndIf
EndProcedure
; another couple of unused methods, but they need to be there:
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
; ---------------------------------------------------------
; Ok, now that all methods are there, we fill the virtual table with the
; addresses:
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()
; Here's the DataSection with the IID's for IUnknown and IBindStatusCallback
; I put them here, because they belong to the Interface stuff, not to the GUI part.
DataSection
IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IBindStatusCallback: ; {79eac9c1-baf9-11ce-8c82-00aa004ba90b}
Data.l $79eac9c1
Data.w $baf9, $11ce
Data.b $8c, $82, $00, $aa, $00, $4b, $a9, $0b
EndDataSection
; That was actually all that was there to do to implement a IBindStatusCallback
; Interface in our program. We now have a 'StatusObject' object structure containing
; our Interface. That's all we need.
; GUI part comes next. Let's first create a nice GUI with the Visual Designer:
; ---------------------------------------------------------
; PureBasic Visual Designer v3.80 build 1249
; 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, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "File download:")
If CreateGadgetList(WindowID())
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, "http://luchezl.free.fr/Autres/Boxe_Thai.rar")
StringGadget(#Gadget_SaveTo, 70, 30, 320, 20, "F:\Documents and Settings\Lio\Bureau\test.rar")
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
; ---------------------------------------------------------
; Ok, next we need a Procedure for our thread. It does nothing than
; call the UrlDownloadToFile_() function with our Global settings and, of course
; our Interface, and then SendMessage the result back to the main thread.
; A thread procedure MUST have one argument, but as we don't need
; it, we call it Dummy.
Procedure BackgroundDownload(Dummy.l)
Result.l = URLDownloadToFile_(0, @Url, @SaveTo, 0, @StatusObject)
SendMessage_(MainWindow, #WM_DOWNLOADEND, 0, Result)
EndProcedure
; Next is the WindowCallback procedure. Here we handle, what comes back from
; our OnProgress method, and from the thread procedure:
Procedure WindowCallback(Window.l, Message.l, wParam.l, lParam.l)
Result.l = #PB_ProcessPureBasicEvents
; download is in progress...
If Message = #WM_DOWNLOADPROGRESS
; in wParam, we habe a pointer to the infor structure:
*Progress.ProgressData = wParam
; let's update the ProgressBar:
; Progress may be always equal to ProgressMax, for example if the real size
; is unknown.
If *Progress\Progress = *Progress\ProgressMax Or *Progress\ProgressMax = 0
SetGadgetState(#Gadget_Progress, 0)
Else
SetGadgetState(#Gadget_Progress,(*Progress\Progress*100)/*Progress\ProgressMax)
EndIf
; a pointer to the extra text is in lParam:
StatusText.s = PeekS(lParam)
; now we check those StatusCodes, that are used for downloads, and set up a nice
; message:
Select *Progress\StatusCode
Case #BINDSTATUS_FINDINGRESOURCE: Text.s = "Finding " + StatusText
Case #BINDSTATUS_CONNECTING: Text.s = "Connecting to " + StatusText
Case #BINDSTATUS_REDIRECTING: Text.s = "Resolved to " + StatusText
Case #BINDSTATUS_BEGINDOWNLOADDATA: Text.s = "Downloading " + StatusText
Case #BINDSTATUS_ENDDOWNLOADDATA: Text.s = "Finished downloading " + StatusText
Case #BINDSTATUS_USINGCACHEDCOPY: Text.s = "Receiving file from cache."
Case #BINDSTATUS_MIMETYPEAVAILABLE: Text.s = "MIME Type is " + StatusText
Case #BINDSTATUS_PROXYDETECTING: Text.s = "A Proxy Server was detected"
Default: Text.s = ""
EndSelect
If Text <> ""
AddGadgetItem(#Gadget_Status, - 1, Text)
EndIf
; scroll down to the end:
SetGadgetState(#Gadget_Status, CountGadgetItems(#GAdget_Status)- 1)
; Set the sizes also in our TextGadget
SetGadgetText(#Gadget_StatusText, Str(*Progress\Progress) + " of " + Str(*Progress\ProgressMax) + " Bytes complete")
ProcedureReturn Abort
; download finished:
; Note: there is also a StatusCode for finished, but it is not sent on errors, so
; we also need this one:
ElseIf Message = #WM_DOWNLOADEND
; lParam contains the result of the UrlDownLoadToFile_() Api:
If lParam = #S_OK
; jippeeeee :)
AddGadgetItem(#Gadget_Status, - 1, "Download complete.")
SetGadgetState(#Gadget_Progress, 100)
Else
; damn :(
AddGadgetItem(#Gadget_Status, - 1, "Download failed!!")
SetGadgetState(#Gadget_Progress, 0)
EndIf
SetGadgetState(#Gadget_Status, CountGadgetItems(#GAdget_Status)- 1)
; switch Start/Stop button:
DisableGadget(#Gadget_Start, #FALSE)
DisableGadget(#Gadget_Stop, #TRUE)
EndIf
ProcedureReturn Result
EndProcedure
; ---------------------------------------------------------
; Now that's finally where our program starts:
; open the window and set the WindowCallback:
Open_DownloadWindow()
SetWindowCallback(@WindowCallback())
; who needs an 'abort' button now?
DisableGadget(#Gadget_Stop, #TRUE)
; A nice little extra for the StringGadgets: AutoComplete feature
; only present on IE5+, so we load the function manually:
#SHACF_URLALL = 2|4
#SHACF_FILESYSTEM = 1
CoInitialize_(0)
If OpenLibrary(0, "shlwapi.dll")
CallFunction(0, "SHAutoComplete", GadgetID(#Gadget_Url), #SHACF_URLALL)
CallFunction(0, "SHAutoComplete", GadgetID(#Gadget_SaveTo), #SHACF_FILESYSTEM)
CloseLibrary(0)
EndIf
; finally: the main loop:
Repeat
Select WaitWindowEvent()
Case #PB_EventCloseWindow: End
Case #PB_EventGadget
Select EventGadgetID()
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
; download starts:
Case #Gadget_Start
; set Abort to false, so our download doesn't get stopped imediately
Abort = #FALSE
; switch start/stop
DisableGadget(#Gadget_Start, #TRUE)
DisableGadget(#Gadget_Stop, #FALSE)
; cleat gadgets:
SetGadgetState(#Gadget_Progress, 0)
ClearGadgetItemList(#Gadget_Status)
; set our global values:
Url = GetGadgetText(#Gadget_Url)
SaveTo = GetGadgetText(#Gadget_SaveTo)
; this one is important for our messages to work:
MainWindow = WindowID(#DownloadWindow)
; finally, start the download by creating the thread:
CreateThread(@BackgroundDownload(), 0)
Case #Gadget_Stop
; to stop, we set Abort to #TRUE, and on the next time, the
; OnProgress method get's called, the download is aborted.
Abort = #TRUE
Sleep_(200)
Debug DeleteFile(SaveTo)
Sleep_(200)
Debug DeleteFile(SaveTo)
EndSelect
EndSelect
ForEver
; ---------------------------------------------------------
;
; WOW, now my fingers really hurt!
;
; I hope, you were able to understand all the stuff i was talking here,
; and that it helps you getting into COM (and doing nice downloads).
; If you have further questions, feel free to ask me or anybody else on
; the PureBasic forums (http://purebasic.myforums.net) or send me an
; email (freak@purearea.net)
;
; btw: forgive me for all the typos, but there is unfortunately no spell
; checking feature in the PB Editor :D ... and english is not my native language.
; (well, i doubt that my german is much better though :) )
;
;
; Timo
; ---------------------------------------------------------