特色栏目： python 批处理 net编程 Javascript Php Asp Css Html5 Android seo centos

delphi 压缩

来源：互联网收集：自由互联发布时间：2021-06-23

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 =

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:\Ark\ProjectDebug\PublicBill\Server\QueryOut\Log‘,‘E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\log.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:\Ark\ProjectDebug\PublicBill\Server\QueryOut\Log2‘,‘E:\Ark\ProjectDebug\PublicBill\Server\QueryOut\log.rar‘);
  except
    Application.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事先设置缓冲区大小了....
　

　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;

View Code

　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;

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

View Code

假设以下为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;

View Code

客户端只要压压缩后就可以使用了:

procedure TForm1.Button1Click(sender:TObject);
var
　vData:string;
begin
　vData:=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;　 
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;

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示例代码

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;
 
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:\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);
var
  ds: TDecompressionStream;
  fs,ms: TMemoryStream;    
  num: Integer;
begin
  fs := 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: 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

View Code

上一篇：Delphi Try Except 实例
下一篇：Delphi ADOQuery

delphi 压缩

相关文章