stvinfo.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StVInfo.pas 4.03                            *}
{*********************************************************}
{* SysTools: Version Information Extraction Component    *}
{*********************************************************}

{$I StDefine.inc}

{$I+} {I/O Checking On}

unit StVInfo;

interface

uses
  Windows, SysUtils, Classes,
  StBase, StConst;

{!!.02 - added }
const
  STVERMAJOR   = 0;
  STVERMINOR   = 1;
  STVERBUILD   = 2;
  STVERRELEASE = 3;
{!!.02 - added end }

type
  PVerTranslation = ^TVerTranslation;
  TVerTranslation = record
    Language : Word;
    CharSet  : Word;
  end;

  TStCustomVersionInfo = class(TStComponent)
  protected {private}
{$Z+}
    FComments            : string;
    FCompanyName         : string;
    FFileDescription     : string;
    FFileDate            : TDateTime;
    FFileFlags           : DWORD;                                      {!!.02}
    FFileFlagsMask       : DWORD;                                      {!!.02}
    FFileMajorVersion    : DWORD;                                      {!!.02}
    FFileMinorVersion    : DWORD;                                      {!!.02}
    FFileName            : string;
    FFileOS              : DWORD;                                      {!!.02}
    FFileType            : DWORD;                                      {!!.02}
    FFileSubtype         : DWORD;                                      {!!.02}
    FFileVersion         : string;
    FFileVersionFloat    : Double;
    FInternalName        : string;
    FLanguageCount       : LongInt;
    FLanguageName        : string;
    FLegalCopyright      : string;
    FLegalTrademark      : string;
    FOriginalFilename    : string;
    FProductMajorVersion : DWORD;                                      {!!.02}
    FProductMinorVersion : DWORD;                                      {!!.02}
    FProductName         : string;
    FProductVersion      : string;
    FProductVersionFloat : Double;
    FTranslationValue    : LongInt;
    VInfoLoaded          : Boolean;

    function GetComments : string;
    function GetCompanyName : string;
    function GetFileDate: TDateTime;
    function GetFileDescription : string;
    function GetFileFlags: DWORD;                                      {!!.02}
    function GetFileFlagsMask: DWORD;                                  {!!.02}
    function GetFileMajorVersion: DWORD;                               {!!.02}
    function GetFileMinorVersion: DWORD;                               {!!.02}
    function GetFileOS: DWORD;                                         {!!.02}
    function GetFileSubtype: DWORD;                                    {!!.02}
    function GetFileType: DWORD;                                       {!!.02}
    function GetFileVersion : string;
    function GetFileVersionFloat : Double;
    function GetInternalName : string;
    function GetLanguageCount: LongInt;
    function GetLanguageName: string;
    function GetLegalCopyright : string;
    function GetLegalTrademark : string;
    function GetOriginalFilename : string;
    function GetProductMajorVersion: DWORD;                            {!!.02}
    function GetProductMinorVersion: DWORD;                            {!!.02}
    function GetProductName : string;
    function GetProductVersion : string;
    function GetProductVersionFloat : Double;
    function GetTranslationValue: LongInt;
    procedure SetFileName(const Value : string);

    function LoadVersionInfo(const Key : string) : string;
    procedure Loaded; override;

{!!.02 - added }
    function GetFileVerSubPart(Index : Integer) : Word;
    function GetProdVerSubPart(Index : Integer) : Word;
{!!.02 - added end }

  protected

{$Z-}
    {properties}
    property Comments : string
      read GetComments;

    property CompanyName : string
      read GetCompanyName;

    property FileDate : TDateTime
      read GetFileDate;

    property FileDescription : string
      read GetFileDescription;

    property FileFlags : DWORD                                         {!!.02}
      read GetFileFlags;

    property FileFlagsMask : DWORD                                     {!!.02}
      read GetFileFlagsMask;

    property FileMajorVersion : DWORD                                  {!!.02}
      read GetFileMajorVersion;

    property FileMinorVersion : DWORD                                  {!!.02}
      read GetFileMinorVersion;

    property FileName : string
      read FFileName write SetFileName;

    property FileOS : DWORD                                            {!!.02}
      read GetFileOS;

    property FileType : DWORD                                          {!!.02}
      read GetFileType;

    property FileSubtype : DWORD                                       {!!.02}
      read GetFileSubtype;

    property FileVersion : string
      read GetFileVersion;

    property FileVersionFloat : Double
      read GetFileVersionFloat;

    property InternalName : string
      read GetInternalName;

    property LanguageCount : LongInt
      read GetLanguageCount;

    property LanguageName : string
      read GetLanguageName;

    property LegalCopyright : string
      read GetLegalCopyright;

    property LegalTrademark : string
      read GetLegalTrademark;

    property OriginalFilename : string
      read GetOriginalFilename;

    property ProductName : string
      read GetProductName;

    property ProductMajorVersion : DWORD                               {!!.02}
      read GetProductMajorVersion;

    property ProductMinorVersion : DWORD                               {!!.02}
      read GetProductMinorVersion;

    property ProductVersion : string
      read GetProductVersion;

    property ProductVersionFloat : Double
      read GetProductVersionFloat;

    property TranslationValue : LongInt
      read GetTranslationValue;

