versinfo.pas

动态提示控件

    property ShowResource: TPreDefs
      read FShowResource
      write SetShowResource;
{$ENDIF}
  end;

implementation

const
  PREDEF_RESOURCES: array[IDX_COMPANYNAME..IDX_BUILDFLAGS] of string = (
     'CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
     'LegalCopyright', 'LegalTrademarks', 'OriginalFilename', 'ProductName',
     'ProductVersion', 'Comments', 'BuildFlags'
    );

  PREDEF_CAPTIONS: array[IDX_COMPANYNAME..IDX_BUILDFLAGS] of string = (
     SResCapCompanyName, SResCapFileDescription, SResCapFileVersion,
     SResCapInternalName, SResCapLegalCopyright, SResCapLegalTrademarks,
     SResCapOriginalFilename, SResCapProductName, SResCapProductVersion,
     SResCapComments, SResCapBuildFlags
    );

{$IFDEF DFS_DELPHI_2}
  {$DEFINE ST2DT_UNDEF}
{$ENDIF}
{$IFDEF DFS_CPPB_1}
  {$DEFINE ST2DT_UNDEF}
{$ENDIF}

{$IFDEF ST2DT_UNDEF}
function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
  with SystemTime do
    Result := EncodeDate(wYear, wMonth, wDay) +
      EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
end;
{$ENDIF}

{$IFNDEF DFS_WIN32}
function IsLibrary: boolean;
begin
  Result := PrefixSeg = 0;
end;
{$ENDIF}


constructor TFixedFileVersionInfo.Create(AParent: TdfsVersionInfoResource);
begin
  inherited Create;
  FParent := AParent;
end;

function TFixedFileVersionInfo.GetSignature: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwSignature;
end;

function TFixedFileVersionInfo.GetStructureVersion: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwStrucVersion;
end;

function TFixedFileVersionInfo.GetFileVersionMS: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwFileVersionMS;
end;

function TFixedFileVersionInfo.GetFileVersionLS: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwFileVersionLS;
end;

function TFixedFileVersionInfo.GetProductVersionMS: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwProductVersionMS;
end;

function TFixedFileVersionInfo.GetProductVersionLS: DWORD;
begin
  if FData = nil then
    Result := 0
  else
    Result := FData^.dwProductVersionLS;
end;

function TFixedFileVersionInfo.GetValidFlags: TFixedFileInfoFlags;
begin
  Result := [];
  if FData <> nil then
  begin
    if (FData^.dwFileFlagsMask and VS_FF_DEBUG) <> 0 then
      Include(Result, ffDebug);
    if (FData^.dwFileFlagsMask and VS_FF_PRERELEASE) <> 0 then
      Include(Result, ffPreRelease);
    if (FData^.dwFileFlagsMask and VS_FF_PATCHED) <> 0 then
      Include(Result, ffPatched);
    if (FData^.dwFileFlagsMask and VS_FF_PRIVATEBUILD) <> 0 then
      Include(Result, ffPrivateBuild);
    if (FData^.dwFileFlagsMask and VS_FF_INFOINFERRED ) <> 0 then
      Include(Result, ffInfoInferred );
    if (FData^.dwFileFlagsMask and VS_FF_SPECIALBUILD ) <> 0 then
      Include(Result, ffSpecialBuild );
  end;
end;

