dll checker 1

[EscapeUK]

need a bit of code wheere i can type in a the name of a dll, ocx or tlb file. Then returns the version number, date created/modified and file location.

ta

 

[paulbent]

Put this code in a bas module, you also need a reference to Microsoft Scripting Runtime. I've cut and pasted this from various places in a large project, hope it hangs together:

'Miscellaneous strings used in the app
Public Const PATH_SEP = "\" 'Path separator in a filename

'Stores attributes of an exe or dll
Public Type DLL_ATTRIB
    strCompany As String      'Company name
    strCreated As String      'Date created
    strLastAccessed As String 'Date last accessed
    strModified As String     'Date last modified
    strFileDesc As String     'File description
    strFileVer As String      'File version
    strIntName As String      'Internal name
    strCopyright As String    'Legal copyright
    strOrigName As String     'Original filename
    strProdName As String     'Product name
    strProdVer As String      'Product version
    strSize As String         'File size in bytes
End Type

Public Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long

Public 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

Public Declare Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" _
(ByVal lptstrFilename As String, _
lpdwHandle As Long) As Long

Public Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" _
(pBlock As Any, _
ByVal lpSubBlock As String, _
lplpBuffer As Any, _
puLen As Long) As Long

Public Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dest As Any, _
ByVal Source As Long, _
ByVal Length As Long)

Public Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As Long) As Long
'_________________________
Public Function fStripNulls(ByVal strIn As String) As String

    '--- Given a null terminated string, removes the null
    '    char and any chars to the right
    '    Returns the string stripped of nulls
    
    If InStr(1, strIn, Chr$(0)) > 0 Then
        strIn = Left$(strIn, InStr(1, strIn, Chr$(0)) - 1)
    Else
        strIn = vbNullString
    End If

    'Return value
    fStripNulls = strIn

