Version Info Issue
3 отговора
116 прегледа
Primer na Delphi
Ne se samnqvam , che kakto kaza Pechenia nqma da imash problem s VB-to , no mislq che tozi primer sahsto ne e losh, makar , che tozi nachin na pisane na funkcii v drugi funkcii ne go obicham.
unit verinfo;
interface
type
TFileVersionInfo = record
fCompanyName,
fFileDescription,
fFileVersion,
fInternalName,
fLegalCopyRight,
fLegalTradeMark,
fOriginalFileName,
fProductName,
fProductVersion,
fComments: string;
end;
procedure GetAppVersionInfo(sAppNamePath: string);
var
FileVersionInfo: TFileVersionInfo;
implementation
uses
Windows, SysUtils, Forms;
procedure GetAppVersionInfo(sAppNamePath: string);
{ sAppNamePath must specify full path and file name, if sAppNamePath }
{ is empty then the current running app is used. }
var
VerSize: integer;
VerBuf: PChar;
VerBufValue: pointer;
VerHandle: cardinal;
VerBufLen: cardinal;
VerKey: string;
function GetInfo(ThisKey: string): string;
begin
Result := '';
VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +
IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey;
if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then
Result := StrPas(VerBufValue);
end;
function QueryValue(ThisValue: string): string;
begin
Result := '';
if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and
VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then
Result := GetInfo(ThisValue);
end;
begin
if sAppNamePath = '' then
sAppNamePath := Application.ExeName;
VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
VerBuf := AllocMem(VerSize);
try
FileVersionInfo.fCompanyName := QueryValue('CompanyName');
FileVersionInfo.fFileDescription := QueryValue('FileDescription');
FileVersionInfo.fFileVersion := QueryValue('FileVersion');
FileVersionInfo.fInternalName := QueryValue('InternalName');
FileVersionInfo.fLegalCopyRight := QueryValue('LegalCopyRight');
FileVersionInfo.fLegalTradeMark := QueryValue('LegalTradeMark');
FileVersionInfo.fOriginalFileName := QueryValue('OriginalFileName');
FileVersionInfo.fProductName := QueryValue('ProductName');
FileVersionInfo.fProductVersion := QueryValue('ProductVersion');
FileVersionInfo.fComments := QueryValue('Comments');
finally
FreeMem(VerBuf, VerSize);
end;
end;
end.