Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/vbasic/Data/Utils/XZipComp.exe/XceedWinsock.Cab/F112657_xwlAddressedByteTransferEvents.pas

Pascal/Delphi Source File | 2000-04-18 | 7.4 KB | 227 lines

unit xwlAddressedByteTransferEvents;

{
  Xceed Winsock Library: Delphi supplement file.
  Copyright (c) 2000 Xceed Software Inc.

  This file is used to receive dispatch events from the
  AddressedByteTransferEvents class.

  This file is part of the Xceed Winsock Library. The source code in
  this file is only intended as a supplement to Xceed Winsock Library's
  documentation, and is provided "as is", without warranty of any kind,
  either expressed or implied.
}

interface

uses
  XCEEDWINSOCKlib_TLB, Windows, ActiveX;

type

  IAddressedByteTransferEvents = interface
    { These prototypes were copied from IdXWAddressedByteTransferEvents from
      the Xceed Winsock Library. The disids were removed to transform this
      dispinterface to a standard implementable interface. }
    procedure OnAddressedBytesSent(const xSocket: IDispatch; const xRemoteAddress: IDispatch;
                                   lBytesSent: Integer; lUserParam: Integer; lResultCode: Integer);
    procedure OnAddressedBytesReceived(const xSocket: IDispatch; const xRemoteAddress: IDispatch;
                                       vaData: OleVariant; lUserParam: Integer; lResultCode: Integer);
    procedure OnAddressedBytesAvailable(const xSocket: IDispatch; lBytesReceived: Integer;
                                        lBytesAvailable: Integer);
  end;

  TAddressedByteTransferEvents = class( TObject, IUnknown, IDispatch )
  private
    { This is the implementing interface passed at construction }
    m_iCallback : IAddressedByteTransferEvents;

    { This is my connection point with the advised event object, and its
      associated cookie }
    m_iConnectionPoint : IConnectionPoint;
    m_lCookie : LongInt;

    { IUnknown }
    function QueryInterface( const IID: TGUID; out Obj ) : HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    { IDispatch }
    function GetTypeInfoCount( out Count : Integer ) : HResult; stdcall;
    function GetTypeInfo( Index, LocaleID : Integer; out TypeInfo ) : HResult; stdcall;
    function GetIDsOfNames( const IID : TGUID; Names : Pointer;
                            NameCount, LocaleID : Integer; DispIDs : Pointer ) : HResult; stdcall;
    function Invoke( DispID : Integer; const IID : TGUID; LocaleID : Integer;
                     Flags : Word; var Params; VarResult, ExcepInfo, ArgErr : Pointer ) : HResult; stdcall;
  protected
  public
    { Public member exposed for advise with Xceed Winsock Library }
    m_xEventObject : AddressedByteTransferEvents;

    { Public methods }
    constructor Create( iImpl : IAddressedByteTransferEvents );
    destructor  Destroy; override;
  end;

implementation


{ IUnknown implementation }
function TAddressedByteTransferEvents.QueryInterface( const IID: TGUID; out Obj ) : HResult;
begin
  if GetInterface( IID, Obj ) then
    Result := S_OK
  else if IsEqualIID( IID, IdXWAddressedByteTransferEvents ) then
  begin
    GetInterface( IDispatch, Obj );
    Result := S_OK;
  end
  else
    Result := E_NOINTERFACE;
end;