End Function
'_________________________________
Public Function fGetVersionInfo(ByVal strFile As String) As DLL_ATTRIB

    '--- Given the filename of an exe or dll, retrieves file
    '     attributes and returns them in a udt
    
    Dim objFSO As FileSystemObject     'WSH FileSystem object to get version etc
    Dim objFile As File      'WSH File object
    Dim lngRtn As Long       'API function return value
    Dim lngHandle As Long    'Not used, set to 0 by GetFileVersionInfoSize
    Dim lngBufferLen As Long 'Length of string buffer
    Dim lngVerPtr As Long    'Pointer to version info
    Dim lngHex As Long       'Buffer for values to be converted to hex string
    Dim strTmp1 As String    'Temp string buffer
    Dim strTmp2 As String    'Temp string buffer
    Dim strTmp3 As String    'Temp string buffer
    Dim strLangCharset As String  'Language and code page hex identifier
    Dim abytTmp1() As Byte    'Temp byte array buffer
    Dim abytTmp2() As Byte    'Temp byte array buffer
    
    'If the passed in filename doesn't contain
    'the full path, try it as a system file
    If InStr(1, strFile, PATH_SEP) = 0 Then
        strTmp1 = String(255, "0")
         lngRtn = GetSystemDirectory(strTmp1, Len(strTmp1))
         strFile = fStripNulls(strTmp1) & PATH_SEP & strFile
    End If
    'Get size of version resource
    lngBufferLen = GetFileVersionInfoSize(strFile, lngHandle)
    If lngBufferLen < 1 Then
        'No Version Info available
        Exit Function
    End If
    
    'Size the byte array
    ReDim abytTmp1(lngBufferLen)
    'Retrieve the version info into the byte array
    lngRtn = GetFileVersionInfo(strFile, _
    CLng(0), lngBufferLen, abytTmp1(0))
    If lngRtn = 0 Then
        'GetFileVersionInfo failed
        Exit Function
    End If
    
    'Query the byte buffer for language id & code page
    lngRtn = VerQueryValue(abytTmp1(0), _
    &quot;\VarFileInfo\Translation&quot;, lngVerPtr, lngBufferLen)
    If lngRtn = 0 Then
        'VerQueryValue failed
        Exit Function
    End If
    
    'lngVerPtr is a pointer to four 4 bytes of Hex number,
    'first two bytes are language id, and last two bytes are code
    'page. However, Lang_Charset_String needs a  string of
    '4 hex digits, the first two characters correspond to the
    'language id and last two the last two character correspond
    'to the code page id.
    'now we change the order of the language id and code page
    'and convert it into a string representation.
    'For example, it may look like 040904E4
    'Or to pull it all apart:
    '04------        = SUBLANG_ENGLISH_USA
    '--09----        = LANG_ENGLISH
    ' ----04E4 = 1252 = Codepage for Windows:Multilingual
    ReDim abytTmp2(255)
    MoveMemory abytTmp2(0), lngVerPtr, lngBufferLen
    lngHex = abytTmp2(2) + abytTmp2(3) * &H100 + _
    abytTmp2(0) * &H10000 + abytTmp2(1) * &H1000000
    strLangCharset = Hex$(lngHex)
    'Zero fill from left to length 8
    Do While Len(strLangCharset) < 8
            strLangCharset = &quot;0&quot; & strLangCharset
    Loop

    'Get each piece of information and return it
    'Company name
    fGetVersionInfo.strCompany = fQueryVersionInfo(strLangCharset, _
    &quot;CompanyName&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'File description
    fGetVersionInfo.strFileDesc = fQueryVersionInfo(strLangCharset, _
    &quot;FileDescription&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'File version
    fGetVersionInfo.strFileVer = fQueryVersionInfo(strLangCharset, _
    &quot;FileVersion&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'Internal name
    fGetVersionInfo.strIntName = fQueryVersionInfo(strLangCharset, _
    &quot;InternalName&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'Copyright
    fGetVersionInfo.strCopyright = fQueryVersionInfo(strLangCharset, _
    &quot;LegalCopyright&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'Original filename
    fGetVersionInfo.strOrigName = fQueryVersionInfo(strLangCharset, _
    &quot;OriginalFileName&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'Product name
    fGetVersionInfo.strProdName = fQueryVersionInfo(strLangCharset, _
    &quot;ProductName&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    'Product version
    fGetVersionInfo.strProdVer = fQueryVersionInfo(strLangCharset, _
    &quot;ProductVersion&quot;, lngVerPtr, lngBufferLen, abytTmp1)
    
    '*** Problem with W98 ***
    'Testing on W98, the File object's DateCreated property
    'returns an &quot;application or object error&quot; (according to a
    'watch on objFile) for a few system files. When the property
    'is read, VB raises run-time error 5, illegal function call
    'Tried to use the GetFileTime API but it needs a handle to
    'the file and CreateFile wouldn't open these system files,
    'like Kernel32.dll, on W98
    'Both methods work fine for all system files on XP
    'Have to workaround the W98 issue with Resume Next
        
    'Return some file attributes from the WSH File object
    Set objFSO = New FileSystemObject
    Set objFile = objFSO.GetFile(strFile)
    'Handle unexpected W98 errors
    On Error GoTo LocalErr
    With objFile
        'Date created
        'Buffer the date created in case an error is raised
        strTmp3 = .DateCreated
        fGetVersionInfo.strCreated = strTmp3
        'Date last accessed
        fGetVersionInfo.strLastAccessed = .DateLastAccessed
        'Date last modified
        fGetVersionInfo.strModified = .DateLastModified
        'File size
        fGetVersionInfo.strSize = .Size
    End With
    
    GoTo ExitFunc

LocalErr:
    Select Case Err.Number
    Case 5
        'Workaround W98 problem
        'Return unknown for the creation date
        strTmp3 = &quot;(unknown)&quot;
        Resume Next
    Case Else
        'Release object references
        Set objFile = Nothing
        Set objFSO = Nothing
        'Turn off the local handler
        On Error GoTo 0
        'Pass the error up the call stack
        Err.Raise Err.Number, , Err.Description
    End Select
        
ExitFunc:
    'Release object references
    Set objFile = Nothing
    Set objFSO = Nothing
   
End Function
[code]

Paul Bent
Northwind IT Systems
[URL unfurl="true"]http://www.northwindit.co.uk[/URL]