DELPHI 通過ZLib來壓縮文件夾

unit Unit1;interfaceusesZLib,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;constcBufferSize = $4096;cIdent: string[3] = 'zsf';cVersion = $01;cErrorIdent = -1;cErrorVersion = -2;typeTFileHead = packed recordrIdent: string[3]; //標識rVersion: Byte; //版本 end;typeTForm1 = class(TForm)Edit1: TEdit;Button1: TButton;Button2: TButton;procedure Button1Click(Sender: TObject);procedure Button2Click(Sender: TObject);privatefunction 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;varForm1: TForm1;implementation{$R *.dfm}function TForm1.DirectoryCompression(mDirectory,mFileName: TFileName): Integer; varvFileInfo: 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 dobeginif (vSearchRec.Attr and faDirectory > 0) and(Pos(vSearchRec.Name, '..') = 0) thenpSearchFile(mPath + '\' + vSearchRec.Name)else if Pos(vSearchRec.Name, '..') = 0 thenpAppendFile(mPath + '\' + vSearchRec.Name);K := FindNext(vSearchRec);end;FindClose(vSearchRec);end; beginResult := 0; if not DirectoryExists(mDirectory) thenExit;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; beginResult := -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 tryfor I := 1 to vFileStream.Size div cBufferSize do beginvFileStream.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); vari : Integer; begintryi:=DirectoryCompression('E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\Log','E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\log.rar');exceptApplication.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; beginResult := 0; if not FileExists(mFileName) thenExit;vFileInfo := TStringList.Create; vMemoryStream := TMemoryStream.Create; mDirectory := ExcludeTrailingPathDelimiter(mDirectory);vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);tryif 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 dobeginvMemoryStream.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; beginResult := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1); end;function TForm1.StrRight(const mStr: string; mDelimiter: string): string; beginif Pos(mDelimiter, mStr) > 0 thenResult := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)elseResult := ''; end;function TForm1.FileDecompression(mFileName: TFileName;mStream: TStream): Integer;var vFileStream: TFileStream; vBuffer: array[0..cBufferSize]of Char; I: Integer; beginResult := -1;if not Assigned(mStream) then Exit;ForceDirectories(ExtractFilePath(mFileName)); //創建目錄 vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);with TDecompressionStream.Create(mStream) dotryrepeatI := Read(vBuffer, cBufferSize);vFileStream.Write(vBuffer, I);until I = 0;Result := vFileStream.Size;finallyFree;vFileStream.Free;end; end;procedure TForm1.Button2Click(Sender: TObject); vari : Integer; begintryi:=DirectoryDecompression('E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\Log2','E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\log.rar');exceptApplication.MessageBox('',PChar(inttostr(i)),48);end;end;end. View Code

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事先設置緩沖區大小了....
　

　usesencddecdEx; varInput,Output:TMemoryStream;beginInput:=TMemoryStream.Create;tryInput.LoadFromFile('c:\aaa.txt');Output:=TMemoryStream.Create;tryOutput.Size:=(Input.Size + 2) div 3 * 4;EncodeStream(Input,Output);finallyOutput.Free;end;finallyInput.Free;end;end; View Code

?

　OK! 大功告成!!! 大家有興趣可以測試一下,加不加Output.Size:=(Input.Size + 2) div 3 * 4這一句的不同效果~
二.ZLib壓縮/解壓
　　在一些分布式系統中,特別是Internet分布式系統,由於網絡帶寬所限,我們需要對傳輸的大流量數據進行壓縮,以減輕網絡的負擔,加快程序運行速度,一般用到的壓縮/解壓方法是使用ZLib單元. ZLib單元主要提供了兩個類:TCompressionStream和TDeCompressionStream. 這兩個類分別處理壓縮和解壓縮. 使用方法可以查閱相關的資料. 在這里提供兩個過程,再對壓縮時的參數作些比較:

usesZLib; procedure Zip(Input,Output:TStream;Compress:Boolean); constMAXBUFSIZE=1024 * 16;　 //16 KB varCS:TCompressionStream;DS:TDecompressionStream;Buf:array[0..MAXBUFSIZE-1] of Byte;BufSize:Integer; beginif Assigned(Input) and Assigned(Output) thenbeginif Compress thenbeginCS:=TCompressionStream.Create(clDefault,Output);tryCS.CopyFrom(Input,0);　//從開始處復制finallyCS.Free;end;end elsebeginDS:=TDecompressionStream.Create(Input);tryBufSize:=DS.Read(Buf,MAXBUFSIZE);while BufSize>0 dobeginOutput.Write(Buf,BufSize);BufSize:=DS.Read(Buf,MAXBUFSIZE);end;finallyDS.Free;end;end;end; end; function Zip(Input:string;Compress:Boolean):string; varInputStream,OutputStream:TStringStream; beginif Input='' then Exit;InputStream:=TStringStream.Create(Input);tryOutputStream:=TStringStream.Create('');tryZip(InputStream,OutputStream,Compress);Result:=OutputStream.DataString;finallyOutputStream.Free;end;finallyInputStream.Free;end; end; View Code

　　以上兩個方法是兩個名稱一樣,參數不同的過程. 第一個是對流進行壓縮/解壓,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; varP:Pointer;Size:Integer; beginif not VarIsArray(vData) then Exit;Size:=VarArrayHighBound(vData,1)-VarArrayLowBound(vData,1)+1;P:=VarArrayLock(vData);trySetLength(Result,Size);Move(P^,Result[1],Size);finallyVarArrayUnLock(vData);end; end; View Code

