-
Aug 20th, 2021, 09:47 AM
#1
Thread Starter
PowerPoster
HOW TO get dll version,like 1.2.3.4?
HOW TO get dll version,like 1.2.3.4?
why this code is err
Code:
Option Explicit
Type FileInfo
wLength As Integer
wValueLength As Integer
szKey As String * 16
dwSignature As Long
dwStrucVersion As Long
dwFileVersionMS As Long
dwFileVersionLS As Long
End Type
' NOTE: The following Declare statements are case sensitive.
Declare Function GetFileVersionInfo& Lib "Version" _
Alias "GetFileVersionInfoA" (ByVal FileName$, _
ByVal dwHandle&, ByVal cbBuff&, ByVal lpvData$)
Declare Function GetFileVersionInfoSize& Lib "Version" Alias _
"GetFileVersionInfoSizeA" (ByVal FileName$, dwHandle&)
Declare Sub hmemcpy Lib "Kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbBytes&)
Function LOWORD(x As Long) As Integer
LOWORD = x And &HFFFF&
' Low 16 bits contain Minor revision number.
End Function
Function HIWORD(x As Long) As Integer
HIWORD = x / &HFFFF&
' High 16 bits contain Major revision number.
End Function
'----------------------------------------
'ÒÔÏÂΪִÐÐÄ£¿é£¬ÔÚ VBE ½çÃæ°´ F5 Ö´ÐÐ
'----------------------------------------
Function displayVersion(FileName As String)
Dim x As FileInfo
Dim FileVer As String
Dim dwHandle&, BufSize&, lpvData$, R&
'*** Get Version Information If Available ****
FileVer = ""
'FileName = ·½
BufSize& = GetFileVersionInfoSize(FileName, dwHandle&)
If BufSize& = 0 Then
MsgBox "Invalid File Name or no Version information available"
Exit Function
End If
lpvData$ = Space$(BufSize&)
R& = GetFileVersionInfo(FileName, dwHandle&, BufSize&, lpvData$)
hmemcpy x, ByVal lpvData$, Len(x)
'**** Parse File Version Number ****
FileVer = Trim$(Str$(HIWORD(x.dwFileVersionMS))) + "."
FileVer = FileVer + Trim$(Str$(LOWORD(x.dwFileVersionMS))) + "."
FileVer = FileVer + Trim$(Str$(HIWORD(x.dwFileVersionLS))) + "."
FileVer = FileVer + Trim$(Str$(LOWORD(x.dwFileVersionLS)))
displayVersion = FileVer
MsgBox FileVer, 64, "Version of " & FileName
End Function
Last edited by xiaoyao; Aug 20th, 2021 at 12:13 PM.
Reason: Please move to code bank
-
Aug 20th, 2021, 10:03 AM
#2
Thread Starter
PowerPoster
Re: HOW TO get dll version,like 1.2.3.4?
IT'S GOOD
Code:
'Visual Basic | Get File Version Information Details (OCX, EXE, DLL etc) Code Example
'https://visualbasic.happycodings.com/files-directories-drives/code30.html
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Type VS_FIXEDFILEINFO
Signature As Long
StrucVersionl As Integer ' e.g. = &h0000 = 0
StrucVersionh As Integer ' e.g. = &h0042 = .42
FileVersionMSl As Integer ' e.g. = &h0003 = 3
FileVersionMSh As Integer ' e.g. = &h0075 = .75
FileVersionLSl As Integer ' e.g. = &h0000 = 0
FileVersionLSh As Integer ' e.g. = &h0031 = .31
ProductVersionMSl As Integer ' e.g. = &h0003 = 3
ProductVersionMSh As Integer ' e.g. = &h0010 = .1
ProductVersionLSl As Integer ' e.g. = &h0000 = 0
ProductVersionLSh As Integer ' e.g. = &h0031 = .31
FileFlagsMask As Long ' = &h3F for version "0.42"
FileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
FileOS As Long ' e.g. VOS_DOS_WINDOWS16
FileType As Long ' e.g. VFT_DRIVER
FileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
FileDateMS As Long ' e.g. 0
FileDateLS As Long ' e.g. 0
End Type
'Purpose : To obtain the file version info of a DLL, OCX, EXE etc.
'Inputs : sFileName The path and name of the file to return the version info
'Outputs : Returns the file version number of the specified file
Function FileVersionNo(sFileName As String) As String
Dim lFileHwnd As Long, lRet As Long, lBufferLen As Long, lplpBuffer As Long, lpuLen As Long
Dim abytBuffer() As Byte
Dim tVerInfo As VS_FIXEDFILEINFO
Dim sBlock As String, sStrucVer As String
'Get the size File version info structure
lBufferLen = GetFileVersionInfoSize(sFileName, lFileHwnd)
If lBufferLen = 0 Then
Exit Function
End If
'Create byte array buffer, then copy memory into structure
ReDim abytBuffer(lBufferLen)
Call GetFileVersionInfo(sFileName, 0&, lBufferLen, abytBuffer(0))
Call VerQueryValue(abytBuffer(0), "\", lplpBuffer, lpuLen)
Call CopyMem(tVerInfo, ByVal lplpBuffer, Len(tVerInfo))
'Determine structure version number (For info only)
sStrucVer = Format$(tVerInfo.StrucVersionh) & "." & Format$(tVerInfo.StrucVersionl)
'Concatenate file version number details into a result string
FileVersionNo = Format$(tVerInfo.FileVersionMSh) & "." & Format$(tVerInfo.FileVersionMSl, "00") & "."
If tVerInfo.FileVersionLSh > 0 Then
FileVersionNo = FileVersionNo & Format$(tVerInfo.FileVersionLSh, "0000") & "." & Format$(tVerInfo.FileVersionLSl, "00")
Else
FileVersionNo = FileVersionNo & Format$(tVerInfo.FileVersionLSl, "0000")
End If
End Function
'Eg. Get Version Details of C:\Windows\System\Comctl32.ocx
Sub Example()
Debug.Print FileVersionNo("C:\Windows\System\comctl32.ocx")
End Sub
Code:
Function GetDllVersion(dll As String) As String
'8.0.20063.235
Dim fso As FileSystemObject
Set fso = New FileSystemObject
GetDllVersion = fso.GetFileVersion(dll)
Set fso = Nothing
End Function
Last edited by xiaoyao; Aug 20th, 2021 at 10:13 AM.
-
Aug 20th, 2021, 10:27 AM
#3
Thread Starter
PowerPoster
Re: HOW TO get dll version,like 1.2.3.4?
getversion4(*.DLL)
Can get more comprehensive information
Private Type FILE_VERSION_INFO
InfoAvailable As String
DescCompany As String
DescFileDesc As String
DescCopyRight As String
DescFileVersion As String
VerFileVersion As String
VerProductVersion As String
VerFileType As String
End Type
Code:
'VB/WinAPI, How to use GetFileVersionInfo() in VB?
'http://computer-programming-forum.com/74-vb-winapi/05cb6094fd6a1077.htm
Private Declare Function GetFileVersionInfoSize _
Lib "version.dll" Alias "GetFileVersionInfoSizeA" _
(ByVal lptstrFilename As String, _
lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo _
Lib "version.dll" Alias "GetFileVersionInfoA" _
(ByVal lptstrFilename As String, _
ByVal dwHandle As Long, _
ByVal dwLen As Long, _
lpData As Byte) As Long
Private Declare Function VerQueryValue _
Lib "version.dll" Alias "VerQueryValueA" _
(pBlock As Byte, _
ByVal lpSubBlock As String, _
lplpBuffer As Long, _
puLen As Long) As Long
Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, _
Source As Any, _
ByVal NumBytes As Long)
Private Const VFT_UNKNOWN = &H0&
Private Const VFT_APP = &H1&
Private Const VFT_DLL = &H2&
Private Const VFT_DRV = &H3&
Private Const VFT_FONT = &H4&
Private Const VFT_VXD = &H5&
Private Const VFT_STATIC_LIB = &H7&
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersion As Long ' e.g. 0x00000042 = "0.42"
dwFileVersionMS As Long ' e.g. 0x00030075 = "3.75"
dwFileVersionLS As Long ' e.g. 0x00000031 = "0.31"
dwProductVersionMS As Long ' e.g. 0x00030010 = "3.10"
dwProductVersionLS As Long ' e.g. 0x00000031 = "0.31"
dwFileFlagsMask As Long ' = 0x3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type
Private Type MinMajVer
MinVer As Integer
MajVer As Integer
End Type
Private Type FILE_VERSION_INFO
InfoAvailable As String
DescCompany As String
DescFileDesc As String
DescCopyRight As String
DescFileVersion As String
VerFileVersion As String
VerProductVersion As String
VerFileType As String
End Type
Function getversion4(DLL As String) As String
Dim FileVersionInfo As FILE_VERSION_INFO
Call GetFileVersionInfoStrings(DLL, FileVersionInfo)
getversion4 = FileVersionInfo.VerFileVersion
End Function
Sub GetFileVersionInfoStrings(FileName As String, FVI As FILE_VERSION_INFO)
Dim verBuf() As Byte ' Version buffer
Dim ffi As VS_FIXEDFILEINFO, fiiaddr As Long, fiilen As Long
Dim fressize As Long, freshnd As Long
fressize = GetFileVersionInfoSize(FileName, freshnd)
If fressize > 64000 Then fressize = 64000
ReDim verBuf(fressize + 1)
If GetFileVersionInfo(FileName, freshnd, fressize, verBuf(0)) = 0 Then
FVI.InfoAvailable = "No version information available for this file"
Else
If VerQueryValue(verBuf(0), "\", fiiaddr, fiilen) = 0 Then
FVI.InfoAvailable = "No fixed version information in this file"
Else
FVI.InfoAvailable = "Fixed version information exists in this File"
CopyMemory ffi, ByVal fiiaddr, 52
With ffi
Select Case .dwFileType
Case VFT_UNKNOWN: FVI.VerFileType = "Unknown"
Case VFT_APP: FVI.VerFileType = "Application"
Case VFT_DLL: FVI.VerFileType = "Dynamiclink library"
Case VFT_DRV: FVI.VerFileType = "Device driver"
Case VFT_FONT: FVI.VerFileType = "Font resource"
Case VFT_VXD: FVI.VerFileType = "Virtual device"
Case VFT_STATIC_LIB: FVI.VerFileType = "Static link library"
End Select
FVI.VerFileVersion = CalcVersion(.dwFileVersionMS) & "." & _
CalcVersion(.dwFileVersionLS)
FVI.VerProductVersion = CalcVersion(.dwProductVersionMS)
End With
With FVI
.DescCompany = GetInfoString("CompanyName", verBuf)
.DescCopyRight = GetInfoString("LegalCopyright", verBuf)
.DescFileDesc = GetInfoString("FileDescription", verBuf)
.DescFileVersion = GetInfoString("FileVersion", verBuf)
End With
End If
End If
End Sub
Private Function GetInfoString(stringtoget As String, verBuf() As Byte) As String
Dim tbuf As String, xlatelang As Integer, xlatecode As Integer, _
numentries As Integer, fiiaddr As Long, xlatestring As String, _
xlateval As Long, fiilen As Long, x As Integer
If (VerQueryValue(verBuf(0), "\VarFileInfo\Translation", fiiaddr, fiilen) <> 0) Then ' Translation table exists
numentries = fiilen / 4
xlateval = 0
For x = 1 To numentries
' Copy the 4 byte tranlation entry for the first
CopyMemory xlatelang, ByVal fiiaddr, 2
CopyMemory xlatecode, ByVal (fiiaddr + 2), 2
' Exit if U.S. English was found
If xlatelang = &H409 Then Exit For
fiiaddr = fiiaddr + 4
Next x
Else
' No translation table - Assume standard ASCII
xlatelang = &H409
xlatecode = 0
End If
' Make sure hex string is 8 chars long
xlatestring = LPad(Hex$(xlatelang) & LPad(Hex$(xlatecode), 4, "0"), 8, "0")
If VerQueryValue(verBuf(0), "\StringFileInfo\" & xlatestring & "\" & stringtoget, fiiaddr, fiilen) = 0 Then
GetInfoString = "Unavailable"
Exit Function
End If
tbuf = String$(fiilen + 1, Chr$(0))
'THIS MAY HAVE PROBLEMS * FROM WHAT I HAVE READ
'ONE SHOULD NOT USE A STRING DIRECTLY IN CopyMemory
'Rather to use ByVal Strptr(StringVar). This works and the StrPtr
'setup does NOT. NT USERS BEWARE (perhaps). LET ME KNOW
'IF IT BLOWS '
' Copy the fixed file info into the structure
CopyMemory ByVal tbuf, ByVal fiiaddr, fiilen
GetInfoString = TrimNull(tbuf)
If GetInfoString = "" Then GetInfoString = "None"
End Function
Private Function CalcVersion(vernum As Long) As String
Dim MinorMajor As MinMajVer
CopyMemory MinorMajor, vernum&, 4
With MinorMajor
CalcVersion = Trim(Str$(.MajVer) & "." & Trim$(Str$(.MinVer)))
End With
End Function
Private Function NormalizeDir(strDir As String) As String
NormalizeDir = strDir
If Right$(strDir, 1) <> "\" Then NormalizeDir = NormalizeDir & "\"
End Function
Function LPad(strIn As String, intPad As Integer, strPadChar As String) As String
LPad = strIn
While Len(LPad) < intPad
LPad = strPadChar + LPad
Wend
End Function
Private Function TrimNull(strIn As String) As String
Dim nullpos As Integer
nullpos = InStr(strIn, Chr$(0))
If (nullpos > 1) Then
TrimNull = Left$(strIn, nullpos - 1)
Else
TrimNull = ""
End If
End Function
-
Sep 8th, 2021, 12:13 PM
#4
Re: HOW TO get dll version,like 1.2.3.4?
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|