unzipfile.pas

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

unit unZipFile;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, //Graphics, Controls, Forms,Dialogs, StdCtrls;
  Zip32, unZip32;

function DoZipFile(SrcFileName,ZipFileName : string; pMsgStr:TStrings=nil):Boolean;
function DoZipFiles(FileList: TStrings; ZipFileName :string; pMsgStr:TStrings=nil):Boolean;
function DoUnzipFile(ZipFileName, TrgDir:string; pMsgStr:TStrings=nil) :Boolean;

implementation

var
  pZipMsg   :TStrings;
  pUnzipMsg :TStrings;

procedure SetDummyInitFunctions(var Z:TZipUserFunctions); forward;
function DummyPrint(Buffer: PChar; Size: ULONG): integer; stdcall ; forward;
function DummyPassword(P: PChar; N: Integer; M, Name: PChar): integer; stdcall ; forward;
function DummyComment(Buffer: PChar): PChar; stdcall ; forward;

procedure Set_UnZipOptions(var O: TDCL); forward;
procedure Set_UserFunctions(var Z:TUserFunctions); forward;
function DllPrnt(Buffer: PChar; Size: ULONG): integer; stdcall; forward;
function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer; stdcall; forward;
function DllService(CurFile: PChar; Size: ULONG): integer; stdcall; forward;
function DllReplace(FileName: PChar): integer; stdcall; forward;
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; forward;

function DoZipFile(SrcFileName,ZipFileName : string; pMsgStr:TStrings):Boolean;
var
  i        : integer;
  ZipRec   : TZCL;
  ZUF      : TZipUserFunctions;
begin
  Result := False;
  if Trim(ZipFileName) = '' then Exit;
  if Trim(SrcFileName) = '' then Exit;

  pZipMsg := pMsgStr;

  SetDummyInitFunctions(ZUF);



  ZipRec.argc := 1;

  { name of zip file - allocate room for null terminated string  }
  GetMem(ZipRec.lpszZipFN, Length(ZipFileName) + 1 );
  ZipRec.lpszZipFN := StrPCopy( ZipRec.lpszZipFN, ZipFileName);



  { dynamic array allocation }
  SetLength(ZipRec.FNV, 1);

  { copy the file names from FileList to ZipRec.FNV dynamic array }
  GetMem(ZipRec.FNV[0], Length(SrcFileName) + 1 );
  StrPCopy( ZipRec.FNV[0], SrcFileName);

  { send the data to the dll }
  if (ZpArchive(ZipRec)=0) then
    Result := True;



  { release the memory for the file list }
  for i := (ZipRec.argc - 1) downto 0 do
    FreeMem(ZipRec.FNV[i], Length(SrcFileName) + 1 );

  { release the memory for the ZipRec.FNV dynamic array
    NOTE : This line actually is useless.
           Dynamic arrays are lifitime managed, just like long strings.
           They released when they live scope}
  ZipRec.FNV := nil;

  { release the memory for the ZipFileName }
  FreeMem(ZipRec.lpszZipFN, Length(ZipFileName) + 1 );

  pZipMsg := nil;
end;

function DoZipFiles(FileList: TStrings; ZipFileName : string; pMsgStr:TStrings):Boolean;
var
  i        : integer;
  ZipRec   : TZCL;
  ZUF      : TZipUserFunctions;
begin
  Result := False;
  if Trim(ZipFileName) = '' then Exit;
  if FileList.Count <= 0 then Exit;

  pZipMsg := pMsgStr;
  SetDummyInitFunctions(ZUF);



  { number of files to zip }
  ZipRec.argc := FileList.Count;

  { name of zip file - allocate room for null terminated string  }
  GetMem(ZipRec.lpszZipFN, Length(ZipFileName) + 1 );
  ZipRec.lpszZipFN := StrPCopy( ZipRec.lpszZipFN, ZipFileName);


  
  { dynamic array allocation }
  SetLength(ZipRec.FNV, ZipRec.argc );

  { copy the file names from FileList to ZipRec.FNV dynamic array }
  for i := 0 to ZipRec.argc - 1 do
  begin
    GetMem(ZipRec.FNV[i], Length(FileList[i]) + 1 );
    StrPCopy( ZipRec.FNV[i], FileList[i]);
  end;

  { send the data to the dll }
  if ZpArchive(ZipRec)=0 then
    Result := True;



  { release the memory for the file list }
  for i := (ZipRec.argc - 1) downto 0 do
    FreeMem(ZipRec.FNV[i], Length(FileList[i]) + 1 );

  { release the memory for the ZipRec.FNV dynamic array
    NOTE : This line actually is useless.
           Dynamic arrays are lifitime managed, just like long strings.
           They released when they live scope}
  ZipRec.FNV := nil;

  { release the memory for the ZipFileName }
  FreeMem(ZipRec.lpszZipFN, Length(ZipFileName) + 1 );

  pZipMsg := nil;
