home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / Misc / FileInfo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-27  |  8.4 KB  |  252 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.   protected
  69.     procedure setExecutableFile(FileName : String);
  70.     procedure clearInfo;
  71.   public
  72.     { public declarations }
  73.     constructor Create(AOwner : TComponent); override;
  74.     procedure FindFileVersionInfo;
  75.   published
  76.     { published declarations }
  77.     property Comments : String read fComments write fComments;
  78.     property CompanyName : String read fCompanyName write fCompanyName;
  79.     property CountryCode : String read fCountryCode write fCountryCode;
  80.     property ExecutableFile : String read fExecutableFile write setExecutableFile;
  81.     property FileDescription : String read fFileDescription write fFileDescription;
  82.     property FileVersion : String read fFileVersion write fFileVersion;
  83.     property InternalName : String read fInternalName write fInternalName;
  84.     property LegalCopyright : String read fLegalCopyright write fLegalCopyright;
  85.     property LegalTradeMarks : String read fLegalTradeMarks write fLegalTradeMarks;
  86.     property OriginalFilename : String read fOriginalFilename write fOriginalFilename;
  87.     property ProductName : String read fProductName write fProductName;
  88.     property ProductVersion : String read fProductVersion write fProductVersion;
  89.   end;
  90.  
  91.     TTranslation = record
  92.       b1 : byte;
  93.     b2 : byte;
  94.     b3 : byte;
  95.     b4 : byte;
  96.   end;
  97.  
  98.   PTranslation = ^TTranslation;
  99.  
  100. implementation
  101.  
  102. {-----------------------------------------------------------------------------}
  103. constructor TFileVersionInfo.Create(AOwner : TComponent);
  104. {creates a TFileVersionInfo object}
  105. begin
  106.   inherited Create(AOwner);
  107.   setExecutableFile(ParamStr(0));
  108. end;
  109.  
  110. {-----------------------------------------------------------------------------}
  111. procedure TFileVersionInfo.setExecutableFile(FileName : String);
  112. {sets the executable filename and calls the fileversioninfo API}
  113. begin
  114.   fExecutableFile := FileName;
  115.   FindFileVersionInfo;
  116. end;
  117.  
  118. {-----------------------------------------------------------------------------}
  119. {$IFDEF MSWINDOWS}
  120. procedure TFileVersionInfo.FindFileVersionInfo;
  121. {calls the fileversioninfo API and sets the component properties}
  122. var
  123.   StringBuffer       : PChar;
  124.   VersionPointer     : PChar;
  125.   QueryStr           : String;
  126.   pQueryStr          : array [0..255] of char;
  127. {$IFDEF DELPHI1}
  128.   Size               : Longint;
  129.   VersionValueLength : Word;
  130.   lpExecutableFile   : array [0..255] of char;
  131. {$ELSE}
  132.   Size               : DWord;
  133.   VersionValueLength : DWord;
  134. {$ENDIF}
  135. begin
  136.     {clear all properties}
  137.   clearInfo;
  138.  
  139.     {get size of fileversioninfo buffer}
  140. {$IFDEF WINDOWS}
  141.   StrPCopy(lpExecutableFile, fExecutableFile);
  142.   Size := GetFileVersionInfoSize(lpExecutableFile, Size);
  143. {$ENDIF}
  144. {$IFDEF WIN32}
  145.   Size := GetFileVersionInfoSize(PChar(fExecutableFile), Size);
  146. {$ENDIF}
  147.  
  148.   if Size > 0 then
  149.   begin {fileversioninfo exists}
  150. {allocate memory for fileversioninfo strings}
  151.     StringBuffer := AllocMem(Size);
  152.         {copy fileversioninfo into buffer}
  153. {$IFDEF WINDOWS}
  154.     GetFileVersionInfo(lpExecutableFile, 0, Size, StringBuffer);
  155. {$ENDIF}
  156. {$IFDEF WIN32}
  157.     GetFileVersionInfo(PChar(fExecutableFile), 0, Size, StringBuffer);
  158. {$ENDIF}
  159.  
  160. {convert Translation to correct countrycode}
  161.     VerQueryValue(StringBuffer, PChar('\VarFileInfo\Translation'),
  162.       Pointer(VersionPointer), VersionValueLength);
  163.  
  164.     fCountryCode :=
  165.       IntToHex(PTranslation(VersionPointer)^.b2, 2) +
  166.       IntToHex(PTranslation(VersionPointer)^.b1, 2) +
  167.       IntToHex(PTranslation(VersionPointer)^.b4, 2) +
  168.       IntToHex(PTranslation(VersionPointer)^.b3, 2);
  169.  
  170.         {get company name}
  171.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'CompanyName';
  172.     StrPCopy(pQueryStr, QueryStr);
  173.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  174.       fCompanyName := StrPas(VersionPointer);
  175.         {get file description}
  176.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'FileDescription';
  177.     StrPCopy(pQueryStr, QueryStr);
  178.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  179.       fFileDescription := StrPas(VersionPointer);
  180.         {get file version}
  181.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'FileVersion';
  182.     StrPCopy(pQueryStr, QueryStr);
  183.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  184.       fFileVersion := StrPas(VersionPointer);
  185.         {get internal name}
  186.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'InternalName';
  187.     StrPCopy(pQueryStr, QueryStr);
  188.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  189.       fInternalName := StrPas(VersionPointer);
  190.         {get legal copyright}
  191.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'LegalCopyright';
  192.     StrPCopy(pQueryStr, QueryStr);
  193.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  194.       fLegalCopyright := StrPas(VersionPointer);
  195.         {get legal trademarks}
  196.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'LegalTradeMarks';
  197.     StrPCopy(pQueryStr, QueryStr);
  198.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  199.       fLegalTradeMarks := StrPas(VersionPointer);
  200.         {get original filename}
  201.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'OriginalFilename';
  202.     StrPCopy(pQueryStr, QueryStr);
  203.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  204.       fOriginalFilename := StrPas(VersionPointer);
  205.         {get product name}
  206.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'ProductName';
  207.     StrPCopy(pQueryStr, QueryStr);
  208.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  209.       fProductName := StrPas(VersionPointer);
  210.         {get product version}
  211.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'ProductVersion';
  212.     StrPCopy(pQueryStr, QueryStr);
  213.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  214.       fProductVersion := StrPas(VersionPointer);
  215.         {get comments}
  216.     QueryStr := '\StringFileInfo\' + fCountryCode + '\' + 'Comments';
  217.     StrPCopy(pQueryStr, QueryStr);
  218.     if VerQueryValue(StringBuffer, pQueryStr, Pointer(VersionPointer), VersionValueLength) then
  219.       fComments := StrPas(VersionPointer);
  220.  
  221.         {free previously allocated memory}
  222.     FreeMem(StringBuffer, Size);
  223.   end;
  224. end;
  225. {$ENDIF}
  226.  
  227. {$IFDEF LINUX}
  228. procedure TFileVersionInfo.FindFileVersionInfo;
  229. begin
  230. end;
  231. {$ENDIF}
  232.  
  233. {-----------------------------------------------------------------------------}
  234. procedure TFileVersionInfo.clearInfo;
  235. {clear all properties}
  236. begin
  237.   fCompanyName := '';
  238.   fFileDescription := '';
  239.   fFileVersion := '';
  240.   fInternalName := '';
  241.   fLegalCopyright := '';
  242.   fLegalTradeMarks := '';
  243.   fOriginalFilename := '';
  244.   fProductName := '';
  245.   fProductVersion := '';
  246.   fComments := '';
  247.   fCountryCode := '';
  248. end;
  249.  
  250.  
  251. end.
  252.