unzipfile.pas

压缩解压缩zip文件压缩 解压缩zip文件压缩解压缩zip文件

{----------------------------------------------------------------------------------}
procedure TfrmMain.btnSaveToClick(Sender: TObject);
begin
  if SaveDialog.Execute then edtZipFileName.Text := SaveDialog.FileName;
end;
{----------------------------------------------------------------------------------}
procedure TfrmMain.btnZipFilesClick(Sender: TObject);
begin
  Memo.Lines.Clear;
  ZipFiles(edtZipFileName.Text, lboFilesToZip.Items);   
end;











unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UnZip32, StdCtrls, Spin, ComCtrls, Buttons;

type
  TfrmMain = class(TForm)
    Pager: TPageControl;
    tabOperations: TTabSheet;
    tabMessages: TTabSheet;
    lboVersion: TListBox;
    edtFileToUnzip: TEdit;
    edtUnzipToDir: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    chExtractOnlyNewer: TCheckBox;
    chSpaceToUnderscore: TCheckBox;
    chPromptToOverwrite: TCheckBox;
    chCFlag: TCheckBox;
    chTFlag: TCheckBox;
    chVFlag: TCheckBox;
    chUFlag: TCheckBox;
    chZFlag: TCheckBox;
    chDFlag: TCheckBox;
    chOFlag: TCheckBox;
    chAFlag: TCheckBox;
    chZIFlag: TCheckBox;
    chC_flag: TCheckBox;
    Label3: TLabel;
    spinQuiet: TSpinEdit;
    spinPrivilege: TSpinEdit;
    Label4: TLabel;
    Label5: TLabel;
    Memo1: TMemo;
    btnClearMemo: TSpeedButton;
    btnUnZip: TSpeedButton;
    Memo2: TMemo;
    SpeedButton1: TSpeedButton;
    Label6: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnUnZipClick(Sender: TObject);
    procedure btnClearMemoClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMDropFiles(var Msg: TMessage); message WM_DropFiles;
    procedure Set_UnZipOptions(var O: TDCL);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;



{ global routines }
procedure UnZipDllVersionToStrings(List: TStrings);
procedure Set_UserFunctions(var Z: TUserFunctions);


{ user functions for use with the TUserFunctions structure }
function DllPrnt(Buffer: PChar; Size: ULONG): integer; stdcall;
function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer; stdcall;
function DllService(CurFile: PChar; Size: ULONG): integer; stdcall;
function DllReplace(FileName: PChar): integer; stdcall;
procedure DllMessage(UnCompSize : ULONG;
                     CompSize   : ULONG;
                     Factor     : UINT;
                     Month      : UINT;
                     Day        : UINT;
                     Year       : UINT;
                     Hour       : UINT;
                     Minute     : UINT;
                     C          : Char;
                     FileName   : PChar;
                     MethBuf    : PChar;
                     CRC        : ULONG;
                     Crypt      : Char); stdcall;



implementation

{$R *.DFM}




uses
  ShellApi;







{ global routines }

{----------------------------------------------------------------------------------}
procedure UnZipDllVersionToStrings(List: TStrings);
var
 pVer : PUzpVer;
 S    : string;
begin

  PVer := UzpVersion;     

  { display the information }
  with List do
  begin
    Clear;
    Add('Flag         : ' + IntToStr(pVer^.Flag) + ' [1: is_beta, ?: uses_zlib]');
    Add('BetaLevel    : ' + pVer^.BetaLevel);
    Add('Date         : ' + pVer^.Date);
    Add('ZLib_Version : ' + pVer^.ZLib_Version);
    S := IntToStr(pVer^.UnZip.Major);
    S := S + '.' + IntToStr(pVer^.UnZip.Minor);
    Add('UnZip        : ' + S);
    S := IntToStr(pVer^.WinDll.Major);
    S := S + '.' + IntToStr(pVer^.WinDll.Minor);
    Add('WinDll       : ' + S);
  end;  

end;

{ user functions for use with the TUserFunctions structure }
{----------------------------------------------------------------------------------}
function DllPrnt(Buffer: PChar; Size: ULONG): integer;
begin
  frmMain.Memo2.Lines.Add(Buffer);
  Result := Size;
end;
{----------------------------------------------------------------------------------}
function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer;
begin
  Result := 1;
end;
{----------------------------------------------------------------------------------}
function DllService(CurFile: PChar; Size: ULONG): integer;
begin
  Result := 0;
end;
{----------------------------------------------------------------------------------}
function DllReplace(FileName: PChar): integer;
begin
  Result := 1;
end;
{----------------------------------------------------------------------------------}
procedure DllMessage(UnCompSize : ULONG;
                     CompSize   : ULONG;
                     Factor     : UINT;
                     Month      : UINT;
                     Day        : UINT;
                     Year       : UINT;
                     Hour       : UINT;
                     Minute     : UINT;
                     C          : Char;
                     FileName   : PChar;
                     MethBuf    : PChar;
                     CRC        : ULONG;
                     Crypt      : Char);
