Главная » 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