interceptor.~pas

非常丰富的delphi小程序,相信会对你有帮助

unit interceptor;
interface

uses
  Windows, ActiveX, ComObj, SConnect;

type
  TMy_Interceptor = class(TComObject, IDataIntercept)
  protected
    procedure DataIn(const Data: IDataBlock); stdcall;
    procedure DataOut(const Data: IDataBlock); stdcall;
  end;

const
  Class_My_Interceptor: TGUID = '{B249776C-E429-11D1-AAA4-00C04FA35CFA}';

implementation

uses ComServ, SysUtils, ZLib, Classes, MidConst;

procedure Encode(SrcStream: TStream);
var
  Buffer : TMemoryStream;
  Ch : byte;
begin
  if SrcStream.Size=0 then  exit;
 Buffer := TMemoryStream.Create;
  try
    SrcStream.Position := 0;
    while SrcStream.Position < SrcStream.Size do
    begin
      SrcStream.Read(Ch,1);
      Ch := Ch XOR Ord('z');
      Buffer.Write(ch,1);
    end;
    Buffer.Position := 0;
    SrcStream.Size := 0;
    SrcStream.CopyFrom(Buffer, 0);
  finally
    Buffer.Free;
  end;
end;

procedure Decode(SrcStream: TStream);
var
  Buffer : TMemoryStream;
  Ch : byte;
begin
  if SrcStream.Size=0 then  exit;

  Buffer := TMemoryStream.Create;
  try
    SrcStream.Position := 0;
    while SrcStream.Position < SrcStream.Size do
    begin
      SrcStream.Read(Ch,1);
      Ch := Ch XOR Ord('z');
      Buffer.Write(ch,1);
    end;
    Buffer.Position := 0;
    SrcStream.Size := 0;
    SrcStream.CopyFrom(Buffer, 0);
  finally
    Buffer.Free;
  end;
end;


procedure TMy_Interceptor.DataIn(const Data: IDataBlock);
var
  Size: Integer;
  InStream, OutStream: TMemoryStream;
  ZStream: TDecompressionStream;
  p: Pointer;
begin
  InStream := TMemoryStream.Create;
  try
    { Skip BytesReserved bytes of data }
    p := Pointer(Integer(Data.Memory) + Data.BytesReserved);
    Size := PInteger(p)^;
    if Size = 0 then Exit; 
    p := Pointer(Integer(p) + SizeOf(Size));
    InStream.Write(p^, Data.Size - SizeOf(Size));
    Decode(InStream);
    OutStream := TMemoryStream.Create;
    try
      InStream.Position := 0;
      ZStream := TDecompressionStream.Create(InStream);
      try
        OutStream.CopyFrom(ZStream, Size);
      finally
        ZStream.Free;
      end;
      { Clear the datablock, then write the uncompressed data back into the
        datablock }
      Data.Clear;
      Data.Write(OutStream.Memory^, OutStream.Size);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;


procedure TMy_Interceptor.DataOut(const Data: IDataBlock);
var
  InStream, OutStream: TMemoryStream;
  ZStream: TCompressionStream;
  Size: Integer;
begin
  InStream := TMemoryStream.Create;
  try
    { Skip BytesReserved bytes of data }
    InStream.Write(Pointer(Integer(Data.Memory) + Data.BytesReserved)^, Data.Size);
    Size := InStream.Size;
    if Size = 0 then Exit; 
    OutStream := TMemoryStream.Create;
    try
      ZStream := TCompressionStream.Create(clFastest, OutStream);
      try
        ZStream.CopyFrom(InStream, 0);
      finally
        ZStream.Free;
      end;
      { Clear the datablock, then write the compressed data back into the
        datablock }
      Encode(OutStream);
      Data.Clear;
      Data.Write(Size, SizeOf(Integer));
      Data.Write(OutStream.Memory^, OutStream.Size);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;

initialization

  TPacketInterceptFactory.Create(ComServer, TMy_Interceptor, Class_My_Interceptor,
    'My_Interceptor', 'My_Interceptor_Sample', ciMultiInstance, tmApartment);
end.