Главная » Delphi » Основная » Сжатие файлов

Сжатие файлов

09:00
Джо © (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