function TAddressedByteTransferEvents._AddRef: Integer;
begin
  { We don't care }
  Result := 1;
end;

function TAddressedByteTransferEvents._Release: Integer;
begin
  { We don't care }
  Result := 1;
end;

{ IDispatch implementation }
function TAddressedByteTransferEvents.GetTypeInfoCount( out Count : Integer ) : HResult;
begin
  { We don't support any type info }
  Count := 0;
  result := S_OK;
end;

function TAddressedByteTransferEvents.GetTypeInfo( Index, LocaleID : Integer; out TypeInfo ) : HResult;
begin
  { We don't need to handle this IDispatch method }
  result := E_NOTIMPL;
end;

function TAddressedByteTransferEvents.GetIDsOfNames( const IID : TGUID;
                                                  Names : Pointer;
                                                  NameCount, LocaleID : Integer;
                                                  DispIDs : Pointer ) : HResult;
begin
  { We don't need to handle this IDispatch method }
  result := E_NOTIMPL;
end;

function TAddressedByteTransferEvents.Invoke( DispID : Integer; const IID : TGUID;
                                           LocaleID : Integer; Flags : Word;
                                           var Params; VarResult, ExcepInfo, ArgErr : Pointer ) : HResult;
var
  xParams : TDispParams;
begin
  if not Assigned( m_iCallback ) then
  begin
    result := E_FAIL;
    Exit;
  end;

  { Depending on the DispId, we unmangle parameters and call the proper
    m_iCallback method }
  case DispId of
    100: { OnAddressedBytesSent }
    begin
      xParams := TDispParams( Params );
      if xParams.cArgs <> 5 then
        result := DISP_E_BADPARAMCOUNT
      else
      begin
        m_iCallback.OnAddressedBytesSent( IDispatch( xParams.rgvarg[4].dispVal ),
                                          IDispatch( xParams.rgvarg[3].dispVal ),
                                          xParams.rgvarg[2].lVal,
                                          xParams.rgvarg[1].lVal,
                                          xParams.rgvarg[0].lVal );
        result := S_OK;
      end;
    end;

    101: { OnAddressedBytesReceived }
    begin
      xParams := TDispParams( Params );
      if xParams.cArgs <> 5 then
        result := DISP_E_BADPARAMCOUNT
      else
      begin
        m_iCallback.OnAddressedBytesReceived( IDispatch( xParams.rgvarg[4].dispVal ),
                                              IDispatch( xParams.rgvarg[3].dispVal ),
                                              OleVariant( xParams.rgvarg[2] ),
                                              xParams.rgvarg[1].lVal,
                                              xParams.rgvarg[0].lVal );
        result := S_OK;
      end;
    end;

    102: { OnAddressedBytesAvailable }
    begin
      xParams := TDispParams( Params );
      if xParams.cArgs <> 3 then
        result := DISP_E_BADPARAMCOUNT
      else
      begin
        m_iCallback.OnAddressedBytesAvailable( IDispatch( xParams.rgvarg[2].dispVal ),
                                               xParams.rgvarg[1].lVal,
                                               xParams.rgvarg[0].lVal );
        result := S_OK;
      end;
    end;

    else
      result := DISP_E_MEMBERNOTFOUND;
  end;
end;

{ Constructor }
constructor TAddressedByteTransferEvents.Create( iImpl : IAddressedByteTransferEvents );
var
  iContainer : IConnectionPointContainer;
begin
  inherited Create;

  { Set callback }
  m_iCallback := iImpl;

  { Allocate event object }
  m_xEventObject := CoAddressedByteTransferEvents.Create;

  { Retrieve its IConnectionPointContainer interface }
  iContainer := m_xEventObject As IConnectionPointContainer;

  { Find a connection point with this container }
  iContainer.FindConnectionPoint( IdXWAddressedByteTransferEvents,
                                  m_iConnectionPoint );

  if Assigned( m_iConnectionPoint ) then
  begin
    { Advise with this connection point }
    m_iConnectionPoint.Advise( Self As IUnknown, m_lCookie );
  end;
end;

{ Destructor }
destructor TAddressedByteTransferEvents.Destroy;
begin
  if Assigned( m_iConnectionPoint ) and ( m_lCookie <> 0 )then
    m_iConnectionPoint.Unadvise( m_lCookie );

  m_iConnectionPoint := Nil;
  m_xEventObject := Nil;
  m_iCallback := Nil;

  inherited Destroy;
end;

end.