Autor |
Beitrag |
JuPi
Hält's aus hier
Beiträge: 5
|
Verfasst: So 23.06.02 17:11
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
|
Verfasst: So 23.06.02 17:30
Welche Komponente/ Funktion verwendest du?
|
|
JuPi
Hält's aus hier
Beiträge: 5
|
Verfasst: So 23.06.02 18:29
Titel: Ich habe mich für noch keine entschieden
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
|
Verfasst: Do 27.06.02 11:24
Hallo, folgendes habe ich mal in einem anderen Forum geschrieben.
Erst mal in den Uses UrlMon und ActiveX hinzufügen:
Quelltext 1: 2:
| uses UrlMon, ActiveX; |
Dann wird folgender Typ deklariert:
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:
Quelltext 1: 2: 3:
| var Form1: TForm1; usercancel: Boolean = False; |
Jetzt kommen wir zur Implementation:
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:
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
|
Verfasst: Do 27.06.02 18:24
Titel: Funktioniert leider nicht...
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
|
Verfasst: Do 27.06.02 20:01
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
|
Verfasst: Do 27.06.02 20:18
Titel: Units sind alle eingebunden
... 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
|
Verfasst: Do 27.06.02 20:19
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
|
Verfasst: Do 27.06.02 20:29
Titel: Hast du auch D3?
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
|
Verfasst: Do 27.06.02 23:32
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
|
|