unzip32.pas

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

  IZ_PW_CANCEL           = -1; { no password available (for this entry) }
  IZ_PW_CANCELALL        = -2; { no password, skip any further pwd. request }
  IZ_PW_ERROR            = 5; { = PK_MEM2 : failure (no mem, no tty, ...) }

{ flag values for status callback function  }
  UZ_ST_START_EXTRACT    = 1;
  UZ_ST_IN_PROGRESS      = 2;
  UZ_ST_FINISH_MEMBER    = 3;

{ return values of status callback function  }
  UZ_ST_CONTINUE         = 0;
  UZ_ST_BREAK            = 1;


type
  PPChar = ^PChar;


   
  { dll prototypes }

  { decs.h } 
procedure  Wiz_NoPrinting(Flag: Integer); stdcall;
function   Wiz_Validate(Archive: PChar;  AllCodes: Integer): Integer; stdcall;
function   Wiz_Init(var pG; var UserFunc: TUserFunctions): Bool; stdcall;
function   Wiz_SetOpts(var pG; var Options: TDCL): Bool; stdcall;
function   Wiz_Unzip(var pG; ifnc: Integer; ifnv: PPChar; xfnc: Integer; xfnv: PPChar): Integer; stdcall;
function   Wiz_SingleEntryUnzip(ifnc: Integer; ifnv: PPChar; xfnc: Integer;
                                xfnv: PPChar; var Options: TDCL;
                                var UserFunc: TUserFunctions): Integer; stdcall;
function   Wiz_UnzipToMemory(Zip: PChar;  FileName: PChar; var UserFunctions: TUserFunctions;
                             var RetStr: TUzpBuffer): Integer; stdcall;
function   Wiz_Grep(Archive: PChar; FileName: PChar; Pattern: PChar; Cmd: Integer;
                    SkipBin: Integer; var UserFunctions: TUserFunctions): Integer; stdcall;

  { unzip.h }
procedure  UzpFreeMemBuffer(var RetStr: TUzpBuffer); stdcall;
function   UzpVersion: PUzpVer; stdcall;
procedure  UzpVersion2(var Version: TUzpVer2); stdcall;

  { helper }
function IsExpectedUnZipDllVersion: boolean;




implementation




uses
 SysUtils;


  { dll routines }

  { decs.h } 
procedure  Wiz_NoPrinting; external UNZIP_DLL name 'Wiz_NoPrinting';
function   Wiz_Validate; external UNZIP_DLL name 'Wiz_Validate';
function   Wiz_Init; external UNZIP_DLL name 'Wiz_Init';
function   Wiz_SetOpts; external UNZIP_DLL name 'Wiz_SetOpts';
function   Wiz_Unzip; external UNZIP_DLL name 'Wiz_Unzip';
function   Wiz_SingleEntryUnzip; external UNZIP_DLL name 'Wiz_SingleEntryUnzip';
function   Wiz_UnzipToMemory; external UNZIP_DLL name 'Wiz_UnzipToMemory';
function   Wiz_Grep; external UNZIP_DLL name 'Wiz_Grep';

  { unzip.h }
procedure  UzpFreeMemBuffer; external UNZIP_DLL name 'UzpFreeMemBuffer';
function   UzpVersion; external UNZIP_DLL name 'UzpVersion';
procedure  UzpVersion2; external UNZIP_DLL name 'UzpVersion2';





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;

  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;

end.