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 >
Wrap
Pascal/Delphi Source File
|
2001-01-20
|
7KB
|
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.