📄 stvinfo.pas
字号:
if Key <> '' then begin
InfoStr := BaseStr + Key;
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res then begin
Result := StrPas(PChar(Buffer));
// Exit; {!!.02}
end else begin
Result := '';
RaiseStError(EStVersionInfoError, stscBadVerInfoKey);
end;
end {!!.02}
else begin {!!.02}
{ Get the fixed version info. }
Bytes := SizeOf(FixedInfo);
FillChar(FixedInfo, Bytes, 0);
{ '\' is used to get the root block. }
Res := VerQueryValue(Data, '\', Buffer, Bytes);
if not Res then
RaiseStError(EStVersionInfoError, stscVerInfoFail);
Move(Buffer^, FixedInfo, Bytes);
with FixedInfo do begin
FFileMajorVersion := dwFileVersionMS;
FFileMinorVersion := dwFileVersionLS;
FProductMajorVersion := dwProductVersionMS;
FProductMinorVersion := dwProductVersionLS;
FFileFlagsMask := dwFileFlagsMask;
FFileFlags := dwFileFlags;
{!!.02 - rewritten }
{ Note: Most files don't set the binary date. }
// FFileDate := MakeLong(dwFileDateMS, dwFileDateLS);
FT.dwHighDateTime := dwFileDateMS;
FT.dwLowDateTime := dwFileDateLS;
FileTimeToSystemTime(FT, ST);
FFileDate := SystemTimeToDateTime(ST);
{!!.02 - rewritten end}
FFileOS := dwFileOS;
FFileType := dwFileType;
FFileSubtype := dwFileSubtype;
end;
{ Comments }
InfoStr := BaseStr + 'Comments';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FComments := StrPas(PChar(Buffer))
else
FComments := '';
{ CompanyName }
InfoStr := BaseStr + 'CompanyName';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FCompanyName := StrPas(PChar(Buffer))
else
FCompanyName := '';
{ FileDescription }
InfoStr := BaseStr + 'FileDescription';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FFileDescription := StrPas(PChar(Buffer))
else
FFileDescription := '';
{ FileVersion }
InfoStr := BaseStr + 'FileVersion';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then begin
FFileVersion := StrPas(PChar(Buffer));
{ First try to convert the version number to a float as-is. }
Val(FFileVersion, FFileVersionFloat, ErrCode);
if ErrCode <> 0 then
{ Failed. Create the float with the local MakeFloat function. }
try
FFileVersionFloat := MakeFloat(FFileVersion);
except
FFileVersionFloat := 0;
end;
end else begin
FFileVersion := '';
FFileVersionFloat := 0;
end;
{ InternalName }
InfoStr := BaseStr + 'InternalName';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FInternalName := StrPas(PChar(Buffer))
else
FInternalName := '';
{ LegalCopyright }
InfoStr := BaseStr + 'LegalCopyright';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FLegalCopyright := StrPas(PChar(Buffer))
else
FLegalCopyright := '';
{ LegalTrademarks }
InfoStr := BaseStr + 'LegalTrademarks';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FLegalTrademark := StrPas(PChar(Buffer))
else
FLegalTrademark := '';
{ OriginalFilename }
InfoStr := BaseStr + 'OriginalFilename';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FOriginalFilename := StrPas(PChar(Buffer))
else
FOriginalFilename := '';
{ ProductName }
InfoStr := BaseStr + 'ProductName';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then
FProductName := StrPas(PChar(Buffer))
else
FProductName := '';
{ ProductVersion }
InfoStr := BaseStr + 'ProductVersion';
Res := VerQueryValue(Data, StrPCopy(TempStr, InfoStr), Buffer, Bytes);
if Res and (Bytes <> 0) then begin
FProductVersion := StrPas(PChar(Buffer));
{ First try to convert the product number to a float as-is. }
Val(FProductVersion, FProductVersionFloat, ErrCode);
if ErrCode <> 0 then
{ Failed. Create the float with the local MakeFloat function. }
try
FProductVersionFloat := MakeFloat(FProductVersion);
except
FProductVersionFloat := 0;
end;
end else begin
FProductVersion := '';
FProductVersionFloat := 0;
end;
end; {!!.02}
finally
FreeMem(Data, Size);
FreeMem(Trans, TrSize);
end;
end;
function TStCustomVersionInfo.GetComments : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FComments;
end;
function TStCustomVersionInfo.GetCompanyName : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FCompanyName;
end;
function TStCustomVersionInfo.GetFileDescription : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileDescription;
end;
function TStCustomVersionInfo.GetFileVersion : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileVersion;
end;
function TStCustomVersionInfo.GetInternalName : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FInternalName;
end;
function TStCustomVersionInfo.GetLegalCopyright : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FLegalCopyright;
end;
function TStCustomVersionInfo.GetLegalTrademark : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FLegalTrademark;
end;
function TStCustomVersionInfo.GetOriginalFilename : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FOriginalFilename;
end;
function TStCustomVersionInfo.GetProductName : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FProductName;
end;
function TStCustomVersionInfo.GetProductVersion : string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FProductVersion;
end;
function TStCustomVersionInfo.GetProductVersionFloat : Double;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FProductVersionFloat;
end;
function TStCustomVersionInfo.GetFileVersionFloat : Double;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileVersionFloat;
end;
procedure TStCustomVersionInfo.SetFileName(const Value : string);
var
Buff : array [0..255] of Char;
begin
if (Value <> '') and not (csDesigning in ComponentState) then
if not FileExists(Value) then
RaiseStError(EStVersionInfoError, stscFileOpen);
if FFileName <> Value then
VInfoLoaded := False;
FFileName := Value;
{ If FileName is an emtpy string then load the }
{ version info for the current process. }
if (FFileName = '') and not (csDesigning in ComponentState) then
if GetModuleFileName(0, Buff, SizeOf(Buff)) = 0 then
FFileName := ''
else
FFileName := StrPas(Buff);
end;
function TStCustomVersionInfo.GetFileDate: TDateTime;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileDate;
end;
function TStCustomVersionInfo.GetFileFlags: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileFlags;
end;
function TStCustomVersionInfo.GetFileFlagsMask: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileFlagsMask;
end;
function TStCustomVersionInfo.GetFileOS: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileOS;
end;
function TStCustomVersionInfo.GetFileSubtype: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileSubtype;
end;
function TStCustomVersionInfo.GetFileType: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileType;
end;
function TStCustomVersionInfo.GetFileMajorVersion: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileMajorVersion;
end;
function TStCustomVersionInfo.GetFileMinorVersion: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FFileMinorVersion;
end;
function TStCustomVersionInfo.GetProductMajorVersion: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FProductMajorVersion;
end;
function TStCustomVersionInfo.GetProductMinorVersion: DWORD; {!!.02}
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FProductMinorVersion;
end;
function TStCustomVersionInfo.GetLanguageCount: LongInt;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FLanguageCount;
end;
function TStCustomVersionInfo.GetLanguageName: string;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FLanguageName;
end;
function TStCustomVersionInfo.GetTranslationValue: LongInt;
begin
if not VInfoLoaded then
LoadVersionInfo('');
Result := FTranslationValue;
end;
function TStCustomVersionInfo.GetKeyValue(const Key: string): string;
begin
Result := LoadVersionInfo(Key);
end;
procedure TStCustomVersionInfo.Loaded;
begin
inherited Loaded;
if FFileName = '' then
SetFileName('');
end;
{!!.02 - added }
function TStCustomVersionInfo.GetFileVerSubPart(Index: Integer): Word;
begin
Result := 0;
if not VInfoLoaded then
LoadVersionInfo('');
case Index of
STVERMAJOR: Result := HIWORD(FFileMajorVersion);
STVERMINOR: Result := LOWORD(FFileMajorVersion);
STVERBUILD: Result := HIWORD(FFileMinorVersion);
STVERRELEASE: Result := LOWORD(FFileMinorVersion);
end; { case }
end;
function TStCustomVersionInfo.GetProdVerSubPart(Index: Integer): Word;
begin
Result := 0;
if not VInfoLoaded then
LoadVersionInfo('');
case Index of
STVERMAJOR: Result := HIWORD(FProductMajorVersion);
STVERMINOR: Result := LOWORD(FProductMajorVersion);
STVERBUILD: Result := HIWORD(FProductMinorVersion);
STVERRELEASE: Result := LOWORD(FProductMinorVersion);
end; { case }
end;
{!!.02 - added end }
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -