Elle est assez compliquée et comme je suis pas encore niveau moyen moyen en pure...
Sinon en compilant vous comprendrez que c'est un programme qui télécharge des fichiers sur le web avec une barre de progression.
Quelqu'un pourrait t-il l'expliquer ?
C'est assez long
Code : Tout sélectionner
; ---------------------------------------------------------
; 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, "")
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
; ---------------------------------------------------------
; 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
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://jconserv.net/purebasic) 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
; ---------------------------------------------------------
