uses

 ZLib;

{ Compress a stream }

procedure CompressStream(inpStream, outStream: TStream);

var

 InpBuf, OutBuf: Pointer;

 InpBytes, OutBytes: Integer;

begin

 InpBuf := nil;

 OutBuf := nil;

 try

   GetMem(InpBuf, inpStream.Size);

   inpStream.Position := 0;

   InpBytes := inpStream.Read(InpBuf^, inpStream.Size);

   CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);

   outStream.Write(OutBuf^, OutBytes);

 finally

   if InpBuf <> nil then FreeMem(InpBuf);

   if OutBuf <> nil then FreeMem(OutBuf);

 end;

end;

{ Decompress a stream }

procedure DecompressStream(inpStream, outStream: TStream);

var

 InpBuf, OutBuf: Pointer;

 OutBytes, sz: Integer;

begin

 InpBuf := nil;

 OutBuf := nil;

 sz     := inpStream.Size - inpStream.Position;

 if sz > 0 then  

   try

     GetMem(InpBuf, sz);

     inpStream.Read(InpBuf^, sz);

     DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);

     outStream.Write(OutBuf^, OutBytes);

   finally

     if InpBuf <> nil then FreeMem(InpBuf);

     if OutBuf <> nil then FreeMem(OutBuf);

   end;

 outStream.Position := 0;

end;

{

 Example:

  Compress the contents of RichEdit1 and

  calculate the compression rate.

  Then save the stream to a file (ms2.dat)

 Beispiel:

  Komprimiert den Inhalt von RichEdit1 und

  berechnet die Kompressionsrate.

  Dann wird der Stream in eine Datei (ms2.dat) gespeichert.

}

procedure TForm1.Button1Click(Sender: TObject);

var

 ms1, ms2: TMemoryStream;

begin

 ms1 := TMemoryStream.Create;

 try

   ms2 := TMemoryStream.Create;

   try

     RichEdit1.Lines.SaveToStream(ms1);

     CompressStream(ms1, ms2);

     ShowMessage(Format('Stream Compression Rate: %d %%',

       [round(100 / ms1.Size * ms2.Size)]));

     ms2.SaveToFile('C:\ms2.dat');

   finally

     ms1.Free;

   end;

 finally

   ms2.Free;

 end;

end;

{

 Loads the stream from a file (ms2.dat)

 and decompresses it.

 Then loads the Stream to RichEdit1.

 Lden komprimierten Stream von einer Datei (ms2.dat)

 und dekomprimiert ihn.

 Dann wird der Stream wieder in RichEdit1 geladen.

}

procedure TForm1.Button2Click(Sender: TObject);

var

 ms1, ms2: TMemoryStream;

begin

 ms1 := TMemoryStream.Create;

 try

   ms2 := TMemoryStream.Create;

   try

     ms1.LoadFromFile('C:\ms2.dat');

     DecompressStream(ms1, ms2);

     RichEdit1.Lines.LoadFromStream(ms2);

   finally

     ms1.Free;

   end;

 finally

   ms2.Free;

 end;

end;

**********************************

procedure Compress(var CompressedStream: TMemoryStream);

var

 SourceStream: TCompressionStream;

 DestStream: TMemoryStream;

 Count: Integer;

Begin

 Count := CompressedStream.Size;

 DestStream := TMemoryStream.Create;

 SourceStream:=TCompressionStream.Create(clMax, DestStream);

 Try

   CompressedStream.SaveToStream(SourceStream);

   SourceStream.Free;

   CompressedStream.Clear;

   CompressedStream.WriteBuffer(Count, SizeOf(Count));

   CompressedStream.CopyFrom(DestStream, 0);

 finally

   DestStream.Free;

 end;

end;

procedure UnCompress(const CompressedStream: TMemoryStream);

var

 SourceStream: TDecompressionStream;

 DestStream: TMemoryStream;

 Buffer: PChar;

 Count: integer;

Begin

 CompressedStream.Seek(0,soFromBeginning);

 CompressedStream.ReadBuffer(Count, SizeOf(Count));

 GetMem(Buffer, Count);

 DestStream := TMemoryStream.Create;

 SourceStream := TDecompressionStream.Create(CompressedStream);

 Try

   SourceStream.ReadBuffer(Buffer^, Count);

   DestStream.WriteBuffer(Buffer^, Count);

   DestStream.Position := 0;//复位流指针

   CompressedStream.LoadFromStream(DestStream);

 finally

   FreeMem(Buffer);

   DestStream.Free;

 end;

end;

附件是ZlibEx，封装了ZIP的算法。

Zlibex 1.1.3有Bug的：

ZLibEx 1.1.3 支持流压缩方式，我们可以不断 Write 数据给压缩流，并读取解压缩后的数据，但必须注意：解压后的数据，必须在 ZLibEx 的 TCompressionStream Free 之后才是完整的，因为 TCompressionStream 有自己的缓冲区，如果最后压缩的数据，生成的 ZIP 数据小于缓冲区大小，那么最后压缩数据是不会写入输出的目标流的，必须在最后 Free 后才会写入最后的压缩后的数据！

ZlibEx.pas 本身是有 Bug 的。 ZlibEx 的 Destroy 修正如下：

destructor TCompressionStream.Destroy;

var

 iStreamPos : Integer;

begin

 FZStream.next_in := nil;

 FZStream.avail_in := 0;

 try

   /// 增加的行

   iStreamPos := Destination.Position;

   if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;

////////////////////////////////////////////////////////////////////////////////

///   这里是修正的 ZLibEx 的代码！

{                repeat

                       FZStream.next_out := Buffer;

                       FZStream.avail_out := BufferSize;

                       FStream.WriteBuffer(Buffer^, BufferSize - FZStream.avail_out);

               until ZCompressCheck(deflate(FZStream, Z_FINISH)) = Z_STREAM_END;

}

   FZStream.next_out := Buffer;

   FZStream.avail_out := BufferSize;

   while ZCompressCheck(deflate(FZStream, Z_FINISH)) <> Z_STREAM_END do

   begin

     FStream.WriteBuffer(Buffer^, BufferSize - FZStream.avail_out);

     FZStream.next_out := Buffer;

     FZStream.avail_out := BufferSize;

   end;

   if FZStream.avail_out < BufferSize then

   begin

     FStream.WriteBuffer(Buffer^, BufferSize - FZStream.avail_out);

   end;

////////////////////////////////////////////////////////////////////////////////

       finally

   deflateEnd(FZStream);

 end;

       FreeAndNil(FInternalStream);

 FStreamPos := Destination.Position;

 Destination.Position := iStreamPos;

       inherited;

end;