function TFixedFileVersionInfo.GetFlags: TFixedFileInfoFlags;
begin
  Result := [];
  if FData <> nil then
  begin
    if (FData^.dwFileFlags and VS_FF_DEBUG) <> 0 then
      Include(Result, ffDebug);
    if (FData^.dwFileFlags and VS_FF_PRERELEASE) <> 0 then
      Include(Result, ffPreRelease);
    if (FData^.dwFileFlags and VS_FF_PATCHED) <> 0 then
      Include(Result, ffPatched);
    if (FData^.dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
      Include(Result, ffPrivateBuild);
    if (FData^.dwFileFlags and VS_FF_INFOINFERRED ) <> 0 then
      Include(Result, ffInfoInferred );
    if (FData^.dwFileFlags and VS_FF_SPECIALBUILD ) <> 0 then
      Include(Result, ffSpecialBuild );
  end;
end;

function TFixedFileVersionInfo.GetFileOperatingSystem: TVersionOperatingSystemFlags;
{$IFNDEF DFS_WIN32}
var
  FileOS: word;
{$ENDIF}
begin
  Result := [];
  if FData <> nil then
  begin
    case HiWord(FData^.dwFileOS) of
      VOS_DOS shr 16:   Include(Result, vosDOS);
      VOS_OS216 shr 16: Include(Result, vosOS2_16);
      VOS_OS232 shr 16: Include(Result, vosOS2_32);
      VOS_NT shr 16:    Include(Result, vosNT);
    else
      Include(Result, vosUnknown);
    end;

{$IFDEF DFS_WIN32}
    case LoWord(FData^.dwFileOS) of
      LoWord(VOS__WINDOWS16): Include(Result, vosWindows16);
      LoWord(VOS__PM16):      Include(Result, vosPresentationManager16);
      LoWord(VOS__PM32):      Include(Result, vosPresentationManager32);
      LoWord(VOS__WINDOWS32): Include(Result, vosWindows32);
    else
      Include(Result, vosUnknown);
    end;
{$ELSE}
    FileOS := LoWord(FData^.dwFileOS);
    if      FileOS = LoWord(VOS__WINDOWS16) then Include(Result, vosWindows16)
    else if FileOS = LoWord(VOS__PM16) then      Include(Result, vosPresentationManager16)
    else if FileOS = LoWord(VOS__PM32) then      Include(Result, vosPresentationManager32)
    else if FileOS = LoWord(VOS__WINDOWS32) then Include(Result, vosWindows32)
    else                                         Include(Result, vosUnknown);
{$ENDIF}
  end;
end;

function TFixedFileVersionInfo.GetFileType: TVersionFileType;
begin
  Result := vftUnknown;
  if FData <> nil then
  begin
    case FData^.dwFileType of
      VFT_APP:        Result := vftApplication;
      VFT_DLL:        Result := vftDLL;
      VFT_DRV:        Result := vftDriver;
      VFT_FONT:       Result := vftFont;
      VFT_VXD:        Result := vftVXD;
      VFT_STATIC_LIB: Result := vftStaticLib;
    end;
  end;
end;

function TFixedFileVersionInfo.GetFileSubType: DWORD;
begin
  if FData = nil then
    Result := 0
  else begin
    Result := FData^.dwFileSubtype;
  end;
end;

function TFixedFileVersionInfo.GetCreationDate: TDateTime;
{$IFDEF DFS_WIN32}
var
  SysTime: TSystemTime;
  FileTime: TFileTime;
begin
  if FData = nil then
    Result := 0
  else begin
    FileTime.dwLowDateTime := FData^.dwFileDateLS;
    FileTime.dwHighDateTime := FData^.dwFileDateMS;
    if FileTimeToSystemTime(FileTime, SysTime) then
    begin
      Result := SystemTimeToDateTime(SysTime);
    end else
      Result := 0;
  end;
{$ELSE}
var
  SR: TSearchRec;
begin
  { Fake it until I can figure out how to convert dwFileDateMS and LS }
  Result := 0;
  if assigned(FParent) then
  begin
    if FindFirst(FParent.GetResourceFilename, faAnyFile, SR) = 0 then
    begin
      Result := FileDateToDateTime(SR.Time);
      FindClose(SR);
    end;
  end;
(*
var
  BigNum: comp;
begin
  if FData = nil then
    Result := 0
  else begin

    BigNum := (FData^.dwFileDateMS * MaxLongInt) + FData^.dwFileDateLS;
    BigNum := BigNum / 10000000;
  { LS and MS is the number of 100 nanosecond intervals since 1/1/1601 }
  { 10,000,000s of a second }
    Result := EncodeDate(1601, 1, 1);
    Result := BigNum.....
  end;
*)

{$ENDIF}
end;



constructor TVersionNumberInformation.Create(MSVer, LSVer: DWORD);
begin
  inherited Create;

  FValid := false;
  FMostSignificant := MSVer;
  FLeastSignificant := LSVer;
end;

function TVersionNumberInformation.GetVersionNumber(Index: integer): word;
begin
  Result := 0;
  if FValid then
    case Index of
      IDX_VER_MAJOR:   Result := HiWord(FMostSignificant);
      IDX_VER_MINOR:   Result := LoWord(FMostSignificant);
      IDX_VER_RELEASE: Result := HiWord(FLeastSignificant);
      IDX_VER_BUILD:   Result := LoWord(FLeastSignificant)
    end
end;

function TVersionNumberInformation.GetVersionNumberString: string;
begin
  if FValid then
  begin
    if FVersionNumberString = '' then
      Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build])
    else
      Result := FVersionNumberString;
  end
  else
    Result := ''
