hxVersion.pas
上传用户:youjie821
上传日期:2013-01-27
资源大小:459k
文件大小:8k
源码类别:

PlugIns编程

开发平台:

Delphi

  1. unit hxVersion;
  2. interface
  3. uses
  4.   Windows, Classes, SysUtils;
  5. type
  6.   { define a generic exception class for version info, and an exception
  7.     to indicate that no version info is available. }
  8.   EVersionError = class(Exception);
  9.   EVerInfoError = class(EVersionError);
  10.   ENoVerInfoError = class(EVersionError);
  11.   ENoFixedVerInfo = class(EVersionError);
  12.   // define enum type representing different types of version info
  13.   TVerInfoType = (
  14.     viCompanyName,
  15.     viFileDescription,
  16.     viFileVersion,
  17.     viInternalName,
  18.     viLegalCopyright,
  19.     viLegalTrademarks,
  20.     viOriginalFileName,
  21.     viProductName,
  22.     viProductVersion,
  23.     viComments);
  24. const
  25.   // define an array constant of strings representing the pre-defined
  26.   // version information keys.
  27.   VerNameArray: array[viCompanyName..viComments] of string[20] = (
  28.     'CompanyName',
  29.     'FileDescription',
  30.     'FileVersion',
  31.     'InternalName',
  32.     'LegalCopyright',
  33.     'LegalTrademarks',
  34.     'OriginalFileName',
  35.     'ProductName',
  36.     'ProductVersion',
  37.     'Comments');
  38. type
  39.   // Define the version info class
  40.   TVerInfoRes = class
  41.   private
  42.     Handle: DWORD;
  43.     Size: Integer;
  44.     RezBuffer: string;
  45.     TransTable: PLongint;
  46.     FixedFileInfoBuf: PVSFixedFileInfo;
  47.     FFileFlags: TStringList;
  48.     FFileName: string;
  49.     procedure FillFixedFileInfoBuf;
  50.     procedure FillFileVersionInfo;
  51.     procedure FillFileMaskInfo;
  52.   protected
  53.     function GetFileVersion: string;
  54.     function GetProductVersion: string;
  55.     function GetFileDescription: string;
  56.     function GetFileOS: string;
  57.   public
  58.     constructor Create(AFileName: string);
  59.     destructor Destroy; override;
  60.     function GetPreDefKeyString(AVerKind: TVerInfoType): string;
  61.     function GetUserDefKeyString(AKey: string): string;
  62.     property FileVersion: string read GetFileVersion;
  63.     property FileDescription: string read GetFileDescription;
  64.     property ProductVersion: string read GetProductVersion;
  65.     property FileFlags: TStringList read FFileFlags;
  66.     property FileOS: string read GetFileOS;
  67.   end;
  68.   // 获取文件版本号
  69.   function GetFileVersion(FileName: string): string;
  70.   // 获取文件描述信息
  71.   function GetFileDescription(FileName: string): string;
  72. implementation
  73. const
  74.   // strings that must be fed to VerQueryValue() function
  75.   SFInfo  = 'StringFileInfo';
  76.   VerTranslation: PChar = 'VarFileInfoTranslation';
  77.   FormatStr = '%s%.4x%.4x%s%s';
  78. function VersionString(Ms, Ls: LongInt): string;
  79. begin
  80.   Result:= Format('%d.%d.%d.%d', [HIWORD(Ms), LOWORD(Ms), HIWORD(Ls), LOWORD(Ls)]);
  81. end;
  82. function GetFileVersion(FileName: string): string;
  83. begin
  84.   try
  85.     with TVerInfoRes.Create(FileName) do
  86.     begin
  87.       Result:= FileVersion;
  88.     end;
  89.   except
  90.     on E: EVersionError do
  91.       Result:= '0';
  92.     {
  93.     on E: EVerInfoError do
  94.       Result:= '0.0.0.0';
  95.     on E: ENoVerInfoError do
  96.       Result:= '0.0.0.0';
  97.     on E: ENoFixedVerInfo do
  98.       Result:= '0.0.0.0';
  99.     }
  100.   end;
  101. end;
  102. function GetFileDescription(FileName: string): string;
  103. begin
  104.   try
  105.     with TVerInfoRes.Create(FileName) do
  106.     begin
  107.       Result:= FileDescription;
  108.     end;
  109.   except
  110.     on E: EVersionError do
  111.       Result:= '';
  112.   end;
  113. end;
  114. { TVerInfoRes }
  115. constructor TVerInfoRes.Create(AFileName: string);
  116. begin
  117.   FFileName:= AFileName;
  118.   FFileFlags:= TStringList.Create;
  119.   // Get the file version information
  120.   FillFileVersionInfo;
  121.   // Get the fixed file info
  122.   FillFixedFileInfoBuf;
  123.   // Get the file mask values
  124.   FillFileMaskInfo;
  125. end;
  126. destructor TVerInfoRes.Destroy;
  127. begin
  128.   FFileFlags.Free;
  129.   inherited;
  130. end;
  131. procedure TVerInfoRes.FillFileVersionInfo;
  132. var
  133.   SBSize: UInt;
  134. begin
  135.   // Determine size of version information
  136.   Size:= GetFileVersionInfoSize(PChar(FFileName), Handle);
  137.   if Size <= 0 then
  138.     raise ENoVerInfoError.Create('No Version Info Available');
  139.   // Set the length accordingly
  140.   SetLength(RezBuffer, Size);
  141.   // Fill the buffer with version information, raise exception on error
  142.   if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then
  143.     raise EVerInfoError.Create('Cannot obtain version info');
  144.   // Get translation info, raise exception on error
  145.   if not VerQueryValue(PChar(RezBuffer), VerTranslation, pointer(TransTable), SBSize) then
  146.     raise EVerInfoError.Create('No language info.');
  147. end;
  148. procedure TVerInfoRes.FillFileMaskInfo;
  149. begin
  150.   with FixedFileInfoBuf^ do
  151.   begin
  152.     if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0 then
  153.       FFileFlags.Add('Pre-release');
  154.     if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
  155.       FFileFlags.Add('Private build');
  156.     if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
  157.       FFileFlags.Add('Special build');
  158.     if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then
  159.       FFileFlags.Add('Debug');
  160.   end;
  161. end;
  162. procedure TVerInfoRes.FillFixedFileInfoBuf;
  163. var
  164.   Size: Cardinal;
  165. begin
  166.   if VerQueryValue(PChar(RezBuffer), '', pointer(FixedFileInfoBuf), Size) then
  167.   begin
  168.     if Size < sizeof(TVSFixedFileInfo) then
  169.       raise ENoFixedVerInfo.Create('No fixed file info');
  170.   end
  171.   else
  172.     raise ENoFixedVerInfo.Create('No fixed file info');
  173. end;
  174. function TVerInfoRes.GetFileOS: string;
  175. begin
  176.   with FixedFileInfoBuf^ do
  177.     case dwFileOS of
  178.       VOS_UNKNOWN: // Same as VOS_BASE
  179.         Result:= 'Unknown';
  180.       VOS_DOS:
  181.         Result:= 'Designed for MS-DOS';
  182.       VOS_OS216:
  183.         Result:= 'Designed for 16-it OS/2';
  184.       VOS_OS232:
  185.         Result:= 'Desinged for 32-bit OS/2';
  186.       VOS_NT:
  187.         Result:= 'Desgined for Windows/NT';
  188.       VOS__WINDOWS16:
  189.         Result:= 'Designed for 16-bit Windows';
  190.       VOS__PM16:
  191.         Result:= 'Desgined for 16-bit PM';
  192.       VOS__PM32:
  193.         Result:= 'Desgined for 32-bit PM';
  194.       VOS__WINDOWS32:
  195.         Result:= 'Desgined for 32-bit Windows';
  196.       VOS_DOS_WINDOWS16:
  197.         Result:= 'Desgined for 16-bit Windows, running on MS-DOS';
  198.       VOS_DOS_WINDOWS32:
  199.         Result:= 'Desgined for Win32 API, running on MS-DOS';
  200.       VOS_OS216_PM16:
  201.         Result:= 'Desgined for 16-bit PM, running on 16-bit OS/2';
  202.       VOS_OS232_PM32:
  203.         Result:= 'Desgined for 32-bit PM, running on 32-bit OS/2';
  204.       VOS_NT_WINDOWS32:
  205.         Result:= 'Desgined for Win32API, running on Windows/NT';
  206.     else
  207.       Result:= 'Unknown';
  208.     end;
  209. end;
  210. function TVerInfoRes.GetFileVersion: string;
  211. begin
  212.   with FixedFileInfoBuf^ do
  213.     Result:= VersionString(dwFileVersionMS, dwFileVersionLS);
  214. end;
  215. function TVerInfoRes.GetPreDefKeyString(AVerKind: TVerInfoType): string;
  216. var
  217.   P: PChar;
  218.   S: UInt;
  219. begin
  220.   Result:= Format(FormatStr, [SfInfo, LoWord(TransTable^), HiWord(TransTable^),
  221.     VerNameArray[AVerKind], #0]);
  222.   // get and return version query info, return empty string on error
  223.   if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  224.     Result:= StrPas(P)
  225.   else
  226.     Result:= '';
  227. end;
  228. function TVerInfoRes.GetProductVersion: string;
  229. begin
  230.   with FixedFileInfoBuf^ do
  231.     Result:= VersionString(dwProductVersionMS, dwProductVersionLS);
  232. end;
  233. function TVerInfoRes.GetUserDefKeyString(AKey: string): string;
  234. var
  235.   P: PChar;
  236.   S: UInt;
  237. begin
  238.   Result:= Format(FormatStr, [SfInfo, LoWord(TransTable^), HiWord(TransTable^),
  239.     AKey, #0]);
  240.   // get and return version query info, return empty string on error
  241.   if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  242.     Result:= StrPas(P)
  243.   else
  244.     Result:= '';
  245. end;
  246. function TVerInfoRes.GetFileDescription: string;
  247. begin
  248.   Result:= GetPreDefKeyString(viFileDescription);
  249. end;
  250. end.