Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d456/DCSLIB25.ZIP/DCVerInfo.pas

Pascal/Delphi Source File | 2001-01-20 | 6.9 KB | 258 lines

{
 BUSINESS CONSULTING
 s a i n t - p e t e r s b u r g

         Components Library for Borland Delphi 4.x, 5.x
         Copyright (c) 1998-2000 Alex'EM

}
unit DCVerInfo;

interface

uses Windows;

type
  TModuleVersion = record
    case Integer of
    0: (Minor, Major, Build, Release: Word);
    1: (VersionMS, VersionLS: LongInt);
  end;

  TDCVersionInfo = class(TObject)
  private
    FFileName: PChar;
    FBuffer: PChar;
    FSize: Integer;
    FValidRead: boolean;
    procedure ReadVersionInfo;
    function GetFileName: string;
    procedure SetFileName(const Value: string);
    function GetTranslation: Pointer;
    function GetFixedFileInfo: PVSFixedFileInfo;
    function GetFileLongVersion: TModuleVersion;
    function GetProducTModuleVersion: TModuleVersion;
    function GetVersionNum: Longint;
    function GetTranslationString: string;
    function GetOSVersion: string;
    function GetMemoryTotal: string;
    function GetFileDate: TDateTime;
  protected
    property FixedFileInfo: PVSFixedFileInfo read GetFixedFileInfo;
  public
    constructor Create(const AFileName: string);
    destructor Destroy; override;
    function GetVerValue(const VerName: string): string;
    property ValidRead: boolean read FValidRead;
    property FileName: string read GetFileName write SetFileName;
    property FileLongVersion: TModuleVersion read GetFileLongVersion;
    property ProductLongVersion: TModuleVersion read GetProducTModuleVersion;
    property VersionNum: Longint read GetVersionNum;
    property Values[const Name: string]: string read GetVerValue;
    property OSVersion: string read GetOSVersion;
    property MemoryTotal: string read GetMemoryTotal;
    property FileDate: TDateTime read GetFileDate;
    function GetFileVersion: string;
    function GetProductVersion: string;
  end;

implementation

uses SysUtils, DCConst;

type
  TVersionKeys =
     ( vkCompanyName     , vkFileDescription, vkFileVersion    ,
       vkInternalName    , vkLegalCopyright , vkLegalTrademarks,
       vkOriginalFileName, vkProductName    , vkProductVersion ,
       vkComments         );
const
  aVersionKeys: array[TVersionKeys] of PChar =
     ( 'CompanyName'     , 'FileDescription', 'FileVersion'    ,
       'InternalName'    , 'LegalCopyright' , 'LegalTrademarks',
       'OriginalFileName', 'ProductName'    , 'ProductVersion' ,
       'Comments'        );


function VersionToString(const Version: TModuleVersion): string;
begin
  with Version do
    Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
end;

constructor TDCVersionInfo.Create(const AFileName: string);
begin
  inherited Create;
  FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
  ReadVersionInfo
end;

destructor TDCVersionInfo.Destroy;
begin
  if FBuffer <> nil then FreeMem(FBuffer, FSize);
  StrDispose(FFileName);
  inherited Destroy;
end;

procedure TDCVersionInfo.ReadVersionInfo;
 var
   Handle: DWord;
begin
  FValidRead := False;
  FSize := GetFileVersionInfoSize(FFileName, Handle);
  if FSize > 0 then
    try
      GetMem(FBuffer, FSize);
      FValidRead := GetFileVersionInfo(FFileName, Handle, FSize, FBuffer)
    except
      raise;
    end;
end;

function TDCVersionInfo.GetFileName: string;
begin
  Result := StrPas(FFileName);
end;

procedure TDCVersionInfo.SetFileName(const Value: string);
begin
  if FBuffer <> nil then FreeMem(FBuffer, FSize);
  FBuffer := nil;
  StrDispose(FFileName);
  FFileName := StrPCopy(StrAlloc(Length(Value) + 1), Value);
  ReadVersionInfo
