scanpro.bas

葡萄木马防火墙

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 = "普通进程"
If sprocess < 10 Then
jclx = "内核进程"
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 = "未知进程" 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 = "隐藏进程"
If isSysSer(sprocess) Then
color = RGB(100, 220, 100): jclx = "系统服务"
If isMSfile(scanpro.GetPname(sprocess)) = False Then
   color = RGB(0, 100, 200): jclx = "未知服务"
End If
End If

jk:
Call AddTextData(jclx & pname & " ->进程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) & " ->进程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 = "--系统内核--": Exit Function
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProcess = 0 Then
GetPname = "--[无法分析]--"
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 & "--[无法分析]--"
'GetPname = ppath
End If
End If
CloseHandle hProcess
End Function

Function GetPmod(ByVal pid As Long)
Form1.List5.Clear
Form1.List5.AddItem "双击鼠标左键分析DLL -单击鼠标右键关闭可疑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) & " ->进程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