Einzelnen Beitrag anzeigen

Benutzerbild von d3g
d3g

Registriert seit: 21. Jun 2002
602 Beiträge
 
#5
  Alt 29. Jan 2003, 16:34
Ich hab mal ein Beispiel für UrlDownloadToFile() gebastelt ...

Code:
[b]unit[/b] Unit1;

[b]interface[/b]

[b]uses[/b]
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UrlMon, StdCtrls, ComCtrls, ComObj, ActiveX, ComServ;

[b]type[/b]
  TDownloadCallback = [b]class[/b](TCOMObject, IBindStatusCallback)
    [b]function[/b] OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; [b]stdcall[/b];
    [b]function[/b] GetPriority([b]out[/b] nPriority): HResult; [b]stdcall[/b];
    [b]function[/b] OnLowResource(reserved: DWORD): HResult; [b]stdcall[/b];
    [b]function[/b] OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; [b]stdcall[/b];
    [b]function[/b] OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; [b]stdcall[/b];
    [b]function[/b] GetBindInfo([b]out[/b] grfBINDF: DWORD; [b]var[/b] bindinfo: TBindInfo): HResult; [b]stdcall[/b];
    [b]function[/b] OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; [b]stdcall[/b];
    [b]function[/b] OnObjectAvailable([b]const[/b] iid: TGUID; punk: IUnknown): HResult; [b]stdcall[/b];
  [b]end[/b];


[b]type[/b]
  TForm1 = [b]class[/b](TForm)
    ProgressBar: TProgressBar;
    Button: TButton;
    [b]procedure[/b] ButtonClick(Sender: TObject);
    [b]procedure[/b] FormCreate(Sender: TObject);
  [b]private[/b]
    [color=#000080][i]{ Private declarations }[/i][/color]
    dlc: TDownloadCallback;
  [b]public[/b]
    [color=#000080][i]{ Public declarations }[/i][/color]
  [b]end[/b];

[b]var[/b]
  Form1: TForm1;

[b]implementation[/b]

[color=#008000]{$R *.dfm}[/color]

[b]function[/b] TDownloadCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult; [b]stdcall[/b];
[b]begin[/b]
  Form1.ProgressBar.Position := [color=#000080]0[/color];
  Result := S_OK;
[b]end[/b];

[b]function[/b] TDownloadCallback.GetPriority([b]out[/b] nPriority): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]function[/b] TDownloadCallback.OnLowResource(reserved: DWORD): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]function[/b] TDownloadCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; [b]stdcall[/b];
[b]begin[/b]
  Form1.ProgressBar.Max := ulProgressMax;
  Form1.ProgressBar.Position := ulProgress;
  Application.ProcessMessages();
  Result := S_OK;
  [color=#000080][i]// to cancel, return E_ABORT instead of S_OK[/i][/color]
[b]end[/b];

[b]function[/b] TDownloadCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]function[/b] TDownloadCallback.GetBindInfo([b]out[/b] grfBINDF: DWORD;
  [b]var[/b] bindinfo: TBindInfo): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]function[/b] TDownloadCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]function[/b] TDownloadCallback.OnObjectAvailable([b]const[/b] iid: TGUID;
  punk: IUnknown): HResult; [b]stdcall[/b];
[b]begin[/b]
  Result := E_NOTIMPL;
[b]end[/b];

[b]procedure[/b] TForm1.ButtonClick(Sender: TObject);
[b]begin[/b]
  UrlDownloadToFile([b]nil[/b], [color=#000080]'http://www.delphipraxis.net/viewtopic.php?t=2801'[/color],
                    [color=#000080]'C:\UrlDownloadToFile.html'[/color], [color=#000080]0[/color], dlc);
[b]end[/b];

[b]procedure[/b] TForm1.FormCreate(Sender: TObject);
[b]begin[/b]
  dlc := TDownloadCallback.Create();
[b]end[/b];

[b]initialization[/b]
  TComObjectFactory.Create(ComServer, TDownloadCallback, IBindStatusCallback,
                           [color=#000080]'TDownloadCallback'[/color],
                           [color=#000080]'Callback Interface for UrlDownloadToFile()'[/color],
                           ciMultiInstance, tmApartment);

[b]end[/b].
MfG,
d3g
-- Crucifixion?
-- Yes.
-- Good. Out of the door, line on the left, one cross each.
  Mit Zitat antworten Zitat