如何获取版本信息 (100分)

; 各位高手：
; ; ; ;我想在About对话框中显示的版本信息能够自动获得，不用手工修改，该怎么处理。
; ;

来自：cAkk 时间：1999-10-5 15:09:09 ID：139642
下面的函数可以得到文件的版本信息,注意,delphi做的程序,如果想
包含版本信息, 必须在菜单"project/options/version info"里面
添加版本信息.
function GetVersion;
var
; InfoSize, Wnd: DWORD;
; VerBuf: Pointer;
; szName: array[0..255] of Char;
; Value: Pointer;
; Len: UINT;
; TransString:string;
begin
; InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
; if InfoSize ＜＞ 0 then
; begin
; ; GetMem(VerBuf, InfoSize);
; ; try
; ; ; if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
; ; ; begin
; ; ; ; Value :=nil;
; ; ; ; VerQueryValue(VerBuf, '/VarFileInfo/Translation', Value, Len);
; ; ; ; if Value ＜＞ nil then
; ; ; ; ; ;TransString := IntToHex(MakeLong(HiWord(Longint(Value^)), LoWord(Longint(Value^))), 8);
; ; ; ; Result := '';
; ; ; ; StrPCopy(szName, '/StringFileInfo/'+Transstring+'/FileVersion');
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;^^^^^^^此处换成ProductVersion得到的是"产品版本"
; ; ; ; if VerQueryValue(VerBuf, szName, Value, Len) then
; ; ; ; ; ;Result := StrPas(PChar(Value));
; ; ; end;
; ; finally
; ; ; FreeMem(VerBuf);
; ; end;
; end;
end;

;
;

--------------------------------------------------------------------------------
来自：cAkk 时间：1999-10-5 15:43:42 ID：139661
更正,函数声明为:
function GetVersion(filename:string):string;

忘了加参数了.

;
;

http://www.delphibbs.com/delphibbs/rules.asp

http://211.101.4.25/delphibbs/rules.asp

°¦£¡ÕâЩÈËÔõô¶¼Õâô¿ì£¡

procedure TFrmAbout.FormShow(Sender: TObject);
var sVer:String;
; ; iV1,iV2,iV3,iV4:integer;
; ; szFileName:array[0..49] of char;
; ; szModuleName:array[0..19] of char;
; ; iSize:integer;
begin
; StrPCopy(szModuleName,'NameOfModule');
; iSize:=GetModuleFileName(GetModuleHandle(szModuleName),szFileName,SizeOf(szFileName));
; if iSize>0 then
; begin
; ; ;sVer:=StrPas(szFileName);
; ; ;GetFileVersion(sVer,iV1,iV2,iV3,iV4);
; ; ;lblver.Caption:='Ver:'+IntToStr(iV1)+'.'+IntToStr(iV2)+'.'+IntToStr(iV3)+'.'+IntToStr(iV4);
; end;
end;

//delphi 5 开发人员指南中的例子,生成类时传递文件名称就可以使用了
unit VerInfo;
{
====================================
Project Name ; :
Form Name ; ; ;:
Pas Name ; ; ; : VerInfo
Table Name ; ; :
Procedure Name :
---------------------------------------------------->
输入参数 ;:
输出参数 ;:
---------------------------------------------------->
开发者 ; ;: Xavier Pacheco and Steve Teixeira
开发日期 ;: 1999
说 ; ;明 ;: 取得文件的信息如版本号等
---------------------------------------------------->
修改者 ; ;: SW英俊
修改日期 ;: 01/09/16
修改内容 ;: 1.取得主版本在辅助版本信息GetMajorVersion,GetMinorVersion
; ; ; ; ; ; ; MajorVersion,MinorVersion
====================================================
}


interface

uses SysUtils, WinTypes, Dialogs, Classes;

type
; { define a generic exception class for version info, and an exception
; ; to indicate that no version info is available. }
; EVerInfoError ; = class(Exception);
; ENoVerInfoError = class(Exception);
; eNoFixeVerInfo ;= class(Exception);

