unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UrlMon,
ActiveX;
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;
public
{ Public declarations }
end;
var
Form1: TForm1;
usercancel: Boolean = False;
implementation
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;
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;
end.