⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 zipprev.pas

📁 电子小说阅读器v2.68可用于阅读pdf.html等各种形式的文档
💻 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 + -