end;

procedure SetDummyInitFunctions(var Z:TZipUserFunctions);
begin
  { prepare ZipUserFunctions structure }
  with Z do
  begin
    @Print     := @DummyPrint;
    @Comment   := @DummyPassword;
    @Password  := @DummyComment;
  end;
  { send it to dll }
  ZpInit(Z);
end;

function DummyComment(Buffer: PChar): PChar;
begin
  Result := Buffer;
end;

function DummyPrint(Buffer: PChar; Size: LongWord): integer;
begin
  if Assigned(pZipMsg) then
    pZipMsg.Add(Buffer);
  Result := Size;
end;
{----------------------------------------------------------------------------------}
function DummyPassword(P: PChar; N: Integer; M, Name: PChar): integer;
begin
  Result := 1;
end;

function DoUnzipFile(ZipFileName, TrgDir:string; pMsgStr:TStrings):Boolean;
var
  UF : TUserFunctions;
  Opt  : TDCL;
begin
  Result := False;
  if Trim(ZipFileName) = '' then Exit;
  if Trim(TrgDir) = '' then Exit;

  pUnzipMsg := pMsgStr;
  Set_UserFunctions(UF);

  Set_UnZipOptions(Opt);
  Opt.lpszZipFN         := PChar(ZipFileName);
  Opt.lpszExtractDir    := PChar(TrgDir);


  if (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 }
                           = 0) then
    Result := True;

  pUnzipMsg := nil;
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;

{ user functions for use with the TUserFunctions structure }
{----------------------------------------------------------------------------------}
function DllPrnt(Buffer: PChar; Size: ULONG): integer;
begin
  if Assigned(pUnzipMsg) then
    pUnzipMsg.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_UnZipOptions(var O: TDCL);
begin
  with O do
  begin
    ExtractOnlyNewer  := 0;    //Integer(chExtractOnlyNewer.Checked) ;
    SpaceToUnderscore := 0;    //Integer(chSpaceToUnderscore.Checked);
    PromptToOverwrite := 0;    //Integer(chPromptToOverwrite.Checked);
    fQuiet            := 0;    //quiet flag. 1 = few messages, 2 = no messages, 0 = all messages spinQuiet.Value;
    nCFlag            := 0;   //Integer(chCFlag.Checked);
    nTFlag            := 0;   //Integer(chTFlag.Checked);
    nVFlag            := 0;   //Integer(chVFlag.Checked);
    nUFlag            := 0;   //Integer(chUFlag.Checked);
    nZFlag            := 0;   //Integer(chZFlag.Checked);
    nDFlag            := 0;    //Integer(chDFlag.Checked);
    //nOFlag            := 0;    //Integer(chOFlag.Checked);
    nOFlag            := 1;    //Always Overwrite File
    nAFlag            := 0;    //Integer(chAFlag.Checked);
    nZIFlag           := 0;    //Integer(chZIFlag.Checked);
    C_flag            := 0;    //Integer(chC_flag.Checked);
    fPrivilege        := 1;   //1 => restore Acl's, 2 => Use privileges spinPrivilege.Value;
    //lpszZipFN         := PChar(edtFileToUnZip.Text);
    //lpszExtractDir    := PChar(edtUnZipToDir.Text);
  end;
end;

(*
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Buttons, Zip32;

type
  TfrmMain = class(TForm)
    Pager: TPageControl;
    tabZipOptions: TTabSheet;
    tabMessages: TTabSheet;
    chSuffix: TCheckBox;
    chEncrypt: TCheckBox;
    chSystem: TCheckBox;
    chVolume: TCheckBox;
    chExtra: TCheckBox;
    chNoDirEntries: TCheckBox;
    chExcludeDate: TCheckBox;
    chIncludeDate: TCheckBox;
    chVerbose: TCheckBox;
    chQuiet: TCheckBox;
    chCRLF_LF: TCheckBox;
    chLF_CRLF: TCheckBox;
    chJunkDir: TCheckBox;
    chRecurse: TCheckBox;
    chGrow: TCheckBox;
    chForce: TCheckBox;
    chMove: TCheckBox;
    chDeleteEntries: TCheckBox;
    chUpdate: TCheckBox;
    chFreshen: TCheckBox;
    chJunkSFX: TCheckBox;
    chLatestTime: TCheckBox;
    chComment: TCheckBox;
    chOffsets: TCheckBox;