AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Internet / LAN / ASP.NET Delphi Datei downloaden (mit Fortschrittsanzeige)

Datei downloaden (mit Fortschrittsanzeige)

Ein Thema von DeCodeGuru · begonnen am 8. Jun 2002 · letzter Beitrag vom 8. Jun 2002
Antwort Antwort
DeCodeGuru

Registriert seit: 7. Jun 2002
Ort: Walluf
66 Beiträge
 
#1

Datei downloaden (mit Fortschrittsanzeige)

  Alt 8. Jun 2002, 10:02
Erst mal in den Uses UrlMon und ActiveX hinzufügen:

Delphi-Quellcode:
uses
  UrlMon, ActiveX;
Dann wird folgender Typ deklariert:

Delphi-Quellcode:
type
  cDownloadStatusCallback = class(TObject,IUnknown,IBindStatusCallback)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;
Dann brauchen wir noch eine Variable:

Delphi-Quellcode:
var
  Form1: TForm1;
  usercancel: Boolean = False;
Jetzt kommen wir zur Implementation:

Delphi-Quellcode:
function cDownloadStatusCallback._AddRef: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback._Release: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if(GetInterface(IID,Obj)) then
  begin
    Result := 0
  end else
  begin
    Result := E_NOINTERFACE;
  end;
end;

function cDownloadStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  case ulStatusCode of
    BINDSTATUS_FINDINGRESOURCE:
    begin
      Form1.Label1.Caption := 'Datei wurde gefunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_CONNECTING:
    begin
      Form1.Label1.Caption := 'Es wird verbunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_BEGINDOWNLOADDATA:
    begin
      Form1.Gauge1.Progress := 0;
      Form1.Label1.Caption := 'Der Download wurde gestartet...';
      if (UserCancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_DOWNLOADINGDATA:
    begin
      Form1.Gauge1.Progress := MulDiv(ulProgress,100,ulProgressMax);
      Form1.Label1.Caption := 'Datei wird heruntergeladen...';
      if (UserCancel) then
      begin
        Result := E_ABORT; exit;
      end;
    end;
    BINDSTATUS_ENDDOWNLOADDATA:
    begin
      Form1.Label1.Caption := 'Download wurd beendet...';
    end;
  end;
  Application.ProcessMessages;

  Result := S_OK;
end;
Und zu guter Letzt kommen wir zum Herunterladen:

Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
var
  cDownStatus : cDownloadStatusCallback;
  status: integer;
begin
  cDownStatus := cDownloadStatusCallBack.Create;
  
   status := URLDownloadToFIle(nil,'http://www.google.de/index.html',
     'C:\index.html',0,CDownStatus);
    cDownStatus.Free;

   if (status <> 0) then
      Form1.Label1.Caption:='Es gab einen Fehler beim Herunterladen!';
end;
So, das wars!!

MfG DeCodeGuru

[edit=Chakotay1308]Einige Erweiterungen von MathiasSimmack implementiert. Mfg, Chakotay1308[/edit]
[edit=fkerber] Mfg, fkerber[/edit]
MfG DeCodeGuru
-=][ Wenn Windows die Antwort ist, muss es eine doofe Frage gewesen sein ][=-
  Mit Zitat antworten Zitat
MathiasSimmack
(Gast)

n/a Beiträge
 
#2
  Alt 8. Jun 2002, 10:20
Machen wir nur noch die Erweiterung für NonVCL, denn mein Setup ist ein solches:
Delphi-Quellcode:
function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
  szST : string;
begin
  case ulStatusCode of
    BINDSTATUS_BEGINDOWNLOADDATA:
      begin
        // reset progressbar
        SendMessage(GetDlgItem(hDlg,IDC_PROGRESS),PBM_SETPOS,0,0);

        // show current action
        szST := szStatusText;
        SendMessage(GetDlgItem(hDlg,IDC_ACTIONTEXT),WM_SETTEXT,0,integer(szST));

        // download exit by the user?
        if(m_fUserCancel) then
          begin
            Result := E_ABORT; exit;
          end;
      end;
    BINDSTATUS_DOWNLOADINGDATA:
      begin
        // update progress
        SendMessage(GetDlgItem(hDlg,IDC_PROGRESS),PBM_SETPOS,MulDiv(ulProgress,100,ulProgressMax),0);

        // download exit by the user?
        if(m_fUserCancel) then
          begin
            Result := E_ABORT; exit;
          end;
      end;
    BINDSTATUS_ENDDOWNLOADDATA:
      SendMessage(hDlg,WM_CLOSE,0,0); // close Download dialog
  end;

  // message pump
  if(PeekMessage(msg,hDlg,0,0,PM_REMOVE)) then IsDialogMessage(hDlg,msg);

  Result := S_OK; // default result
end;
[edit=Chakotay1308]Auf das Wesentliche gekürzt. Mfg, Chakotay1308[/edit]
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:20 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz