delphi运行期的执行文件,怎么获取它的版本号

delphi运行期的执行文件,怎么获取它的版本号,第1张

Function FileVersion(Const aFile: StringVar AMajor, AMinor, ARelease, ABuild: DWORD): Boolean

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


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/tougao/11775494.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-18
下一篇 2023-05-18

发表评论

登录后才能评论

评论列表(0条)

保存