update: 14.06.08 - now using Prototype instead of CallFunction
Code: Select all
; English forum: http://www.purebasic.fr/english/viewtopic.php?t=13910&highlight=
; Author: sverson - update 14.06.2008
; Date: 03. February 2005
; OS: Windows
; Demo: Yes
; GetFileVersionInfo exe/dll any language
;/ gfvi.pb - GetFileVersionInfo for PureBasic
;/ 2005-02-03 sverson v1.0
;/ 2008-06-13 sverson v2.0
;/ * PB 4.20 - OK
;/ * unicode - except Language!
;/ 2008-06-14 sverson v2.1
;/ * unicode - Language fixed
;/
;/ more info on this topic:
;/ http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/resources/versioninformation.asp
Enumeration;- element name keys
#GFVI_FileVersion = $0001
#GFVI_FileDescription = $0002
#GFVI_LegalCopyright = $0004
#GFVI_InternalName = $0008
#GFVI_OriginalFilename = $0010
#GFVI_ProductName = $0020
#GFVI_ProductVersion = $0040
#GFVI_CompanyName = $0080
#GFVI_LegalTrademarks = $0100
#GFVI_SpecialBuild = $0200
#GFVI_PrivateBuild = $0400
#GFVI_Comments = $0800
#GFVI_Language = $1000
#GFVI_All = $1FFF
EndEnumeration
Procedure.s GFVI_GetElementName(elementKey.l);- get element name from key [gfvi]
If elementKey = #GFVI_FileVersion : ProcedureReturn "FileVersion"
ElseIf elementKey = #GFVI_FileDescription : ProcedureReturn "FileDescription"
ElseIf elementKey = #GFVI_LegalCopyright : ProcedureReturn "LegalCopyright"
ElseIf elementKey = #GFVI_InternalName : ProcedureReturn "InternalName"
ElseIf elementKey = #GFVI_OriginalFilename : ProcedureReturn "OriginalFilename"
ElseIf elementKey = #GFVI_ProductName : ProcedureReturn "ProductName"
ElseIf elementKey = #GFVI_ProductVersion : ProcedureReturn "ProductVersion"
ElseIf elementKey = #GFVI_CompanyName : ProcedureReturn "CompanyName"
ElseIf elementKey = #GFVI_LegalTrademarks : ProcedureReturn "LegalTrademarks"
ElseIf elementKey = #GFVI_SpecialBuild : ProcedureReturn "SpecialBuild"
ElseIf elementKey = #GFVI_PrivateBuild : ProcedureReturn "PrivateBuild"
ElseIf elementKey = #GFVI_Comments : ProcedureReturn "Comments"
ElseIf elementKey = #GFVI_Language : ProcedureReturn "Language"
EndIf
EndProcedure
CompilerIf #PB_Compiler_Unicode
Prototype.l GetFileVersionInfoSizeW(lptstrFilename.p-unicode, lpdwHandle.l)
Prototype.l GetFileVersionInfoW(lptstrFilename.p-unicode, dwHandle.l, dwLen.l, lpData.l)
Prototype.l VerQueryValueW(pBlock.l,lpSubBlock.p-unicode,lplpBuffer.l,puLen.w)
Prototype.l VerLanguageNameW(wLang.l,szLang.p-unicode,cchLang.l)
CompilerElse
Prototype.l GetFileVersionInfoSizeA(lptstrFilename.p-ascii, lpdwHandle.l)
Prototype.l GetFileVersionInfoA(lptstrFilename.p-ascii, dwHandle.l, dwLen.l, lpData.l)
Prototype.l VerQueryValueA(pBlock.l,lpSubBlock.p-ascii,lplpBuffer.l,puLen.w)
Prototype.l VerLanguageNameA(wLang.l,szLang.p-ascii,cchLang.l)
CompilerEndIf
Procedure.s GFVI_GetInfo(lptstrFilename$,lekFlags,bFieldName);- get exe/dll file information [gfvi]
Protected lpdwHandle.l, dwLen.w, lpData.l, lplpBuffer.l, puLen.l, *pBlock, lpSubBlock$
Protected nSize.w, szLang$, bBit.b, lekFlag.l, sElement$, sGFVI$
lplpBuffer = 0 : puLen = 0 : sGFVI$ = "" : nSize = 128 : szLang$ = Space(nSize)
If FileSize(lptstrFilename$)>0
If OpenLibrary(1,"Version.dll")
CompilerIf #PB_Compiler_Unicode
GetFileVersionInfoSize.GetFileVersionInfoSizeW = GetFunction(1,"GetFileVersionInfoSizeW")
GetFileVersionInfo.GetFileVersionInfoW = GetFunction(1,"GetFileVersionInfoW")
VerQueryValue.VerQueryValueW = GetFunction(1,"VerQueryValueW")
VerLanguageName.VerLanguageNameW = GetFunction(1,"VerLanguageNameW")
CompilerElse
GetFileVersionInfoSize.GetFileVersionInfoSizeA = GetFunction(1,"GetFileVersionInfoSizeA")
GetFileVersionInfo.GetFileVersionInfoA = GetFunction(1,"GetFileVersionInfoA")
VerQueryValue.VerQueryValueA = GetFunction(1,"VerQueryValueA")
VerLanguageName.VerLanguageNameA = GetFunction(1,"VerLanguageNameA")
CompilerEndIf
dwLen = GetFileVersionInfoSize(lptstrFilename$,@lpdwHandle)
If dwLen>0
*pBlock=AllocateMemory(dwLen)
If *pBlock>0
Result = GetFileVersionInfo(lptstrFilename$,0,dwLen,*pBlock)
If Result
lpSubBlock$ = "\\VarFileInfo\\Translation"
Result = VerQueryValue(*pBlock,lpSubBlock$,@lplpBuffer,@puLen)
If Result
CPLI$ = RSet(Hex(PeekW(lplpBuffer)),4,"0")+RSet(Hex(PeekW(lplpBuffer+2)),4,"0")
VerLanguageName(PeekW(lplpBuffer),szLang$,nSize)
EndIf
lekFlag = 1
For bBit = 1 To 12
If lekFlag & lekFlags
sElement$ = GFVI_GetElementName(lekFlag)
lpSubBlock$ = "\\StringFileInfo\\"+CPLI$+"\\"+sElement$
Result = VerQueryValue(*pBlock,lpSubBlock$,@lplpBuffer,@puLen)
If Result
If sGFVI$<>"" : sGFVI$+Chr(10) : EndIf
If bFieldName
sGFVI$=sGFVI$+sElement$+":"+Chr(9)+PeekS(lplpBuffer,puLen)
Else
sGFVI$=sGFVI$+PeekS(lplpBuffer,puLen)
EndIf
EndIf
EndIf
lekFlag << 1
Next
If lekFlag & lekFlags
If sGFVI$<>"" : sGFVI$+Chr(10) : EndIf
If bFieldName
sElement$ = GFVI_GetElementName(lekFlag)
sGFVI$ = sGFVI$+sElement$+":"+Chr(9)+szLang$
Else
sGFVI$ = sGFVI$+szLang$
EndIf
EndIf
EndIf
FreeMemory(*pBlock)
EndIf
EndIf
CloseLibrary(1)
EndIf
EndIf
ProcedureReturn sGFVI$
EndProcedure
;- DEMO
File$ = OpenFileRequester("Open File", "", "GFVI (exe,dll)|*.exe;*.dll|all files (*.*)|*.*", 0)
VInfo$ = GFVI_GetInfo(File$,#GFVI_FileVersion|#GFVI_CompanyName,#False)
MessageRequester("Fileinfo for "+GetFilePart(File$),VInfo$,#MB_OK|#MB_ICONINFORMATION)
VInfo$ = GFVI_GetInfo(File$,#GFVI_All,#True)
MessageRequester("Fileinfo for "+GetFilePart(File$),VInfo$,#MB_OK|#MB_ICONINFORMATION)
End... have fun!
