如何在程序中取得delphi的build号和程序版本号(50分)

我想把程序版本号和build号动太显示在关于对话框中，请教各位dfw该如何做？

用API : GetVerion或GetVersionEx

to bluerain:
我是要把自己的程序的版本号和build号显示在关于对话框中，不是操作系统的。
这两个函数是取得操作系统的版本号啊！！！

sorry,写错了,是
GetFileVersionInfo

to bluerain:
好象还挺复杂，能否给个例子，因为我搞不清得到的文件版本信息的结构，
以及从如何从返回的数据中取出版本号和build号，手头没有资料，帮助文件
中的信息好象也不全。

给你一个我一年多以前写的一个程序.功能比仅仅得到版本多很多.你看一下,然后把
没用的东西删掉就可以了,不过后来一直没去做完善,可能有一些BUG,如果你有兴趣的话,
改好了,别忘了给我一份,呵呵.
TFileInformation获得关于(dll,exe,vxd等文件的信息)

{**********************************************************************}
{ }
{ File Information Component }
{ version 1.0 for Delphi 5 }
{ }
{ Copyright (C) 2001 Sun Yu }
{ }
{**********************************************************************}
{ This Component include TFileInformation. }
{ The TFileInformation is object to user. It's used to get the }
{ file(mainly *.dll,*.exe,*.vxd) version information, the operation }
{ system on which the file run and the file type(e.g. app, dll,drv) }
{ Main function and Constant Listed as follows : }
{ }
{ LanguageName : the language which file complied with }
{ CompanyName : the file's company name }
{ FileVersion : the file version }
{ ProductVersion : the product version }
{ ProductName : the product name }
{ InternalName : the file's internal name }
{ OriginalFileName : the file's original file name }
{ LegalCopyright : the legal copyright }
{ LegalTrademarks : the legal trade marks }
{ FileDescription : the description of file }
{ Comments : the comments of file }
{ PrivateBuild : the private build number }
{ SpecialBuild : the special build number }
{ FileType : the file type with chinese or english format }
{ FileOSType : the platform on which file run with chinese or }
{ english format }
{**********************************************************************}


unit FileInformation;

interface

uses windows,classes,sysutils;

Type TFileInfo = record
ID : DWORD;
CNName : string;
ENName : string;
end;

Type
TFileInformation = class(TObject)
private
FFileName : string;
lpData : PChar;
FResult : boolean;
FLangID : WORD;
FLangSubID : WORD;
FFixFileInfo : PVSFixedFileInfo;
FHasVer : boolean;
protected
LanguageCode : string;
Procedure GetLanguageCode;
function Indexof(ftype : DWORD; TypeSet : array of TFileInfo) : integer;
function HasVersionInfo : boolean;
public
constructor Create(FileName : string);
destructor Destroy; override;
function LanguageName : string;
function CompanyName : string;
function FileVersion : string;
function ProductVersion : string;
function ProductName : string;
function InternalName : string;
function OriginalFileName : string;
function LegalCopyright : string;
function LegalTrademarks : string;
function FileDescription : string;
function Comments : string;
function PrivateBuild : string;
function SpecialBuild : string;
function FileType(IsChinese : boolean=True) : string;
function FileOSType(IsChinese : boolean=True) : string;
end;

implementation

const
CFileOS : array[1..9] of TFileInfo =
((ID: VOS_DOS; CNName: 'MS-DOS程序'; ENName: 'designed for MS-DOS'),
(ID: VOS_NT; CNName: 'Windows NT/Windows 2000程序'; ENName: 'designed for Windows NT/Windows 2000'),
(ID: VOS__WINDOWS16; CNName: '16-bit Windows程序'; ENName: 'designed for 16-bit Windows'),
(ID: VOS__WINDOWS32; CNName: '32-bit Windows程序'; ENName: 'designed for 32-bit Windows API'),
(ID: VOS_OS216; CNName: '16-bit OS/2程序'; ENName: 'designed for 16-bit OS/2'),
(ID: VOS_OS232; CNName: '32-bit OS/2程序'; ENName: 'designed for 32-bit OS/2'),
(ID: VOS__PM16; CNName: '16-bit OS/2 Presentation Manager'; ENName: 'designed for 16-bit Presentation Manager'),
(ID: VOS_OS232; CNName: '32-bit OS/2 Presentation Manager'; ENName: 'designed for 32-bit Presentation Manager'),
(ID: VOS_UNKNOWN; CNName: '未知平台程序'; ENName: 'designed for unknown Operation system'));

CFileType : array[1..7] of TFileInfo =
((ID: VFT_UNKNOWN; CNName: '未知类型文件'; ENName: 'unknown file type'),
(ID: VFT_APP; CNName: '应用程序'; ENName: 'an application'),
(ID: VFT_DLL; CNName: '动态链接库(DLL)';ENName: 'dynamic-link library (DLL)'),
(ID: VFT_DRV; CNName: '设备驱动文件'; ENName: 'a device driver'),
(ID: VFT_FONT; CNName: '字库文件'; ENName: 'a font'),
(ID: VFT_VXD; CNName: '虚拟设备文件'; ENName: 'a virtual device'),
(ID: VFT_STATIC_LIB;CNName: '静态链接库(LIB)';ENName: 'a static-link library'));

CFileDriverType : array[1..11] of TFileInfo =
((ID: VFT2_UNKNOWN; CNName: '未知类型文件'; ENName: 'unknown driver type'),
(ID: VFT2_DRV_COMM; CNName: '通讯驱动文件'; ENName: 'a communications driver'),
(ID: VFT2_DRV_PRINTER; CNName: '打印驱动文件'; ENName: 'a printer driver'),
(ID: VFT2_DRV_KEYBOARD;CNName: '键盘驱动文件'; ENName: 'a keyboard driver'),
(ID: VFT2_DRV_LANGUAGE;CNName: '语言驱动文件'; ENName: 'a language driver'),
(ID: VFT2_DRV_DISPLAY; CNName: '显示驱动文件'; ENName: 'a display driver'),
(ID: VFT2_DRV_MOUSE; CNName: '鼠标驱动文件'; ENName: 'a mouse driver'),
(ID: VFT2_DRV_NETWORK; CNName: '网络驱动文件'; ENName: 'a network driver'),
(ID: VFT2_DRV_SYSTEM; CNName: '系统驱动文件'; ENName: 'a system driver'),
(ID: VFT2_DRV_INSTALLABLE; CNName: '安装驱动文件'; ENName: 'a installable driver'),
(ID: VFT2_DRV_SOUND; CNName: '声音驱动文件'; ENName: 'a sound driver'));

CFileFontType : array[1..4] of TFileInfo =
((ID: VFT2_UNKNOWN; CNName: '未知字库文件'; ENName: 'unknown font type'),
(ID: VFT2_FONT_RASTER; CNName: '光栅字库文件'; ENName: 'a raster font'),
(ID: VFT2_FONT_VECTOR; CNName: '矢量字库文件'; ENName: 'a vector font'),
(ID: VFT2_FONT_TRUETYPE;CNName: 'TRUETYPE字库文件'; ENName: 'a TrueType font'));

{ TFileVersion }

// construct TFileVersion Class
constructor TFileInformation.Create(FileName : string);
var
tempHD : cardinal;
VerLeng : DWORD;
CurLeng : cardinal;
begin
FResult := False;
FFileName := FileName;
VerLeng := GetFileVersionInfoSize(PChar(FFileName),tempHD);
if VerLeng <> 0 then
begin
GetMem(lpData,VerLeng);
if GetFileVersionInfo(PChar(FFileName),0,VerLeng,lpData) then
begin
FResult := True;
VerQueryValue(lpData,'/',Pointer(FFixFileInfo),CurLeng);
FHasVer := HasVersionInfo;
GetLanguageCode;
end;
end;
end;

// destruct TFileInformation Class
destructor TFileInformation.Destroy;
begin
inherited;
if FResult then FreeMem(lpData);
end;


// get language code
procedure TFileInformation.GetLanguageCode;
var
lpBuf : pLongInt;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,'/VarFileInfo/Translation',Pointer(lpBuf),Verleng) then
begin
FLangID := LoWord(lpBuf^);
FLangSubID := HiWord(lpBuf^);
LanguageCode := IntToHex(FLangID,4)+IntToHex(FLangSubID,4);
end;
end;

// get language name
function TFileInformation.LanguageName: string;
var
Lang : TLanguages;
begin
if FResult then
begin
Lang := TLanguages.Create;
result := Lang.Name[Lang.Indexof(FLangID)];
Lang.Free;
end;
end;

// get company name
function TFileInformation.CompanyName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/CompanyName/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get file version
function TFileInformation.FileVersion: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/FileVersion/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get product version
function TFileInformation.ProductVersion: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/ProductVersion/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get product name
function TFileInformation.ProductName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/ProductName/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get internal name
function TFileInformation.InternalName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/InternalName/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get original file name
function TFileInformation.OriginalFileName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/OriginalFileName/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get legal copyright
function TFileInformation.LegalCopyright: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/LegalCopyright/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get legal trademarks
function TFileInformation.LegalTrademarks: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/LegalTrademarks/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get file description
function TFileInformation.FileDescription: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/FileDescription/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get comments
function TFileInformation.Comments: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/Comments/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;

// get file private build
function TFileInformation.PrivateBuild: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if FFixFileInfo.dwFileFlags = VS_FF_PRIVATEBUILD then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/PrivateBuild/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf
else
result := '';
end;

// get file special build
function TFileInformation.SpecialBuild: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if FFixFileInfo.dwFileFlags = VS_FF_SPECIALBUILD then
if VerQueryValue(lpData,PChar('/StringFileInfo/'+LanguageCode+'/PrivateBuild/'),
Pointer(lpBuf),VerLeng) then
result := lpBuf
else
result := '';
end;

// get file type
function TFileInformation.FileType(IsChinese : boolean) : string;
var
IndexType : integer;
IndexSubType : integer;
begin
if FResult then
begin
IndexType := Indexof(FFixFileInfo.dwFileType,CFileType);
if IndexType > 0 then
if FFixFileInfo.dwFileType = VFT_DRV then
begin
IndexSubType := Indexof(FFixFileInfo.dwFileSubtype,CFileDriverType);
if IndexSubType > 0 then
if IsChinese then
result := CFileDriverType[IndexSubType].CNName
else
result := CFileDriverType[IndexSubType].ENName
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else if FFixFileInfo.dwFileType = VFT_FONT then
begin
IndexSubType := Indexof(FFixFileInfo.dwFileSubtype,CFileFontType);
if IndexSubType > 0 then
if IsChinese then
result := CFileFontType[IndexSubType].CNName
else
result := CFileFontType[IndexSubType].ENName
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else
result := '';
end;

// get file operation system
function TFileInformation.FileOSType(IsChinese : boolean) : string;
var
Index : integer;
begin
if FResult then
begin
Index := Indexof(FFixFileInfo.dwFileOS,CFileOS);
if Index > 0 then
if IsChinese then
result := CFileOS[Index].CNName
else
result := CFileOS[Index].ENName
else
result := '';
end;
end;

// get the index of file type
function TFileInformation.Indexof(ftype : DWORD; TypeSet : array of TFileInfo) : integer;
var
i : integer;
begin
result := -1;
for i:=Low(TypeSet) to High(TypeSet) do
if ftype = TypeSet.ID then
begin
result := i+1;
exit;
end;
end;

// decide whether the file has version information
function TFileInformation.HasVersionInfo : boolean;
var
ftype : DWORD;
begin
ftype := FFixFileInfo.dwFileType;
if (ftype = VFT_APP) or (ftype = VFT_DLL) or (ftype = VFT_VXD)
or (ftype = VFT_STATIC_LIB) then
result := True
else
result := False;
end;

end.

本来还可以取出其他的信息,比如版权申明之类的,没有用到,就把他删掉了
但版本和Build都有
var
dwHandle,dwLen,puLen : Cardinal;
lpData : Array[0..1023] of Char;
tmpInfo : PChar;
lpSubBlock : string;
lplpPointer : Pointer;
Lang : Dword;
begin
tmpInfo := StrAlloc(256);

dwLen := GetFileVersionInfoSize(Pchar(Application.ExeName),dwHandle);
if dwLen = 0 then exit;

if not GetFileVersionInfo(Pchar(Application.ExeName),dwHandle,dwLen,@lpData) then
exit;

lpSubBlock := '/VarFileInfo/Translation';
if VerQueryValue(@lpData,PChar(lpSubBlock),lplpPointer,puLen) then
begin
Lang := DWORD(lplpPointer^);

//取得版本号
lpSubBlock := Format('/StringFileInfo/%.04X%.04X/FileVersion',
[LoWord(Lang),HiWord(Lang)]);
if VerQueryValue(@lpData,PChar(lpSubBlock),lplpPointer,puLen) then
begin
StrCopy(tmpInfo,lplpPointer);
Label2.Caption:= '版本 '+StrPas(tmpInfo);
end;
end;
StrDispose(tmpInfo);
end;

谢谢，问题已经解决，我用的方法和alter的代码类似，对两位的代码又进行了测试，
都可顺利通过。

多人接受答案了。