getversioninfo.pas

全功能windows 资源编程器。 Delphi 编写 Windows 界面.

unit getversioninfo;

{Written by Rick Peterson, Modified by Frank Wunderlich}

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 TypInfo;

type
{$M+}
  TVersionType=(vtCompanyName, vtFileDescription, vtFileVersion, vtInternalName,
                vtLegalCopyright,vtLegalTradeMark, vtOriginalFileName,
                vtProductName, vtProductVersion, vtComments);
  TIntVersionInfo = record
    MainV,SubV,Release,Build:byte;
  end;

  TrpVersionInfo = class
  private
    FVersionInfo : Array [0 .. ord(high(TVersionType))] of string;
    FIntVersionInfo: Array [0 ..1] of TIntVersionInfo;
    FLangID,FCharset:Word;
    FFileOS,FFileType,FFileFlags:Integer;
    procedure SetVersionInfo(filename:string); virtual;
  protected
  public
    constructor Create(filename:String);
    function GetIntFileVersion:TIntVersionInfo;
    function GetIntProductVersion:TIntVersionInfo;
    function GetLangID:Word;
    function GetCharset:Word;
    function GetFileOS:Integer;
    function GetFileType:Integer;
    function isPrivateBuild:Boolean;
    function isSpecialBuild:Boolean;
    function isDebugBuild:Boolean;
    function isPatched:Boolean;
    function isPreRelease:Boolean;
    function GetCompanyName: string;
    function GetFileDescription: string;
    function GetFileVersion: string;
    function GetInternalName: string;
    function GetLegalCopyright: string;
    function GetLegalTradeMark: string;
    function GetOriginalFileName: string;
    function GetProductName: string;
    function GetProductVersion: string;
    function GetComments: string;
    function GetVersionInfo(VersionType: TVersionType): string; virtual;
  end;

var
  VersionInfo : TrpVersionInfo;

implementation

constructor TrpVersionInfo.Create(filename:String);
begin
  inherited Create;
  SetVersionInfo(filename);
end;

function TrpVersionInfo.GetIntFileVersion:TIntVersionInfo;
begin
  result := FIntVersionInfo[0];
end;

function TrpVersionInfo.GetIntProductVersion:TIntVersionInfo;
begin
  result := FIntVersionInfo[1];
end;

function TrpVersionInfo.GetLangID:Word;
begin
  result:=FLangID;
end;

function TrpVersionInfo.GetCharset:Word;
begin
  result:=FCharset;
end;

function TrpVersionInfo.GetFileOS:Integer;
begin
  result:=FFileOS;
end;

function TrpVersionInfo.GetFileType:Integer;
begin
  result:=FFileType;
end;

function TrpVersionInfo.isPrivateBuild:Boolean;
begin
  result:=(FFileFlags and VS_FF_PRIVATEBUILD)>0;
end;

function TrpVersionInfo.isSpecialBuild:Boolean;
begin
  result:=(FFileFlags and VS_FF_SPECIALBUILD)>0;
end;

function TrpVersionInfo.isDebugBuild:Boolean;
begin
  result:=(FFileFlags and VS_FF_DEBUG)>0;
end;

function TrpVersionInfo.isPatched:Boolean;
begin
  result:=(FFileFlags and VS_FF_PATCHED)>0;
end;

function TrpVersionInfo.isPreRelease:Boolean;
begin
  result:=(FFileFlags and VS_FF_PRERELEASE)>0;
end;

//Stringfileinfo
function TrpVersionInfo.GetCompanyName: string;
begin
  result := GetVersionInfo(vtCompanyName);
end;

function TrpVersionInfo.GetFileDescription: string;
begin
  result := GetVersionInfo(vtFileDescription);
end;

function TrpVersionInfo.GetFileVersion: string;
begin
  result := GetVersionInfo(vtFileVersion);
end;

function TrpVersionInfo.GetInternalName: string;
begin
  result := GetVersionInfo(vtInternalName);
end;

function TrpVersionInfo.GetLegalCopyright: string;
begin
  result := GetVersionInfo(vtLegalCopyright);
end;

function TrpVersionInfo.GetLegalTradeMark: string;
begin
  result := GetVersionInfo(vtLegalTradeMark);
end;

function TrpVersionInfo.GetOriginalFileName: string;
begin
  result := GetVersionInfo(vtOriginalFileName);
end;

function TrpVersionInfo.GetProductName: string;
begin
  result := GetVersionInfo(vtProductName);
end;

function TrpVersionInfo.GetProductVersion: string;
begin
  result := GetVersionInfo(vtProductVersion);
end;

function TrpVersionInfo.GetComments: string;
begin
  result := GetVersionInfo(vtComments);
end;

function TrpVersionInfo.GeTVersionInfo(VersionType: TVersionType): string;
begin
  result := FVersionInfo[ord(VersionType)];
end;

procedure TrpVersionInfo.SetVersionInfo(filename:string);
var
  sVersionType,rootinfo : string;
  VersionInfoSize, VersionInfoValueSize: DWord;
  i: integer;
  VersionInfo,VersionInfoValue, Key: pointer;
begin
  VersionInfoSize:= GetFileVersionInfoSize(PChar(filename),VersionInfoSize);
  if (VersionInfoSize > 0) then
  begin
    VersionInfo := AllocMem(VersionInfoSize);
    GetFileVersionInfo(PChar(filename),0,VersionInfoSize, VersionInfo);
    VerQueryValue(VersionInfo, '\', VersionInfoValue,VersionInfoValueSize);
    if VersionInfoValueSize<>0 then
    begin
      with TVSFixedFileInfo(VersionInfoValue^) do
      begin
        FIntVersionInfo[0].MainV:=HiWord(dwFileVersionMS);
	FIntVersionInfo[0].SubV:=LoWord(dwFileVersionMS);
	FIntVersionInfo[0].Release:=HiWord(dwFileVersionLS);
	FIntVersionInfo[0].Build:=LoWord(dwProductVersionLS);
        FIntVersionInfo[1].MainV:=HiWord(dwProductVersionMS);
	FIntVersionInfo[1].SubV:=LoWord(dwProductVersionMS);
	FIntVersionInfo[1].Release:=HiWord(dwProductVersionLS);
	FIntVersionInfo[1].Build:=LoWord(dwProductVersionLS);
        FFileOS:=dwFileOS;
        FFileType:=dwFileType;
        FFileFlags:=dwFileFlags;
      end;
    end;
    if VerQueryValue(VersionInfo, '\VarFileInfo\Translation', VersionInfoValue, VersionInfoValueSize) then
    begin
      FLangID:=loword(VersionInfoValue^);
      FCharset:=hiword(integer(VersionInfoValue^));
      rootInfo:='StringFileInfo\'+inttohex(FLangID,4)+inttohex(FCharset,4)+'\';
      for i := 0 to Ord(High(TVersionType)) do
      begin
        sVersionType := GetEnumName(TypeInfo(TVersionType),i);
        sVersionType := Copy(sVersionType,3,length(sVersionType));
        Key := PChar (RootInfo + sVersionType);
        if VerQueryValue(VersionInfo, Key, Pointer(VersionInfoValue),VersionInfoValueSize) then
          FVersionInfo[i] := PCHAR(VersionInfoValue);
      end;
      FreeMem(VersionInfo,VersionInfoSize);
    end;
  end;
end;

end.