www.pudn.com > ownfirewall > NetStat.bas

Attribute VB_Name = "NetStat" 
Option Explicit 
 
Type MIB_TCPROW 
  dwState As Long 
  dwLocalAddr As Long 
  dwLocalPort As Long 
  dwRemoteAddr As Long 
  dwRemotePort As Long 
End Type 
 
Type MIB_TCPTABLE 
  dwNumEntries As Long 
  table(100) As MIB_TCPROW 
End Type 
Public MIB_TCPTABLE As MIB_TCPTABLE 
 
Type MIB_UDPROW 
  dwLocalAddr As Long     'IP address on local computer 
  dwLocalPort As Long     ' port number on local computer 
  'dwState As Long 
End Type 
 
Type MIB_UDPTABLE 
  dwNumEntries As Long    'number of entries in the table 
  table(100) As MIB_UDPROW 'table of MIB_UDPROW structs 
End Type 
  
Public MIB_UDPTABLE As MIB_UDPTABLE 
  
 
Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As MIB_TCPTABLE, _ 
 ByRef pdwsize As Long, ByVal border As Long) As Long 
Declare Function GetUdpTable Lib "iphlpapi.dll" (ByRef pUdpTable As MIB_UDPTABLE, _ 
 ByRef pdwsize As Long, ByVal border As Long) As Long 
 
Public IP_States(13) As String 
Public Last_Tcp_Cnt As Integer 
Public Last_Udp_Cnt As Integer 
 
Sub InitStates() 
  IP_States(0) = "???" 
  IP_States(1) = "CLOSED" 
  IP_States(2) = "LISTENING" 
  IP_States(3) = "SYN_SENT" 
  IP_States(4) = "SYN_RCVD" 
  IP_States(5) = "ESTABLISHED" 
  IP_States(6) = "FIN_WAIT1" 
  IP_States(7) = "FIN_WAIT2" 
  IP_States(8) = "CLOSE_WAIT" 
  IP_States(9) = "CLOSING" 
  IP_States(10) = "LAST_ACK" 
  IP_States(11) = "TIME_WAIT" 
  IP_States(12) = "DELETE_TCB" 
End Sub 
 
Sub Test_Tcp() 
Dim ret As Long, x As Integer, LTmp As Long 
Dim tcpt As MIB_TCPTABLE 
Dim udpt As MIB_UDPTABLE 
  LTmp = Len(MIB_TCPTABLE) 
  ret = GetTcpTable(tcpt, LTmp, 0) 
  x = tcpt.dwNumEntries 
  If x > Last_Tcp_Cnt Then 
    Command2 
  ElseIf x < Last_Tcp_Cnt Then 
    Command3 
  End If 
  Last_Tcp_Cnt = x 
  LTmp = Len(MIB_UDPTABLE) 
  ret = GetUdpTable(udpt, LTmp, 1) 
  x = udpt.dwNumEntries 
  If x > Last_Udp_Cnt Then 
    Command2 
  ElseIf x < Last_Udp_Cnt Then 
    Command3 
  End If 
  Last_Udp_Cnt = x 
End Sub 
 
Sub Save2Log(MsgT As String) 
Dim Filenum As Integer 
Dim FileS As String 
  FileS = App.Path & "\Hits.Log" 
  Filenum = FreeFile 
  Open FileS For Append As Filenum 
  Print #Filenum, MsgT 
  Close Filenum 
End Sub