home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCVerInfo.pas < prev    next >
Pascal/Delphi Source File  |  2001-01-20  |  7KB  |  258 lines

  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8. }
  9. unit DCVerInfo;
  10.  
  11. interface
  12.  
  13. uses Windows;
  14.  
  15. type
  16.   TModuleVersion = record
  17.     case Integer of
  18.     0: (Minor, Major, Build, Release: Word);
  19.     1: (VersionMS, VersionLS: LongInt);
  20.   end;
  21.  
  22.   TDCVersionInfo = class(TObject)
  23.   private
  24.     FFileName: PChar;
  25.     FBuffer: PChar;
  26.     FSize: Integer;
  27.     FValidRead: boolean;
  28.     procedure ReadVersionInfo;
  29.     function GetFileName: string;
  30.     procedure SetFileName(const Value: string);
  31.     function GetTranslation: Pointer;
  32.     function GetFixedFileInfo: PVSFixedFileInfo;
  33.     function GetFileLongVersion: TModuleVersion;
  34.     function GetProducTModuleVersion: TModuleVersion;
  35.     function GetVersionNum: Longint;
  36.     function GetTranslationString: string;
  37.     function GetOSVersion: string;
  38.     function GetMemoryTotal: string;
  39.     function GetFileDate: TDateTime;
  40.   protected
  41.     property FixedFileInfo: PVSFixedFileInfo read GetFixedFileInfo;
  42.   public
  43.     constructor Create(const AFileName: string);
  44.     destructor Destroy; override;
  45.     function GetVerValue(const VerName: string): string;
  46.     property ValidRead: boolean read FValidRead;
  47.     property FileName: string read GetFileName write SetFileName;
  48.     property FileLongVersion: TModuleVersion read GetFileLongVersion;
  49.     property ProductLongVersion: TModuleVersion read GetProducTModuleVersion;
  50.     property VersionNum: Longint read GetVersionNum;
  51.     property Values[const Name: string]: string read GetVerValue;
  52.     property OSVersion: string read GetOSVersion;
  53.     property MemoryTotal: string read GetMemoryTotal;
  54.     property FileDate: TDateTime read GetFileDate;
  55.     function GetFileVersion: string;
  56.     function GetProductVersion: string;
  57.   end;
  58.  
  59. implementation
  60.  
  61. uses SysUtils, DCConst;
  62.  
  63. type
  64.   TVersionKeys =
  65.      ( vkCompanyName     , vkFileDescription, vkFileVersion    ,
  66.        vkInternalName    , vkLegalCopyright , vkLegalTrademarks,
  67.        vkOriginalFileName, vkProductName    , vkProductVersion ,
  68.        vkComments         );
  69. const
  70.   aVersionKeys: array[TVersionKeys] of PChar =
  71.      ( 'CompanyName'     , 'FileDescription', 'FileVersion'    ,
  72.        'InternalName'    , 'LegalCopyright' , 'LegalTrademarks',
  73.        'OriginalFileName', 'ProductName'    , 'ProductVersion' ,
  74.        'Comments'        );
  75.  
  76.  
  77. function VersionToString(const Version: TModuleVersion): string;
  78. begin
  79.   with Version do
  80.     Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
  81. end;
  82.  
  83. constructor TDCVersionInfo.Create(const AFileName: string);
  84. begin
  85.   inherited Create;
  86.   FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
  87.   ReadVersionInfo
  88. end;
  89.  
  90. destructor TDCVersionInfo.Destroy;
  91. begin
  92.   if FBuffer <> nil then FreeMem(FBuffer, FSize);
  93.   StrDispose(FFileName);
  94.   inherited Destroy;
  95. end;
  96.  
  97. procedure TDCVersionInfo.ReadVersionInfo;
  98.  var
  99.    Handle: DWord;
  100. begin
  101.   FValidRead := False;
  102.   FSize := GetFileVersionInfoSize(FFileName, Handle);
  103.   if FSize > 0 then
  104.     try
  105.       GetMem(FBuffer, FSize);
  106.       FValidRead := GetFileVersionInfo(FFileName, Handle, FSize, FBuffer)
  107.     except
  108.       raise;
  109.     end;
  110. end;
  111.  
  112. function TDCVersionInfo.GetFileName: string;
  113. begin
  114.   Result := StrPas(FFileName);
  115. end;
  116.  
  117. procedure TDCVersionInfo.SetFileName(const Value: string);
  118. begin
  119.   if FBuffer <> nil then FreeMem(FBuffer, FSize);
  120.   FBuffer := nil;
  121.   StrDispose(FFileName);
  122.   FFileName := StrPCopy(StrAlloc(Length(Value) + 1), Value);
  123.   ReadVersionInfo
  124. end;
  125.  
  126. function TDCVersionInfo.GetTranslation: Pointer;
  127. var
  128.   Len: UINT;
  129. begin
  130.   if FValidRead then VerQueryValue(FBuffer, '\VarFileInfo\Translation', Result, Len)
  131.   else Result := nil;
  132. end;
  133.  
  134. function TDCVersionInfo.GetTranslationString: string;
  135. var
  136.   P: Pointer;
  137. begin
  138.   Result := '';
  139.   P := GetTranslation;
  140.   if P <> nil then
  141.     Result := IntToHex(MakeLong(HiWord(Longint(P^)), LoWord(Longint(P^))), 8);
  142. end;
  143.  
  144. function TDCVersionInfo.GetFixedFileInfo: PVSFixedFileInfo;
  145. var
  146.   Len: UINT;
  147. begin
  148.   if FValidRead then VerQueryValue(FBuffer, '\', Pointer(Result), Len)
  149.   else Result := nil;
  150. end;
  151.  
  152. function TDCVersionInfo.GetProducTModuleVersion: TModuleVersion;
  153. begin
  154.   if Assigned(FixedFileInfo) then
  155.   begin
  156.     Result.VersionMS := FixedFileInfo^.dwProductVersionMS;
  157.     Result.VersionLS := FixedFileInfo^.dwProductVersionLS;
  158.   end
  159. end;
  160.  
  161. function TDCVersionInfo.GetFileLongVersion: TModuleVersion;
  162. begin
  163.   if Assigned(FixedFileInfo) then
  164.   begin
  165.     Result.VersionMS := FixedFileInfo^.dwFileVersionMS;
  166.     Result.VersionLS := FixedFileInfo^.dwFileVersionLS;
  167.   end
  168. end;
  169.  
  170. function TDCVersionInfo.GetVersionNum: Longint;
  171. begin
  172.   Result := FixedFileInfo^.dwFileVersionMS
  173. end;
  174.  
  175. function TDCVersionInfo.GetVerValue(const VerName: string): string;
  176. var
  177.   szName: array[0..255] of Char;
  178.   Value: Pointer;
  179.   Len: UINT;
  180. begin
  181.   Result := '';
  182.   StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\' + VerName);
  183.   if FValidRead and VerQueryValue(FBuffer, szName, Value, Len) then
  184.     Result := StrPas(PChar(Value))
  185.   else
  186.     Result := '';
  187. end;
  188.  
  189. function TDCVersionInfo.GetOSVersion: string;
  190.  var
  191.   Platform : string[10];
  192.   Version  : TModuleVersion;
  193. begin
  194.   {GetVersionEx}
  195.   with Version do
  196.   begin
  197.     Major := Win32MajorVersion;
  198.     Minor := Win32MinorVersion;
  199.   end;
  200.   case Win32Platform of
  201.     VER_PLATFORM_WIN32s        :
  202.       begin
  203.         Platform    := '32s';
  204.         Version.Build := Win32BuildNumber;
  205.       end;
  206.     VER_PLATFORM_WIN32_WINDOWS :
  207.       begin
  208.         if (Win32MajorVersion >= 4) and (Win32MinorVersion >= 10)
  209.            then Platform    := '98'
  210.            else Platform    := '95';
  211.         Version.Build := {LO Word} Win32BuildNumber and $FFFF;
  212.       end;
  213.     VER_PLATFORM_WIN32_NT      :
  214.       begin
  215.         Platform := 'NT';
  216.         Version.Build := Win32BuildNumber;
  217.       end;
  218.    end;
  219.  
  220.    with Version do
  221.      if CompareStr(Trim(Win32CSDVersion), '') = 0 then
  222.        Result := Format(INFO_FMT_VER   , [Platform, Major, Minor, Build])
  223.      else
  224.        Result := Format(INFO_FMT_VERCSD, [Platform, Major, Minor, Build,
  225.          Win32CSDVersion]);
  226. end;
  227.  
  228. function TDCVersionInfo.GetMemoryTotal: string;
  229.  var
  230.   MS: TMemoryStatus;
  231. begin
  232.   MS.dwLength := SizeOf(TMemoryStatus);
  233.   GlobalMemoryStatus(MS);
  234.   Result := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
  235. end;
  236.  
  237. function TDCVersionInfo.GetFileVersion: string;
  238. begin
  239.   Result := GetVerValue(aVersionKeys[vkFileVersion]);
  240.   if Result = '' then Result := VersionToString(FileLongVersion);
  241. end;
  242.  
  243. function TDCVersionInfo.GetProductVersion: string;
  244. begin
  245.   Result := GetVerValue(aVersionKeys[vkProductVersion]);
  246.   if Result = '' then Result := VersionToString(ProductLongVersion);
  247. end;
  248.  
  249. function TDCVersionInfo.GetFileDate: TDateTime;
  250.  var
  251.   Age: integer;
  252. begin
  253.   Age := FileAge(FFileName);
  254.   Result := FileDateToDateTime(Age);
  255. end;
  256.  
  257. end.
  258.