假設以下為MIDAS服務器或COM+對象一個方法.

function TDeptCoor.GetDeptData: OleVariant; varCommand:WideString;Options:TGetRecordOptions;RecsOut:Integer;Params,OwnerData:OleVariant; begintryCommand:='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;exceptSetAbort;raise;end; end; View Code

客戶端只要壓壓縮后就可以使用了:

procedure TForm1.Button1Click(sender:TObject); varvData:string; beginvData:=DeptCoor.GetDeptData;vData:=Zip(vData,False);　　　　　//解壓ClientDataSet1.XMLData:=vData;　　//注意,這里用的是XMLData,不是Data,否則會報錯!!! end; View Code

　　　　　　　　
四. SOAP系統中壓縮后編碼:
　在SOAP系統中,由於二進制數據不能直接傳遞,需要進行Base64編碼, 我們可以在數據傳遞前先壓縮/Base64編碼,接收后再Base64解碼/解壓縮.
同樣,也給出兩個函數,來分別完成這兩個過程

function SoapPacket(const Input:string):string;　 varInputStream,OutputStream:TStringStream; beginInputStream:=TStringStream.Create(Input);tryOutputStream:=TStringStream.Create('');tryZip(InputStream,OutputStream,True);InputStream.Size:=0;OutputStream.Position:=0;　 //很重要!!! 　　　EncodeStream(OutputStream,InputStream);Result:=InputStream.DataString;finallyOutputStream.Free;end;finallyInputStream.Free;end; end; function SoapUnpack(const Input:string):string; varInputStream,OutputStream:TStringStream; beginInputStream:=TStringStream.Create(Input);tryOutputStream:=TStringStream.Create('');tryDecodeStream(InputStream,OutputStream);InputStream.Size:=0;OutputStream.Position:=0; //很重要!!! 　　　Zip(OutputStream,InputStream,False);Result:=InputStream.DataString;finallyOutputStream.Free;end;finallyInputStream.Free;end; end; View Code

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); finallyCompStream.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; finallyDecompStream.Free; end; end; //測試代碼 procedure Test; var SrcStream,PackedStream,UnpackedStream:TMemoryStream; begin SrcStream := TMemoryStream.Create; trySrcStream.LoadFromFile('c:\test.xml');PackedStream := TMemoryStream.Create;try//壓縮 PackStream(SrcStream, PackedStream);PackedStream.Seek(0, soFromBeginning);PackedStream.SaveToFile('c:\test_xml.pk');UnpackedStream := TMemoryStream.Create;try//解壓縮 UnpackStream(PackedStream, UnpackedStream);UnpackedStream.Seek(0, soFromBeginning);UnpackedStream.SaveToFile('c:\test_xml.xml');finallyUnpackedStream.Free;end;finallyPackedStream.Free;end; finallySrcStream.Free; end; end; View Code

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:\test.xml'); PackedStream := TMemoryStream.Create; try //壓縮 PackStream(SrcStream, PackedStream); PackedStream.Seek(0, soFromBeginning); PackedStream.SaveToFile('c:\test_xml.pk'); UnpackedStream := TMemoryStream.Create; try //解壓縮 UnpackStream(PackedStream, UnpackedStream); UnpackedStream.Seek(0, soFromBeginning); UnpackedStream.SaveToFile('c:\test_xml.xml'); finally UnpackedStream.Free; end; finally PackedStream.Free; end; finally SrcStream.Free; end; end; View Code

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; View Code

?

使用的例子如下：

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; View Code

壓縮與解壓縮進度

unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ComCtrls;typeTForm1 = 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;varForm1: TForm1;implementation{$R *.dfm}uses Zlib;{壓縮的 OnProgress 事件} procedure TForm1.CsProgress(Sender: TObject); beginProgressBar1.Position := Integer(TCompressionStream(Sender).Position div 1024);Application.ProcessMessages; end;{解壓縮的 OnProgress 事件} procedure TForm1.DsProgress(Sender: TObject); beginProgressBar1.Position := Integer(TDecompressionStream(Sender).Position div 1024);Application.ProcessMessages; end;{壓縮} procedure TForm1.Button1Click(Sender: TObject); varcs: TCompressionStream;fs,ms: TMemoryStream;num: Integer; beginfs := TMemoryStream.Create;fs.LoadFromFile('c:\temp\test.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:\temp\test.zipx');ms.Free;fs.Free; end;{解壓縮} procedure TForm1.Button2Click(Sender: TObject); vards: TDecompressionStream;fs,ms: TMemoryStream; num: Integer; beginfs := TMemoryStream.Create;fs.LoadFromFile('c:\temp\test.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:\temp\test2.txt');ds.Free;ms.Free;fs.Free; end;end.窗體文件: object Form1: TForm1Left = 0Top = 0Caption = 'Form1'ClientHeight = 136ClientWidth = 205Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'Tahoma'Font.Style = []OldCreateOrder = FalsePixelsPerInch = 96TextHeight = 13object Button1: TButtonLeft = 64Top = 24Width = 75Height = 25Caption = #21387#32553TabOrder = 0OnClick = Button1Clickendobject Button2: TButtonLeft = 64Top = 55Width = 75Height = 25Caption = #35299#21387#32553TabOrder = 1OnClick = Button2Clickendobject ProgressBar1: TProgressBarLeft = 24Top = 97Width = 150Height = 17TabOrder = 2end end View Code

?

轉載于:https://www.cnblogs.com/blogpro/p/11345888.html

總結

以上是生活随笔為你收集整理的delphi 压缩的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。