function ShowVersion:String // 获得应用程序的版本号
var
VerInfo : PChar
lpTranslate : PLANGANDCODEPAGE
FileName:String
VerInfoSize, VerSize, cbTranslate : DWORD
VerValueSize : DWORD
Data 纳樱: String
VerFileV:PChar
lpFileVersion:string
begin
Result := '0.0.0.0'
FileName := Application.ExeName // 应用程序对应的 exe 文件
VerInfoSize := GetFileVersionInfoSize(PChar(FileName),VerSize)
if VerInfoSize > 0 then
begin
VerInfo := AllocMem(VerInfoSize)
GetFileVersionInfo(PChar(FileName),0,VerInfoSize,VerInfo)
VerQueryValue(VerInfo, PChar('/VarFileInfo/Translation'), Pointer(lpTranslate),cbTranslate)
if cbTranslate <> 0 then
begin
Data := format('/StringFileInfo/%.4x%.4x/FileVersion',[lpTranslate^.wLanguage,lpTranslate^.wCodePage])
VerQueryValue(VerInfo, PAnsiChar(data),Pointer(VerFileV), 宏茄桥VerValueSize)
if VerValueSize <> 0 then
begin
SetString(lpFileVersion,VerFileV,VerValueSize-1)
Result:=lpFileVersion
end
end
FreeMem(VerInfo,VerInfoSize)
end
else
begin
Result:='0.0.0.0'
Application.MessageBox('获取文件版本信息时遇到致命错误,请重新打开软件。','错误蔽猛',MB_OK+MB_ICONSTOP)
Application.Terminate
end
end
function GetApplicationVersion:String // Added 取得程序团庆晌版本号var FileName:String
InfoSize,Wnd:DWORD
VerBuf:Pointer
VerInfo:^VS_FIXEDFILEINFO
begin
Result:='0.0.0.0'
FileName:=Application.ExeName
InfoSize:=GetFileVersionInfoSize(PChar(FileName),Wnd)
if InfoSize<>0 then
begin
GetMem(VerBuf,InfoSize)
try
if GetFileVersionInfo(PChar(FileName),Wnd,InfoSize,VerBuf) then
begin
VerInfo:=nil
VerQueryValue(VerBuf,'\塌锋'差空,Pointer(VerInfo),Wnd)
if VerInfo<>nil then Result:=Format('%d.%d.%d.%d',[VerInfo^.dwFileVersionMS shr 16,
VerInfo^.dwFileVersionMS and $0000ffff,
VerInfo^.dwFileVersionLS shr 16,
VerInfo^.dwFileVersionLS and $0000ffff])
end
finally
FreeMem(VerBuf,InfoSize)
end
end
end
你可以用下面的方式去取一坦携耐下版本号,应该没什么问题!!!定一个版本信息结构:
type
PFixedFileInfo = ^TFixedFileInfo
TFixedFileInfo = record
dwSignature : DWORD
dwStrucVersion : DWORD
wFileVersionMS : WORD // 次版本号
wFileVersionLS : WORD // 主版本号
wProductVersionMS : WORD // 建立次数(build)
wProductVersionLS : WORD // 发行次数(release)
dwFileFlagsMask : DWORD
dwFileFlags : DWORD
dwFileOS : DWORD
dwFileType : DWORD
dwFileSubtype : DWORD
dwFileDateMS : DWORD
dwFileDateLS : DWORD
end // TFixedFileInfo
下面是取版本信息函让春数
function FileInfo( const FileName :String ) : TFixedFileInfo
var
dwHandle, dwVersionSize : DWORD
strSubBlock : String
pTemp : Pointer
pData : Pointer
begin
strSubBlock := '
// 取得文件版本信息的大小
dwVersionSize := GetFileVersionInfoSize( PChar( FileName ), dwHandle )
if dwVersionSize <> 0 then
begin
GetMem( pTemp, dwVersionSize )
try
//取文件版本信息
if GetFileVersionInfo( PChar( FileName ),dwHandle,
dwVersionSize,pTemp ) then
//查询文件隐罩版本信息
if VerQueryValue( pTemp,PChar( strSubBlock ),
pData,dwVersionSize ) then
Result := PFixedFileInfo( pData )^
finally
FreeMem( pTemp )
end // try
end // if dwVersionSize
end
调用例子:
var
f1:string
x :TFixedFileInfo
begin
f1 := Application.ExeName
x := FileInfo( f1 )
ShowMessage( f1 +
#13#10 'Version: ' + IntToStr( x.wFileVersionLS ) + '. ' +
IntToStr( x.wFileVersionMS ) +
#13#10 'Release: ' + IntToStr( x.wProductVersionLS) +
#13#10 'Build: ' + IntToStr( x.wProductVersionMS ) )
end
**********************************
获取文件版本信息
type
TFileInfo = packed record
CommpanyName: string
FileDescription: string
FileVersion: string
InternalName: string
LegalCopyright: string
LegalTrademarks: string
OriginalFileName: string
ProductName: string
ProductVersion: string
Comments: string
VsFixedFileInfo:VS_FIXEDFILEINFO
UserDefineValue:string
end
function GetFileVersionInfomation(const FileName: string var info: TFileInfoUserDefine:string= ' '):
boolean
const
SFInfo= '
var
VersionInfo: Pointer
InfoSize: DWORD
InfoPointer: Pointer
Translation: Pointer
VersionValue: string
unused: DWORD
begin
unused := 0
Result := False
InfoSize := GetFileVersionInfoSize(pchar(FileName), unused)
if InfoSize > 0 then
begin
GetMem(VersionInfo, InfoSize)
Result := GetFileVersionInfo(pchar(FileName), 0, InfoSize, VersionInfo)
if Result then
begin
VerQueryValue(VersionInfo, ' ', Translation, InfoSize)
VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) +
IntToHex(HiWord(Longint(Translation^)), 4) + '
VerQueryValue(VersionInfo, pchar(VersionValue + 'CompanyName '), InfoPointer, InfoSize)
info.CommpanyName := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileDescription '), InfoPointer, InfoSize)
info.FileDescription := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileVersion '), InfoPointer, InfoSize)
info.FileVersion := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'InternalName '), InfoPointer, InfoSize)
info.InternalName := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalCopyright '), InfoPointer, InfoSize)
info.LegalCopyright := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalTrademarks '), InfoPointer, InfoSize)
info.LegalTrademarks := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'OriginalFileName '), InfoPointer, InfoSize)
info.OriginalFileName := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductName '), InfoPointer, InfoSize)
info.ProductName := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductVersion '), InfoPointer, InfoSize)
info.ProductVersion := string(pchar(InfoPointer))
VerQueryValue(VersionInfo, pchar(VersionValue + 'Comments '), InfoPointer, InfoSize)
info.Comments := string(pchar(InfoPointer))
if VerQueryValue(VersionInfo, ', InfoPointer, InfoSize) then
info.VsFixedFileInfo := TVSFixedFileInfo(InfoPointer^)
if UserDefine <>' ' then
begin
if VerQueryValue(VersionInfo,pchar(VersionValue+UserDefine),InfoPointer,InfoSize) then
info.UserDefineValue:=string(pchar(InfoPointer))
end
end
FreeMem(VersionInfo)
end
end
调用演示:
procedure TForm1.Button1Click(Sender: TObject)
var
info: TFileInfo
begin
if OpenDialog1.Execute then
begin
if GetFileVersionInfomation(opendialog1.FileName, info, 'WOW Version ') then
begin
Listbox1.Items.Add(OpenDialog1.FileName)
ListBox1.Items.Add( 'Comments: ' + info.Comments)
ListBox1.Items.Add( 'CommpanyName: ' + info.CommpanyName)
ListBox1.Items.Add( 'FileDescription: ' + info.FileDescription)
ListBox1.Items.Add( 'FileVersion: ' + info.FileVersion)
ListBox1.Items.Add( 'InternalName: ' + info.InternalName)
ListBox1.Items.Add( 'LegalCopyright: ' + info.LegalCopyright)
ListBox1.Items.Add( 'LegalTrademarks: ' + info.LegalTrademarks)
ListBox1.Items.Add( 'OriginalFileName: ' + info.OriginalFileName)
ListBox1.Items.Add( 'ProductName: ' + info.ProductName)
ListBox1.Items.Add( 'ProductVersion: ' + info.ProductVersion)
ListBox1.Items.Add( 'UserDefineValue: ' + info.UserDefineValue)
if boolean(info.VsFixedFileInfo.dwFileFlags and vs_FF_Debug) then
listbox1.Items.Add( 'Debug:True ')
else
ListBox1.Items.Add( 'Debug:False ')
ListBox1.Items.Add( ' ')
end
end
end
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)