home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / Midas / Intrcpt / intrcptu.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  4.2 KB  |  137 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Midas Socket Server Intercepor Demo             }
  5. {                                                       }
  6. {*******************************************************}
  7.  
  8. unit Intrcptu;
  9.  
  10. {
  11.   NOTE: This demo requires the ZLib units found in the extras directory on the
  12.   CD.
  13.  
  14.   The Socket Server has the ability to install an interception COM object that
  15.   can be called whenever it receives or sends data.  Using this feature, you
  16.   can encrypt or compress data using any method you wish.  This demo uses the
  17.   ZLib compression units that ship on the CD to compress/uncompress all data
  18.   going over the wire.
  19.  
  20.   To use this demo;
  21.   1) Make sure you have copied the ZLib units from the CD to a directory and
  22.      have added that directory to this projects search path.
  23.   2) Compile Intrcpt.dpr.
  24.   3) Register Intrcpt.DLL using REGSVR32 or TREGSVR on both the client and the
  25.      server.
  26.   4) On the Server: Bring up the properties for the Socket Server (right click
  27.      on the icon in the task bar and select properties) and put the GUID for
  28.      Intrcpt.DLL in the Interceptor GUID edit control.  The GUID is defined
  29.      below as Class_DataCompressor.
  30.   5) On the Client: Set the TSocketConnection.InterceptorGUID property to the
  31.      Class_DataCompressor GUID and recompile your client.
  32. }
  33.  
  34. interface
  35.  
  36. uses
  37.   Windows, ActiveX, ComObj, SConnect;
  38.  
  39. type
  40.   {
  41.     The interception object needs to implement IDataIntercept defined in
  42.     SConnect.pas.  This interface has 2 procedures DataIn and DataOut described
  43.     below.
  44.   }
  45.   TDataCompressor = class(TComObject, IDataIntercept)
  46.   protected
  47.     procedure DataIn(const Data: IDataBlock); stdcall;
  48.     procedure DataOut(const Data: IDataBlock); stdcall;
  49.   end;
  50.  
  51. const
  52.   Class_DataCompressor: TGUID = '{B249776C-E429-11D1-AAA4-00C04FA35CFA}';
  53.  
  54. implementation
  55.  
  56. uses ComServ, SysUtils, ZLib, Classes;
  57.  
  58. {
  59.   DataIn is called whenever data is coming into the client or server.  Use this
  60.   procedure to uncompress or decrypt data.
  61. }
  62. procedure TDataCompressor.DataIn(const Data: IDataBlock);
  63. var
  64.   Size: Integer;
  65.   InStream, OutStream: TMemoryStream;
  66.   ZStream: TDecompressionStream;
  67.   p: Pointer;
  68. begin
  69.   InStream := TMemoryStream.Create;
  70.   try
  71.     { Skip BytesReserved bytes of data }
  72.     p := Pointer(Integer(Data.Memory) + Data.BytesReserved);
  73.     Size := PInteger(p)^;
  74.     p := Pointer(Integer(p) + SizeOf(Size));
  75.     InStream.Write(p^, Data.Size - SizeOf(Size));
  76.     OutStream := TMemoryStream.Create;
  77.     try
  78.       InStream.Position := 0;
  79.       ZStream := TDecompressionStream.Create(InStream);
  80.       try
  81.         OutStream.CopyFrom(ZStream, Size);
  82.       finally
  83.         ZStream.Free;
  84.       end;
  85.       { Clear the datablock, then write the uncompressed data back into the
  86.         datablock }
  87.       Data.Clear;
  88.       Data.Write(OutStream.Memory^, OutStream.Size);
  89.     finally
  90.       OutStream.Free;
  91.     end;
  92.   finally
  93.     InStream.Free;
  94.   end;
  95. end;
  96.  
  97. {
  98.   DataOut is called whenever data is leaving the client or server.  Use this
  99.   procedure to compress or encrypt data.
  100. }
  101. procedure TDataCompressor.DataOut(const Data: IDataBlock);
  102. var
  103.   InStream, OutStream: TMemoryStream;
  104.   ZStream: TCompressionStream;
  105.   Size: Integer;
  106. begin
  107.   InStream := TMemoryStream.Create;
  108.   try
  109.     { Skip BytesReserved bytes of data }
  110.     InStream.Write(Pointer(Integer(Data.Memory) + Data.BytesReserved)^, Data.Size);
  111.     Size := InStream.Size;
  112.     OutStream := TMemoryStream.Create;
  113.     try
  114.       ZStream := TCompressionStream.Create(clFastest, OutStream);
  115.       try
  116.         ZStream.CopyFrom(InStream, 0);
  117.       finally
  118.         ZStream.Free;
  119.       end;
  120.       { Clear the datablock, then write the compressed data back into the
  121.         datablock }
  122.       Data.Clear;
  123.       Data.Write(Size, SizeOf(Integer));
  124.       Data.Write(OutStream.Memory^, OutStream.Size);
  125.     finally
  126.       OutStream.Free;
  127.     end;
  128.   finally
  129.     InStream.Free;
  130.   end;
  131. end;
  132.  
  133. initialization
  134.   TComObjectFactory.Create(ComServer, TDataCompressor, Class_DataCompressor,
  135.     'DataCompressor', 'SampleInterceptor', ciMultiInstance, tmApartment);
  136. end.
  137.