end;



{$IFDEF DFS_VERSION_INFO_AS_CLASS}
constructor TdfsVersionInfoResource.Create;
begin
  inherited Create;

  FVersionInfo := nil;
  FVersionInfoSize := 0;
  FFilename := '';
  FTranslationIDIndex := 0;
  FForceEXE := FALSE;
  FTranslationIDs := TStringList.Create;
  FFileVersion := TVersionNumberInformation.Create(0, 0);
  FProductVersion := TVersionNumberInformation.Create(0, 0);
  FFixedInfo := TFixedFileVersionInfo.Create(Self);
end;
{$ELSE}
constructor TdfsVersionInfoResource.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FVersionInfo := nil;
  FVersionInfoSize := 0;
  FFilename := '';
  FTranslationIDIndex := 0;
  FForceEXE := FALSE;
  FTranslationIDs := TStringList.Create;
  FFileVersion := TVersionNumberInformation.Create(0, 0);
  FProductVersion := TVersionNumberInformation.Create(0, 0);
  FFixedInfo := TFixedFileVersionInfo.Create(Self);
  FShowResource := [Low(TPreDef)..High(TPreDef)]
end;
{$ENDIF}

destructor TdfsVersionInfoResource.Destroy;
begin
  FFileVersion.Free;
  FProductVersion.Free;
  FFixedInfo.Free;
  FTranslationIDs.Free;
  if FVersionInfo <> nil then
    FreeMem(FVersionInfo, FVersionInfoSize);

  inherited Destroy;
end;

{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
procedure TdfsVersionInfoResource.Loaded;
begin
  inherited Loaded;

  ReadVersionInfoData;
(*
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
  PopulateControls;
{$ENDIF}
*)
end;
{$ENDIF}

procedure TdfsVersionInfoResource.SetFilename(const Val: TVersionFilename);
begin
  FFilename := Val;
  ReadVersionInfoData;
end;

procedure TdfsVersionInfoResource.ReadVersionInfoData;
const
  TRANSLATION_INFO = '\VarFileInfo\Translation';
type
  TTranslationPair = packed record
    Lang,
    CharSet: word;
  end;
  PTranslationIDList = ^TTranslationIDList;
  TTranslationIDList = array[0..MAXINT div SizeOf(TTranslationPair)-1] of TTranslationPair;
var
  QueryLen: UINT;
  IDsLen: UINT;
  Dummy: DWORD;
  IDs: PTranslationIDList;
  IDCount: integer;
  FixedInfoData: PVSFixedFileInfo;
  TempFilename: array[0..255] of char;
begin
  FTranslationIDs.Clear;
  FFixedInfo.Data := nil;
  if FVersionInfo <> nil then
    FreeMem(FVersionInfo, FVersionInfoSize);
  StrPCopy(TempFileName, GetResourceFilename);

  { Denis Kopprasch: added a try-Except because GetFileVersionInfoSize can fail
    with an invalid pointer or something like that! }
  try
    FVersionInfoSize := GetFileVersionInfoSize(TempFileName, Dummy);
  except
    FVersionInfoSize := 0;
  end;

  if FVersionInfoSize = 0 then
  begin
    FVersionInfo := nil;
    FFileVersion.Valid := false;
    FProductVersion.Valid := false;
  end else begin
    GetMem(FVersionInfo, FVersionInfoSize);
    GetFileVersionInfo(TempFileName, Dummy, FVersionInfoSize, FVersionInfo);

    VerQueryValue(FVersionInfo, '\', pointer(FixedInfoData), QueryLen);
    FFixedInfo.Data := FixedInfoData;
    if VerQueryValue(FVersionInfo, TRANSLATION_INFO, Pointer(IDs), IDsLen) then
    begin
      { Denis Kopprasch: if IDCount = 0, the for .. to ...-Statement is executed