Download mit Fortschrittsanzeige

JuPi · Hält's aus hier Beiträge: 5

Hi!

Wie macht man möglichst einfach einen Download mit Fortschrittsanzeige. Ich bitte um Quellcode, da ich bis jetzt nur Sachen mit der Funktion "Urlmon" heruntergeladen hab.

Vielen Dank,
JuPi

toms · Beiträge: 1099 Erhaltene Danke: 2

Welche Komponente/ Funktion verwendest du?

JuPi · Hält's aus hier Beiträge: 5

Ich hätte Winshoes 7.3 und die THTTP-Komponente von Delphi zur Verfügung...
Am liebsten wärs mir ganz ohne Komponente, z. B. nur mit der Urlmon-Funktion und ein paar zusätzlichen Zeilen oder so...

mfg
JuPi

DeCodeGuru · Beiträge: 1333 Erhaltene Danke: 1 Arch Linux Eclipse

Hallo, folgendes habe ich mal in einem anderen Forum geschrieben.

Erst mal in den Uses UrlMon und ActiveX hinzufügen:

markieren

Quelltext

1:
2:

uses 
  UrlMon, ActiveX;

Dann wird folgender Typ deklariert:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

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:

markieren

Quelltext

1:
2:
3:

var 
  Form1: TForm1; 
  usercancel: Boolean = False;

Jetzt kommen wir zur Implementation:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:

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:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

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

So, das wars!!

MfG DeCodeGuru

JuPi · Hält's aus hier Beiträge: 5

Erstmal danke für die Antwort, ich habe den Code in mein Programm eingefügt. Allerdings wird mir jetzt gemeldet, dass sich die Deklarationen von "GetPriority", "OnDataAvailable" und "OnObjectAvailable" von denen in Interface "IBindStatusCallback" unterscheidet.

Ich habe übrigens Delphi3 Professional. Was muss ich ändern, damit es klappt?

mfg
JuPi

DeCodeGuru · Beiträge: 1333 Erhaltene Danke: 1 Arch Linux Eclipse

hast, du alle units eingebunden???
Wenn ja, musst du mal den ganzen Code durchforsten un gucken, ob es irgendwo abweichungen gibt.

MfG DeCodeGuru

JuPi · Hält's aus hier Beiträge: 5

... aber ich habe zumindest den Fehler in der function GetPriority korrigieren können mit Hilfe der MSDN-Library, es muss nämlich heißen: GetPriority(out nPriority:longint)
Ich habe auch festgestellt, das in den beiden anderen Funktionen zwei bzw. eine Variable Pointer sind, nur meckert Delphi, wenn ich versuche, eine der Variablen zu pointen, die gepointet werden müssen.

mfg
JuPi

DeCodeGuru · Beiträge: 1333 Erhaltene Danke: 1 Arch Linux Eclipse

also, ich habe den code jetzt mal in ein neues Projekt eingefügt und es hat auf anhiebt gefuntzt.

JuPi · Hält's aus hier Beiträge: 5

Da bestimmte API-Funktionen hinzugefügt/verändert wurden könnte es sein, dass der Code mit D3 nicht funktioniert....

DeCodeGuru · Beiträge: 1333 Erhaltene Danke: 1 Arch Linux Eclipse

kann sein, ich werde mal auf meinem Zweitrechner Delphi 3 aufspielen und den Code dann mal testen. Kann aber erstmal nichts versprechen, da ich übermorgen in Urlaub fahre.

MfG DeCodeGuru

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme