DELPHI 通过ZLib来压缩文件夹
unit Unit1; interface uses ZLib, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const cBufferSize = $4096; cIdent: string[3] = 'zsf'; cVersion = $01; cErrorIdent = -1; cErrorVersion = -2; type TFileHead = packed record rIdent: string[3]; //标识 rVersion: Byte; //版本 end; type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private function StrLeft(const mStr: string; mDelimiter: string): string; function StrRight(const mStr: string; mDelimiter: string): string; function FileCompression(mFileName: TFileName; mStream: TStream): Integer; function FileDecompression(mFileName: TFileName; mStream: TStream): Integer; function DirectoryCompression(mDirectory, mFileName: TFileName): Integer; function DirectoryDecompression(mDirectory, mFileName: TFileName): Integer; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function TForm1.DirectoryCompression(mDirectory, mFileName: TFileName): Integer; var vFileInfo: TStrings; vFileInfoSize: Integer; vFileInfoBuffer: PChar; vFileHead: TFileHead; vMemoryStream: TMemoryStream; vFileStream: TFileStream; procedure pAppendFile(mSubFile: TFileName); begin vFileInfo.Append(Format('%s|%d', [StringReplace(mSubFile, mDirectory + '', '', [rfReplaceAll, rfIgnoreCase]), FileCompression(mSubFile, vMemoryStream)])); Inc(Result); end; procedure pSearchFile(mPath: TFileName); var vSearchRec: TSearchRec; K: Integer; begin K := FindFirst(mPath + '*.*', faAnyFile, vSearchRec); while K = 0 do begin if (vSearchRec.Attr and faDirectory > 0) and (Pos(vSearchRec.Name, '..') = 0) then pSearchFile(mPath + '' + vSearchRec.Name) else if Pos(vSearchRec.Name, '..') = 0 then pAppendFile(mPath + '' + vSearchRec.Name); K := FindNext(vSearchRec); end; FindClose(vSearchRec); end; begin Result := 0; if not DirectoryExists(mDirectory) then Exit; vFileInfo := TStringList.Create; vMemoryStream := TMemoryStream.Create; mDirectory := ExcludeTrailingPathDelimiter(mDirectory); vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite); try pSearchFile(mDirectory); vFileInfoBuffer := vFileInfo.GetText; vFileInfoSize := StrLen(vFileInfoBuffer); { DONE -oZswang -c添加 : 写入头文件信息 } vFileHead.rIdent := cIdent; vFileHead.rVersion := cVersion; vFileStream.Write(vFileHead, SizeOf(vFileHead)); vFileStream.Write(vFileInfoSize, SizeOf(vFileInfoSize)); vFileStream.Write(vFileInfoBuffer^, vFileInfoSize); vMemoryStream.Position := 0; vFileStream.CopyFrom(vMemoryStream, vMemoryStream.Size); finally vFileInfo.Free; vMemoryStream.Free; vFileStream.Free; end; end; function TForm1.FileCompression(mFileName: TFileName; mStream: TStream): Integer; var vFileStream: TFileStream; vBuffer: array[0..cBufferSize]of Char; vPosition: Integer; I: Integer; begin Result := -1; if not FileExists(mFileName) then Exit; if not Assigned(mStream) then Exit; vPosition := mStream.Position; vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone); with TCompressionStream.Create(clMax, mStream) do try for I := 1 to vFileStream.Size div cBufferSize do begin vFileStream.Read(vBuffer, cBufferSize); Write(vBuffer, cBufferSize); end; I := vFileStream.Size mod cBufferSize; if I > 0 then begin vFileStream.Read(vBuffer, I); Write(vBuffer, I); end; finally Free; vFileStream.Free; end; Result := mStream.Size - vPosition; //增量 end; procedure TForm1.Button1Click(Sender: TObject); var i : Integer; begin try i:=DirectoryCompression('E:ArkProjectDebugPublicBillServerQueryOutLog','E:ArkProjectDebugPublicBillServerQueryOutlog.rar'); except Application.MessageBox('',PChar(inttostr(i)),48); end; end; function TForm1.DirectoryDecompression(mDirectory, mFileName: TFileName): Integer; var vFileInfo: TStrings; vFileInfoSize: Integer; vFileHead: TFileHead; vMemoryStream: TMemoryStream; vFileStream: TFileStream; I: Integer; begin Result := 0; if not FileExists(mFileName) then Exit; vFileInfo := TStringList.Create; vMemoryStream := TMemoryStream.Create; mDirectory := ExcludeTrailingPathDelimiter(mDirectory); vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone); try if vFileStream.Size < SizeOf(vFileHead) then Exit; { DONE -oZswang -c添加 : 读取头文件信息 } vFileStream.Read(vFileHead, SizeOf(vFileHead)); if vFileHead.rIdent <> cIdent then Result := cErrorIdent; if vFileHead.rVersion <> cVersion then Result := cErrorVersion; if Result <> 0 then Exit; vFileStream.Read(vFileInfoSize, SizeOf(vFileInfoSize)); vMemoryStream.CopyFrom(vFileStream, vFileInfoSize); vMemoryStream.Position := 0; vFileInfo.LoadFromStream(vMemoryStream); for I := 0 to vFileInfo.Count - 1 do begin vMemoryStream.Clear; vMemoryStream.CopyFrom(vFileStream, StrToIntDef(StrRight(vFileInfo[I], '|'), 0)); vMemoryStream.Position := 0; FileDecompression(mDirectory + '' + StrLeft(vFileInfo[I], '|'), vMemoryStream); end; Result := vFileInfo.Count; finally vFileInfo.Free; vMemoryStream.Free; vFileStream.Free; end; end; function TForm1.StrLeft(const mStr: string; mDelimiter: string): string; begin Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1); end; function TForm1.StrRight(const mStr: string; mDelimiter: string): string; begin if Pos(mDelimiter, mStr) > 0 then Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt) else Result := ''; end; function TForm1.FileDecompression(mFileName: TFileName; mStream: TStream): Integer; var vFileStream: TFileStream; vBuffer: array[0..cBufferSize]of Char; I: Integer; begin Result := -1; if not Assigned(mStream) then Exit; ForceDirectories(ExtractFilePath(mFileName)); //创建目录 vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite); with TDecompressionStream.Create(mStream) do try repeat I := Read(vBuffer, cBufferSize); vFileStream.Write(vBuffer, I); until I = 0; Result := vFileStream.Size; finally Free; vFileStream.Free; end; end; procedure TForm1.Button2Click(Sender: TObject); var i : Integer; begin try i:=DirectoryDecompression('E:ArkProjectDebugPublicBillServerQueryOutLog2','E:ArkProjectDebugPublicBillServerQueryOutlog.rar'); except Application.MessageBox('',PChar(inttostr(i)),48); end; end; end.
Base64编码解码及ZLib压缩解压
最近在写的程序与SOAP相关,所以用到了一些Base64编码/解码及数据压缩/解压方面的知识. 在这里来作一些总结:
一.Base64编码/解码
一般用到的是Delphi自带的单元EncdDecd,当然还有第三方提供的单元或控件,其中我所接触到的认为比较好的有Indy的TIdMimeEncode / TIdMimeDecode组件,以及RjMime单元.
在这里主要想讲讲如何才能获得最好的编码/解码性能,EncdDecd提供了EncodeStream/DecodeString, EncodeString/DecodeString两对函数,如果你使用EncodeString/DecodeString,这没有什麽可争议,效率是死的,如果你使用了EncodeStream/DecodeStream,这里面可大有文章了. 先来看看两个函数的声明:
procedure EncodeStream(Input, Output: TStream);
procedure DecodeStream(Input, Output: TStream);
很明了, 两个参数,都为TStream, TStream是抽象类, 其派生类主要有TMomoryStream,TStringStream,TFileStream等,都可以作为参数传递进去,对於Input参数,无论TMemoryStream, TStringStream, TFileStream都不会影响性能,但是对於Output参数,由於压缩的结果是写住OutputStream,因此压缩过程中不断地执行TStream的Write方法,如果是TMemoryStream,那效率真是太糟糕了,我作过测试,编码一个5M多的文件,要十几秒钟!但如果是TStringStream呢,只要0.2~0.3秒! 这究竟是为什麽呢,因为TMemoryStream里不断调用Write方法的结果是,不断地向Windows要求分配内存!从而导致性能下降!而TStringStream和TFileStream则没有这个问题. 因此,在这里极力向朋友们建议,Output参数最好不用TMemoryStream.
不过不要紧,你一定要用的话,也是有方法解决性能下降这个问题的! 因为效率下降的原因是不断的申请内存空间,我们可以从这个方向首手,能不能一次性给它分配好内存空间呢,如果我们事先能确定编码或解码后的数据大小(字节数),那麽这是可行的. 问题的关键就是如何确定这个编码或解码后的字节数了. 对於EncdDecd,我可以给出这个计算方法:
(1)假设编码前的字节数为X,那麽编码后的字节数为 (X + 2) div 3 * 4. 不过,要对EncdDecd进行相应的修改,找到这一小段:
if K > 75 then
begin
BufPtr[0] := #$0D;
BufPtr[1] := #$0A;
Inc(BufPtr, 2);
K := 0;
end;
将其注释掉, 因为这其实是没什麽用的,只是用来对编码后的字符串分行的~,我们可以注释后将单元另存为EncdDecdEx,以后就使用它了!!!
(2)假设解码前的字节数是X,那麽解码后的字节数约为 (X + 3) div 4 * 3
*****注:与编码不同的是,解码的字节数不是确定的,差值在0~2之间.
这样我们就可以在编码/解码前对Output参数的TMemoryStream事先设置缓冲区大小了....
uses encddecdEx; var Input,Output:TMemoryStream; begin Input:=TMemoryStream.Create; try Input.LoadFromFile('c:aaa.txt'); Output:=TMemoryStream.Create; try Output.Size:=(Input.Size + 2) div 3 * 4; EncodeStream(Input,Output); finally Output.Free; end; finally Input.Free; end; end;
OK! 大功告成!!! 大家有兴趣可以测试一下,加不加Output.Size:=(Input.Size + 2) div 3 * 4这一句的不同效果~
二.ZLib压缩/解压
在一些分布式系统中,特别是Internet分布式系统,由於网络带宽所限,我们需要对传输的大流量数据进行压缩,以减轻网络的负担,加快程序运行速度,一般用到的压缩/解压方法是使用ZLib单元. ZLib单元主要提供了两个类:TCompressionStream和TDeCompressionStream. 这两个类分别处理压缩和解压缩. 使用方法可以查阅相关的资料. 在这里提供两个过程,再对压缩时的参数作些比较:
uses ZLib; procedure Zip(Input,Output:TStream;Compress:Boolean); const MAXBUFSIZE=1024 * 16; //16 KB var CS:TCompressionStream; DS:TDecompressionStream; Buf:array[0..MAXBUFSIZE-1] of Byte; BufSize:Integer; begin if Assigned(Input) and Assigned(Output) then begin if Compress then begin CS:=TCompressionStream.Create(clDefault,Output); try CS.CopyFrom(Input,0); //从开始处复制 finally CS.Free; end; end else begin DS:=TDecompressionStream.Create(Input); try BufSize:=DS.Read(Buf,MAXBUFSIZE); while BufSize>0 do begin Output.Write(Buf,BufSize); BufSize:=DS.Read(Buf,MAXBUFSIZE); end; finally DS.Free; end; end; end; end; function Zip(Input:string;Compress:Boolean):string; var InputStream,OutputStream:TStringStream; begin if Input='' then Exit; InputStream:=TStringStream.Create(Input); try OutputStream:=TStringStream.Create(''); try Zip(InputStream,OutputStream,Compress); Result:=OutputStream.DataString; finally OutputStream.Free; end; finally InputStream.Free; end; end;
以上两个方法是两个名称一样,参数不同的过程. 第一个是对流进行压缩/解压,Input,Output分别是压缩/解压前的流与压缩/解压后的流. 第二个是对字符串进行压缩/解压. 两个过程都有Compress参数,这个参数用来决定进行压缩操作还是解压操作: True--压缩; false--解压.
在第一个过程中,有这样一句:
CS:=TCompressionStream.Create(clDefault,Output);
这是在建立压缩类以对流进行压缩, 这里面有个参数clDefault,当然还有其它的选项:clNone, clFastest, clDefault, clMax;
clNone与clFastest就不讨论了,因为不能获得良好的压缩效果,在这里想讨论clDeafult与clMax哪一个好点,我作了一些测试,测试数据如下:
源文件大小 压缩所用时间 压缩后文件大小
clDefault 2.71M ~1.4s ~937K
5.10M ~2.8s ~1.77M
clMax 2.71M ~2.5s ~934K
5.10M ~4.7s ~1.77M
由这些数据可以看出,clDefault参数与clMax参数,压缩率已经非常接近了,但是所用的时间却相差了近一倍! 也就是说,差不多的压缩效率,clDefault参数比clMax参数节省了一半的时间! 因此,建议大家使用参数clDefault,这是压缩效率比较好的参数.
三. 何对MIDAS封包进行压缩.
我们知道,MIDAS封包外在类型是OleVariant,其内部格式没有对外公开! 经过我的一些测试,该封包是以varByte为基础类型的VarArray数组.
因此,我们可以将其转换成string类型再进行压缩,至於压缩后是以string传输还是转换回VarByte array类型,就由个人决定了. 下面的函数完成将MIDAS数据包转换成string类型.
function UnpackMIDAS(vData:OleVariant):string; var P:Pointer; Size:Integer; begin if not VarIsArray(vData) then Exit; Size:=VarArrayHighBound(vData,1)-VarArrayLowBound(vData,1)+1; P:=VarArrayLock(vData); try SetLength(Result,Size); Move(P^,Result[1],Size); finally VarArrayUnLock(vData); end; end;
假设以下为MIDAS服务器或COM+对象一个方法.
function TDeptCoor.GetDeptData: OleVariant; var Command:WideString; Options:TGetRecordOptions; RecsOut:Integer; Params,OwnerData:OleVariant; begin try Command:='SELECT DeptID,DeptNo,DeptName,MasterID FROM Department ORDER BY DeptNo'; Options:=[grReset,grMetaData]; Result:=FCommTDM.AS_GetRecords('CommDsp',-1,RecsOut,Byte(Options),Command,Params,OwnerData); Result:=UnpackMIDAS(Result); //将MIDAS封包转换成string类型 Result:=Zip(Result,True); //进行压缩,再将压缩后结果转回. SetComplete; except SetAbort; raise; end; end;
客户端只要压压缩后就可以使用了:
procedure TForm1.Button1Click(sender:TObject); var vData:string; begin vData:=DeptCoor.GetDeptData; vData:=Zip(vData,False); //解压 ClientDataSet1.XMLData:=vData; //注意,这里用的是XMLData,不是Data,否则会报错!!! end;
四. SOAP系统中压缩后编码:
在SOAP系统中,由於二进制数据不能直接传递,需要进行Base64编码, 我们可以在数据传递前先压缩/Base64编码,接收后再Base64解码/解压缩.
同样,也给出两个函数,来分别完成这两个过程
function SoapPacket(const Input:string):string; var InputStream,OutputStream:TStringStream; begin InputStream:=TStringStream.Create(Input); try OutputStream:=TStringStream.Create(''); try Zip(InputStream,OutputStream,True); InputStream.Size:=0; OutputStream.Position:=0; //很重要!!! EncodeStream(OutputStream,InputStream); Result:=InputStream.DataString; finally OutputStream.Free; end; finally InputStream.Free; end; end; function SoapUnpack(const Input:string):string; var InputStream,OutputStream:TStringStream; begin InputStream:=TStringStream.Create(Input); try OutputStream:=TStringStream.Create(''); try DecodeStream(InputStream,OutputStream); InputStream.Size:=0; OutputStream.Position:=0; //很重要!!! Zip(OutputStream,InputStream,False); Result:=InputStream.DataString; finally OutputStream.Free; end; finally InputStream.Free; end; end;
Delphi使用Zlib
uses zlib; //将Src使用Zlib压缩后存入Dst当中 procedure PackStream(const Src:TStream; Dst:TStream); var CompStream: TCompressionStream; begin //增加“断言”以防止输入参数有误 Assert(Src <> Nil); Assert(Dst <> Nil); CompStream := TCompressionStream.Create(clDefault,Dst); try //将源数据的偏移转到首部 Src.Seek(0,soFromBeginning); //使用CopyFrom将源数据输入到压缩流，以实现压缩 CompStream.CopyFrom(Src,0); finally CompStream.Free; end; end; //将以zlib压缩的Src解压缩后存入Dst当中 procedure UnpackStream(const Src:TStream; Dst:TStream); var DecompStream: TDecompressionStream; NewSize: Int64; begin //增加“断言”以防止输入参数有误 Assert(Src <> Nil); Assert(Dst <> Nil); DecompStream:= TDecompressionStream.Create(Src); try //将源数据的偏移转到首部 NewSize := Src.Seek(0, soFromEnd); Src.Seek(0, soFromBeginning); //使用CopyFrom将源数据输入到解压缩流，以实现解压缩 //并得到实际解压缩后的数据大小(NewSize) //内部会使用AllocMem(System单元定义)对Dst进行内存重新分配 //所以，Dst的内存管理必须兼容AllocMem进行内存分配 NewSize := Dst.CopyFrom(DecompStream,NewSize); //重新设置Dst的实际大小(已经在解压缩过程当中进行重新分配) Dst.Size := NewSize; finally DecompStream.Free; end; end; //测试代码 procedure Test; var SrcStream,PackedStream,UnpackedStream:TMemoryStream; begin SrcStream := TMemoryStream.Create; try SrcStream.LoadFromFile('c: est.xml'); PackedStream := TMemoryStream.Create; try //压缩 PackStream(SrcStream, PackedStream); PackedStream.Seek(0, soFromBeginning); PackedStream.SaveToFile('c: est_xml.pk'); UnpackedStream := TMemoryStream.Create; try //解压缩 UnpackStream(PackedStream, UnpackedStream); UnpackedStream.Seek(0, soFromBeginning); UnpackedStream.SaveToFile('c: est_xml.xml'); finally UnpackedStream.Free; end; finally PackedStream.Free; end; finally SrcStream.Free; end; end;
Delphi使用Zlib示例代码
uses zlib; //将Src使用Zlib压缩后存入Dst当中 procedure PackStream(const Src:TStream; Dst:TStream); var CompStream: TCompressionStream; begin //增加“断言”以防止输入参数有误 Assert(Src <> Nil); Assert(Dst <> Nil); CompStream := TCompressionStream.Create(clDefault,Dst); try //将源数据的偏移转到首部 Src.Seek(0,soFromBeginning); //使用CopyFrom将源数据输入到压缩流，以实现压缩 CompStream.CopyFrom(Src,0); finally CompStream.Free; end; end; //将以zlib压缩的Src解压缩后存入Dst当中 procedure UnpackStream(const Src:TStream; Dst:TStream); var DecompStream: TDecompressionStream; NewSize: Int64; begin //增加“断言”以防止输入参数有误 Assert(Src <> Nil); Assert(Dst <> Nil); DecompStream:= TDecompressionStream.Create(Src); try //将源数据的偏移转到首部 NewSize := Src.Seek(0, soFromEnd); Src.Seek(0, soFromBeginning); //使用CopyFrom将源数据输入到解压缩流，以实现解压缩 //并得到实际解压缩后的数据大小(NewSize) //内部会使用AllocMem(System单元定义)对Dst进行内存重新分配 //所以，Dst的内存管理必须兼容AllocMem进行内存分配 NewSize := Dst.CopyFrom(DecompStream,NewSize); //重新设置Dst的实际大小(已经在解压缩过程当中进行重新分配) Dst.Size := NewSize; finally DecompStream.Free; end; end; //测试代码 procedure Test; var SrcStream,PackedStream,UnpackedStream:TMemoryStream; begin SrcStream := TMemoryStream.Create; try SrcStream.LoadFromFile('c: est.xml'); PackedStream := TMemoryStream.Create; try //压缩 PackStream(SrcStream, PackedStream); PackedStream.Seek(0, soFromBeginning); PackedStream.SaveToFile('c: est_xml.pk'); UnpackedStream := TMemoryStream.Create; try //解压缩 UnpackStream(PackedStream, UnpackedStream); UnpackedStream.Seek(0, soFromBeginning); UnpackedStream.SaveToFile('c: est_xml.xml'); finally UnpackedStream.Free; end; finally PackedStream.Free; end; finally SrcStream.Free; end; end;
Delphi使用zlib来压缩文件
使用时，需要Zlib.pas和 Zlibconst.pas两个单元文件，这两个文件保存在 Delphi 5.0安装光盘上 InfoExtrasZlib目录下，此外，在 InfoExtrasZlibObj目录中还保存了 Zlib.pas单元引用的 Obj文件，把这个目录拷贝到delphi的lib下，即可。可以适当的改动比如增加目录压缩和分文件压缩，其实就是在文件流前面增加一部分描述结构就是，不多说。使用 时，还要use zlib单元。 两个函数如下:
procedure CompressIt(var CompressedStream: TMemoryStream; const CompressionLevel: TCompressionLevel); // 参数是传递的流和压缩方式 var SourceStream: TCompressionStream; DestStream: TMemoryStream; Count: int64; //注意，此处修改了,原来是int 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 UnCompressit(const CompressedStream: TMemoryStream; var UnCompressedStream: TMemoryStream); //参数 压缩过的流，解压后的流 var SourceStream: TDecompressionStream; DestStream: TMemoryStream; Buffer: PChar; Count: int64; 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.Position := length(VER_INFO); //从DestStream流中载入图像流 UnCompressedStream.LoadFromStream(DestStream); finally FreeMem(Buffer); DestStream.Free; end; end;
使用的例子如下：
procedure TForm1.Button5Click(Sender: TObject); //把指定文件压缩然后保存为另外一个压缩包， //呵呵，我使用的时候是把后缀改成cab,可以唬一些人吧？ var SM: TMemoryStream; begin if OpenDialog1.Execute then begin if SaveDialog1.Execute then begin SM := TMemoryStream.Create; try Sm.LoadFromFile(OpenDialog1.FileName); SM.Position := 0; Compressit(sm, clDefault); sm.SaveToFile(SaveDialog1.FileName); finally SM.Free; end; end; end; end; procedure TForm1.BitBtn2Click(Sender: TObject); //把指定的压缩包解成原来的文件。 var SM, DM: TMemoryStream; begin if OpenDialog1.Execute then begin if SaveDialog1.Execute then begin SM := TMemoryStream.Create; DM := TMemoryStream.Create; try Sm.LoadFromFile(OpenDialog1.FileName); SM.Position := 0; UnCompressit(sm, dm); dm.Position := 0; dm.SaveToFile(SaveDialog1.FileName); finally SM.Free; DM.Free; end; end; end; end;
压缩与解压缩进度
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; ProgressBar1: TProgressBar; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CsProgress(Sender: TObject); {压缩的 OnProgress 事件} procedure DsProgress(Sender: TObject); {解压缩的 OnProgress 事件} end; var Form1: TForm1; implementation {$R *.dfm} uses Zlib; {压缩的 OnProgress 事件} procedure TForm1.CsProgress(Sender: TObject); begin ProgressBar1.Position := Integer(TCompressionStream(Sender).Position div 1024); Application.ProcessMessages; end; {解压缩的 OnProgress 事件} procedure TForm1.DsProgress(Sender: TObject); begin ProgressBar1.Position := Integer(TDecompressionStream(Sender).Position div 1024); Application.ProcessMessages; end; {压缩} procedure TForm1.Button1Click(Sender: TObject); var cs: TCompressionStream; fs,ms: TMemoryStream; num: Integer; begin fs := TMemoryStream.Create; fs.LoadFromFile('c: emp est.txt'); {我是用一个 15M 的文本文件测试的} num := fs.Size; ms := TMemoryStream.Create; ms.Write(num, SizeOf(num)); cs := TCompressionStream.Create(clMax, ms); {在原来代码基础是添加这两行} ProgressBar1.Max := Integer(fs.Size div 1024); cs.OnProgress := CsProgress; fs.SaveToStream(cs); cs.Free; ms.SaveToFile('c: emp est.zipx'); ms.Free; fs.Free; end; {解压缩} procedure TForm1.Button2Click(Sender: TObject); var ds: TDecompressionStream; fs,ms: TMemoryStream; num: Integer; begin fs := TMemoryStream.Create; fs.LoadFromFile('c: emp est.zipx'); fs.Position := 0; fs.ReadBuffer(num,SizeOf(num)); ms := TMemoryStream.Create; ms.SetSize(num); ds := TDecompressionStream.Create(fs); {在原来代码基础是添加这两行} ProgressBar1.Max := Integer(ms.Size div 1024); ds.OnProgress := DsProgress; ds.Read(ms.Memory^, num); ms.SaveToFile('c: emp est2.txt'); ds.Free; ms.Free; fs.Free; end; end. 窗体文件: object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 136 ClientWidth = 205 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 64 Top = 24 Width = 75 Height = 25 Caption = #21387#32553 TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 64 Top = 55 Width = 75 Height = 25 Caption = #35299#21387#32553 TabOrder = 1 OnClick = Button2Click end object ProgressBar1: TProgressBar Left = 24 Top = 97 Width = 150 Height = 17 TabOrder = 2 end end