netstart.bas

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

Attribute VB_Name = "modNetstat"
Public MIBICMPSTATS As MIBICMPSTATS
Public Type MIBICMPSTATS
    dwEchos As Long
    dwEchoReps As Long
End Type

Public MIBICMPINFO As MIBICMPINFO
Public Type MIBICMPINFO
    icmpOutStats As MIBICMPSTATS
End Type

Public MIB_ICMP As MIB_ICMP
Public Type MIB_ICMP
    stats As MIBICMPINFO
End Type

Public Declare Function GetIcmpStatistics Lib "iphlpapi.dll" (pStats As MIBICMPINFO) As Long
Public Last_ICMP_Cnt As Integer 'ICMP count

'-------------------------------------------------------------------------------
'Types and functions for the TCP table:

'--------------------
Type MIB_TCPROW_EX
     dwState As Long
     dwLocalAddr As Long
     dwLocalPort As Long
     dwRemoteAddr As Long
     dwRemotePort As Long
     dwProcessId As Long
End Type
Type MIB_TCPTABLE_EX
     dwNumEntries As Long
     table() As MIB_TCPROW_EX
End Type
Public MIB_TCPTABLE_EX As MIB_TCPTABLE_EX
Type MIB_UDPROW_EX
     dwLocalAddr As Long
     dwLocalPort As Long
     dwProcessId As Long
End Type
Type MIB_UDPTABLE_EX
    dwNumEntries As Long
    table(150) As MIB_UDPROW_EX
