📄 zipprev.pas
字号:
{
模块名称:预览ZIP文件
使用方法:ShowSelZipFile('ZIP文件名', 返回选中的文件名:TStringList) :
返回值: 1、mrOk:确定选中文件
2、mrCancel:取消
3、m_ZipFileList:返回选中的文件
}
unit ZipPrev;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Spin, ComCtrls, Buttons, ExtCtrls, Grids, UnZip32;
type
TFormZipPrev = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
BtnOk: TButton;
BtnCancel: TButton;
CheckBoxList: TCheckBox;
FileList: TListView;
procedure FormShow(Sender: TObject);
procedure BtnOkClick(Sender: TObject);
private
{ Private declarations }
procedure Set_UnZipOptions(var O: TDCL);
public
{ Public declarations }
end;
var
FormZipPrev: TFormZipPrev;
m_strZipFilename : string;
m_nFileCount : integer;
m_ZipFileList : TStringList;
function ShowSelZipFile(strZipFilename : string; var ListZipFile : TStringList) : boolean;
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 Set_UserFunctions(var Z: TUserFunctions);
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
Global;
{$R *.DFM}
function ShowSelZipFile(strZipFilename : string; var ListZipFile : TStringList) : boolean;
begin
m_strZipFilename := strZipFilename;
m_ZipFileList := ListZipFile;
if FormZipPrev = nil then FormZipPrev := TFormZipPrev.Create(nil);
with FormZipPrev do
begin
Result := (ShowModal = mrOk);
Free;
FormZipPrev := nil;
end;
end;
procedure TFormZipPrev.FormShow(Sender: TObject);
var UF : TUserFunctions;
Opt : TDCL;
begin
if not IsExpectedUnZipDllVersion then
ModalResult := mrCancel;
m_nFileCount := 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;
procedure TFormZipPrev.BtnOkClick(Sender: TObject);
var nFileIndex : integer;
nFileIndex1 : integer;
strFileName : string;
begin
if m_ZipFileList.Count > 0 then
m_ZipFileList.Clear;
for nFileIndex := m_nFileCount - 1 downto 0 do
if FileList.Items.Item[nFileIndex].Selected then
begin
strFileName := m_strZipFileName + c_strZipSpilt +
FileList.Items.Item[nFileIndex].SubItems.Text +
FileList.Items[nFileIndex].Caption;
nFileIndex1 := 1;
while (nFileIndex1 <= Length(strFileName)) do
begin //删除无用字符
if strFileName[nFileIndex1] < #32 then
Delete(strFileName, nFileIndex1, 1)
else
inc(nFileIndex1);
end;
m_ZipFileList.Add(strFileName);
end;
if m_ZipFileList.Count > 0 then
ModalResult := mrOk
else
ModalResult := mrCancel;
end;
procedure TFormZipPrev.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(m_strZipFileName);
lpszExtractDir := PChar('');
end;
end;
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 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 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;
strFileName : string;
strPathName : string;
strFileExtName : string;
nFileIndex : integer;
nFileIndex1 : integer;
begin
strFileName := Filename;
strPathName := '';
//忽略目录
if strFileName[Length(strFileName)] = '/' then Exit;
for nFileIndex := Length(strFileName) downto 1 do
begin
if strFileName[nFileIndex] = '/' then
begin
//分割目录和文件
strPathName := copy(strFileName, 1, nFileIndex);
strFileName := copy(strFileName, nFileIndex + 1, Length(strFileName));
if not FormZipPrev.CheckBoxList.Checked then
begin //过滤多余文件
strFileExtName := LowerCase(ExtractFileExt(strFileName));
if not ((strFileExtName = '.txt') or (strFileExtName = '.htm') or (strFileExtName = '.html') or
(strFileExtName = '.rtf') or (strFileExtName = '.ini') or (strFileExtName = '.zip') or
(strFileExtName = '.gb') or (strFileExtName = '.blf')) then
Exit;
end;
nFileIndex1 := pos('/', strPathName);
while nFileIndex1 > 0 do
begin
strPathName[nFileIndex1] := '\';
nFileIndex1 := pos('/', strPathName);
end;
//文件数+1
inc(m_nFileCount);
FileListItem := FormZipPrev.FileList.Items.Add;
FileListItem.Caption := strFileName;
FileListItem.SubItems.Text := strPathName;
Exit;
end;
end;
if not FormZipPrev.CheckBoxList.Checked then
begin //过滤多余文件
strFileExtName := LowerCase(ExtractFileExt(strFileName));
if not ((strFileExtName = '.txt') or (strFileExtName = '.htm') or (strFileExtName = '.html') or
(strFileExtName = '.rtf') or (strFileExtName = '.ini') or (strFileExtName = '.zip') or
(strFileExtName = '.gb') or (strFileExtName = '.blf')) then
Exit;
end;
//文件数+1
inc(m_nFileCount);
FileListItem := FormZipPrev.FileList.Items.Add;
FileListItem.Caption := strFileName;
FileListItem.SubItems.Text := strPathName;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -