bindstatuscallback.pas

特性： 1、阻塞模式更新 2、具备比较完备的进度控制 3、与autoupgrader组件相比

unit BindStatusCallback;

interface

uses
  UrlMon,
  Windows,
  ActiveX;

type
  TOnWork = function(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HRESULT of object;
  
  TBindStatusCallback = class(TInterfacedObject, IBindStatusCallback)
  protected
    FRefCount: Integer;
    FOnWork: TOnWork;
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  private
    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
    property OnWork: TOnWork read FOnWork write FOnWork;
  end;

implementation

function TBindStatusCallback.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  if GetInterface(IID, Obj) then Result := S_OK
  else Result := E_NOINTERFACE;
end;

function TBindStatusCallback._AddRef: Integer;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TBindStatusCallback._Release: Integer;
begin
  Dec(FRefCount);
  Result := FRefCount;
end;

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.GetPriority(out nPriority): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnObjectAvailable(const IID: TGUID; punk: IInterface): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HRESULT;
begin               
  if Assigned(FOnWork) then begin
    Result := FOnWork(ulProgress, ulProgressMax, ulStatusCode, szStatusText);
  end else begin
    Result := S_OK;
  end;
end;

{var
  Status: string;
begin
  case ulStatusCode of
    1: Status := ('BINDSTATUS_FINDINGRESOURCE');
    2: Status := ('BINDSTATUS_CONNECTING');
    3: Status := ('BINDSTATUS_REDIRECTING');
    4: Status := ('BINDSTATUS_BEGINDOWNLOADDATA');
    5: Status := ('BINDSTATUS_DOWNLOADINGDATA');
    6: Status := ('BINDSTATUS_ENDDOWNLOADDATA   ');
    7: Status := ('BINDSTATUS_BEGINDOWNLOADCOMPONENTS');
    8: Status := ('BINDSTATUS_INSTALLINGCOMPONENTS');
    9: Status := ('BINDSTATUS_ENDDOWNLOADCOMPONENTS');
    10: Status := ('BINDSTATUS_USINGCACHEDCOPY');
    11: Status := ('BINDSTATUS_SENDINGREQUEST');
    12: Status := ('BINDSTATUS_CLASSIDAVAILABLE');
    13: Status := ('BINDSTATUS_MIMETYPEAVAILABLE');
    14: Status := ('BINDSTATUS_CACHEFILENAMEAVAILABLE');
    15: Status := ('BINDSTATUS_BEGINSYNCOPERATION');
    16: Status := ('BINDSTATUS_ENDSYNCOPERATION');
    17: Status := ('BINDSTATUS_BEGINUPLOADDATA');
    18: Status := ('BINDSTATUS_UPLOADINGDATA');
    19: Status := ('BINDSTATUS_ENDUPLOADINGDATA');
    20: Status := ('BINDSTATUS_PROTOCOLCLASSID');
    21: Status := ('BINDSTATUS_ENCODING');
    22: Status := ('BINDSTATUS_VERFIEDMIMETYPEAVAILABLE');
    23: Status := ('BINDSTATUS_CLASSINSTALLLOCATION');
    24: Status := ('BINDSTATUS_DECODING');
    25: Status := ('BINDSTATUS_LOADINGMIMEHANDLER');
    26: Status := ('BINDSTATUS_CONTENTDISPOSITIONATTACH');
    27: Status := ('BINDSTATUS_FILTERREPORTMIMETYPE');
    28: Status := ('BINDSTATUS_CLSIDCANINSTANTIATE');
    29: Status := ('BINDSTATUS_IUNKNOWNAVAILABLE');
    30: Status := ('BINDSTATUS_DIRECTBIND');
    31: Status := ('BINDSTATUS_RAWMIMETYPE');
    32: Status := ('BINDSTATUS_PROXYDETECTING');
    33: Status := ('BINDSTATUS_ACCEPTRANGES');
  end;

  if DoCancel then
    Result := E_ABORT
  else
    Result := S_OK;
end;}

end.