Var
LpdwHandle, VersionSize: DWORD
VB: Pointer
VS: PVSFixedFileInfo
Begin
Result := False
AMajor := 0
AMinor := 0
ARelease := 0
ABuild := 0
LpdwHandle := 0
VersionSize := GetFileVersionInfoSize(PChar(aFile), LpdwHandle)
If VersionSize >0 Then
Begin
GetMem(VB, VersionSize)
Try
If GetFileVersionInfo(PChar(aFile), 0, VersionSize, VB) Then
Begin
VerQueryValue(VB, '\', Pointer(VS), VersionSize)
AMajor := VS.DwFileVersionMS Div $10000
AMinor := VS.DwFileVersionMS Mod $10000
ARelease := VS.DwFileVersionLS Div $10000
ABuild := VS.DwFileVersionLS Mod $10000
Result := True
End
Finally
Freemem(VB)
End
End
End
版本信息是在生成的可执行文件后,右键-属性-版本 里会显示的 ,或鼠标移到那个程序上面时也有显示,如果在Delphi里设置了版本号后还没显示,应该是你delphi的问题了,建议可以重装下试试 ,我用的是D7,测试过是正常的。
你可以用下面的方式去取一下版本号,应该没什么问题!!!定一个版本信息结构:
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条)