; // define enum type representing different types of version info
; TVerInfoType =
; ; (viCompanyName,
; ; ;viFileDescription,
; ; ;viFileVersion,
; ; ;viInternalName,
; ; ;viLegalCopyright,
; ; ;viLegalTrademarks,
; ; ;viOriginalFilename,
; ; ;viProductName,
; ; ;viProductVersion,
; ; ;viComments);

const

; // define an array constant of strings representing the pre-defined
; // version information keys.
; VerNameArray: array[viCompanyName..viComments] of String[20] =
; ('CompanyName',
; ;'FileDescription',
; ;'FileVersion',
; ;'InternalName',
; ;'LegalCopyright',
; ;'LegalTrademarks',
; ;'OriginalFilename',
; ;'ProductName',
; ;'ProductVersion',
; ;'Comments');

type

; // Define the version info class
; TVerInfoRes = class
; private
; ; Handle ; ; ; ; ; ;: DWord;
; ; Size ; ; ; ; ; ; ;: Integer;
; ; RezBuffer ; ; ; ; : String;
; ; TransTable ; ; ; ;: PLongint;
; ; FixedFileInfoBuf ;: PVSFixedFileInfo;
; ; FFileFlags ; ; ; ;: TStringList;
; ; FFileName ; ; ; ; : String;
; ; procedure FillFixedFileInfoBuf;
; ; procedure FillFileVersionInfo;
; ; procedure FillFileMaskInfo;
; protected
; ; function GetFileVersion ; : String;
; ; function GetProductVersion: String;
; ; function GetFileOS ; ; ; ;: String;
; ; //取得主版本在辅助版本信息
; ; function GetMajorVersion : string ;
; ; function GetMinorVersion : string ;
; public
; ; constructor Create(AFileName: String);
; ; destructor Destroy; override;
; ; function GetPreDefKeyString(AVerKind: TVerInfoType): String;
; ; function GetUserDefKeyString(AKey: String): String;
; ; property FileVersion ; ;: String read GetFileVersion;
; ; property ProductVersion : String read GetProductVersion;
; ; property FileFlags ; ; ;: TStringList read FFileFlags;
; ; property FileOS ; ; ; ; : String read GetFileOS;
{ TODO -ohsw -c01/01/09/16 : ;}
; ; property MajorVersion : string read GetMajorVersion ; ;
; ; property MinorVersion : string read GetMinorVersion ; ;
; end;

implementation

uses Windows;

const
; // strings that must be fed to VerQueryValue() function
; SFInfo ; ; ; ; ; ; ; ;= '/StringFileInfo/';
; VerTranslation: PChar = '/VarFileInfo/Translation';
; FormatStr ; ; ; ; ; ; = '%s%.4x%.4x/%s%s';


constructor TVerInfoRes.Create(AFileName: String);
begin
; FFileName := aFileName;
; FFileFlags := TStringList.Create;
; // Get the file version information
; FillFileVersionInfo;
; //Get the fixed file info
; FillFixedFileInfoBuf;
; // Get the file mask values
; FillFileMaskInfo;
end;


destructor TVerInfoRes.Destroy;
begin
; FFileFlags.Free;
end;

procedure TVerInfoRes.FillFileVersionInfo;
var
; SBSize: UInt;
begin
; // Determine size of version information
; Size := GetFileVersionInfoSize(PChar(FFileName), Handle);
; if Size <= 0 then ; ; ; ; { raise exception if size <= 0 }
; ; raise ENoVerInfoError.Create('没有可以利用的版本信息');//No Version Info Available.

; // Set the length accordingly
; SetLength(RezBuffer, Size);
; // Fill the buffer with version information, raise exception on error
; if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then
; ; raise EVerInfoError.Create('不能获取版本信息');//Cannot obtain version info.

; // Get translation info, raise exception on error
; if not VerQueryValue(PChar(RezBuffer), VerTranslation, ;pointer(TransTable),
; SBSize) then
; ; raise EVerInfoError.Create('没有语言信息'); // No language info.
end;

procedure TVerInfoRes.FillFixedFileInfoBuf;
var
; Size: Cardinal;
begin
; if VerQueryValue(PChar(RezBuffer), '/', Pointer(FixedFileInfoBuf), Size) then begin
; ; ;if Size < SizeOf(TVSFixedFileInfo) then
; ; ; ; raise eNoFixeVerInfo.Create('No fixed file info');
; end
; else
; ; raise eNoFixeVerInfo.Create('No fixed file info')
end;

