这是我以前写的一个(也是在其他大富翁帮助下完成的)，
用的是delphi自带的zlib单元，一般压缩率达到50％以上吧，有什么问题再问我
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls ,Zlib;//delphi的压缩功能要调用Zlib单元
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
//压缩过程
procedure Compress(var CompressedStream: TMemoryStream; const CompressionLevel: TCompressionLevel);
//解压过程
procedure UnCompress(const CompressedStream: TMemoryStream);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.UnCompress(const CompressedStream: TMemoryStream); //解压过程
var
SourceStream: TDecompressionStream;
DestStream: TMemoryStream;
Buffer: PChar;
Count: Integer;
Begin
//从被压缩的数据流中读出原始数据的大小
CompressedStream.ReadBuffer(Count, SizeOf(Count));
//根据原始数据的大小为将要读入的原始数据流分配内存块
GetMem(Buffer, Count);
DestStream := TMemoryStream.Create;
SourceStream := TDecompressionStream.Create(CompressedStream);
Try
//将被压缩的数据流解压缩，然后存入 Buffer内存块中
SourceStream.ReadBuffer(Buffer^, Count);
//将原始数据流保存至 DestStream流中
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position := 0;//复位流指针
//从 DestStream流中载入原始数据流
if savedialog1.Execute then DestStream.SaveToFile(savedialog1.FileName);
finally
FreeMem(Buffer);
DestStream.Free;
end;
end;
procedure TForm1.Compress(var CompressedStream: TMemoryStream; const CompressionLevel: TCompressionLevel);
//压缩过程
var
SourceStream: TCompressionStream;
DestStream: TMemoryStream;
Count: Integer;
Begin
Count := CompressedStream.Size;
DestStream := TMemoryStream.Create;
SourceStream:=TCompressionStream.Create(CompressionLevel, DestStream);
Try
//SourceStream中保存着原始的数据流
CompressedStream.SaveToStream(SourceStream);
//将原始数据流进行压缩， DestStream中保存着压缩后的数据流
SourceStream.Free;
CompressedStream.Clear;
//写入原始数据的尺寸
CompressedStream.WriteBuffer(Count, SizeOf(Count));
//写入经过压缩的数据流
CompressedStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject); //压缩按钮
var
CompressedStream: TMemoryStream;
begin
CompressedStream := TMemoryStream.Create;
Try
if opendialog1.Execute then
begin
CompressedStream.LoadFromFile(opendialog1.FileName);
Compress(CompressedStream, clDefault);
if savedialog1.Execute then CompressedStream.SaveToFile(savedialog1.FileName);
end;
finally
CompressedStream.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject); //解压按钮
var
CompressedStream: TMemoryStream;
begin
if opendialog1.Execute then
begin
CompressedStream := TMemoryStream.Create;
CompressedStream.LoadFromFile(opendialog1.FileName);
UnCompress(CompressedStream);
CompressedStream.Free;
end;
end;
end.
