home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / XZipComp.exe / XceedWinsock.Cab / F112660_xwlFileTransferEvents.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-18  |  7.2 KB  |  223 lines
  1. unit xwlFileTransferEvents;
  2.  
  3. {
  4.   Xceed Winsock Library: Delphi supplement file.
  5.   Copyright (c) 2000 Xceed Software Inc.
  6.  
  7.   This file is used to receive dispatch events from the
  8.   FileTransferEvents class.
  9.  
  10.   This file is part of the Xceed Winsock Library. The source code in
  11.   this file is only intended as a supplement to Xceed Winsock Library's
  12.   documentation, and is provided "as is", without warranty of any kind,
  13.   either expressed or implied.
  14. }
  15.  
  16. interface
  17.  
  18. uses
  19.   XCEEDWINSOCKlib_TLB, Windows, ActiveX;
  20.  
  21. type
  22.  
  23.   IFileTransferEvents = interface
  24.     { These prototypes were copied from IdXWFileTransferEvents from
  25.       the Xceed Winsock Library. The disids were removed to transform this
  26.       dispinterface to a standard implementable interface. }
  27.     procedure OnFileSent( const xSocket : IDispatch;
  28.                           const sFilename : WideString;
  29.                           lStartOffset : Integer;
  30.                           lBytesSent : Integer;
  31.                           lBytesTotal : Integer;
  32.                           lUserParam : Integer;
  33.                           bTransferCompleted : WordBool;
  34.                           lResultCode: Integer );
  35.     procedure OnFileReceived( const xSocket : IDispatch;
  36.                               const sFilename : WideString;
  37.                               lStartOffset : Integer;
  38.                               lBytesReceived : Integer;
  39.                               lBytesTotal : Integer;
  40.                               lUserParam : Integer;
  41.                               bTransferCompleted : WordBool;
  42.                               lResultCode : Integer );
  43.   end;
  44.  
  45.   TFileTransferEvents = class( TObject, IUnknown, IDispatch )
  46.   private
  47.     { This is the implementing interface passed at construction }
  48.     m_iCallback : IFileTransferEvents;
  49.  
  50.     { This is my connection point with the advised event object, and its
  51.       associated cookie }
  52.     m_iConnectionPoint : IConnectionPoint;
  53.     m_lCookie : LongInt;
  54.  
  55.     { IUnknown }
  56.     function QueryInterface( const IID: TGUID; out Obj ) : HResult; stdcall;
  57.     function _AddRef: Integer; stdcall;
  58.     function _Release: Integer; stdcall;
  59.  
  60.     { IDispatch }
  61.     function GetTypeInfoCount( out Count : Integer ) : HResult; stdcall;
  62.     function GetTypeInfo( Index, LocaleID : Integer; out TypeInfo ) : HResult; stdcall;
  63.     function GetIDsOfNames( const IID : TGUID; Names : Pointer;
  64.                             NameCount, LocaleID : Integer; DispIDs : Pointer ) : HResult; stdcall;
  65.     function Invoke( DispID : Integer; const IID : TGUID; LocaleID : Integer;
  66.                      Flags : Word; var Params; VarResult, ExcepInfo, ArgErr : Pointer ) : HResult; stdcall;
  67.   protected
  68.   public
  69.     { Public member exposed for advise with Xceed Winsock Library }
  70.     m_xEventObject : FileTransferEvents;
  71.  
  72.     { Public methods }
  73.     constructor Create( iImpl : IFileTransferEvents );
  74.     destructor  Destroy; override;
  75.   end;
  76.  
  77. implementation
  78.  
  79.  
  80. { IUnknown implementation }
  81. function TFileTransferEvents.QueryInterface( const IID: TGUID; out Obj ) : HResult;
  82. begin
  83.   if GetInterface( IID, Obj ) then
  84.     Result := S_OK
  85.   else if IsEqualIID( IID, IdXWFileTransferEvents ) then
  86.   begin
  87.     GetInterface( IDispatch, Obj );
  88.     Result := S_OK;
  89.   end
  90.   else
  91.     Result := E_NOINTERFACE;
  92. end;
  93.  
  94. function TFileTransferEvents._AddRef: Integer;
  95. begin
  96.   { We don't care }
  97.   Result := 1;
  98. end;
  99.  
  100. function TFileTransferEvents._Release: Integer;
  101. begin
  102.   { We don't care }
  103.   Result := 1;
  104. end;
  105.  
  106. { IDispatch implementation }
  107. function TFileTransferEvents.GetTypeInfoCount( out Count : Integer ) : HResult;
  108. begin
  109.   { We don't support any type info }
  110.   Count := 0;
  111.   result := S_OK;
  112. end;
  113.  
  114. function TFileTransferEvents.GetTypeInfo( Index, LocaleID : Integer; out TypeInfo ) : HResult;
  115. begin
  116.   { We don't need to handle this IDispatch method }
  117.   result := E_NOTIMPL;
  118. end;
  119.  
  120. function TFileTransferEvents.GetIDsOfNames( const IID : TGUID;
  121.                                                   Names : Pointer;
  122.                                                   NameCount, LocaleID : Integer;
  123.                                                   DispIDs : Pointer ) : HResult;
  124. begin
  125.   { We don't need to handle this IDispatch method }
  126.   result := E_NOTIMPL;
  127. end;
  128.  
  129. function TFileTransferEvents.Invoke( DispID : Integer; const IID : TGUID;
  130.                                            LocaleID : Integer; Flags : Word;
  131.                                            var Params; VarResult, ExcepInfo, ArgErr : Pointer ) : HResult;
  132. var
  133.   xParams : TDispParams;
  134. begin
  135.   { Depending on the DispId, we unmangle parameters and call the proper
  136.     m_iCallback method }
  137.   case DispId of
  138.     100: { OnFileSent }
  139.     begin
  140.       xParams := TDispParams( Params );
  141.       if xParams.cArgs <> 8 then
  142.         result := DISP_E_BADPARAMCOUNT
  143.       else
  144.       begin
  145.         m_iCallback.OnFileSent( IDispatch( xParams.rgvarg[7].dispVal ),
  146.                                 WideString( xParams.rgvarg[6].bstrVal ),
  147.                                 xParams.rgvarg[5].lVal,
  148.                                 xParams.rgvarg[4].lVal,
  149.                                 xParams.rgvarg[3].lVal,
  150.                                 xParams.rgvarg[2].lVal,
  151.                                 xParams.rgvarg[1].vbool,
  152.                                 xParams.rgvarg[0].lVal );
  153.         result := S_OK;
  154.       end;
  155.     end;
  156.  
  157.     101: { OnFileReceived }
  158.     begin
  159.       xParams := TDispParams( Params );
  160.       if xParams.cArgs <> 8 then
  161.         result := DISP_E_BADPARAMCOUNT
  162.       else
  163.       begin
  164.         m_iCallback.OnFileReceived( IDispatch( xParams.rgvarg[7].dispVal ),
  165.                                     WideString( xParams.rgvarg[6].bstrVal ),
  166.                                     xParams.rgvarg[5].lVal,
  167.                                     xParams.rgvarg[4].lVal,
  168.                                     xParams.rgvarg[3].lVal,
  169.                                     xParams.rgvarg[2].lVal,
  170.                                     xParams.rgvarg[1].vbool,
  171.                                     xParams.rgvarg[0].lVal );
  172.         result := S_OK;
  173.       end;
  174.     end;
  175.  
  176.     else
  177.       result := DISP_E_MEMBERNOTFOUND;
  178.   end;
  179. end;
  180.  
  181. { Constructor }
  182. constructor TFileTransferEvents.Create( iImpl : IFileTransferEvents );
  183. var
  184.   iContainer : IConnectionPointContainer;
  185. begin
  186.   inherited Create;
  187.  
  188.   { Set callback }
  189.   m_iCallback := iImpl;
  190.  
  191.   { Allocate event object }
  192.   m_xEventObject := CoFileTransferEvents.Create;
  193.  
  194.   { Retrieve its IConnectionPointContainer interface }
  195.   iContainer := m_xEventObject As IConnectionPointContainer;
  196.  
  197.   { Find a connection point with this container }
  198.   iContainer.FindConnectionPoint( IdXWFileTransferEvents,
  199.                                   m_iConnectionPoint );
  200.  
  201.   if Assigned( m_iConnectionPoint ) then
  202.   begin
  203.     { Advise with this connection point }
  204.     m_iConnectionPoint.Advise( Self As IUnknown, m_lCookie );
  205.   end;
  206. end;
  207.  
  208. { Destructor }
  209. destructor TFileTransferEvents.Destroy;
  210. begin
  211.   if Assigned( m_iConnectionPoint ) and ( m_lCookie <> 0 )then
  212.     m_iConnectionPoint.Unadvise( m_lCookie );
  213.  
  214.   m_iConnectionPoint := Nil;
  215.   m_xEventObject := Nil;
  216.   m_iCallback := Nil;
  217.  
  218.   inherited Destroy;
  219. end;
  220.  
  221. end.
  222.  
  223.