amzip.pas

可以压缩和解压一个文件夹（里面有多个文件）或者一个文件！

{
	Create by more - 2008.08.22

  I Extended Patrik Spanel's TZipFile
  into easy-to-use zipping class.
}

unit AmZip;

interface

uses
	Windows, Classes, SysUtils, SciZipFile;

type
	TAmZip = class(TZipFile)

  public
  	procedure AddFile(const Name: String); overload;

  	procedure AddFolders(FolderName: String;Recurse: Boolean = True);//添加子目录
  	procedure AddSubFolderFile(Folder:String;const Name: String);//添加子目录的文件

    function  UnZipFile(fIndex:integer;ToPath:String):Boolean;
  end;

implementation

{utils}
procedure ListPathsEx(Path: String; Paths: TStrings; Recurse: Boolean);
var
  Pattern :string;
  SR: TSearchRec;

  subPath:String;
begin
  Pattern := Path + '*.*';

  if FindFirst(Pattern, faDirectory, SR) <> 0 then
    Exit;

  repeat
    if (SR.Attr and faDirectory <> 0) and
      (SR.Name <> '.') and
      (SR.Name <> '..') then
    begin
      subPath := ExtractFilePath(Pattern) + SR.Name + '\';//找到子目录
      Paths.Add(subPath);
      if Recurse then
        ListPathsEx(subPath, Paths, Recurse); //递归查找
    end;
  until FindNext(SR) <> 0;

  FindClose(SR);
end;

procedure ListFilesEx(Folder: String; Files: TStrings; Recurse: Boolean);

  //得到该目录下的所有文件
  procedure ListEx(Folder: String; Files: TStrings);
  var
    Pattern :string;
    SR: TSearchRec;
  begin
    Pattern := Folder+'*.*' ;
    if FindFirst(Pattern, faAnyFile, SR) <> 0 then
      Exit;

    repeat
      if (SR.Attr and faDirectory = 0) and (SR.Name <> '.') and
                    (SR.Name <> '..') then
        Files.Add(Folder + SR.Name);
    until FindNext(SR) <> 0;

    FindClose(SR);
  end;

var
  Paths: TStringList;
  FileName: String;
  FilePath:String;
  I: Integer;
begin
  Paths := TStringList.Create;
  // FileName := ExtractFileName(Folder);
  try
    //SetCurrentDir(Folder);//设置当前路径，然后查询该路径下的文件，文件夹

    ListEx(Folder, Files);
    if Recurse then
    begin
      ListPathsEx(Folder, Paths, Recurse);//获取该目录下的所有子目录

      for I := 0 to Paths.Count - 1 do
      begin
        Files.Add(Paths[I]);//添加一个目录
        ListEx(Paths[I], Files);//再将子目录下的文件添加到Files中
      end;
    end;
  finally
    Paths.Free;
  end;
end;


{ TAmZip }
//添加一个文件到zip包的根目录下
procedure TAmZip.AddFile(const Name: String);
var
  F: TFileStream;
  B: String;
begin
  F := TFileStream.Create(Name, fmOpenRead);
  try
  	SetLength(B, F.Size);
    F.ReadBuffer(B[1], F.Size);
    inherited AddFile(ExtractFileName(Name), 0);  //保存文件名
    Data[Count-1] := B;//压缩文件到流中
  finally
    F.Free;
  end;
end;

//添加一个文件夹到zip包的根目录下
procedure TAmZip.AddFolders(FolderName: String; Recurse: Boolean);
var
  fileList: TStringList;
  I: Integer;

  SDirName:String;
begin
  if not DirectoryExists(FolderName) then
  begin
    exit;//目录不存在，不添加
  end;

  if FolderName[Length(FolderName)] <>'\'then
  begin
    FolderName := FolderName +'\';//为目录添加/ 结尾
  end;
  SDirName := FolderName;
  
  fileList := TStringList.Create;
  try
  	ListFilesEx(FolderName, fileList, Recurse);  //枚举出该目录下的所有文件及子目录

    Delete(SDirName,Length(SDirName),1);
    SDirName := ExtractFilePath(SDirName);//获取到父目录

    AddSubFolderFile(SDirName,     //目录
                       FolderName);//

    for I := 0 to fileList.Count - 1 do
	  	AddSubFolderFile(SDirName, //目录
                       fileList[I]);
  finally
    fileList.Free;
  end;
end;


procedure TAmZip.AddSubFolderFile(Folder:String;const Name: String);
var
  F: TFileStream;
  B: String;

  zipFileName:String;
  len:integer;
begin
  //生成相对路径
  len := Length(Folder);
  zipFileName := StringReplace(Name,'\', '/', [rfReplaceAll]) ;
  Delete(zipFileName,1,len);

  if (FileExists(Name)) then
  begin
    F := TFileStream.Create(Name, fmOpenRead);
    try
      SetLength(B, F.Size);
      F.ReadBuffer(B[1], F.Size);
      inherited AddFile(zipFileName, 0);  //保存文件名
      Data[Count-1] := B;                 //压缩文件到流中
    finally
      F.Free;
    end;
  end
  else
  begin
    B :='';//空的数据内容
    inherited AddFile(zipFileName, 0);  //保存文件名
    Data[Count-1] := B;                 //压缩文件到流中  
  end;
end;

function TAmZip.UnZipFile(fIndex: integer; ToPath: String): Boolean;
var
  ZipFileStream: TFileStream;
  B:String;

  sFileName:String;
  sPathName:String;
  LastChar:Char;
begin
  result := false;
  if (fIndex < 0) or (fIndex > High(Files)) then
  begin
    exit;
  end;

  if not DirectoryExists(ToPath) then
    CreateDir(ToPath);

  sFileName :=StringReplace(Name[fIndex],'/', '\', [rfReplaceAll]) ;
  LastChar := sFileName[Length(sFileName)];
  if (LastChar='/')  or (LastChar='\') then
  begin
    //创建子目录
    sPathName:=  ToPath + '\'+sFileName;
    if not DirectoryExists(sPathName) then
      CreateDir(sPathName);
  end
  else
  begin
    //解压文件
    SetCurrentDir(ToPath);
    ZipFileStream := TFileStream.Create(sFileName, fmCreate);
    try
      B := Data[fIndex];
      ZipFileStream.WriteBuffer(B[1], Length(B));
    finally
      ZipFileStream.Free;
    end;
  end;
end;

end.