zipprev.pas

编写

unit zipprev;

interface

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

type
  Tf_zipprev = class(TForm)
    Panel_Filename: TPanel;
    Panel1: TPanel;
    Panel2: TPanel;
    btnOk: TButton;
    btnCancel: TButton;
    FileList: TListView;
    Panel3: TPanel;
    CheckList: TCheckBox;
    procedure btnCancelClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FileListDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
	{ Private declarations }
    procedure Set_UnZipOptions(var O: TDCL);
  public
    { Public declarations }
  end;

var
  f_zipprev: Tf_zipprev;
  FileCount : integer;
  zipFileName : string;

procedure Set_UserFunctions(var Z: TUserFunctions);

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

uses main;

{$R *.DFM}

function DllPrnt(Buffer: PChar; Size: ULONG): integer;
begin
  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);
var FileListItem : TListItem;
	sFileName : string;
	sPathName : string;
    sFileExtName : string;
	cFileIndex : integer;
	cFileIndex1 : integer;
begin
  sFileName:=Filename;
  sPathName:='';

  //忽略目录
  if sFileName[Length(sFileName)]='/' then exit;

  for cFileIndex:=Length(sFileName) downto 1 do
  begin
	   if sFileName[cFileIndex]='/' then
	   begin
            //分割目录和文件
			sPathName:=copy(sFileName,1,cFileIndex);
			sFileName:=copy(sFileName,cFileIndex+1,Length(sFileName));

            if not f_zipprev.CheckList.Checked then
            begin  //过滤多余文件
                 sFileExtName:=f_main.Get_Filename_Ext(sFileName);
                 if not ((sFileExtName='txt') or (sFileExtName='htm') or (sFileExtName='html') or
                         (sFileExtName='rtf') or (sFileExtName='ini') or (sFileExtName='zip') or
                         (sFileExtName='gb') or (sFileExtName='blf'))  then
                    exit;
            end;

			cFileIndex1:=pos('/',sPathName);
			while cFileIndex1>0 do
			begin
				 sPathName[cFileIndex1]:='\';
				 cFileIndex1:=pos('/',sPathName);
			end;

            //文件数+1
            inc(FileCount);

			FileListItem:=f_zipprev.FileList.Items.Add;
			FileListItem.Caption:=sFileName;
			FileListItem.SubItems.Text:=sPathName;

			exit;
	   end;
  end;

  if not f_zipprev.CheckList.Checked then
  begin  //过滤多余文件
       sFileExtName:=f_main.Get_Filename_Ext(sFileName);
       if not ((sFileExtName='txt') or (sFileExtName='htm') or (sFileExtName='html') or
               (sFileExtName='rtf') or (sFileExtName='ini') or (sFileExtName='zip') or
               (sFileExtName='gb') or (sFileExtName='blf'))  then
          exit;
  end;

  //文件数+1
  inc(FileCount);

  FileListItem:=f_zipprev.FileList.Items.Add;
  FileListItem.Caption:=sFileName;
  FileListItem.SubItems.Text:=sPathName;
end;

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

procedure Tf_zipprev.Set_UnZipOptions(var O: TDCL);
begin
  with O do
  begin
	   ExtractOnlyNewer  := 0;
	   SpaceToUnderscore := 0;
	   PromptToOverwrite := 0;
	   fQuiet            := 0;
	   nCFlag            := 0;
	   nTFlag            := 0;
	   nVFlag            := 1;  //浏览
	   nUFlag            := 0;
	   nZFlag            := 0;
	   nDFlag            := 1;  //带目录
	   nOFlag            := 0;
	   nAFlag            := 0;
	   nZIFlag           := 0;
	   C_flag            := 0;
	   fPrivilege        := 1;
	   lpszZipFN         := PChar(ZipFileName);
	   lpszExtractDir    := PChar('');
  end;
end;

procedure Tf_zipprev.btnCancelClick(Sender: TObject);
begin
  ModalResult:=mrCancel;
end;

procedure Tf_zipprev.btnOkClick(Sender: TObject);
var cFileIndex : integer;
    cFileIndex1 : integer;
	cFileName : string;
begin
  f_main.ZipFileList.Clear;

  for cFileIndex:=FileCount-1 downto 0 do
	  if FileList.Items.Item[cFileIndex].Selected then
	  begin
		   cFileName:=ZipFilename+'|'+
					  FileList.Items.Item[cFileIndex].SubItems.Text+
					  FileList.Items[cFileIndex].Caption;
		   cFileIndex1:=1;
		   while (cFileIndex1<=Length(cFileName)) do
		   begin  //删除无用字符
				if cFileName[cFileIndex1]<#32 then
				   Delete(cFileName,cFileIndex1,1)
				else
				   inc(cFileIndex1);
		   end;

		   f_main.ZipFileList.Items.Add(cFileName);
	  end;

  if f_main.ZipFileList.Items.Count<=0 then
	 ModalResult:=mrCancel
  else
	 ModalResult:=mrOk;
end;

procedure Tf_zipprev.FileListDblClick(Sender: TObject);
begin
  btnOkClick(Sender);
end;

procedure Tf_zipprev.FormShow(Sender: TObject);
var UF : TUserFunctions;
	Opt  : TDCL;
begin
  if not IsExpectedUnZipDllVersion then
     ModalResult:=mrCancel;

  zipFileName:=Panel_Filename.Caption;

  FileCount:=0;
  FileList.Items.Clear;

  Set_UserFunctions(UF);
  Set_UnZipOptions(Opt);

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

end.