Бывалый
Профиль
Группа: Участник
Сообщений: 247
Регистрация: 25.8.2004
Где: Брянск
Репутация: 1
Всего: 7
|
Сорри конечно, но переводить лениво. Вот уже готовый пример на Дельфях, которым сам пользуюсь. Принцип тот же самый: | Код |
unit VerInfo;
interface
uses SysUtils, WinTypes, Dialogs, Classes;
type
EVerInfoError = class(Exception);
ENoVerInfoError = class(Exception);
eNoFixeVerInfo = class(Exception);
TVerInfoType =
(viCompanyName,
viFileDescription,
viFileVersion,
viInternalName,
viLegalCopyright,
viLegalTrademarks,
viOriginalFilename,
viProductName,
viProductVersion,
viComments);
const
VerNameArray: array[viCompanyName..viComments] of String[20] =
('CompanyName',
'FileDescription',
'FileVersion',
'InternalName',
'LegalCopyright',
'LegalTrademarks',
'OriginalFilename',
'ProductName',
'ProductVersion',
'Comments');
type
TVerInfoRes = class
private
Handle : DWord;
Size : Integer;
RezBuffer : String;
TransTable : PLongint;
FixedFileInfoBuf : PVSFixedFileInfo;
FFileFlags : TStringList;
FFileName : String;
procedure FillFixedFileInfoBuf;
procedure FillFileVersionInfo;
procedure FillFileMaskInfo;
protected
function GetFileVersion : String;
function GetProductVersion: String;
function GetFileOS : String;
public
constructor Create(AFileName: String);
destructor Destroy; override;
function GetPreDefKeyString(AVerKind: TVerInfoType): String;
function GetUserDefKeyString(AKey: String): String;
property FileVersion : String read GetFileVersion;
property ProductVersion : String read GetProductVersion;
property FileFlags : TStringList read FFileFlags;
property FileOS : String read GetFileOS;
end;
implementation
uses Windows;
const
SFInfo = '\StringFileInfo\';
VerTranslation: PChar = '\VarFileInfo\Translation';
FormatStr = '%s%.4x%.4x\%s%s';
constructor TVerInfoRes.Create(AFileName: String);
begin
FFileName := aFileName;
FFileFlags := TStringList.Create;
FillFileVersionInfo;
FillFixedFileInfoBuf;
FillFileMaskInfo;
end;
destructor TVerInfoRes.Destroy;
begin
FFileFlags.Free;
end;
procedure TVerInfoRes.FillFileVersionInfo;
var
SBSize: UInt;
begin
Size := GetFileVersionInfoSize(PChar(FFileName), Handle);
if Size <= 0 then { raise exception if size <= 0 }
raise ENoVerInfoError.Create('No Version Info Available.');
SetLength(RezBuffer, Size);
if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then
raise EVerInfoError.Create('Cannot obtain version info.');
if not VerQueryValue(PChar(RezBuffer), VerTranslation, pointer(TransTable), SBSize) then
raise EVerInfoError.Create('No language info.');
end;
procedure TVerInfoRes.FillFixedFileInfoBuf;
var
Size: Cardinal;
begin
if VerQueryValue(PChar(RezBuffer), '\', Pointer(FixedFileInfoBuf), Size) then
begin
if Size < SizeOf(TVSFixedFileInfo) then
raise eNoFixeVerInfo.Create('No fixed file info');
end
else raise eNoFixeVerInfo.Create('No fixed file info')
end;
procedure TVerInfoRes.FillFileMaskInfo;
begin
with FixedFileInfoBuf^ do
begin
if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0 then
FFileFlags.Add('Pre-release');
if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
FFileFlags.Add('Private build');
if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
FFileFlags.Add('Special build');
if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then
FFileFlags.Add('Debug');
end;
end;
function TVerInfoRes.GetPreDefKeyString(AVerKind: TVerInfoType): String;
var
P: PChar;
S: UInt;
begin
Result := Format(FormatStr,
[SfInfo,
LoWord (TransTable^),
HiWord (TransTable^),
VerNameArray [aVerKind],
#0]);
if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
Result := StrPas(P)
else
Result := '';
end;
function TVerInfoRes.GetUserDefKeyString(AKey: String): String;
var
P: Pchar;
S: UInt;
begin
Result := Format(FormatStr,
[SfInfo,
LoWord (TransTable^),
HiWord (TransTable^),
aKey,
#0]);
if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
Result := StrPas(P)
else
Result := '';
end;
function VersionString(Ms, Ls: Longint): String;
begin
Result := Format('%d.%d.%d.%d',
[HIWORD(Ms),
LOWORD(Ms),
HIWORD(Ls),
LOWORD(Ls)]);
end;
function TVerInfoRes.GetFileVersion: String;
begin
with FixedFileInfoBuf^ do
Result := VersionString(dwFileVersionMS, dwFileVersionLS);
end;
function TVerInfoRes.GetProductVersion: String;
begin
with FixedFileInfoBuf^ do
Result := VersionString(dwProductVersionMS, dwProductVersionLS);
end;
function TVerInfoRes.GetFileOS: String;
begin
with FixedFileInfoBuf^ do
case dwFileOS of
VOS_UNKNOWN: // Same as VOS__BASE
Result := 'Unknown';
VOS_DOS:
Result := 'Designed for MS-DOS';
VOS_OS216:
Result := 'Designed for 16-bit OS/2';
VOS_OS232:
Result := 'Designed for 32-bit OS/2';
VOS_NT:
Result := 'Designed for Windows NT';
VOS__WINDOWS16:
Result := 'Designed for 16-bit Windows';
VOS__PM16:
Result := 'Designed for 16-bit PM';
VOS__PM32:
Result := 'Designed for 32-bit PM';
VOS__WINDOWS32:
Result := 'Designed for 32-bit Windows';
VOS_DOS_WINDOWS16:
Result := 'Designed for 16-bit Windows, running on MS-DOS';
VOS_DOS_WINDOWS32:
Result := 'Designed for Win32 API, running on MS-DOS';
VOS_OS216_PM16:
Result := 'Designed for 16-bit PM, running on 16-bit OS/2';
VOS_OS232_PM32:
Result := 'Designed for 32-bit PM, running on 32-bit OS/2';
VOS_NT_WINDOWS32:
Result := 'Designed for Win32 API, running on Windows/NT';
else
Result := 'Unknown';
end;
end;
end.
|
И как этим пользоваться: | Код |
procedure TMyFormShowInfo (Sender: TObject);
var
VerString : String;
i : integer;
sFFlags : String;
begin
VerInfoRes := TVerInfoRes.Create(Application.ExeName);
for i := ord(viCompanyName) to ord(viComments) do
begin
VerString := VerInfoRes.GetPreDefKeyString(TVerInfoType(i));
if VerString <> '' then
Memo1.Lines.Add(VerNameArray[TVerInfoType(i)] + ' - '
+ VerString);
end;
VerString := VerInfoRes.GetUserDefKeyString('Author');
if VerString <> EmptyStr then
Memo1.Lines.Add('Author - ' + VerString);
Memo1.Lines.Add('File Version - ' + VerInfoRes.FileVersion);
Memo1.Lines.Add('Product Version - ' + VerInfoRes.ProductVersion);
for i := 0 to VerInfoRes.FileFlags.Count - 1 do
begin
if i <> 0 then sFFlags := SFFlags+', ';
sFFlags := SFFlags+VerInfoRes.FileFlags[i];
end;
Memo1.Lines.Add('File Flags - ' + SFFlags);
Memo1.Lines.Add('Operating System - ' + VerINfoRes.FileOS);
VerInfoRes.Free;
end;
|
--------------------
Не работает - исправь, работает - не трогай!!! |
Builder C++ to Delphi, Помогите перенисти код 
Загрузка ...
