PureBasic Forums - English

Code: Select all

Type IBindStatusCallback_Vtable
    pQueryInterface     As Dword
    pAddRef             As Dword
    pRelease            As Dword
    pOnStartBinding     As Dword
    pGetPriority        As Dword
    pOnLowResource      As Dword
    pOnProgress         As Dword
    pOnStopBinding      As Dword
    pGetBindInfo        As Dword
    pOnDataAvailable    As Dword
    pOnObjectAvailable  As Dword
    sReserved           As String * 500
End Type

Type IBindStatusCallback_Object

    pUnknown         As Dword Ptr                    '// Object
    cRef             As Long                         '// Reference counter
    vTable           As IBindStatusCallback_Vtable   '// vTable
                    
    '// Any class private data
    nValue          As Long
    szWebSite       As Asciiz * 1024
    szFileName      As Asciiz * %MAX_PATH
    hWndProgress    As Long

End Type

Function IBSCB_QueryInterface( pUnk As Dword Ptr, riid As Dword, ppvObject As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_Addref( pUnk As Dword Ptr ) As Long
    Dim pObject As IBindStatusCallback_Object Ptr
    pObject = pUnk
    Incr @pObject.cRef
    Function = @pObject.cRef
End Function

Function IBSCB_Release( pUnk As Dword Ptr ) As Long
    Dim pObject As IBindStatusCallback_Object Ptr
    pObject = pUnk
    Decr @pObject.cRef
    If @pObject.cRef = 0 Then
        '// Class is terminating, clear it's data (for example reasons)
        @pObject.nValue = 0
    End If
    Function = @pObject.cRef
End Function

Function IBSCB_OnStartBinding( pUnk As Dword Ptr, ByVal dwReserved As Dword, pib As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_GetPriority( pUnk As Dword Ptr, pnPriority As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_OnLowResource( pUnk As Dword Ptr, ByVal reserved As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_OnProgress( _
      pUnk As Dword Ptr _
    , ByVal ulProgress      As Dword _
    , ByVal ulProgressMax   As Dword _
    , ByVal ulStatusCode    As Dword _
    , ByVal wszStatusText   As Dword _
    ) As Long

    Dim nNewPos As Long
    Dim pObject As IBindStatusCallback_Object Ptr

    pObject = pUnk
    
    nNewPos = Max( 0, Min( 100, ulProgress * ( 100# / ulProgressMax ) ) )
    SendMessage @pObject.hWndProgress, %PBM_SETPOS, nNewPos, 0
    
    '============================================
    ' Fort testing, after 5% it will abort!
    '============================================

    If nNewPos > 5 Then    
        Function = %E_ABORT    
    End If
    
    VD_Debug_Print Str$( nNewPos ) & Str$( ulProgress ) & Str$( ulProgressMax )

End Function

Function IBSCB_OnStopBinding( pUnk As Dword Ptr, ByVal hresult As Long, ByVal szError As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_GetBindInfo( pUnk As Dword Ptr, grfBINDF As Dword, pbindinfo As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_OnDataAvailable( pUnk As Dword Ptr, ByVal grfBSCF As Dword, ByVal dwSize As Dword, pformatetc As Dword, pstgmed As Dword ) As Long
    Function = %E_NOTIMPL
End Function

Function IBSCB_OnObjectAvailable( pUnk As Dword Ptr, riid As Dword, punknown As Dword Ptr ) As Long
    Function = %E_NOTIMPL
End Function

Function SetIBindStatusObject( TObj As IBindStatusCallback_Object ) As Long

    Poke$ VarPtr( TObj ), String$( Len( TObj ), 0 )
    TObj.pUnknown                   = VarPtr( TObj.vTable )
    TObj.vTable.pQueryInterface     = CodePtr( IBSCB_QueryInterface )
    TObj.vTable.pAddRef             = CodePtr( IBSCB_Addref )
    TObj.vTable.pRelease            = CodePtr( IBSCB_Release )
    TObj.vTable.pOnStartBinding     = CodePtr( IBSCB_OnStartBinding )
    TObj.vTable.pGetPriority        = CodePtr( IBSCB_GetPriority )
    TObj.vTable.pOnLowResource      = CodePtr( IBSCB_OnLowResource )
    TObj.vTable.pOnProgress         = CodePtr( IBSCB_OnProgress )
    TObj.vTable.pOnStopBinding      = CodePtr( IBSCB_OnStopBinding )
    TObj.vTable.pGetBindInfo        = CodePtr( IBSCB_GetBindInfo )
    TObj.vTable.pOnDataAvailable    = CodePtr( IBSCB_OnDataAvailable )
    TObj.vTable.pOnObjectAvailable  = CodePtr( IBSCB_OnObjectAvailable )

    Function = VarPtr( TObj )

End Function

Code: Select all

Type Thread_Data
    szWebSite       As Asciiz * 1024
    szFileName      As Asciiz * %MAX_PATH
    hWndProgress    As Long
End Type

Function DownloadInThread( ByVal nCbHndl As Long, ByVal nTextBoxId As Long, ByVal nPbarId As Long, ByVal sTargetFile As String ) As Long

    Dim hThread     As Long
    Dim hClose      As Long
    Dim pTHD        As Thread_Data Ptr
    
    pTHD                = VD_MemAlloc( Len( Thread_Data ) ) 
    @pTHD.szWebSite     = VD_GetText( nCbHndl, nTextBoxId )
    @pTHD.szFileName    = sTargetFile
    @pTHD.hWndProgress  = GetDlgItem( nCbHndl, nPbarId )
    
    '// Start thread.
    Thread Create DownloadThread( pTHD ) To hThread
    Thread Close hThread To hClose
   
    Function = IsTrue( hThread )

End Function

Function DownloadThread( ByVal lParam As Long ) As Long

    Dim TObject     As IBindStatusCallback_Object
    Dim pTHD        As Thread_Data Ptr

    If lParam = 0 Then Exit Function

    pTHD = lParam

    SetIBindStatusObject TObject

    '// Copy data to local variable.    
    TObject.szWebSite     = @pTHD.szWebSite
    TObject.szFileName    = @pTHD.szFileName
    TObject.hWndProgress  = @pTHD.hWndProgress

    '// Remove the thread data.
    VD_MemFree pTHD
    
    Kill TObject.szFileName

    '// Download.
    URLDownloadToFile(ByVal 0&, TObject.szWebSite, TObject.szFileName, 0, ByVal VarPtr( TObject )

    MsgBox TOBject.szWebSite & $CrLf & TObject.szFileName, %MB_TASKMODAL, "Finished"

End Function