{!!.02 - added }
    property FileVerMajor : Word
      index STVERMAJOR read GetFileVerSubPart;
    property FileVerMinor : Word
      index STVERMINOR read GetFileVerSubPart;
    property FileVerBuild : Word
      index STVERBUILD read GetFileVerSubPart;
    property FileVerRelease : Word
      index STVERRELEASE read GetFileVerSubPart;
    property ProductVerMajor : Word
      index STVERMAJOR read GetProdVerSubPart;
    property ProductVerMinor : Word
      index STVERMINOR read GetProdVerSubPart;
    property ProductVerBuild : Word
      index STVERBUILD read GetProdVerSubPart;
    property ProductVerRelease : Word
      index STVERRELEASE read GetProdVerSubPart;
{!!.02 - added end }


  public
    { Public declarations }
{$Z+}
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
{$Z-}
    function GetKeyValue(const Key : string) : string;

  published
    { Published declarations }
  end;

  TStVersionInfo = class(TStCustomVersionInfo)
  public
    {properties}
    property Comments;
    property CompanyName;
    property FileDescription;
    property FileDate;
    property FileFlags;
    property FileFlagsMask;
    property FileMajorVersion;
    property FileMinorVersion;
    property FileOS;
    property FileType;
    property FileSubtype;
    property FileVersion;
    property FileVersionFloat;
    property InternalName;
    property LanguageCount;
    property LanguageName;
    property LegalCopyright;
    property LegalTrademark;
    property OriginalFilename;
    property ProductMajorVersion;
    property ProductMinorVersion;
    property ProductName;
    property ProductVersion;
    property ProductVersionFloat;
    property TranslationValue;

{!!.02 - added }
    property FileVerMajor;
    property FileVerMinor;
    property FileVerBuild;
    property FileVerRelease;
    property ProductVerMajor;
    property ProductVerMinor;
    property ProductVerBuild;
    property ProductVerRelease;
{!!.02 - added end }


  published
    {properties}
    property FileName;
  end;

implementation

constructor TStCustomVersionInfo.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  VInfoLoaded := False;
  SetFileName('');
end;

destructor TStCustomVersionInfo.Destroy;
begin
  inherited Destroy;
end;

function TStCustomVersionInfo.LoadVersionInfo(const Key : string) : string;
var
  Handle : DWORD;
  Res     : Boolean;
  Size    : Integer;
  Error   : LongInt;
  Data    : Pointer;
  Buffer  : Pointer;
  ErrCode : Integer;
  {$IFDEF VERSION4}
  Bytes   : Cardinal;
  {$ELSE}
  Bytes   : Integer;
  {$ENDIF}
  TempStr : array [0..259] of Char;
  LangBuff: array [0..259] of Char;
  BaseStr : string;
  InfoStr : string;
  Trans   : PVerTranslation;
  TrSize  : Integer;
  FixedInfo : TVSFixedFileInfo;
  FT : TFileTime;                                                      {!!.02}
  ST : TSystemTime;                                                    {!!.02}

  function MakeFloat(S : string) : Double;
  var
    Buff  : array [0..5] of Char;
    I     : Integer;
    Count : Integer;
  begin
    Count := 0;
    FillChar(Buff, SizeOf(Buff), 0);
    Buff[0] := '0';
    { The file version string might be specified like }
    { 4.72.3105.0. Parse it down to just one decimal  }
    { place and create the floating point version #.  }
    for I := 1 to Pred(Length(S)) do begin
      if S[I] = '.' then begin
        { Found the first period. Replace it with the DecimalSeparator }
        { constant so that StrToFloat works properly. }
        S[I] := DecimalSeparator;
        Inc(Count);
        if (Count = 2) and (I <= SizeOf(Buff)) then begin
          Move(S[1], Buff, I - 1);
          Break;
        end;
      end;
    end;
    Result := StrToFloat(Buff);
  end;

begin
  TrSize := 0;
  Size := GetFileVersionInfoSize(StrPCopy(TempStr, FFileName), Handle);
  if Size = 0 then begin
    { GetFileVersionInfoSize might fail because the }
    { file is a 16-bit file or because the file does not     }
    { contain version info. }
    Error := GetLastError;
    if Error = ERROR_RESOURCE_TYPE_NOT_FOUND then
      RaiseStError(EStVersionInfoError, stscNoVerInfo);
    if Error = 0 then
      RaiseStError(EStVersionInfoError, stscVerInfoFail);
  end;

  { Allocate some memory and get version info block. }
  GetMem(Data, Size);
  Res := GetFileVersionInfo(TempStr, Handle, Size, Data);
  Trans  := nil;
  try
    if not Res then
      { Error. Raise an exception. }
      RaiseStError(EStVersionInfoError, stscVerInfoFail);

    { Get the translation value. We need it to get the version info. }
    Res := VerQueryValue(Data, '\VarFileInfo\Translation', Buffer, Bytes);
    if not Res then
      RaiseStError(EStVersionInfoError, stscVerInfoFail);
    TrSize := Bytes;
    GetMem(Trans, TrSize);
    Move(Buffer^, Trans^, TrSize);
    FTranslationValue := LongInt(Trans^);
    FLanguageCount := Bytes div SizeOf(TVerTranslation);
    VerLanguageName(Trans^.Language, LangBuff, SizeOf(LangBuff));
    FLanguageName := StrPas(LangBuff);
    VInfoLoaded := True;

    { Build a base string including the translation value. }
    BaseStr := Format('StringFileInfo\%.4x%.4x\', [Trans^.Language, Trans^.CharSet]);

    { User-defined string. Get the string and exit. }