mdlprocess.bas

一款比较专业

    buffer = String(255, 0)
    GetFileTitle sFileName, buffer, Len(buffer)
    buffer = StripNulls(buffer)
    GetFileName = buffer
End Function

Public Function GetSizeOfFile(ByVal PathFile As String) As Long
    Dim hFile As Long, OFS As OFSTRUCT
    hFile = OpenFile(PathFile, OFS, 0)
    GetSizeOfFile = GetFileSize(hFile, 0)
    Call CloseHandle(hFile)
End Function

Public Function GetMemory(ProcessID As Long) As String
    On Error Resume Next
    Dim byteSize As Double, hProcess As Long, ProcMem As PROCESS_MEMORY_COUNTERS
    ProcMem.cb = LenB(ProcMem)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessID)
    If hProcess <= 0 Then GetMemory = "N/A": Exit Function
    GetProcessMemoryInfo hProcess, ProcMem, ProcMem.cb
    byteSize = ProcMem.WorkingSetSize
    GetMemory = byteSize
    Call CloseHandle(hProcess)
End Function

Private Function GetLongPath(ByVal ShortPath As String) As String
    Dim lngRet As Long
    GetLongPath = String$(MAX_PATH, vbNullChar)
    lngRet = GetLongPathName(ShortPath, GetLongPath, Len(GetLongPath))
    If lngRet > Len(GetLongPath) Then
        GetLongPath = String$(lngRet, vbNullChar)
        lngRet = GetLongPathName(ShortPath, GetLongPath, lngRet)
    End If
    If Not lngRet = 0 Then GetLongPath = Left$(GetLongPath, lngRet)
End Function

