Attribute VB_Name = "scanpro"
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumDeviceDrivers Lib "psapi.dll" (ByRef lpidDev As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function GetDeviceDriverFileNameA Lib "psapi.dll" (ByVal devl As Long, ByVal DriverName As String, ByVal nSize As Long) As Long

Private Declare Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpImageFileName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Dim xs As Boolean
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
Function scanpw(ByVal dllpath As String, ByVal pflag As Long)
Dim pcb As Integer
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
Dim color As Long
dtc = 0
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
Dim sprocess As String
sprocess = ProcessIDs(i)

If pflag = 4 Then
Dim jclx As String * 4
jclx = "普通進(jìn)程"
If sprocess < 10 Then
jclx = "內(nèi)核進(jìn)程"
color = RGB(120, 120, 120)
GoTo jk:
End If
If InStr(GetRemoteParam(sprocess), "\") = 0 Then
   pname = GetPname(sprocess) & GetRemoteParam(sprocess)
   If InStr(pname, "\") = 0 Then color = RGB(255, 50, 50): jclx = "未知進(jìn)程" Else color = 0
   Else
   color = 0
   pname = GetRemoteParam(sprocess)
End If
'------------
h = InStr(pname, "\??\")
If h <> 0 Then
pname = right(pname, Len(pname) - 4)
End If
h = InStr(LCase(pname), LCase("\systemroot\")) <> 0
If h <> 0 Then
pname = right(pname, Len(pname) - 12)
pname = "C:\WINDOWS\" & pname
End If
'------------
If isPHide(sprocess) Then color = RGB(255, 0, 0): jclx = "隱藏進(jìn)程"
If isSysSer(sprocess) Then
color = RGB(100, 220, 100): jclx = "系統(tǒng)服務(wù)"
If isMSfile(scanpro.GetPname(sprocess)) = False Then
   color = RGB(0, 100, 200): jclx = "未知服務(wù)"
End If
End If

jk:
Call AddTextData(jclx & pname & " ->進(jìn)程ID:" & sprocess, color)
dtl = 0
End If
If pflag = 0 Then viru.SetDLL sprocess, dllpath
If pflag = 1 Then viru.UseRemoteFunction sprocess, dllpath, "InstallHook", Form1.hwnd, 4116
If pflag = 2 Then viru.UseRemoteFunction sprocess, dllpath, "InstallHook", Form1.hwnd, 4151
If pflag = 3 Then viru.RemoveDLL sprocess, dllpath
'-----4有了
If pflag = 5 Then
   ScanmodinAll sprocess, dllpath
End If

Next
End Function

Function scandeva()
Dim pcb As Integer
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumDeviceDrivers(ProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
Dim sprocess As String
sprocess = ProcessIDs(i)
'Form1.Caption = sprocess
If GetVerInfo.isMSfile(GetDmod(sprocess)) = True Then
AddTextData GetDmod(sprocess), 0
Else
AddTextData dqtext(GetDmod(sprocess), 600) & "  公司名稱:" & tmpCPN, RGB(255, 0, 0)
End If
'If pflag = 4 Then Form1.List1.AddItem GetRemoteParam(sprocess) & " ->進(jìn)程ID:" & sprocess
'If pflag = 0 Then viru.SetDLL sprocess, dllpath
'If pflag = 1 Then viru.UseRemoteFunction sprocess, dllpath, "InstallHook", Form1.hwnd, 4116
'If pflag = 2 Then viru.UseRemoteFunction sprocess, dllpath, "InstallHook", Form1.hwnd, 4151
'If pflag = 3 Then viru.RemoveDLL sprocess, dllpath
Next
End Function




Function ScanfuncFile(ByVal FuncAddr As Long) As String
'Form1.Caption = FuncAddr
Dim pcb As Integer
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumDeviceDrivers(ProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
Dim sprocess As String
sprocess = ProcessIDs(i)
'Form1.Caption = sprocess
fe = ptGetFileSize(GetDmod(sprocess)) + sprocess
'Form1.List1.AddItem sprocess & " - " & fe & "-FUN:" & FuncAddr
If FuncAddr > sprocess And FuncAddr < fe Then
   ScanfuncFile = GetDmod(sprocess)
   Exit Function
End If
Next
Exit Function
err01:
ScanfuncFile = GetDmod(sprocess)
End Function

Function GetPname(ByVal pid As Long) As String
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim hProcess As Long
Dim cbNeeded2 As Long
'If pid = 0 Or pid = 4 Then GetPname = "--系統(tǒng)內(nèi)核--": Exit Function
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProcess = 0 Then
GetPname = "--[無(wú)法分析]--"
Exit Function
End If
If hProcess <> 0 Then
lRet = EnumProcessModules(hProcess, Modules(1), 255, cbNeeded2)
If lRet <> 0 Then
ModuleName = Space(255)
nSize = 255
lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, 255)
Dim ppath As String
ppath = StrConv(ModuleName, Unicode)
GetPname = ppath
'Else
'Dim szName As String * 128
'GetProcessImageFileName hProcess, szName, 128
'ppath = StrConv(szName, Unicode)
'ppath = ppath & "--[無(wú)法分析]--"
'GetPname = ppath
End If
End If
CloseHandle hProcess
End Function

Function GetPmod(ByVal pid As Long)
Form1.List5.Clear
Form1.List5.AddItem "雙擊鼠標(biāo)左鍵分析DLL -單擊鼠標(biāo)右鍵關(guān)閉可疑DLL列表"
Form1.List5.Visible = True
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim hProcess As Long
Dim cbNeeded2 As Long
Dim tmppnm As String
tmppnm = GetPname(pid)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProcess <> 0 Then
lRet = EnumProcessModules(hProcess, Modules(1), 255, cbNeeded2)
If lRet <> 0 Then
ne = cbNeeded2 / 4
For o = 1 To ne
ModuleName = Space(255)
nSize = 255
lRet = GetModuleFileNameExA(hProcess, Modules(o), ModuleName, 255)
Dim ppath As String
ppath = StrConv(ModuleName, Unicode)
If o > 1 And tmppnm <> ppath Then
'------
If GetVerInfo.isMSfile(ppath) = False Then
Form1.List5.AddItem ppath
End If
'------
End If
Next o
End If
End If
CloseHandle hProcess
End Function

Function ScanmodinAll(ByVal pid As Long, ByVal fppath As String)
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
Dim hProcess As Long
Dim cbNeeded2 As Long
Dim tmppnm As String
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProcess <> 0 Then
lRet = EnumProcessModules(hProcess, Modules(1), 255, cbNeeded2)
If lRet <> 0 Then
ne = cbNeeded2 / 4
For o = 1 To ne
ModuleName = Space(255)
nSize = 255
lRet = GetModuleFileNameExA(hProcess, Modules(o), ModuleName, 255)
Dim ppath As String
ppath = StrConv(ModuleName, Unicode)
If o > 1 And tmppnm <> ppath Then
'------

If isMSfile(ppath) = False Then
'Form2.List1.AddItem ppath
   If ppath = fppath Then
      dtc = dtc + 1
      dlltype(dtc).text = GetPname(pid) & " ->進(jìn)程ID:" & pid
      dlltype(dtc).color = RGB(48, 127, 201)
   End If
End If
'------
End If
Next o
End If
End If
CloseHandle hProcess
End Function

Function GetDmod(ByVal pid As Long) As String
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String
ModuleName = Space(255)
nSize = 256
lRet = GetDeviceDriverFileNameA(pid, ModuleName, 256)
Dim ppath As String
ppath = StrConv(ModuleName, Unicode)
'------------
h = InStr(ppath, "\??\")
If h <> 0 Then
ppath = right(ppath, Len(ppath) - 4)
End If
h = InStr(LCase(ppath), LCase("\windows\")) <> 0
If h <> 0 And InStr(ppath, ":") = 0 Then
ppath = right(ppath, Len(ppath) - 9)
ppath = "C:\WINDOWS\" & ppath
End If
h = InStr(LCase(ppath), LCase("\systemroot\")) <> 0
If h <> 0 Then
ppath = right(ppath, Len(ppath) - 12)
ppath = "C:\WINDOWS\" & ppath
End If
h = InStr(LCase(ppath), ":")
If h = 0 Then
ppath = "C:\WINDOWS\system32\" & ppath
End If
'------------
GetDmod = ppath

End Function