Hier ist ein Beispiel, wie man jeden Download als Fortschrittsanzeige in einer ProgressBar oder Gauge anzeigen lassen kann. Das Einzige, was bestimmt werden muss, ist die Dateiendung des Downloads.
uses ExtCtrls, UrlMon, ActiveX, Gauges
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;
var
Form1: TForm1;
usercancel: Boolean = False;
//
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;
Datei Download :
procedure TForm1.Button1Click(Sender: TObject);
var
cDownStatus : cDownloadStatusCallback;
status: integer;
begin
cDownStatus := cDownloadStatusCallBack.Create;
// DIES IST EIN TESTDOWNLOAD VON 100 MB
status := URLDownloadToFIle(nil,'https://ash-speed.hetzner.com/100MB.bin',
'C:\temp.html',0,CDownStatus); // HIER DER ZIELPFAD DES DOWNLOADS
cDownStatus.Free;
if (status <> 0) then
Form1.Label1.Caption:='Es gab einen Fehler beim Herunterladen!';
end;
Keine Kommentare:
Kommentar veröffentlichen