Текущий архив: 2005.10.02;
Скачать: CL | DM;

Вниз

Zlib - архивирование   Найти похожие ветки 

← →
Lexandr   (2005-09-06 10:31) [0]

Мне нужно упаковать переменную TStream в файл, а затем распаковать из файла в переменную TStrim.
ТJvZlibMultiple - это делает но только наоборот. Может это можно преодолеть или выбрать другой компонент для упаковки.
За ранее Вам благодарен!

---

← →
Lexandre   (2005-09-06 10:35) [1]

... и еще ОЧЕНЬ ВАЖНЫЙ МОМЕНТ - как распаковать TStrim в TStrim без промежуточных файлов!

---

← →
Джо ©   (2005-09-06 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.

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

---

← →
Джо ©   (2005-09-06 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 ©   (2005-09-06 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.

---

← →
Lexandre   (2005-09-06 15:48) [5]

Мужики, а как насчет качества сжатия - это что за алгоритм (сав или zip) мне нужно как можно больший коэф сжатия - инфа по сети передается...
... и всем большое СПАСИБО кто откликнулся...

---

← →
Antonn ©   (2005-09-06 17:02) [6]

Lexandre   (06.09.05 15:48) [5]
это почти RAR

---

← →
Джо ©   (2005-09-07 02:19) [7]

>  [6] Antonn ©   (06.09.05 17:02)
> Lexandre   (06.09.05 15:48) [5]
> это почти RAR

?

---

← →
Slym ©   (2005-09-07 06:30) [8]

Lexandre   (06.09.05 15:48) [5]
Качество сжатия сильно влияет на CPU Time...
Иногда лучше сжимать средненько и не загружать проц на 100%

---

← →
Antonn ©   (2005-09-07 08:15) [9]

Джо ©   (07.09.05 2:19) [7]
к посту [5]:

> а как насчет качества сжатия - это что за алгоритм
> (сав или zip) мне нужно как можно больший коэф сжатия
> - инфа по сети передается...

---

← →
Lexandre   (2005-09-07 10:02) [10]

Ребята, а что я делаю неправильно?

Передаю в процедуру с RichEdita выделенный текст что бы его сжать и сохранить в файл (код сжатия я упустил в примере)
В общем в результате в файле ничего нет
Как правильно сохранить поток в файл?

procedure Compress(Sel_Text: TStrings; FileName: String);
var
CompressionStream:TCompressionStream;
Source: TStream;
Source2: TStringList;
begin
Source:=TMemoryStream.Create;
Sel_Text.SaveToStream(Source);
....
....
Source2:=TStringList.Create;
Source2.LoadFromStream (Source);
Source2.SaveToFile(FileName);
end;

---

← →
Erik1 ©   (2005-09-07 16:18) [11]

А почему бы тебе в дебагере непроверить есть ли в Sel_Text текст и что записывается в Source. А в место TStringList лучше использовать TFileStream. Для проверки сколько байтов записалось в стреам советую посмотреть Size.

---

← →
Slym ©   (2005-09-08 07:48) [12]

Lexandre   (07.09.05 10:02) [10]
Source2:=TStringList.Create;
Source2.LoadFromStream (Source);
Source2.SaveToFile(FileName);
А это нах?
FileStream:=TFileStream.Create(..
try
 CompressionStream:=TCompressionStream(FileStream);
 try
   Sel_Text.SaveToStream(CompressionStream);
 finally
   CompressionStream.Free;
 end;
finally
 FileStream.Free;
end;

---

Страницы: 1 вся ветка

Текущий архив: 2005.10.02;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.048 c