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

Pascal/Delphi Source File | 2000-05-16 | 7.5 KB | 239 lines

unit xwlStringTransferEvents;

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

  This file is used to receive dispatch events from the
  StringTransferEvents 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

  IStringTransferEvents = interface
    { These prototypes were copied from IdXWStringTransferEvents from
      the Xceed Winsock Library. The disids were removed to transform this
      dispinterface to a standard implementable interface. }
    procedure OnStringSent( const xSocket : IDispatch;
                            lUserParam : Integer;
                            lResultCode : Integer );
    procedure OnStringReceived( const xSocket : IDispatch;
                                const sString : WideString;
                                lUserParam : Integer;
                                lResultCode: Integer );
    procedure OnStringAvailable( const xSocket : IDispatch;
                                 lCharsReceived : Integer;
                                 lCharsAvailable : Integer );
    procedure OnOutOfBandStringReceived( const xSocket: IDispatch;
                                         const sString: WideString;
                                         lResultCode: Integer );
  end;

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

    { 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 : StringTransferEvents;

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

implementation


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

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

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

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

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

function TStringTransferEvents.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 TStringTransferEvents.Invoke( DispID : Integer; const IID : TGUID;
                                           LocaleID : Integer; Flags : Word;
                                           var Params; VarResult, ExcepInfo, ArgErr : Pointer ) : HResult;
var
  xParams : TDispParams;
begin
  { Depending on the DispId, we unmangle parameters and call the proper
    m_iCallback method }
  case DispId of
    100: { OnStringSent }
    begin
      xParams := TDispParams( Params );
      if xParams.cArgs <> 3 then
        result := DISP_E_BADPARAMCOUNT
      else
      begin
        m_iCallback.OnStringSent( IDispatch( xParams.rgvarg[2].dispVal ),
                                  xParams.rgvarg[1].lVal,
                                  xParams.rgvarg[0].lVal );
        result := S_OK;
      end;
    end;

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

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

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

    else
      result := DISP_E_MEMBERNOTFOUND;
  end;
end;

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

  { Set callback }
  m_iCallback := iImpl;

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

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

  { Find a connection point with this container }
  iContainer.FindConnectionPoint( IdXWStringTransferEvents,
                                  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 TStringTransferEvents.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.