*.NET (1194)

ASP (359)

Assembler (160)

C/C++ (2328)

ColdFusion (237)

Delphi (239)

Java (309)

Javascript (385)

mIRC Script (8119)

MySQL (95)

Other (3337)

Perl (179)

PHP (1124)

Python (58)

RealBASIC (26)

SQL (234)

TCL (382)

VisualBasic (1717)

Category:

VisualBasic

Title:

DLL/EXE File Information

Pasted:

11th of Feb at 16:22

Views:

35 so far

- Show with line numbers

Paste:

Private Declare Function GetLastError Lib "kernel32" () As Long Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const LANG_NEUTRAL = &H0 Const SUBLANG_DEFAULT = &H1 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 GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Type VS_FIXEDFILEINFO dwSignature As Long dwStrucVersion As Long dwFileVersionMS As Long dwFileVersionLS As Long dwProductVersionMS As Long dwProductVersionLS As Long dwFileFlagsMask As Long dwFileFlags As Long dwFileOS As Long dwFileType As Long dwFileSubtype As Long dwFileDateMS As Long dwFileDateLS As Long End Type Private Sub SwapByte(byte1 As Byte, byte2 As Byte) byte1 = byte1 Xor byte2 byte2 = byte1 Xor byte2 byte1 = byte1 Xor byte2 End Sub Private Function FixedHex(ByVal hexval As Long, ByVal nDigits As Long) As String FixedHex = Right("00000000" & Hex(hexval), nDigits) End Function Public Function GetFileInfo(FileName As String) As clsFileInfoType Dim vffi As VS_FIXEDFILEINFO Dim lSizeOf As Long Dim lResult As Long Dim lData As Long Dim bInfo() As Byte Dim strMsg As String Dim bLang(0 To 3) As Byte Dim sLang As String Set GetFileInfo = New clsFileInfoType lSizeOf = GetFileVersionInfoSize(FileName, lData) If lSizeOf Then 'strInfo = Space(lSizeOf) ReDim bInfo(0 To lSizeOf - 1) As Byte lResult = GetFileVersionInfo(FileName, lData, lSizeOf, bInfo(0)) If lResult > 0 Then lResult = VerQueryValue(bInfo(0), "\", lData, lSizeOf) CopyMemory vffi, ByVal lData, lSizeOf lResult = VerQueryValue(bInfo(0), "\VarFileInfo\Translation", lData, lSizeOf) CopyMemory bLang(0), ByVal lData, 4 SwapByte bLang(0), bLang(1) SwapByte bLang(2), bLang(3) 'bytes need to be re-arranged. sLang = LCase(FixedHex(bLang(0), 2) & FixedHex(bLang(1), 2) & FixedHex(bLang(2), 2) & FixedHex(bLang(3), 2)) 'QueryValue needs to be like : \StringFileInfo\040904b0\ProductName 'ProductName lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\Comments", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.Comments = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\CompanyName", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.CompanyName = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\FileDescription", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.FileDescription = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\FileVersion", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.FileVersion = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\InternalName", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.InternalName = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\LegalCopyright", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.LegalCopyright = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\LegalTrademarks", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.LegalTrademarks = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\OriginalFilename", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.OriginalFilename = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\PrivateBuild", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.PrivateBuild = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\ProductName", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.ProductName = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\ProductVersion", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.ProductVersion = Split(strMsg, "")(0) End If lResult = VerQueryValue(bInfo(0), "\StringFileInfo\" & sLang & "\SpecialBuild", lData, lSizeOf) If lSizeOf > 0 Then strMsg = Space(lSizeOf) lResult = lstrcpy(strMsg, lData) GetFileInfo.SpecialBuild = Split(strMsg, "")(0) End If Else strMsg = Space(200) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, LANG_NEUTRAL, strMsg, 200, ByVal 0& MsgBox strMsg End If End If End Function --------------------------------clsFileInfoType.cls--------------------------------- Public CompanyName As String Public FileDescription As String Public FileVersion As String Public InternalName As String Public LegalCopyright As String Public OriginalFilename As String Public ProductName As String Public ProductVersion As String Public Comments As String Public LegalTrademarks As String Public PrivateBuild As String Public SpecialBuild As String