home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d12345 / MISC.ZIP / Fileinfo.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-02  |  9KB  |  253 lines
  1. unit Fileinfo;
  2.  
  3. {$I Misc.inc}
  4.  
  5. {-----------------------------------------------------------------------------
  6. FileVersionInfo is an original work by Helmut Schottmueller and is hereby placed in the Public Domain.
  7.  
  8. The Original Code is: FileVersionInfo.pas, released 1998-1999.
  9.  
  10. The Initial Developer of the Original Code is Helmut Schottmueller.
  11.  
  12. Contributor(s): Helmut Schottmueller   e-mail: hschottm@informatik.uni-bremen.de
  13.  
  14. Last Modified: 05/25/2000
  15. Current Version: 2.00
  16.  
  17. You may retrieve the latest version of this file from:
  18.  
  19.         http://Chemware.hypermart.net/
  20.  
  21. This work was created with the Project JEDI VCL guidelines:
  22.  
  23.         http://www.delphi-jedi.org/Jedi:VCLVCL
  24.  
  25. in mind. 
  26.  
  27.  
  28. Purpose: extract resource information from executable
  29.  
  30. Known Issues:
  31. -----------------------------------------------------------------------------}
  32.  
  33. {Note from Mat Ballard:
  34.  This component is used by both the TSplash and TAbout dialog boxes in the
  35.  TSplashDlg and TAboutDlg components.}
  36.  
  37. interface
  38.  
  39. uses
  40.   Classes, SysUtils
  41. {$IFDEF WINDOWS}
  42.   ,WinTypes, WinProcs, Ver
  43. {$ENDIF}
  44. {$IFDEF WIN32}
  45.   ,Windows
  46. {$ENDIF}
  47. {$IFDEF LINUX}
  48.  
  49. {$ENDIF}
  50.   ;
  51.  
  52. type
  53.   TFileVersionInfo = class(TComponent)
  54.   private
  55.     { private declarations }
  56.     fCompanyName : String;
  57.     fFileDescription : String;
  58.     fFileVersion : String;
  59.     fInternalName : String;
  60.     fLegalCopyright : String;
  61.     fLegalTradeMarks : String;
  62.     fOriginalFilename : String;
  63.     fProductName : String;
  64.     fProductVersion : String;
  65.     fComments : String;
  66.     fExecutableFile : String;
  67.     fCountryCode    : String;
  68.     procedure setExecutableFile(FileName : String);
  69.     procedure clearInfo;
  70.   protected
  71.     { protected declarations }
  72.   public
  73.     { public declarations }
  74.     constructor Create(AOwner : TComponent); override;
  75.     procedure FindFileVersionInfo;
  76.   published
  77.     { published declarations }
  78.     property Comments : String read fComments write fComments;
  79.     property CompanyName : String read fCompanyName write fCompanyName;
  80.     property CountryCode : String read fCountryCode write fCountryCode;
  81.     property ExecutableFile : String read fExecutableFile write setExecutableFile;
  82.     property FileDescription : String read fFileDescription write fFileDescription;
  83.     property FileVersion : String read fFileVersion write fFileVersion;
  84.     property InternalName : String read fInternalName write fInternalName;
  85.     property LegalCopyright : String read fLegalCopyright write fLegalCopyright;
  86.     property LegalTradeMarks : String read fLegalTradeMarks write fLegalTradeMarks;
  87.     property OriginalFilename : String read fOriginalFilename write fOriginalFilename;
  88.     property ProductName : String read fProductName write fProductName;
  89.     property ProductVersion : String read fProductVersion write fProductVersion;
  90.   end;
  91.  
  92.     TTranslation = record
  93.       b1 : byte;
  94.     b2 : byte;
  95.     b3 : byte;
  96.     b4 : byte;
  97.   end;
  98.  
  99.   PTranslation = ^TTranslation;
  100.  
  101. implementation
  102.  
  103. {-----------------------------------------------------------------------------}
  104. constructor TFileVersionInfo.Create(AOwner : TComponent);
  105. {creates a TFileVersionInfo object}
  106. begin
  107.   inherited Create(AOwner);
  108.   setExecutableFile(ParamStr(0));
  109. end;
  110.  
  111. {-----------------------------------------------------------------------------}
  112. procedure TFileVersionInfo.setExecutableFile(FileName : String);
  113. {sets the executable filename and calls the fileversioninfo API}
  114. begin
  115.   fExecutableFile := FileName;
  116.   FindFileVersionInfo;
  117. end;
  118.  
  119. {-----------------------------------------------------------------------------}
  120. {$IFDEF MSWINDOWS}
  121. procedure TFileVersionInfo.FindFileVersionInfo;
  122. {calls the fileversioninfo API and sets the component properties}
  123. var
  124.   StringBuffer       : PChar;
  125.   VersionPointer     : PChar;
  126.   QueryStr           : String;
  127.   pQueryStr          : array [0..255] of char;
  128. {$IFDEF DELPHI1}
  129.   Size               : Longint;
  130.   VersionValueLength : Word;
  131.   lpExecutableFile   : array [0..255] of char;
  132. {$ELSE}
  133.   Size               : DWord;
  134.   VersionValueLength : DWord;
  135. {$ENDIF}
  136. begin
  137.     {clear all properties}
  138.   clearInfo;
  139.  
  140.     {get size of fileversioninfo buffer}
  141. {$IFDEF WINDOWS}
  142.   StrPCopy(lpExecutableFile, fExecutableFile);
  143.   Size := GetFileVersionInfoSize(lpExecutableFile, Size);
  144. {$ENDIF}
  145. {$IFDEF WIN32}
  146.   Size := GetFileVersionInfoSize(PChar(fExecutableFile), Size);
  147. {$ENDIF}
  148.  
  149.   if Size > 0 then
  150.   begin {fileversioninfo exists}
  151. {allocate memory for fileversioninfo strings}
  152.     StringBuffer := AllocMem(Size);
  153.         {copy fileversioninfo into buffer}
  154. {$IFDEF WINDOWS}
  155.     GetFileVersionInfo(lpExecutableFile, 0, Size, StringBuffer);
  156. {$ENDIF}
  157. {$IFDEF WIN32}
  158.     GetFileVersionInfo(PChar(fExecutableFile), 0, Size, StringBuffer);
  159. {$ENDIF}
  160.  
  161. {convert Translation to correct countrycode}
  162.     VerQueryValue(StringBuffer, PChar('\VarFileInfo\Translation'),
  163.       Pointer(VersionPointer), VersionValueLength);
  164.  
  165.     fCountryCode :=
  166.       IntToHex(PTranslation(VersionPointer)^.b2, 2) +
  167.       IntToHex(PTranslation(VersionPointer)^.b1, 2) +
  168.       IntToHex(PTranslation(VersionPointer)^.b4, 2) +
  169.       IntToHex(PTranslation(VersionPointer)^.b3, 2);
  170.  
  171.         {get company name}
  172.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'CompanyName';
  173.     StrPCopy(pQueryStr, QueryStr);
  174.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  175.       fCompanyName := StrPas(VersionPointer);
  176.         {get file description}
  177.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'FileDescription';
  178.     StrPCopy(pQueryStr, QueryStr);
  179.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  180.       fFileDescription := StrPas(VersionPointer);
  181.         {get file version}
  182.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'FileVersion';
  183.     StrPCopy(pQueryStr, QueryStr);
  184.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  185.       fFileVersion := StrPas(VersionPointer);
  186.         {get internal name}
  187.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'InternalName';
  188.     StrPCopy(pQueryStr, QueryStr);
  189.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  190.       fInternalName := StrPas(VersionPointer);
  191.         {get legal copyright}
  192.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'LegalCopyright';
  193.     StrPCopy(pQueryStr, QueryStr);
  194.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  195.       fLegalCopyright := StrPas(VersionPointer);
  196.         {get legal trademarks}
  197.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'LegalTradeMarks';
  198.     StrPCopy(pQueryStr, QueryStr);
  199.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  200.       fLegalTradeMarks := StrPas(VersionPointer);
  201.         {get original filename}
  202.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'OriginalFilename';
  203.     StrPCopy(pQueryStr, QueryStr);
  204.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  205.       fOriginalFilename := StrPas(VersionPointer);
  206.         {get product name}
  207.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'ProductName';
  208.     StrPCopy(pQueryStr, QueryStr);
  209.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  210.       fProductName := StrPas(VersionPointer);
  211.         {get product version}
  212.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'ProductVersion';
  213.     StrPCopy(pQueryStr, QueryStr);
  214.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  215.       fProductVersion := StrPas(VersionPointer);
  216.         {get comments}
  217.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'Comments';
  218.     StrPCopy(pQueryStr, QueryStr);
  219.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  220.       fComments := StrPas(VersionPointer);
  221.  
  222.         {free previously allocated memory}
  223.     FreeMem(StringBuffer, Size);
  224.   end;
  225. end;
  226. {$ENDIF}
  227.  
  228. {$IFDEF LINUX}
  229. procedure TFileVersionInfo.FindFileVersionInfo;
  230. begin
  231. end;
  232. {$ENDIF}
  233.  
  234. {-----------------------------------------------------------------------------}
  235. procedure TFileVersionInfo.clearInfo;
  236. {clear all properties}
  237. begin
  238.   fCompanyName := '';
  239.   fFileDescription := '';
  240.   fFileVersion := '';
  241.   fInternalName := '';
  242.   fLegalCopyright := '';
  243.   fLegalTradeMarks := '';
  244.   fOriginalFilename := '';
  245.   fProductName := '';
  246.   fProductVersion := '';
  247.   fComments := '';
  248.   fCountryCode := '';
  249. end;
  250.  
  251.  
  252. end.
  253.