Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
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 Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal sSectionName As String, _
ByVal sDriverName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nBufferSize As Long, _
ByVal lpFileName As String) 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 Declare Function VerQueryValue Lib "version.dll" _
Alias "VerQueryValueA" _
(pBlock As Any, _
ByVal lpSubBlock As String, _
lplpBuffer As Any, nVerSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub Command1_Click()
Dim inifile As String
Dim lpSection As String
lpSection = "ODBC 32 bit Drivers"
inifile = "c:\winnt\odbcinst.ini"
Call ODBCGetInstalledDrivers(ListView1, lpSection, inifile)
End Sub
Private Sub Command2_Click()
Dim inifile As String
Dim lpSection As String
Dim sVersion As String
lpSection = Text1.Text
inifile = "c:\winnt\odbcinst.ini"
sVersion = ODBCGetVersionFromDriverName(lpSection, inifile)
Label1.Caption = "Version " & sVersion
End Sub
Private Sub Form_Load()
Command2.Enabled = False
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Text1.Text = Item.Text
Command2.Enabled = Len(Text1.Text) > 0
End Sub
Private Function HiWord(dw As Long) As Long
If dw And &H80000000 Then
HiWord = (dw \ 65536) - 1
Else
HiWord = dw \ 65536
End If
End Function
Private Function LoWord(dw As Long) As Long
If dw And &H8000& Then
LoWord = &H8000& Or (dw And &H7FFF&)
Else
LoWord = dw And &HFFFF&
End If
End Function
Private Function ProfileGetKeyNameData(sSectionName As String, _
sDriverName As String, _
inifile As String) As String
'take the string passed as sDriverName and
'call GetPrivateProfileString to retrieve the
'value under section sSectionName
Dim ret As String
Dim success As Long
Dim nBufferSize As Long
ret = Space$(128)
nBufferSize = CLng(Len(ret))
success = GetPrivateProfileString(sSectionName, _
sDriverName, "", ret, _
nBufferSize, inifile)
'success will hold the length of the
'returned value up to the trailing null
If success Then ProfileGetKeyNameData = Left$(ret, success)
End Function
Private Function StripNulls(startStrg As String) As String
'take a string separated by nulls,
'split off 1 item, and shorten the string
'so that the next item is ready for removal.
'The passed string must have a terminating
'null for this function to work correctly.
'If you remain in a loop, check this first!
Dim pos As Long
Dim Item As String
pos = InStr(1, startStrg, Chr$(0))
If pos Then
StripNulls = Mid$(startStrg, 1, pos - 1)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
End If
End Function
Private Function ODBCGetInstalledDrivers(lv As Control, _
sSectionName As String, _
inifile As String) As Long
'Loads the listview with the ODBC data contained in odbcinst.ini
'First, it calls GetPrivateProfileString to get all key
'name entries under sSectionName. It then loops, passing
'each key name to ppGetItemsInfo(), and the returned
'value is added to the listview.
Dim success As Long
Dim nBufferSize As Long
Dim sInstalled As String
Dim sDriverName As String
Dim sDriverFile As String
Dim sFileVersion As String
Dim ret As String
Dim itmx As ListItem
lv.ListItems.Clear
'call the API passing null as the parameter
'for the sDriverName parameter. This causes
'the API to return a list of all keys under
'that section. Pad the passed string large
'enough to hold the data.
ret = Space$(2048)
nBufferSize = Len(ret)
success = GetPrivateProfileString(sSectionName, _
vbNullString, "", ret, _
nBufferSize, inifile)
'The returned string is a null-separated
'list of key names, terminated by a pair
'of null characters. If the Get call was
'successful, success holds the length of the
'string in ret up to but not including
'that second terminating null. The
'ProfileGetKeyNameData function below extracts
'each key item using a null as a delimeter,
'so trim off one of the terminating nulls.
If success Then
'trim terminating null and trailing spaces
ret = Left$(ret, success)
'with the resulting string,
'extract each element
Do Until ret = ""
'strip off an item. The items correspond to
'the drivers under this section, so it will
'be added to the listview below
sDriverName = StripNulls(ret)
'pass sDriverName to a routine that returns
'the value associated with that key.
sInstalled = ProfileGetKeyNameData(sSectionName, sDriverName, inifile)
'the sDriverName is also the name of a corresponding
'section in the file with the driver info, so
'we need to retrieve the file & path associated
'with the "Driver=" key.
sDriverFile = Space$(MAX_PATH)
nBufferSize = Len(sDriverFile)
success = GetPrivateProfileString(sDriverName, _
"Driver", "", _
sDriverFile, _
nBufferSize, inifile)
If success Then
'we have the path and filename of the
'driver, so grab the file version and
'file internal name
sDriverFile = LCase$(Left$(sDriverFile, success))
sFileVersion = ODBCGetFileVersion(sDriverFile)
'got the data, so add it to the listview
Set itmx = lv.ListItems.Add(, sDriverName, sDriverName)
itmx.SubItems(1) = sDriverFile
itmx.SubItems(2) = sFileVersion
itmx.SubItems(3) = sInstalled
End If
Loop
End If
'return the number of items as an
'indicator of success
ODBCGetInstalledDrivers = lv.ListItems.Count
End Function
Private Function ODBCGetFileVersion(sDriverFile As String) As String
Dim FI As VS_FIXEDFILEINFO
Dim sBuffer() As Byte
Dim nBufferSize As Long
Dim lpBuffer As Long
Dim nVerSize As Long
Dim nUnused As Long
Dim tmpVer As String
'GetFileVersionInfoSize determines whether the operating
'system can obtain version information about a specified
'file. If version information is available, it returns
'the size in bytes of that information. As with other
'file installation functions, GetFileVersionInfoSize
'works only with Win32 file images.
'
'A empty variable must be passed as the second
'parameter, which the call returns 0 in.
nBufferSize = GetFileVersionInfoSize(sDriverFile, nUnused)
If nBufferSize > 0 Then
'create a buffer to receive file-version
'(FI) information.
ReDim sBuffer(nBufferSize)
Call GetFileVersionInfo(sDriverFile, 0&, nBufferSize, sBuffer(0))
'VerQueryValue function returns selected version info
'from the specified version-information resource. Grab
'the file info and copy it into the VS_FIXEDFILEINFO structure.
Call VerQueryValue(sBuffer(0), "\", lpBuffer, nVerSize)
Call CopyMemory(FI, ByVal lpBuffer, Len(FI))
'extract the file version from the FI structure
tmpVer = Format$(HiWord(FI.dwFileVersionMS)) & "." & _
Format$(LoWord(FI.dwFileVersionMS), "00") & "."
If FI.dwFileVersionLS > 0 Then
tmpVer = tmpVer & Format$(HiWord(FI.dwFileVersionLS), "00") & "." & _
Format$(LoWord(FI.dwFileVersionLS), "00")
Else
tmpVer = tmpVer & Format$(FI.dwFileVersionLS, "0000")
End If
End If
ODBCGetFileVersion = tmpVer
End Function
Private Function ODBCGetVersionFromDriverName(sODBCDriverName As String, _
inifile As String) As String
'takes a ODBC driver string and sDriverFileurns
'the driver version
Dim success As Long
Dim nBufferSize As Long
Dim sDriverFile As String
Dim sFileVersion As String
'call the API passing null as the parameter
'for the sDriverName parameter. This causes
'the API to sDriverFileurn a list of all keys under
'that section. Pad the passed string large
'enough to hold the data.
sDriverFile = Space$(MAX_PATH)
nBufferSize = Len(sDriverFile)
success = GetPrivateProfileString(sODBCDriverName, _
"Driver", "", sDriverFile, _
nBufferSize, inifile)
If success Then
'trim terminating null and trailing spaces
sDriverFile = Left$(sDriverFile, success)
'we have the path and filename of the
'driver, so grab the file version and
'file internal name
sDriverFile = LCase$(Left$(sDriverFile, success))
ODBCGetVersionFromDriverName = ODBCGetFileVersion(sDriverFile)
End If
End Function |