viru.bas

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

Attribute VB_Name = "viru"
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As String, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function AddSer Lib "pttd.dll" (void As Long) As Long
Public Declare Function DelDDvr Lib "pttd.dll" Alias "DelSvr" (ByVal StrPtr As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Type ssdt
bp As Long
tidx As Integer
End Type
Public rSSDT As ssdt
Public Declare Function ptGetSSDT Lib "pttd.dll" Alias "GetSSDT" (sss As Long) As Long
Private Const INFINITE = &HFFFFFFFF
Private Const PROCESS_VM_READ = &H10
Private Const TH32CS_SNAPPROCESS = &H2
Private Const MEM_COMMIT = 4096
Private Const PAGE_READWRITE = 4
Private Const PROCESS_CREATE_THREAD = (&H2)
Private Const PROCESS_VM_OPERATION = (&H8)
Public Const PROCESS_VM_WRITE = (&H20)
Private Const MEM_RELEASE = &H8000
Private Const MEM_DECOMMIT = &H4000
Dim isAddDll As Boolean

Public Function GetSSDTData(ByVal pid As Long, ByVal ValRef As Long) As Long
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
If ph = 0 Then GetSSDTData = 0: 'Exit Function
Dim buffpt As Long
ReadProcessMemory ph, ByVal ValRef, buffpt, 8, 0&
'If buffpt(0) = "" Then buffpt(0) = "读取失败"
GetSSDTData = buffpt
CloseHandle ph
End Function

Public Function GetRemoteData(ByVal pid As Long, ByVal ValRef As Long) As String
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
If ph = 0 Then GetRemoteData = "读取失败": 'Exit Function
Dim buffpt(255) As Byte
ReadProcessMemory ph, ByVal ValRef, buffpt(0), 255, 0&
'If buffpt(0) = "" Then buffpt(0) = "读取失败"
GetRemoteData = buffpt
CloseHandle ph
End Function
Public Function SetDLL(ByVal pid As Long, ByVal dllpath As String) As Boolean
'On Error GoTo err01:
Dim ph As Long
'Form1.List1.AddItem pid

ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
'Form1.List1.AddItem "进程操作ID -插入" & ph
'If pid = exp Then Form1.List1.AddItem "进程操作ID -插入" & ph
If ph = 0 Then
Dim nPn As String
nPn = scanpro.GetPname(pid)
'If pid = exp Then Form1.List1.AddItem "进程监控: " & nPn & " -失败"
GoTo err01:
End If
'-
Dim dwSize As Long
lpszdll = dllpath
dwSize = lstrlen(lpszdll) + 1
'If pid = exp Then Form1.List1.AddItem "参数" & lpszdll
'If pid = exp Then Form1.List1.AddItem "参数长度" & dwSize
Dim nMa As Long
nMa = VirtualAllocEx(ph, 0, dwSize, MEM_COMMIT, PAGE_READWRITE)

'If pid = exp Then Form1.List1.AddItem "远程进程新申请内存地址入口" & nMa
If nMa = 0 Then GoTo err01
'-
Dim dwWritten As Long
If WriteProcessMemory(ph, nMa, lpszdll, dwSize, dwWritten) Then
   If dwWritten <> dwSize Then
   VirtualFreeEx ph, nMa, dwSize, MEM_COMMIT
    GoTo err01
   End If
Else
GoTo err01
End If
'-

Dim lbd As Long
lbd = GetProcAddress(GetModuleHandle("kernel32"), "LoadLibraryA")
'If pid = exp Then
'Form1.List1.AddItem "LoadLibrary地址入口" & lbd
'hfa = StrConv(GetRemoteData(pid, nMa), vbUnicode)
'Form1.List1.AddItem "远程参数效验:" & hfa
'End If
Dim nCRTid As Long
hThread = CreateRemoteThread(ph, 0, 0, lbd, nMa, 0, nCRTid)
'If pid = exp Then Form1.List1.AddItem "远程进程创建返回值" & hThread
WaitForSingleObject hThread, INFINITE
VirtualFreeEx ph, nMa, dwSize, MEM_RELEASE
CloseHandle hThread
'-
CloseHandle ph
SetDLL = True
Exit Function
err01:

CloseHandle ph
SetDLL = False
End Function

Public Function UseRemoteFunction(ByVal pid As Long, ByVal FunctionForDll As String, ByVal FunctionName As String, ByVal FunctionParam As String, ByVal FPY As Long) As Boolean
'isAddDll = False
Dim Buff() As Byte
'On Error GoTo err01:
Dim ph As Long
'--------------------------
'Form1.List1.AddItem pid
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
'Form1.List1.AddItem "进程操作ID -启动" & ph
If ph = 0 Then GoTo err01: MsgBox "打开进程1 -失败"
'-
Dim dwSize As Long
lpszdll = FunctionForDll
dwSize = lstrlen(lpszdll) + 1
'Form1.List1.AddItem "参数" & lpszdll
'Form1.List1.AddItem "参数长度" & dwSize
Dim nMa As Long
nMa = VirtualAllocEx(ph, 0, dwSize, MEM_COMMIT, PAGE_READWRITE)
'Form1.List1.AddItem "远程进程新申请内存地址入口" & Hex(nMa)
If nMa = 0 Then GoTo err01: MsgBox "申请内存1 -失败"
'-
Dim dwWritten As Long
If WriteProcessMemory(ph, nMa, lpszdll, dwSize, dwWritten) Then
   If dwWritten <> dwSize Then
   VirtualFreeEx ph, nMa, dwSize, MEM_COMMIT
    GoTo err01
   End If
Else
GoTo err01
MsgBox "写参数1 -失败"
End If
'-
Dim fbd As Long
ru:
fbd = GetProcAddress(GetModuleHandle("kernel32"), "GetModuleHandleA")
'Form1.List1.AddItem "GetModuleHandleA地址入口" & Hex(fbd)
Dim nCRTid As Long
hThread = CreateRemoteThread(ph, 0, 0, fbd, nMa, 0, nCRTid)
WaitForSingleObject hThread, INFINITE
GetExitCodeThread hThread, dwhandle
'Form1.List1.AddItem FunctionForDll & "在远程进程中模块句柄" & Hex(dwhandle)
VirtualFreeEx ph, nMa, dwSize, MEM_RELEASE
CloseHandle hThread
'---------函数地址[远]-----
'Dim ih As Long
If dwhandle = 0 Then
GoTo err01
MsgBox "获得返回值 -失败"
End If
'ih = dwhandle + 4111 'InstallHook函数的地址
ih = dwhandle + FPY
'---------参数存放[变量重用]
lpszdll = FunctionParam
dwSize = lstrlen(lpszdll) + 1
'Form1.List1.AddItem "参数2" & lpszdll
'Form1.List1.AddItem "参数2长度" & dwSize
nMa = VirtualAllocEx(ph, 0, dwSize, MEM_COMMIT, PAGE_READWRITE)
'Form1.List1.AddItem "远程进程新申请内存地址入口2" & Hex(nMa)
If nMa = 0 Then GoTo err01: MsgBox "申请内存2 -失败"
'-
If WriteProcessMemory(ph, nMa, lpszdll, dwSize, dwWritten) Then
   If dwWritten <> dwSize Then
   VirtualFreeEx ph, nMa, dwSize, MEM_COMMIT
    GoTo err01
   End If
Else
GoTo err01
  MsgBox "写参数2 -失败"
End If
'--------------------------
hThread = CreateRemoteThread(ph, 0, 0, ih, nMa, 0, nCRTid)
WaitForSingleObject hThread, INFINITE
VirtualFreeEx ph, nMa, dwSize, MEM_RELEASE
CloseHandle hThread
'--------------------------
CloseHandle ph
UseRemoteFunction = True
Exit Function
err01:
CloseHandle ph
UseRemoteFunction = False
End Function

Public Function RemoveDLL(ByVal pid As Long, ByVal dllpath As String) As Boolean
On Error GoTo err01:
Dim ph As Long
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
'Form1.List1.AddItem "进程操作ID" & ph
If ph = 0 Then GoTo err01
'-
Dim dwSize As Long
lpszdll = dllpath
dwSize = lstrlen(lpszdll) + 1
'Form1.List1.AddItem "参数" & lpszdll
'Form1.List1.AddItem "参数长度" & dwSize
Dim nMa As Long
nMa = VirtualAllocEx(ph, 0, dwSize, MEM_COMMIT, PAGE_READWRITE)
'Form1.List1.AddItem "远程进程新申请内存地址入口" & nMa
'If nMa = 0 Then MsgBox "进程操作失败 -步骤2", 16: GoTo err01
'-
Dim dwWritten As Long
If WriteProcessMemory(ph, nMa, lpszdll, dwSize, dwWritten) Then
   If dwWritten <> dwSize Then
   VirtualFreeEx ph, nMa, dwSize, MEM_COMMIT
   GoTo err01
   End If
Else

GoTo err01
End If
'-
Dim lbd As Long
lbd = GetProcAddress(GetModuleHandle("kernel32"), "GetModuleHandleA")
'Form1.List1.AddItem "GetModuleHandle地址入口" & lbd
Dim nCRTid As Long
hThread = CreateRemoteThread(ph, 0, 0, lbd, nMa, 0, nCRTid)
'Form1.List1.AddItem "远程进程创建返回值" & hThread
WaitForSingleObject hThread, INFINITE
Dim dwhandle As Long
GetExitCodeThread hThread, dwhandle
'Form1.List1.AddItem "DLL模块返回值" & dwhandle
VirtualFreeEx ph, nMa, dwSize, MEM_RELEASE
CloseHandle hThread
'-
Dim fbd As Long
fbd = GetProcAddress(GetModuleHandle("kernel32"), "FreeLibrary")
hThread = CreateRemoteThread(ph, 0, 0, fbd, dwhandle, 0, nCRTid2)
WaitForSingleObject hThread, INFINITE
CloseHandle hThread
'-
CloseHandle ph
RemoveDLL = True
Exit Function
err01:
CloseHandle ph
RemoveDLL = False
End Function

Public Function GetRemoteParam(ByVal pid As Long) As String
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
If ph = 0 Then Exit Function
'-----------
fbd = GetProcAddress(GetModuleHandle("kernel32"), "GetCommandLineW")
Dim nCRTid As Long
hThread = CreateRemoteThread(ph, 0, 0, fbd, 0, 0, nCRTid)
WaitForSingleObject hThread, INFINITE
GetExitCodeThread hThread, dwhandle
tmp1 = GetRemoteData(pid, dwhandle)
i = InStrRev(tmp1, "\")
If i <> 0 Then
GetRemoteParam = StrConv(tmp1, Unicode)
Else
GetRemoteParam = GetPname(pid)
End If
'-----------
CloseHandle ph
End Function

Public Function ishaveDLL(ByVal pid As Long, ByVal dllpath As String) As Boolean
On Error GoTo err01:
Dim ph As Long
ph = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, pid)
'Form1.List1.AddItem "进程操作ID" & ph
If ph = 0 Then GoTo err01
'-
Dim dwSize As Long
lpszdll = dllpath
dwSize = lstrlen(lpszdll) + 1
'Form1.List1.AddItem "参数" & lpszdll
'Form1.List1.AddItem "参数长度" & dwSize
Dim nMa As Long
nMa = VirtualAllocEx(ph, 0, dwSize, MEM_COMMIT, PAGE_READWRITE)
'Form1.List1.AddItem "远程进程新申请内存地址入口" & nMa
'If nMa = 0 Then MsgBox "进程操作失败 -步骤2", 16: GoTo err01
'-
Dim dwWritten As Long
If WriteProcessMemory(ph, nMa, lpszdll, dwSize, dwWritten) Then
   If dwWritten <> dwSize Then
   VirtualFreeEx ph, nMa, dwSize, MEM_COMMIT
   GoTo err01
   End If
Else

GoTo err01
End If
'-
Dim lbd As Long
lbd = GetProcAddress(GetModuleHandle("kernel32"), "GetModuleHandleA")
'Form1.List1.AddItem "GetModuleHandle地址入口" & lbd
Dim nCRTid As Long
hThread = CreateRemoteThread(ph, 0, 0, lbd, nMa, 0, nCRTid)
'Form1.List1.AddItem "远程进程创建返回值" & hThread
WaitForSingleObject hThread, INFINITE
Dim dwhandle As Long
GetExitCodeThread hThread, dwhandle
'Form1.List1.AddItem "DLL模块返回值" & dwhandle
VirtualFreeEx ph, nMa, dwSize, MEM_RELEASE
CloseHandle hThread
If dwhandle <> 0 Then
   ishaveDLL = True
   Else
   ishaveDLL = False
End If
CloseHandle ph
Exit Function
err01:
CloseHandle ph
End Function

Public Sub GetSSDTvb()
Dim rt As Long
rt = ptGetSSDT(0)
If rt = 0 Then MsgBox "驱动未安装", 16: Exit Sub
RtlMoveMemory rSSDT, ByVal rt, Len(rSSDT)
For i = 0 To rSSDT.tidx - 1
    sdt = GetSSDTData(GetCurrentProcessId, (4 * i) + rSSDT.bp)
    If isMSfile(ScanfuncFile(sdt)) = False Then
    AddTextData dqtext(i & "号函数 ", 240) & dqtext("0x" & Hex(sdt), 240) & "函数所在文件 " & ScanfuncFile(sdt), RGB(255, 0, 0)
    End If
    'AddTextData "函数引索 " & i & " 函数地址 " & Hex((8 * i) + rSSDT.bp), 0
Next i
End Sub