end;

function TDCVersionInfo.GetTranslation: Pointer;
var
  Len: UINT;
begin
  if FValidRead then VerQueryValue(FBuffer, '\VarFileInfo\Translation', Result, Len)
  else Result := nil;
end;

function TDCVersionInfo.GetTranslationString: string;
var
  P: Pointer;
begin
  Result := '';
  P := GetTranslation;
  if P <> nil then
    Result := IntToHex(MakeLong(HiWord(Longint(P^)), LoWord(Longint(P^))), 8);
end;

function TDCVersionInfo.GetFixedFileInfo: PVSFixedFileInfo;
var
  Len: UINT;
begin
  if FValidRead then VerQueryValue(FBuffer, '\', Pointer(Result), Len)
  else Result := nil;
end;

function TDCVersionInfo.GetProducTModuleVersion: TModuleVersion;
begin
  if Assigned(FixedFileInfo) then
  begin
    Result.VersionMS := FixedFileInfo^.dwProductVersionMS;
    Result.VersionLS := FixedFileInfo^.dwProductVersionLS;
  end
end;

function TDCVersionInfo.GetFileLongVersion: TModuleVersion;
begin
  if Assigned(FixedFileInfo) then
  begin
    Result.VersionMS := FixedFileInfo^.dwFileVersionMS;
    Result.VersionLS := FixedFileInfo^.dwFileVersionLS;
  end
end;

function TDCVersionInfo.GetVersionNum: Longint;
begin
  Result := FixedFileInfo^.dwFileVersionMS
end;

function TDCVersionInfo.GetVerValue(const VerName: string): string;
var
  szName: array[0..255] of Char;
  Value: Pointer;
  Len: UINT;
begin
  Result := '';
  StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\' + VerName);
  if FValidRead and VerQueryValue(FBuffer, szName, Value, Len) then
    Result := StrPas(PChar(Value))
  else
    Result := '';
end;

function TDCVersionInfo.GetOSVersion: string;
 var
  Platform : string[10];
  Version  : TModuleVersion;
begin
  {GetVersionEx}
  with Version do
  begin
    Major := Win32MajorVersion;
    Minor := Win32MinorVersion;
  end;
  case Win32Platform of
    VER_PLATFORM_WIN32s        :
      begin
        Platform    := '32s';
        Version.Build := Win32BuildNumber;
      end;
    VER_PLATFORM_WIN32_WINDOWS :
      begin
        if (Win32MajorVersion >= 4) and (Win32MinorVersion >= 10)
           then Platform    := '98'
           else Platform    := '95';
        Version.Build := {LO Word} Win32BuildNumber and $FFFF;
      end;
    VER_PLATFORM_WIN32_NT      :
      begin
        Platform := 'NT';
        Version.Build := Win32BuildNumber;
      end;
   end;

   with Version do
     if CompareStr(Trim(Win32CSDVersion), '') = 0 then
       Result := Format(INFO_FMT_VER   , [Platform, Major, Minor, Build])
     else
       Result := Format(INFO_FMT_VERCSD, [Platform, Major, Minor, Build,
         Win32CSDVersion]);
end;

function TDCVersionInfo.GetMemoryTotal: string;
 var
  MS: TMemoryStatus;
begin
  MS.dwLength := SizeOf(TMemoryStatus);
  GlobalMemoryStatus(MS);
  Result := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;

function TDCVersionInfo.GetFileVersion: string;
begin
  Result := GetVerValue(aVersionKeys[vkFileVersion]);
  if Result = '' then Result := VersionToString(FileLongVersion);
end;

function TDCVersionInfo.GetProductVersion: string;
begin
  Result := GetVerValue(aVersionKeys[vkProductVersion]);
  if Result = '' then Result := VersionToString(ProductLongVersion);
end;

function TDCVersionInfo.GetFileDate: TDateTime;
 var
  Age: integer;
begin
  Age := FileAge(FFileName);
  Result := FileDateToDateTime(Age);
end;

end.