getverinfo.bas

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

Attribute VB_Name = "GetVerInfo"
Option Explicit
  Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
  Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
    
  Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
    
  Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
    
  Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
    
  Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
    
  Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
  Public tmpCPN As String
  'Functions:
  Public Function StringFromBuffer(buffer As String) As String
          Dim nPos     As Long
    
          nPos = InStr(buffer, vbNullChar)
          If nPos > 0 Then
                  StringFromBuffer = left$(buffer, nPos - 1)
          Else
                  StringFromBuffer = buffer
          End If
  End Function
    
  Public Function GetFileVersion(ByVal sFile As String) As String
          Dim lVerSize     As Long
          Dim lTemp     As Long
          Dim lRet     As Long
          Dim bInfo()     As Byte
          Dim lpBuffer     As Long
          Dim sDesc     As String
          Dim sKEY     As String
    
          lVerSize = GetFileVersionInfoSize(sFile, lTemp)
          If lVerSize = 0 Then GetFileVersion = "": Exit Function
          ReDim bInfo(lVerSize)
          If lVerSize > 0 Then
          lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
                  If lRet <> 0 Then
                          sKEY = GetNLSKey(bInfo)
                          lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\CompanyName", lpBuffer, lVerSize)
                          If lRet <> 0 Then
                                  sDesc = Space$(lVerSize)
                                  lstrcpyn sDesc, lpBuffer, lVerSize
                                  GetFileVersion = StringFromBuffer(sDesc)
                          End If
                  End If
          End If
  End Function
    
  Public Function GetNLSKey(byteVerData() As Byte) As String
          Static strLANGCP     As String
          Dim lpBufPtr     As Long
          Dim strNLSKey     As String
          Dim fGotNLSKey     As Integer
          Dim intOffset     As Integer
          Dim lVerSize     As Long
          Dim lTmp     As Long
          Dim lBufLen     As Long
          Dim lLCID     As Long
          Dim strTmp     As String
    
          On Error GoTo GNLSKCleanup
          If VerQueryValue(VarPtr(byteVerData(0)), "\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
                  If Len(strLANGCP) = 0 Then
                          lLCID = GetUserDefaultLCID()
                          If lLCID > 0 Then
                                  strTmp = Space$(8)
                                  GetLocaleInfoA lLCID, 11, strTmp, 8
                                  strLANGCP = StringFromBuffer(strTmp)
                                  Do While Len(strLANGCP) < 4
                                          strLANGCP = "0" & strLANGCP
                                  Loop
                                  GetLocaleInfoA lLCID, 9, strTmp, 8
                                  strLANGCP = StringFromBuffer(strTmp) & strLANGCP
                                  Do While Len(strLANGCP) < 8
                                          strLANGCP = "0" & strLANGCP
                                  Loop
                          End If
                  End If
                  If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then
                          strNLSKey = strLANGCP
                          
                  Else
                          For intOffset = 0 To lVerSize - 1 Step 4
                                  CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
                                  strTmp = Hex$(lTmp)
                                  Do While Len(strTmp) < 8
                                          strTmp = "0" & strTmp
                                  Loop
                                  strNLSKey = "\StringFileInfo\" & right$(strTmp, 4) & left$(strTmp, 4)
                                  'MsgBox strNLSKey
                                  If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
                                          fGotNLSKey = True
                                          Exit For
                                  End If
                          Next
                          If Not fGotNLSKey Then
                                  strNLSKey = "\StringFileInfo\040904E4"
                                  If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
                                          fGotNLSKey = True
                                  End If
                          End If
                  End If
          End If
GNLSKCleanup:
          If fGotNLSKey Then
                  GetNLSKey = strNLSKey
                  'MsgBox GetNLSKey
          End If
  End Function
    

Public Function isMSfile(path As String) As Boolean
Dim mss As String

mss = LCase("Microsoft Corporation")
Dim msm As String
tmpCPN = GetFileVersion(path)
msm = LCase(tmpCPN)
If mss = msm Then isMSfile = True Else isMSfile = False
End Function