const
  sFormat = '%7u  %7u %4s  %02u-%02u-%02u  %02u:%02u  %s%s';
  cFactor = '%s%d%%';
  cFactor100 = '100%%';
var
  S       : string;
  sFactor : string;
  Sign    : Char;
begin

  if (CompSize > UnCompSize) then Sign := '-' else Sign := ' ';

  if (Factor = 100)
  then sFactor := cFactor100
  else sFactor := Format(cFactor, [Sign, Factor]);

  S := Format(sFormat, [UnCompSize, CompSize, sFactor, Month, Day, Year, Hour, Minute, C, FileName]);

 frmMain.Memo1.Lines.Add(S);

end;
{----------------------------------------------------------------------------------}
procedure Set_UserFunctions(var Z:TUserFunctions);
begin
  { prepare TUserFunctions structure }
  with Z do
  begin
    @Print                  := @DllPrnt;
    @Sound                  := nil;
    @Replace                := @DllReplace;
    @Password               := @DllPassword;
    @SendApplicationMessage := @DllMessage;
    @ServCallBk             := @DllService;
  end;
end;








  { form's methods }

{----------------------------------------------------------------------------------
 Description    : this message handler allows us to drag n drop files from Explorer
 NOTE           : for more info about this handler check the Win32.hlp for the
                  WM_DROPFILES, DragQueryFile, DragAcceptFiles and DragFinish topics
-----------------------------------------------------------------------------------}
procedure TfrmMain.WMDropFiles(var Msg: TMessage);
var
  hDrop    : THandle;
  FileName : array[0..254] of Char;
begin

  Pager.ActivePage := tabOperations;

  hDrop  := Msg.WParam;
  DragQueryFile(hDrop, 0, FileName, 254);

  edtFileToUnzip.Text := '';
  if ExtractFileExt(FileName) = '.zip' then edtFileToUnzip.Text := FileName;
  
  DragFinish(hDrop);
end;
{----------------------------------------------------------------------------------}
procedure TfrmMain.Set_UnZipOptions(var O: TDCL);
begin
  with O do
  begin
    ExtractOnlyNewer  := Integer(chExtractOnlyNewer.Checked) ;
    SpaceToUnderscore := Integer(chSpaceToUnderscore.Checked);
    PromptToOverwrite := Integer(chPromptToOverwrite.Checked);
    fQuiet            := spinQuiet.Value;
    nCFlag            := Integer(chCFlag.Checked);
    nTFlag            := Integer(chTFlag.Checked);
    nVFlag            := Integer(chVFlag.Checked);
    nUFlag            := Integer(chUFlag.Checked);
    nZFlag            := Integer(chZFlag.Checked);
    nDFlag            := Integer(chDFlag.Checked);
    nOFlag            := Integer(chOFlag.Checked);
    nAFlag            := Integer(chAFlag.Checked);
    nZIFlag           := Integer(chZIFlag.Checked);
    C_flag            := Integer(chC_flag.Checked);
    fPrivilege        := spinPrivilege.Value;
    lpszZipFN         := PChar(edtFileToUnZip.Text);
    lpszExtractDir    := PChar(edtUnZipToDir.Text);
  end;
end;




{ enent handlers }


{----------------------------------------------------------------------------------}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  if not IsExpectedUnZipDllVersion then Application.Terminate;
  UnZipDllVersionToStrings(lboVersion.Items);
  { see WMDropFiles method comments }
  DragAcceptFiles(Handle, True);

  edtFileToUnzip.Text := '';
  edtUnzipToDir.Text := '';
end;
{----------------------------------------------------------------------------------}
procedure TfrmMain.btnClearMemoClick(Sender: TObject);
begin
  case TComponent(Sender).Tag of
    1 : Memo1.Clear;
    2 : Memo2.Clear;
  end;
end;
{----------------------------------------------------------------------------------}
procedure TfrmMain.btnUnZipClick(Sender: TObject);
var
  UF : TUserFunctions;
  Opt  : TDCL;
begin

  {}
  Memo1.Lines.Add('');
  Memo1.Lines.Add('==============================================');

  Memo2.Lines.Add('');
  Memo2.Lines.Add('==============================================');  


  { precautions }
  if Trim(edtFileToUnZip.Text) = '' then Exit;
  if Trim(edtUnZipToDir.Text) = '' then Exit;

  { set user functions }
  Set_UserFunctions(UF);

  { set unzip operation options }
  Set_UnZipOptions(Opt);


  Wiz_SingleEntryUnzip(0,    { number of file names being passed }
                       nil,  { file names to be unarchived }
                       0,    { number of "file names to be excluded from processing" being  passed }
                       nil,  { file names to be excluded from the unarchiving process }
                       Opt,  { pointer to a structure with the flags for setting the  various options }
                       UF);  { pointer to a structure that contains pointers to user functions }

  Pager.ActivePage := tabMessages;
  
end;


end.
*)


end.