End Type
Public MIB_UDPTABLE_EX As MIB_UDPTABLE_EX
'--------------------

Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function AllocateAndGetTcpExTableFromStack Lib "iphlpapi.dll" (ByRef pTcpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long
Private Declare Function AllocateAndGetUdpExTableFromStack Lib "iphlpapi.dll" (ByRef pUdpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long

Public IP_States(13) As String
Private Last_Tcp_Cnt As Integer 'TCP connection count

'-------------------------------------------------------------------------------
'Types and functions for winsock:

Private Const AF_INET = 2
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const SOCKET_ERROR As Long = -1
Private Const WS_VERSION_REQD As Long = &H101

Type HOSTENT
    h_name As Long        ' official name of host
    h_aliases As Long     ' alias list
    h_addrtype As Integer ' host address type
    h_length As Integer   ' length of address
    h_addr_list As Long   ' list of addresses
End Type

Type servent
  s_name As Long            ' (pointer to string) official service name
  s_aliases As Long         ' (pointer to string) alias list (might be null-seperated with 2null terminated)
  s_port As Long            ' port #
  s_proto As Long           ' (pointer to) protocol to use
End Type

Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo As Long
End Type
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, _
        pSource As Any, ByVal dwLength As Long)

Public Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
Private Declare Function inet_ntoa Lib "WSOCK32.DLL" (ByVal inn As Long) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (Addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal host_name As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Declare Function lstrlen Lib "kernel32" (ByVal lpString As Any) As Integer
Private Declare Sub fxp Lib "GetPortListxp.dll" Alias "GetXPPortList" (sss As MIB_TCPTABLE_EX, pdwSize As Long)

Public Function GetAscIP(ByVal inn As Long) As String
  Dim nStr&
    Dim lpStr As Long
    Dim retString As String
    Dim newIP As String
    Dim tmpip(1 To 4) As String * 3
    retString = String(32, 0)
    lpStr = inet_ntoa(inn)
    If lpStr Then
        nStr = lstrlen(lpStr)
        If nStr > 32 Then nStr = 32
        CopyMemory ByVal retString, ByVal lpStr, nStr
        retString = left(retString, nStr)
        tmps = retString
        Dim ipd(1 To 4) As String * 3
For i = 1 To 4
u = InStr(tmps, ".")

If u <> 0 Then s1 = left(tmps, u - 1) Else s1 = tmps
ipd(i) = s1
tmps = right(tmps, Len(tmps) - u)
Next i
newIP = ipd(1) & "." & ipd(2) & "." & ipd(3) & "." & ipd(4)
        GetAscIP = newIP
        
    Else
        GetAscIP = "无法获得IP"
    End If
End Function


Public Function RTtcp(Optional force As Boolean = False)
On Error Resume Next
Dim l As Long
Dim X As Integer, i As Integer
Dim remA As String, LocP As String, RemP As String
Dim state As Integer
Dim tcptnt As MIB_TCPTABLE_EX
l2 = Len(MIB_TCPTABLE_EX)
Dim k As Long
Sd = AllocateAndGetTcpExTableFromStack(k, True, GetProcessHeap, 2, 2)
If k <> 0 Then
CopyMemory tcptnt.dwNumEntries, ByVal k, 4
ReDim tcptnt.table(1 To tcptnt.dwNumEntries)
CopyMemory tcptnt.table(1), ByVal k + 4, Len(tcptnt.table(1)) * tcptnt.dwNumEntries
End If

X = tcptnt.dwNumEntries
'MsgBox x
If X < lC Or X > lC Or force Then
    lC = X
    For i = 1 To X - 1
        remA = GetAscIP(tcptnt.table(i).dwRemoteAddr)
        locA = GetAscIP(tcptnt.table(i).dwLocalAddr)
        RemP = ntohs(tcptnt.table(i).dwRemotePort)
        LocP = ntohs(tcptnt.table(i).dwLocalPort)
        state = tcptnt.table(i).dwState
        Dim sss As String
        If state = 2 Then sss = "等待连接"
        If state = 8 Then sss = "等待关闭"
        If state = 9 Then sss = "在关闭中"
        If state = 1 Then sss = "已经关闭"
        Dim srA As String
        Dim lrA As String
        srA = remA
        lrA = locA
        Dim srP As String * 7
        Dim lrP As String * 7

        Dim pname As String
        If state = 2 Then
        srP = RemP
        lrP = LocP
        Else
        srP = RemP
        lrP = LocP
        End If
        pn = ""
        Dim str7 As String
        str7 = scanpro.GetPname(tcptnt.table(i).dwProcessId)
        pn = InStrRev(str7, "\")
        If pn <> 0 Then pname = right(str7, Len(str7) - pn) Else pname = "--内核进程--"
        Dim tmp As String
        
        tmp = dqtext(pname, 210) & " |" & lrA & " |" & lrP & " |" & srA & " |" & srP & " |" & sss & " |" & str7
        Dim tmp2 As String
        If Len(tmp) > 300 Then
        tmp2 = left(tmp, 300)
        Else
        tmp2 = tmp
        End If
        AddTextData tmp2, 0
    Next i
End If
End Function

Public Function RTudp(Optional force As Boolean = False)
On Error Resume Next
Dim l As Long
Dim X As Integer, i As Integer
Dim LocP As String
Dim state As Integer
Dim udptnt As MIB_UDPTABLE_EX
l2 = Len(MIB_UDPTABLE_EX)
Dim k As Long
S = AllocateAndGetUdpExTableFromStack(k, True, GetProcessHeap, 2, 2)
CopyMemory udptnt, ByVal k, l2
X = udptnt.dwNumEntries
If X < lC Or X > lC Or force Then
    lC = X
    For i = 1 To X - 1
        locA = GetAscIP(udptnt.table(i).dwLocalAddr)
        LocP = ntohs(udptnt.table(i).dwLocalPort)
        Dim srA As String * 15
        Dim lrA As String
        srA = remA
        lrA = locA
        Dim srP As String * 7
        Dim lrP As String * 7
        Dim sss As String * 4
        Dim pname As String
        srP = RemP
        lrP = LocP
        sss = "等待连接"
        Dim str7 As String
        str7 = scanpro.GetPname(udptnt.table(i).dwProcessId)
        pn = InStrRev(str7, "\")
        If pn <> 0 Then pname = right(str7, Len(str7) - pn) Else pname = "--内核进程--"
        Dim tmp As String
        tmp = dqtext(pname, 210) & " |" & lrA & " |" & lrP & " |" & srA & " |" & srP & " |" & sss & " |" & str7
        Dim tmp2 As String
        If Len(tmp) > 200 Then
        tmp2 = left(tmp, 200)
        Else
        tmp2 = tmp
        End If
        AddTextData tmp2, 0
    Next i
End If
End Function


Public Function dqtext(ByVal text As String, ByVal cMax As Integer) As String
For i = 1 To Len(text)
tmp1 = Asc(right(left(text, i), 1))

If tmp1 > 0 Then
   wi = wi + 15
   Else
   wi = wi + 30
End If
If wi > cMax Then Exit Function
dqtext = dqtext & Chr(tmp1)
Next i
Dim yq As String
If wi < cMax Then
   r = (cMax - wi) / 15
   For o = 1 To r
      yq = yq & " "
   Next o
   dqtext = dqtext & yq
End If
End Function