⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 stvinfo.pas

📁 条码控件: 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -