K210.ORG

Джо © (06.09.05 11:14) [2]
В таком духе:

unit CompressUtils;

 

interface

uses Classes, SysUtils, ZLib, ZLibConst;

 

type

 

 IDecompressor = interface

   ['{E852149C-D438-4440-B2AA-B8D1EBFF8F82}']

   function GetCompressed: Boolean;

   property Compressed: Boolean read GetCompressed;

   procedure Decompress (const Dest: TStream);

 end;

 

 ICompressor = interface

   ['{8474E0D6-C866-43A5-9D58-1B8FE7D56C79}']

   procedure CompressTo (const Dest: TStream); overload;

   procedure CompressTo (const AFileName: string); overload;

 end;

 

 TGenericDecompressor = class (TInterfacedObject)

 protected

   function CompressedSignature (Sgn: Word): Boolean; inline;

 end;

 

 TFileDecompressor = class (TGenericDecompressor, IDecompressor)

 private

   FFileName: string;

   FFileStream: TFileStream;

   function GetCompressed: Boolean;

   procedure Decompress (const Dest: TStream);

 public

   constructor Create (const AFileName: string);

   destructor Destroy; override;

 end;

 

 TStreamDecompressor = class (TGenericDecompressor, IDecompressor)

 private

   FSrc: TStream;

   function GetCompressed: Boolean;

   procedure Decompress (const Dest: TStream);

 public

   constructor Create (const Src: TStream);

   destructor Destroy; override;

 end;

 

 TCompressor = class (TInterfacedObject, ICompressor)

 private

   FSrc: TStream;

   FOwnsStream: Boolean;

 public

   constructor Create (ASrc: TStream); overload;

   constructor Create (AFileName: string); overload;

   destructor Destroy; override;

   procedure CompressTo (const Dest: TStream); overload;

   procedure CompressTo (const AFileName: string); overload;

 end;

 

implementation

 

{ TFileDecompressor }

 

constructor TFileDecompressor.Create(const AFileName: string);

begin

 inherited Create;

 FFileName := AFileName;

 FFileStream := TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite);

end;

 

procedure TFileDecompressor.Decompress(const Dest: TStream);

var

 DecomStream: TDecompressionStream;

begin

 if not GetCompressed then

   raise Exception.Create('File is not compressed');

 

 Dest.Position := 0;

 FFileStream.Position := 0;

 

 DecomStream := TDecompressionStream.Create(FFileStream);

 try

   Dest.CopyFrom(DecomStream,DecomStream.Size);

 finally

   DecomStream.Free;

 end;

 

end;

 

destructor TFileDecompressor.Destroy;

begin

 FFileStream.Free;

 inherited;

end;

 

function TFileDecompressor.GetCompressed: Boolean;

var

 F: File;

 Sgn: Word;

begin

 AssignFile(F,FFileName);

 Reset(F,1);

 try

   BlockRead(F,Sgn,SizeOf(Sgn));

   Result := CompressedSignature(Sgn)

 finally

   CloseFile(F);

 end;

end;

 

{ TStreamDecompressor }

 

constructor TStreamDecompressor.Create(const Src: TStream);

begin

 inherited Create;

 FSrc := Src

end;

 

function TStreamDecompressor.GetCompressed: Boolean;

var

 Sgn: Word;

begin

 FSrc.Position := 0;

 FSrc.Read(Sgn,SizeOf(Sgn));

 Result := CompressedSignature(Sgn)

end;

 

procedure TStreamDecompressor.Decompress(const Dest: TStream);

const

 BufSize = 4096;

var

 DecompStream: TDecompressionStream;

 Buff: array [0..BufSize] of Byte;

 R: Integer;

begin

 if not GetCompressed then

   raise Exception.Create('File is not compressed');

 FSrc.Position := 0;

 Dest.Position := 0;

 DecompStream := TDecompressionStream.Create(FSrc);

 try

   R := -1;

   while R <>0 do

   begin

     R := DecompStream.Read(Buff[0],SizeOf(Buff));

     Dest.Write(Buff[0],R)

   end;

 finally

   DecompStream.Free;

 end;

 

end;

 

destructor TStreamDecompressor.Destroy;

begin

 

 inherited;

end;

 

{ TGenericDecompressor }

 

function TGenericDecompressor.CompressedSignature(Sgn: Word): Boolean;

begin

 Result := Sgn = $9C78

end;

 

{ TStreamCompressor }

 

procedure TCompressor.CompressTo(const Dest: TStream);

const

 BufSize = 4096;

var

 ComprStream: TCompressionStream;

 Buff: array [0..BufSize] of Byte;

 R: Integer;

begin

 ComprStream := TCompressionStream.Create(clDefault,Dest);

 try

   R := -1;

   while R <> 0 do

   begin

     R := FSrc.Read(Buff[0],SizeOf(Buff));

     ComprStream.Write(Buff[0],R)

   end;

 finally

   ComprStream.Free;

 end;

end;

 

procedure TCompressor.CompressTo(const AFileName: string);

var

 FileStream: TFileStream;

begin

 FileStream := TFileStream.Create(AFileName,fmCreate);

 try

   CompressTo (FileStream);

 finally

   FileStream.Free;

 end;

end;

 

constructor TCompressor.Create(ASrc: TStream);

begin

 inherited Create;

 FSrc := ASrc;

 FOwnsStream := False;

end;

 

constructor TCompressor.Create(AFileName: string);

begin

 inherited Create;

 FSrc := TFileStream.Create(AFileName,fmOpenRead);

 FOwnsStream := True;

end;

 

destructor TCompressor.Destroy;

begin

 if FOwnsStream then

   FSrc.Free;

 inherited;

end;

 

end.

Примеры сейчас напишу.

Джо © (06.09.05 11:27) [3]
Сжатие:

var

 Compressor: ICompressor;

 AStream,

 AnotherStream: TMemoryStream;

...

 // сжатие из файла в поток

 Compressor := TCompressor.Create ('d:\text.txt');

 Compressor.CompressTo ('d:\file.cmp');

 // сжатие из потока в поток

 Compressor := TCompressor.Create (AStream);

 Compressor.CompressTo (AnotherStream);

 // сжатие из потока в файл

 Compressor := TCompressor.Create (AStream);

 Compressor.CompressTo ('d:\file.cmp');

----------
Разжатие.

var

 Decompressor: IDecompressor;

 AStream, AnotherStream: TMemoryStream;

...

 // из файла в поток

 Decompressor := TFileDecompressor.Create('d:\file.cmp');

 Decompressor.Decompress(AStream);

 // из потока в поток

 Decompressor := TStreamDecompressor.Create(AStream);

 Decompressor.Decompress(AnotherStream);

В таком духе, что ли...
--------------------------------------------------------------------------------
Slym © (06.09.05 14:03) [4]

unit StreamZLib;

 

interface

uses classes

procedure Compress(Source,Dest:TStream);

procedure Decompress(Source,Dest:TStream);

 

implementation

uses zlib;

 

procedure Compress(Source,Dest:TStream);

var

 CompressionStream:TCompressionStream;

 Buf:array[0..4095] of char;

 Readed:integer;

begin

 CompressionStream:=TCompressionStream.Create(clMax,Source);

 try

   repeat

     Readed:=CompressionStream.Read(Buf,SizeOf(Buf));

     Dest.WriteBuffer(Buf,Readed);

   until Readed=0;

 finally

   CompressionStream.Free;

 end;

end;

 

procedure Decompress(Source,Dest:TStream);

var

 DecompressionStream:TDecompressionStream;

 Buf:array[0..4095] of char;

 Readed:integer;

begin

 DecompressionStream:=TDecompressionStream.Create(Source);

 try

   repeat

     Readed:=DecompressionStream.Read(Buf,SizeOf(Buf));

     Dest.WriteBuffer(Buf,Readed);

   until Readed=0;

 finally

   DecompressionStream.Free;

 end;

end;

end.

http://www.delphimaster.ru/cgi-bin/forum.pl?id=1125988262&n=0