uzipdemo.~pas

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

unit UZipDemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls,ShellAPI, ComObj,shlobj;

type
  TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button3: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Button2: TButton;
    GroupBox2: TGroupBox;
    Memo2: TMemo;
    LabeledEditZipFile: TLabeledEdit;
    Button4: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }

    iFileNumber:Integer;
    iFolderNumber:integer;
  public
    { Public declarations }
    procedure DragDropFiles(var Msg: TMessage); message WM_DROPFILES;

    procedure pro_update;

    function fun_MakeZipFile(FileList:TStrings;zipfile:String):Boolean;
    //function fun_LoadZipFile(zipfile:String):Boolean;

    function fun_ReleaseZipFile(zipfile:String;zipPath:String;FileList:TStrings):Boolean;
    function fun_QueryZipFile(zipfile:String;FileList:TStrings):Boolean;

    function SelectDir: string;    
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses TypInfo, SciZipFile, Zippit, AmZip;

{ TForm1 }

procedure TForm1.DragDropFiles(var Msg: TMessage);
var
  DropFile: TFileName;
  i, count, cLength, code: Integer;
begin
  count := DragQueryFile(Msg.WParam, $FFFFFFFF, nil, 0);
  try
    Screen.Cursor := crHourGlass;
    if count > 0 then
    begin
      if Pos('将您需要检测的文件直接拖拽到本窗口中即可进行', Memo1.Text) <> 0 then
        Memo1.Clear;
    end;
    for I := 0 to count - 1 do
    begin
      cLength := MAX_PATH;
      SetLength(DropFile, cLength);
      cLength := DragQueryFile(Msg.WParam, I, PChar(DropFile), cLength);
      SetLength(DropFile, cLength);
      {
      code := GetFileAttributes(PChar(DropFile));
      if (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0) then
      begin
        MessageDlg('"' + DropFile + '" 是目录, 无法 Hash。'#13#10 +
          '点击确定继续!', mtError, [mbOK], 0);
        Continue;
      end;
      CalcMD5ForFile(DropFile);
      }


      code := GetFileAttributes(PChar(DropFile));
      if (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0) then
      begin
        Inc(iFolderNumber);
      end
      else
        Inc(iFileNumber);


      Memo1.Lines.Add(DropFile);
    end;
  finally
    DragFinish(Msg.WParam);
    Screen.Cursor := crDefault;
  end;

  SetForegroundWindow(Handle);

  pro_update;  
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    iFileNumber:=0;
    iFolderNumber:=0;

  DragAcceptFiles(Handle, True);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(Handle, False);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  iFileNumber:=0;
  iFolderNumber:=0;

  pro_update;
end;

procedure TForm1.pro_update;
begin
  LabeledEdit1.Text := IntToStr(iFileNumber);
  LabeledEdit2.Text := IntToStr(iFolderNumber);  
end;



function TForm1.fun_MakeZipFile(FileList: TStrings;zipfile:String): Boolean;
var
  i:integer;
  //Zip: TZippit;
  zip:TAmZip;
  FileName:String;
  FilePath:String;
begin
  result := false;
  if FileList.Count = 0 then
  begin
    Exit;
  end;

  //Zip := TZippit.Create;
  Zip := TAmZip.Create;
  try
    for i :=0  to FileList.Count-1 do
    begin

      if FileExists(FileList[i]) then
      begin
        //FileName := ExtractFileName(FileList[0]);
        //FilePath := ExtractFilePath(FileList[0]);
        
        Zip.AddFile(FileList[i]);
      end
      else
      begin
        Zip.AddFolders(FileList[i]);
      end;
    end;
    Zip.SaveToFile(zipfile);
  finally
    Zip.Free;
  end;
end;
//分析zip 文件里的内容
function TForm1.fun_QueryZipFile(zipfile: String;
  FileList: TStrings): Boolean;
var
  i:integer;
  //Zip: TZippit;
  zip:TAmZip;
  FileName:String;
begin
  result := false;
  if not FileExists(zipfile) then
  begin
    Exit;
  end;

  //Zip := TZippit.Create;
  Zip := TAmZip.Create;  
  try
    zip.LoadFromFile(zipfile);
    for i :=0  to zip.Count-1 do
    begin
      Filelist.Add(Zip.Name[i]);
    end;
  finally
    Zip.Free;
  end;
end;

//解压zip包里的zip 文件
function TForm1.fun_ReleaseZipFile(zipfile: String; zipPath:String;
  FileList: TStrings): Boolean;
var
  i:integer;
  //Zip: TZippit;
  zip:TAmZip;
  FileName:String;
begin
  result := false;
  if not FileExists(zipfile) then
  begin
    Exit;
  end;

  Filelist.Add('');
  Filelist.Add('unzip file to :'+zipPath);
  Filelist.Add('-------------');

//  Zip := TZippit.Create;
  Zip := TAmZip.Create;
  try
    zip.LoadFromFile(zipfile);
    for i :=0  to zip.Count-1 do
    begin
      zip.UnZipFile(i,zipPath);//解压文件到这个目录

      Filelist.Add(zipPath +'\'+Zip.Name[i]);
    end;
  finally
    Zip.Free;
  end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
  OpenDialog1.DefaultExt := '.zip';
  OpenDialog1.Filter := 'Zip file(*.zip)|*.zip';

  if OpenDialog1.Execute then
  begin
    LabeledEditZipFile.Text := OpenDialog1.FileName;
    Memo2.Lines.Clear;

    fun_QueryZipFile(LabeledEditZipFile.Text,
          Memo2.Lines);
  end;
end;


function TForm1.SelectDir: string;
//如果取消取返回为空，否则返回选中的路径
var
  Info: TBrowseInfo;
  IDList: pItemIDList;
  Buffer: PChar;
begin
  result := '';
  Buffer := StrAlloc(MAX_PATH);
  with Info do
  begin
    hwndOwner := Handle;//application.mainform.Handle; //目录对话框所属的窗口句柄
    pidlRoot := nil; //起始位置，缺省为我的电脑
    pszDisplayName := Buffer; //用于存放选择目录的指针
    lpszTitle := 'Select the folder:'; //对话框提示信息
    ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES;
    //选择参数，此处表示显示目录和文件，如果只显示目录则将后一个去掉即可
    lpfn := nil; //指定回调函数指针
    lParam := 0; //传递给回调函数参数
    IDList := SHBrowseForFolder(Info); //读取目录信息
  end;
  if IDList <> nil then
  begin
    SHGetPathFromIDList(IDList, Buffer); //将目录信息转化为路径字符串
    result := strpas(Buffer);
  end;
  StrDispose(buffer);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i1,i2:integer;
begin
  SaveDialog1.DefaultExt := '.zip';
  SaveDialog1.Filter := 'Zip file(*.zip)|*.zip';

  i1 := GetTickCount;
  if SaveDialog1.Execute then
  begin
    fun_MakeZipFile(Memo1.Lines,SaveDialog1.FileName);
  end;
  i2 := GetTickCount;

  Edit1.text := 'timer:'+IntToStr(i2 - i1);
  ShowMessage(Edit1.text);  
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  s:String;

  i1,i2:integer;
begin
  s := SelectDir;

  i1 := GetTickCount;
  if DirectoryExists(s) then
  begin
    fun_ReleaseZipFile(
      LabeledEditZipFile.Text,//zip files
      s,                //target path
      Memo2.Lines);
  end;

  i2 := GetTickCount;
  Edit2.text := 'timer:'+IntToStr(i2 - i1);

  ShowMessage(Edit2.text);
end;


end.