unzip32.pas

delphi 电子书阅读器 外观非常漂亮

var
	Wiz_NoPrinting : TWiz_NoPrinting = nil;
	Wiz_Validate : TWiz_Validate = nil;
	Wiz_Init : TWiz_Init = nil;
	Wiz_SetOpts : TWiz_SetOpts = nil;
	Wiz_Unzip : TWiz_Unzip = nil;
	Wiz_SingleEntryUnzip : TWiz_SingleEntryUnzip = nil;
	Wiz_UnzipToMemory : TWiz_UnzipToMemory = nil;
	Wiz_Grep : TWiz_Grep = nil;

  { unzip.h }
var
	UzpFreeMemBuffer : TUzpFreeMemBuffer = nil;
	UzpVersion : TUzpVersion = nil;
	UzpVersion2 : TUzpVersion2 = nil;

  { loader }
var
	hZIPDLL : THandle;
	boolUseZIPDLL : boolean;

implementation

type
 TFVISubBlock = (sbCompanyName, sbFileDescription, sbFileVersion, sbInternalName, sbLegalCopyright,
   sbLegalTradeMarks, sbOriginalFilename, sbProductName, sbProductVersion, sbComments);

{----------------------------------------------------------------------------------
 Description    : retrieves selected version information from the specified
                  version-information resource. True on success
 Parameters     :
                  const FullPath : string;        the exe or dll full path
                  SubBlock       : TFVISubBlock;  the requested sub block information ie sbCompanyName
                  var sValue     : string         the returned string value
 Error checking : YES
 Notes          :
                  1. 32bit only ( It does not work with 16-bit Windows file images )
				  2. TFVISubBlock is declared as
                     TFVISubBlock = (sbCompanyName, sbFileDescription, sbFileVersion, sbInternalName,
                                     sbLegalCopyright, sbLegalTradeMarks, sbOriginalFilename,
                                     sbProductName, sbProductVersion, sbComments);
 Tested         : in Delphi 4 only
 Author         : Theo Bebekis <[e-mail]>
-----------------------------------------------------------------------------------}
function Get_FileVersionInfo(const FullPath: string; SubBlock: TFVISubBlock; var sValue: string) : Boolean;
const
 	arStringNames : array[sbCompanyName..sbComments] of string =
		('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright',
   		 'LegalTradeMarks', 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments');
var
	Dummy       : DWORD;
	iLen        : DWORD;
	pData       : PChar;
	pVersion    : Pointer;
	pdwLang     : PDWORD;
	sLangID     : string;
	sCharsetID  : string;
	pValue      : PChar;
begin
	Result := False;

	{ get the size of the size in bytes of the file's version information}
	iLen := GetFileVersionInfoSize(PChar(FullPath), Dummy);
	if iLen = 0 then
		Exit;

	{ get the information }
	pData := StrAlloc(iLen + 1);
  	if not GetFileVersionInfo(PChar(FullPath),  { pointer to filename string }
							  0,                { ignored }
							  iLen,             { size of buffer }
                              pData)            { pointer to buffer to receive file-version info }
		then Exit;

	{ get the national ID.
	  retrieve a pointer to an array of language and
	  character-set identifiers. Use these identifiers
	  to create the name of a language-specific
      structure in the version-information resource}
	if not VerQueryValue(pData,                       { address of buffer for version resource (in)}
						 '\VarFileInfo\Translation',  { address of value to retrieve (in) }
						 pVersion,                    { address of buffer for version pointer (out)}
						 iLen )                       { address of version-value length buffer (out)}
  		then Exit;

	{ analyze it }
	pdwLang    := pVersion;
	sLangID    := IntToHex(pdwLang^, 8);
	sCharsetID := Copy(sLangID, 1, 4);
  	sLangID    := Copy(sLangID, 5, 4);

	{ get the info for the requested sub block }
	if not VerQueryValue(pData,
						 PChar('\StringFileInfo\' + sLangID + sCharsetID + '\' + arStringNames[SubBlock]),
						 pVersion,
						 iLen)
  		then Exit;     

	{ copy it to sValue }
	pValue := StrAlloc(iLen + 1);
	StrLCopy(pValue, pVersion, iLen);
	sValue := String(pValue);
	StrDispose(pValue);

  	Result := True;
end;
      
{----------------------------------------------------------------------------------
 NOTE : this function uses the SearchPath WinAPI call to locate the dll and
        then checks up for the version info using the above Get_FileVersionInfo
        to get both the version number and the company name.
        The dll's UzpVersion function does not check for the CompanyName.
        I recommend to call the IsExpectedUnZipDllVersion function as the very
        first step to ensure that is the right dll and not any other with a
        similar name etc.
        This function is more usefull when link the dll dynamically
----------------------------------------------------------------------------------}
function IsExpectedUnZipDllVersion: boolean;
const
	DLL_WARNING =         'Cannot find %s.'  + #10 +
						  'The Dll must be in the application directory, the path,' + #10 +
						  'the Windows directory or the Windows System directory.';
	DLL_VERSION_WARNING = '%s has the wrong version number.' + #10 +
						  'Insure that you have the correct dll''s installed, and that ' + #10 +
                          'an older dll is not in your path or Windows System directory.';
var
	sCompany  : string;
	sVersion  : string;
	iRes      : DWORD;
	pBuffer   : array[0..MAX_PATH - 1] of Char;
   	pFilePart : PChar;
begin
	Result := False;

	if (not boolUseZIPDLL) then Exit;

	iRes := SearchPath(nil,                { address of search path }
					   PChar(UNZIP_DLL),   { address of filename }
					   '.dll',             { address of extension }
					   MAX_PATH - 1,       { size, in characters, of buffer }
					   pBuffer,            { address of buffer for found filename }
					   pFilePart           { address of pointer to file component }
                      );

	if iRes = 0 then
		raise Exception.CreateFmt(DLL_WARNING, [UNZIP_DLL]);

	if Get_FileVersionInfo(String(pBuffer), sbCompanyName, sCompany) and
	   Get_FileVersionInfo(String(pBuffer), sbFileVersion, sVersion) then
	   	Result := (sCompany = COMPANY_NAME) and (sVersion = UNZIP_DLL_VERSION) ;

	if not Result then
		raise Exception.CreateFmt(DLL_VERSION_WARNING, [UNZIP_DLL]);
end;

  { dll prototypes }

  { loader }
procedure LoadZIPDLL;
begin
	UNZIP_DLL := GetAppPath + 'Talezip.dat';
	strZIPPassword := '';
	boolUseZIPDLL := False;

	if (FileExists(UNZIP_DLL)) then
	begin
		hZIPDLL := LoadLibrary(PChar(UNZIP_DLL));
		boolUseZIPDLL := (hZIPDLL >= 32);

		if (boolUseZIPDLL) then
		begin
			{ decs.h }
			@Wiz_NoPrinting := GetProcAddress(hZIPDLL, 'Wiz_NoPrinting');
			@Wiz_Validate := GetProcAddress(hZIPDLL, 'Wiz_Validate');
			@Wiz_Init := GetProcAddress(hZIPDLL, 'Wiz_Init');
			@Wiz_SetOpts := GetProcAddress(hZIPDLL, 'Wiz_SetOpts');
			@Wiz_Unzip := GetProcAddress(hZIPDLL, 'Wiz_Unzip');
			@Wiz_SingleEntryUnzip := GetProcAddress(hZIPDLL, 'Wiz_SingleEntryUnzip');
			@Wiz_UnzipToMemory := GetProcAddress(hZIPDLL, 'Wiz_UnzipToMemory');
			@Wiz_Grep := GetProcAddress(hZIPDLL, 'Wiz_Grep');

			{ unzip.h }
			@UzpFreeMemBuffer := GetProcAddress(hZIPDLL, 'UzpFreeMemBuffer');
			@UzpVersion := GetProcAddress(hZIPDLL, 'UzpVersion');
			@UzpVersion2 := GetProcAddress(hZIPDLL, 'UzpVersion2');
		end;
	end;
end;

procedure UnLoadZIPDLL;
begin
	if (boolUseZIPDLL) then
	begin
		{ decs.h }
		Wiz_NoPrinting := nil;
		Wiz_Validate := nil;
		Wiz_Init := nil;
		Wiz_SetOpts := nil;
		Wiz_Unzip := nil;
		Wiz_SingleEntryUnzip := nil;
		Wiz_UnzipToMemory := nil;
		Wiz_Grep := nil;

		{ unzip.h }
		UzpFreeMemBuffer := nil;
		UzpVersion := nil;
		UzpVersion2 := nil;

		FreeLibrary(hZIPDLL);
		boolUseZIPDLL := False;
	end;
end;

function GetPassword(var s : string; Msg : PChar) : boolean;
var
	strMsg : string;
begin
	strMsg := Msg;

	if ((strMsg = 'Enter password for: ') and (strZIPPassword <> '')) then
	begin  //使用以前的密码，先做尝试
		Result := True;
		s := strZIPPassword;
	end
	else
	begin  //密码输入错误，则重新输入密码
		Result := GetZIPPassword(s);
		if Result then strZIPPassword := s;
	end;
end;

end.