如何确定Delphi应用程序版本问题,怎么解决

如何确定Delphi应用程序版本问题,怎么解决,第1张

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


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

原文地址: https://outofmemory.cn/yw/8194120.html

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

发表评论

登录后才能评论

评论列表(0条)

保存