procedure TVerInfoRes.FillFileMaskInfo;
begin
; with FixedFileInfoBuf^ do begin
; ; if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0then
; ; ; FFileFlags.Add('Pre-release');
; ; if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
; ; ; FFileFlags.Add('Private build');
; ; if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
; ; ; FFileFlags.Add('Special build');
; ; if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then
; ; ; FFileFlags.Add('Debug');
; end;
end;

function TVerInfoRes.GetPreDefKeyString(AVerKind: TVerInfoType): String;
var
; P: PChar;
; S: UInt;
begin
; Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
; ; VerNameArray[aVerKind], #0]);
; // get and return version query info, return empty string on error
; if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
; ; Result := StrPas(P)
; else
; ; Result := '';
end;

function TVerInfoRes.GetUserDefKeyString(AKey: String): String;
var
; P: Pchar;
; S: UInt;
begin
; Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
; ; aKey, #0]);
; // get and return version query info, return empty string on error
; if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
; ; Result := StrPas(P)
; else
; ; Result := '';
end;


function VersionString(Ms, Ls: Longint): String;
begin
; Result := Format('%d.%d.%d.%d', [HIWORD(Ms), LOWORD(Ms),
; ; ;HIWORD(Ls), LOWORD(Ls)]);
end;

function TVerInfoRes.GetFileVersion: String;
begin
; with FixedFileInfoBuf^ do
; ; Result := VersionString(dwFileVersionMS, dwFileVersionLS);
end;

function TVerInfoRes.GetProductVersion: String;
begin
; with FixedFileInfoBuf^ do
; ; Result := VersionString(dwProductVersionMS, dwProductVersionLS);
end;

function TVerInfoRes.GetFileOS: String;
begin
; with FixedFileInfoBuf^ do
; ; case dwFileOS of
; ; ; VOS_UNKNOWN: ;// Same as VOS__BASE
; ; ; ; Result := 'Unknown';
; ; ; VOS_DOS:
; ; ; ; Result := 'Designed for MS-DOS';
; ; ; VOS_OS216:
; ; ; ; Result := 'Designed for 16-bit OS/2';
; ; ; VOS_OS232:
; ; ; ; Result := 'Designed for 32-bit OS/2';
; ; ; VOS_NT:
; ; ; ; Result := 'Designed for Windows NT';


; ; ; VOS__WINDOWS16:
; ; ; ; Result := 'Designed for 16-bit Windows';
; ; ; VOS__PM16:
; ; ; ; Result := 'Designed for 16-bit PM';
; ; ; VOS__PM32:
; ; ; ; Result := 'Designed for 32-bit PM';
; ; ; VOS__WINDOWS32:
; ; ; ; Result := 'Designed for 32-bit Windows';

; ; ; VOS_DOS_WINDOWS16:
; ; ; ; Result := 'Designed for 16-bit Windows, running on MS-DOS';
; ; ; VOS_DOS_WINDOWS32:
; ; ; ; Result := 'Designed for Win32 API, running on MS-DOS';
; ; ; VOS_OS216_PM16:
; ; ; ; Result := 'Designed for 16-bit PM, running on 16-bit OS/2';
; ; ; VOS_OS232_PM32:
; ; ; ; Result := 'Designed for 32-bit PM, running on 32-bit OS/2';
; ; ; VOS_NT_WINDOWS32:
; ; ; ; Result := 'Designed for Win32 API, running on Windows/NT';
; ; else
; ; ; Result := 'Unknown';
; ; end;
end;


function TVerInfoRes.GetMajorVersion: string;
begin
; with FixedFileInfoBuf^ do
; ; Result := Format('%d.%d', [HIWORD(dwFileVersionMS), LOWORD(dwFileVersionMS)]);
end;

function TVerInfoRes.GetMinorVersion: string;
begin
; with FixedFileInfoBuf^ do
; ; Result := Format('%d.%d', [HIWORD(dwFileVersionLS), LOWORD(dwFileVersionLS)]);

end;

end.