Public Function GetVerHeader(ByVal fPN$, ByRef oFP As VERHEADER)
    Dim lngBufferlen&, lngDummy&, lngRc&, lngVerPointer&, lngHexNumber&, i%
    Dim bytBuffer() As Byte, bytBuff(255) As Byte, strBuffer$, strLangCharset$, _
        strVersionInfo(11) As String, strTemp$
    If Dir(fPN$, vbHidden + vbArchive + vbNormal + vbReadOnly + vbSystem) = "" Then
        With oFP
            .CompanyName = "The file """ & GetShortPath(fPN) & """ N/A"
            .FileDescription = "The file """ & GetShortPath(fPN) & """ N/A"
            .FileVersion = "The file """ & GetShortPath(fPN) & """ N/A"
            .InternalName = "The file """ & GetShortPath(fPN) & """ N/A"
            .LegalCopyright = "The file """ & GetShortPath(fPN) & """ N/A"
            .OrigionalFileName = "The file """ & GetShortPath(fPN) & """ N/A"
            .ProductName = "The file """ & GetShortPath(fPN) & """ N/A"
            .ProductVersion = "The file """ & GetShortPath(fPN) & """ N/A"
            .Comments = "The file """ & GetShortPath(fPN) & """ N/A"
            .LegalTradeMarks = "The file """ & GetShortPath(fPN) & """ N/A"
            .PrivateBuild = "The file """ & GetShortPath(fPN) & """ N/A"
            .SpecialBuild = "The file """ & GetShortPath(fPN) & """ N/A"
        End With
        Exit Function
    End If
    lngBufferlen = GetFileVersionInfoSize(fPN$, 0)
    If lngBufferlen > 0 Then
        ReDim bytBuffer(lngBufferlen)
        lngRc = GetFileVersionInfo(fPN$, 0&, lngBufferlen, bytBuffer(0))
        If lngRc <> 0 Then
            lngRc = VerQueryValue(bytBuffer(0), "\VarFileInfo\Translation", _
                lngVerPointer, lngBufferlen)
            If lngRc <> 0 Then
                MoveMemory bytBuff(0), lngVerPointer, lngBufferlen
                lngHexNumber = bytBuff(2) + bytBuff(3) * &H100 + bytBuff(0) * _
                    &H10000 + bytBuff(1) * &H1000000
                strLangCharset = Hex(lngHexNumber)
                Do While Len(strLangCharset) < 8
                    strLangCharset = "0" & strLangCharset
                Loop
                strVersionInfo(0) = "CompanyName"
                strVersionInfo(1) = "FileDescription"
                strVersionInfo(2) = "FileVersion"
                strVersionInfo(3) = "InternalName"
                strVersionInfo(4) = "LegalCopyright"
                strVersionInfo(5) = "OriginalFileName"
                strVersionInfo(6) = "ProductName"
                strVersionInfo(7) = "ProductVersion"
                strVersionInfo(8) = "Comments"
                strVersionInfo(9) = "LegalTrademarks"
                strVersionInfo(10) = "PrivateBuild"
                strVersionInfo(11) = "SpecialBuild"
                For i = 0 To 11
                    strBuffer = String$(255, 0)
                    strTemp = "\StringFileInfo\" & strLangCharset & "\" & _
                        strVersionInfo(i)
                    lngRc = VerQueryValue(bytBuffer(0), strTemp, lngVerPointer, _
                        lngBufferlen)
                    If lngRc <> 0 Then
                        lstrcpy strBuffer, lngVerPointer
                        strBuffer = Mid$(strBuffer, 1, InStr(strBuffer, Chr(0)) - 1)
                        strVersionInfo(i) = strBuffer
                    Else
                        strVersionInfo(i) = ""
                    End If
                Next i
            End If
        End If
    End If
    For i = 0 To 11
        If Trim(strVersionInfo(i)) = "" Then strVersionInfo(i) = ""
    Next i
    With oFP
        .CompanyName = strVersionInfo(0)
        .FileDescription = strVersionInfo(1)
        .FileVersion = strVersionInfo(2)
        .InternalName = strVersionInfo(3)
        .LegalCopyright = strVersionInfo(4)
        .OrigionalFileName = strVersionInfo(5)
        .ProductName = strVersionInfo(6)
        .ProductVersion = strVersionInfo(7)
        .Comments = strVersionInfo(8)
        .LegalTradeMarks = strVersionInfo(9)
        .PrivateBuild = strVersionInfo(10)
        .SpecialBuild = strVersionInfo(11)
    End With
End Function

Private Function GetShortPath(ByVal strFileName As String) As String
    Dim lngRet As Long
    GetShortPath = String$(MAX_PATH, vbNullChar)
    lngRet = GetShortPathNameA(strFileName, GetShortPath, MAX_PATH)
    If Not lngRet = 0 Then GetShortPath = Left$(GetShortPath, lngRet)
End Function

Public Function GetModuleProcessID(lvwProc As ListView, _
    ItemProcID As Integer, lvwModule As ListView, ilsModule As ImageList) As Long
    On Error Resume Next
    Dim ExePath As String
    Dim uProcess As MODULEENTRY32
    Dim hSnapShot As Long
    Dim hPID As Long
    Dim lMod As Long
    Dim intLVW As Integer
    Dim i As Integer
    Dim lvwItem As ListItem
    Dim hVer As VERHEADER
    hPID = lvwProc.SelectedItem.SubItems(ItemProcID)
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, hPID)
    uProcess.dwSize = Len(uProcess)
    lMod = Module32First(hSnapShot, uProcess)
    lvwModule.ListItems.Clear
    ilsModule.ListImages.Clear
    i = 0
    Do While lMod
        i = i + 1
        ExePath = StripNulls(uProcess.szExePath)
        GetVerHeader ExePath, hVer
        ilsModule.ListImages.Add i, , GetIco.Icon(ExePath, SmallIcon)
        Set lvwItem = lvwModule.ListItems.Add(, , GetLongPath(ExePath), , i)
        With lvwItem
            .SubItems(1) = hVer.FileDescription
            .SubItems(2) = GetPathType(ExePath)
            .SubItems(3) = hVer.FileVersion
        End With
        lMod = Module32Next(hSnapShot, uProcess)
    Loop
    Call CloseHandle(hSnapShot)
    For intLVW = 1 To lvwModule.ColumnHeaders.Count
        LV_AutoSizeColumn lvwModule, lvwModule.ColumnHeaders.Item(intLVW)
    Next intLVW
End Function

Sub ScanProcess(showMode As Boolean)
    On Error Resume Next
    Dim ExePath As String
    Dim hProcSnap As Long, hModuleSnap As Long, _
        lProc As Long
    Dim uProcess As PROCESSENTRY32, _
        uModule As MODULEENTRY32
    Dim hPID As Long, hExitCode As Long
    ExePath = String$(128, Chr$(0))
    hProcSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    lProc = Process32First(hProcSnap, uProcess)
    Do While lProc
        If uProcess.th32ProcessID <> 0 Then
            hModuleSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, _
                uProcess.th32ProcessID)
            uModule.dwSize = Len(uModule)
            Module32First hModuleSnap, uModule
            If hModuleSnap > 0 Then
                DoEvents
                Sleep 10
                ExePath = StripNulls(uModule.szExePath)
                If showMode = True Then
                    frmMain.lblScan.Caption = GetLongPath(ExePath)
                    nMemory = nMemory + 1
                End If
                If IsVirus(ExePath) Then
                    hPID = OpenProcess(1&, -1&, uProcess.th32ProcessID)
                    hExitCode = TerminateProcess(hPID, 0&)
                    Call CloseHandle(hPID)
                End If
            End If
        End If
        lProc = Process32Next(hProcSnap, uProcess)
    Loop
    Call CloseHandle(hProcSnap)
End Sub

Public Function GetAppID() As Long
    GetAppID = GetCurrentProcessId
End Function

Public Sub TerminateVirusProcess(strFileName As String)
    On Error Resume Next
    Dim ExePath As String
    Dim hProcSnap As Long, hModuleSnap As Long, _
        lProc As Long
    Dim uProcess As PROCESSENTRY32, _
        uModule As MODULEENTRY32
    Dim hPID As Long, hExitCode As Long
    ExePath = String$(128, Chr$(0))
    hProcSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    lProc = Process32First(hProcSnap, uProcess)
    Do While lProc
        If uProcess.th32ProcessID <> 0 Then
            hModuleSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, _
                uProcess.th32ProcessID)
            uModule.dwSize = Len(uModule)
            Module32First hModuleSnap, uModule
            If hModuleSnap > 0 Then
                ExePath = StripNulls(uModule.szExePath)
                If ExePath = strFileName Then
                    hPID = OpenProcess(1&, -1&, uProcess.th32ProcessID)
                    hExitCode = TerminateProcess(hPID, 0&)
                    Call CloseHandle(hPID)
                End If
            End If
        End If
        lProc = Process32Next(hProcSnap, uProcess)
    Loop
    Call CloseHandle(hProcSnap)
End Sub