Как при выполнении проги можно прочитать данные из Version Info

← →
yaric (2003-04-30 00:59) [0]

Подскажите как можно при выполнении программы получит доступ к тому что указано в Project/Options/Version Info.
Хотелось бы в программе отображать информацию о её версии и сборке, и чтобы она соответствовала той информации что можно получит из данных об exe файле этой программы.

← →
MBo (2003-04-30 07:12) [1]

поройся в форумах (система или WinApi)
Игорь Шевченко совсем недавно давал пример

← →
Separator (2003-04-30 07:20) [2]

Вот есть такой компонент:
unit gsFileVersionInfo; //**! ---------------------------------------------------------- //**! This unit is a part of GSPackage project (Gregory Sitnin"s //**! Delphi Components Package). //**! ---------------------------------------------------------- //**! You may use or redistribute this unit for your purposes //**! while unit"s code and this copyright notice is unchanged //**! and exists. //**! ---------------------------------------------------------- //**! (c) Gregory Sitnin, 2001-2002. All rights reserved. //**! http://www.gregor.ru/ gregor@gregor.ru //**! ---------------------------------------------------------- interface uses Windows, Messages, SysUtils, Classes; type TgsFileVersionInfo = class(TComponent) private FFilename: TFilename; FVersionInfoSize: cardinal; FFileVersion: string; FFileDescription: string; FInternalName: string; FOriginalFilename: string; FCompanyName: string; FProductVersion: string; FProductName: string; FLegalCopyright: string; FLanguageInfo: string; FComments: string; procedure SetFilename(const Value: TFilename); { Private declarations } protected { Protected declarations } property VersionInfoSize: cardinal read FVersionInfoSize; procedure LoadFromFile; procedure ClearAll; public { Public declarations } published { Published declarations } function GetBuildOnly: string; property Filename: TFilename read FFilename write SetFilename; property LanguageInfo: string read FLanguageInfo; property CompanyName: string read FCompanyName; property FileDescription: string read FFileDescription; property FileVersion: string read FFileVersion; property InternalName: string read FInternalName; property LegalCopyright: string read FLegalCopyright; property OriginalFilename: string read FOriginalFilename; property ProductName: string read FProductName; property ProductVersion: string read FProductVersion; property Comments: string read FComments; end; procedure Register; implementation uses dialogs; procedure Register; begin RegisterComponents("GSPackage", [TgsFileVersionInfo]); end; { TgsFileVersionInfo } procedure TgsFileVersionInfo.ClearAll; begin FVersionInfoSize := 0; FCompanyName := ""; FFileDescription := ""; FFileVersion := ""; FInternalName := ""; FLegalCopyright := ""; FOriginalFilename := ""; FProductName := ""; FProductVersion := ""; FComments := ""; end; function TgsFileVersionInfo.GetBuildOnly: string; var p: integer; s: string; begin s := FileVersion; p := LastDelimiter(".",s); Result := copy(s,p+1,length(s)-p); end; procedure TgsFileVersionInfo.LoadFromFile; var VISize: cardinal; VIBuff: pointer; trans: pointer; buffsize: cardinal; temp: integer; str: pchar; LangCharSet: string; function GetStringValue(const From: string): string; begin VerQueryValue(VIBuff,pchar("\StringFileInfo\"+ LanguageInfo+"\"+From), pointer(str), buffsize); if buffsize > 0 then Result := str else Result := "n/a"; end; begin ClearAll; VIBuff := nil; if not fileexists(Filename) then raise EFilerError.Create("File not found: "+Filename); VISize := GetFileVersionInfoSize(pchar(Filename),buffsize); FVersionInfoSize := VISize; if VISize < 1 then raise EReadError.Create("Invalid version info record in file " +Filename); VIBuff := AllocMem(VISize); GetFileVersionInfo(pchar(Filename),cardinal(0),VISize,VIBuff); VerQueryValue(VIBuff,"\VarFileInfo\Translation",Trans,buffsize); if buffsize >= 4 then begin temp:=0; StrLCopy(@temp, pchar(Trans), 2); LangCharSet:=IntToHex(temp, 4); StrLCopy(@temp, pchar(Trans)+2, 2); FLanguageInfo := LangCharSet+IntToHex(temp, 4); end else raise EReadError.Create("Invalid language info in file "+Filename); FCompanyName := GetStringValue("CompanyName"); FFileDescription := GetStringValue("FileDescription"); FFileVersion := GetStringValue("FileVersion"); FInternalName := GetStringValue("InternalName"); FLegalCopyright := GetStringValue("LegalCopyright"); FOriginalFilename := GetStringValue("OriginalFilename"); FProductName := GetStringValue("ProductName"); FProductVersion := GetStringValue("ProductVersion"); FComments := GetStringValue("Comments"); FreeMem(VIBuff,VISize); end; procedure TgsFileVersionInfo.SetFilename(const Value: TFilename); begin FFilename := Value; LoadFromFile; end; end.

← →
$hade (2003-04-30 09:31) [3]

То же самое но уменьшено...и поточнее по subj"у...

procedure TMainForm.FormCreate(Sender: TObject); var bs: integer; t: Cardinal; VI: PChar; FI: PVSFixedFileInfo; begin bs := GetFileVersionInfoSize(Pchar(Application.ExeName), t); if bs > 0 then try GetMem(vi, bs); if GetFileVersionInfo(Pchar(Application.ExeName), 0, bs, vi) then begin VerQueryValue(vi, "\", Pointer(fi), t); FileVersion.FMinor := fi.dwFileVersionMS and $FFFF; FileVersion.FMajor := ((fi.dwFileVersionMS shr 16) and $FFFF); FileVersion.FBuild := fi.dwFileVersionLS and $FFFF; FileVersion.FRelease := ((fi.dwFileVersionLS shr 16) and $FFFF); FileVersion.PMinor := fi.dwProductVersionMS and $FFFF; FileVersion.PMajor := ((fi.dwProductVersionMS shr 16) and $FFFF); FileVersion.PBuild := fi.dwProductVersionLS and $FFFF; FileVersion.PRelease := ((fi.dwProductVersionLS shr 16) and $FFFF); FileVersion.StrVer:=IntToStr(FileVersion.FMajor) +"."+ IntToStr(FileVersion.FMinor) +"."+IntToStr(FileVersion.FRelease) + " (build " + IntToStr (FileVersion.FBuild)+")"; end finally freemem(vi); end; end;

FileVersion - своя структура (record) просто для удобства...
FileVersion.StrVer - тут как раз и находится строка вида:
1.5.65 (build 345)

Как при выполнении проги можно прочитать данные из Version Info Найти похожие ветки