怎样编程实现 检测本地机器开放的端口(基本要求), 更强功能包括建立的连接,连接地址,监听状态,和发送数据报大小,接受数据包大小等。 即netstat -a 的功能。 检测TCP/IP断口 外网的资料 Option Explicit Const PortsChecked = 200 Private Sub Command1_Click() Timer1.Enabled = True Timer1.Interval = 1000 End Sub Private Sub Command2_Click() Timer1.Interval = 0 Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Dim X As Integer List1.Clear
For X = 1 To PortsChecked DoEvents
Text1.Text = X Winsock1.LocalPort = X On Error Resume Next Winsock1.Listen ' If we get an error, the port is busy.
If Err.Number = 10048 Then ' 错误号:本地制已经被使用。 List1.AddItem X ' Log Active port # to list box.
Err.Number = 0 ' 清零,可不可以用ERR.CLEAR End If Winsock1.Close Next X End Sub Private Sub FORM_Load() Label1.Caption = "Checking Port #" Label2.Caption = "Ports In Use" Command1.Caption = "Start" Command2.Caption = "End" Text1.Locked = True End Sub '这个程序只检测TCP/IP断口,其他功能没有,检测不了UDP,能不能改一改检测UDP呢?' ie 服务段和客户端都打开什么端口?? 为什么上面程序只检测到端口,检测不到连接的地址???(我使用了remotehost属性)
我也找倒了他的iphlpapi源代码,而且我把检测udp部分代码完成了,但我不知道怎样把udp端口关掉。 还有他的代码从tcp表中读出的端口为什么写成 port/256+(port mod 256)*256我没有弄明白??
这是高手写的源代码,我加了udp检测部分,望高手指点。 我不明白端口为什么经过那样变换? udp表中没有远程地址和端口,怎么办???Option ExplicitPrivate Type MIB_TCPROW ' TCP连接表中一行的结构 dwState As Long ' 状态 dwLocalAddr As Long ' Local IP dwLocalPort As Long ' Local port dwRemoteAddr As Long ' Remote IP dwRemotePort As Long ' Remote port End Type Private Type MIB_UDPROW dwLocalAddr As Long dwLocalPort As Long End TypePrivate Type MIB_TCPTABLE dwNum_Of_Entries As Long ' 当前 TCP连接的总数 TCP_Table(120) As MIB_TCPROW ' 预留了120行的缓冲区 End TypePrivate Type MIB_UDPTABLE dwNumEntries As Long UDP_Table(120) As MIB_UDPROW End TypePrivate Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable _ As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As LongPrivate Declare Function GetUdpTable Lib "iphlpapi.dll" (ByRef pUDPTable _ As MIB_UDPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef _ pDest As Any, ByRef pSource As Any, ByVal Length As Long)Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _ (ByVal lpszSoundName As String, ByVal uFlags As Long) As LongPrivate Declare Function GetWindowsDirectory Lib "kernel32" Alias _ "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPrivate Declare Function SetTcpEntry Lib "iphlpapi.dll" (ByRef pTcpTable _ As MIB_TCPROW) As LongDim Last_Num_Of_Entries As Long Dim TCP1 As MIB_TCPTABLE Dim UDP1 As MIB_UDPTABLEPrivate Sub Form_Load() Form1.Caption = "黑客监控程序" Form1.Icon = LoadPicture(App.Path + "\eye.ico") Timer1.Interval = 10000 ' 定时监控 Timer1_Timer End SubPrivate Sub Timer1_Timer() Dim Return1, Return2 As Long, i As Long, Tmp1 As Long, Tmp2 As Long Dim Ip_Buf(1 To 4) As Byte Dim Win_Path As String, Tmp3 As String Return1 = GetTcpTable(TCP1, Len(TCP1), 1) ' 返回 TCP连接表 Return2 = GetUdpTable(UDP1, Len(UDP1), 1) ' 返回 udp连接表If Last_Num_Of_Entries <> 0 And _ Last_Num_Of_Entries <> TCP1.dwNum_Of_Entries Then ' 有异常(相邻两次连接表中总数发生变化)时发出警告 Picture1.Visible = True ' 设置警告标志 On Error Resume Next Win_Path = String(145, 0) i = GetWindowsDirectory(Win_Path, 145) '可以使用环境变量%windir%或者%systemroot%,取得系统windows 目录 Win_Path = Left(Win_Path, i) i = sndPlaySound(Win_Path + "\Media\Ding.wav", &H1) ' 发出报警声音 On Error GoTo 0 Else If Picture1.Visible = True Then Picture1.Visible = False End If Last_Num_Of_Entries = TCP1.dwNum_Of_Entries Select Case Return1 ' 判断返回值 Case 0&: Text1 = "": Combo1.Clear For i = 0 To TCP1.dwNum_Of_Entries - 1 Tmp3 = Str(i + 1) + " " Select Case TCP1.TCP_Table(i).dwState ' 显示连接状态 Case 1: Tmp3 = Tmp3 + "CLOSED" Case 2: Tmp3 = Tmp3 + "LISTENING" Case 3: Tmp3 = Tmp3 + "SYN_SENT" Case 4: Tmp3 = Tmp3 + "SYN_RCVD" Case 5: Tmp3 = Tmp3 + "ESTABLISHED" Case 6: Tmp3 = Tmp3 + "FIN_WAIT1" Case 7: Tmp3 = Tmp3 + "FIN_WAIT2" Case 8: Tmp3 = Tmp3 + "CLOSE_WAIT" Case 9: Tmp3 = Tmp3 + "CLOSING" Case 10: Tmp3 = Tmp3 + "LAST_ACK" Case 11: Tmp3 = Tmp3 + "TIME_WAIT" Case 12: Tmp3 = Tmp3 + "DELETE_TCB" End Select Combo1.AddItem Tmp3 ' 充实列表以供用户删除 Tmp3 = Tmp3 + ":" + vbCrLf + vbTab + "Local: " ' 本地IP‘经过换算得到本地地址’ CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwLocalAddr, 4 '写的是字节树组1,却对整个树组付值 Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4)) Tmp1 = TCP1.TCP_Table(i).dwLocalPort ' 本地端口 Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 '经过怎样的换算得到本地端口 Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbTab + "Remote: " ' 远程IP CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwRemoteAddr, 4 Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." _ + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4)) Tmp1 = TCP1.TCP_Table(i).dwRemotePort ' 远程端口 Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbCrLf Text1 = Text1 + Tmp3 Next i Case 50&: MsgBox "系统不支持该API函数": End Case 87: MsgBox "无效的参数": End Case 111&: MsgBox "缓冲区溢出": End Case 232&: MsgBox "无数据": End End Select'udp监测部分 For i = 0 To UDP1.dwNumEntries - 1 CopyMemory Ip_Buf(1), UDP1.UDP_Table(i).dwLocalAddr, 4 ' Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4)) Tmp1 = UDP1.UDP_Table(i).dwLocalPort ' 本地端口 Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 '经过怎样的换算得到本地端口 Text1.Text = Text1.Text + "UDP" + Tmp3 + ":" + Str(Tmp2) + vbCrLf + vbTab ' 显示连接状态 Next i End Sub Private Sub 删除该连接_Click() Dim Return1 As Long If Combo1.ListIndex < 0 Then Exit Sub ' 将欲删连接的状态置为MIB_TCP_STATE_DELETE_TCB(值为12) TCP1.TCP_Table(Combo1.ListIndex).dwState = 12 Return1 = SetTcpEntry(TCP1.TCP_Table(Combo1.ListIndex)) ' 执行删除 If Return1 = 0 Then MsgBox "成功删除当前连接" Else MsgBox "删除连接失败" End If Timer1_Timer End Sub
I don't know , I want to know right answer. Please master told me how to programme
检测本地机器开放的端口(基本要求),
更强功能包括建立的连接,连接地址,监听状态,和发送数据报大小,接受数据包大小等。
即netstat -a 的功能。
检测TCP/IP断口
外网的资料
Option Explicit Const PortsChecked = 200
Private Sub Command1_Click()
Timer1.Enabled = True
Timer1.Interval = 1000
End Sub Private Sub Command2_Click()
Timer1.Interval = 0
Timer1.Enabled = False
End Sub Private Sub Timer1_Timer()
Dim X As Integer
List1.Clear
For X = 1 To PortsChecked
DoEvents
Text1.Text = X
Winsock1.LocalPort = X
On Error Resume Next
Winsock1.Listen ' If we get an error, the port is busy.
If Err.Number = 10048 Then ' 错误号:本地制已经被使用。
List1.AddItem X ' Log Active port # to list box.
Err.Number = 0 ' 清零,可不可以用ERR.CLEAR End If Winsock1.Close
Next X
End Sub Private Sub FORM_Load()
Label1.Caption = "Checking Port #"
Label2.Caption = "Ports In Use"
Command1.Caption = "Start"
Command2.Caption = "End"
Text1.Locked = True
End Sub
'这个程序只检测TCP/IP断口,其他功能没有,检测不了UDP,能不能改一改检测UDP呢?'
ie 服务段和客户端都打开什么端口??
为什么上面程序只检测到端口,检测不到连接的地址???(我使用了remotehost属性)
还有他的代码从tcp表中读出的端口为什么写成 port/256+(port mod 256)*256我没有弄明白??
我不明白端口为什么经过那样变换?
udp表中没有远程地址和端口,怎么办???Option ExplicitPrivate Type MIB_TCPROW ' TCP连接表中一行的结构
dwState As Long ' 状态
dwLocalAddr As Long ' Local IP
dwLocalPort As Long ' Local port
dwRemoteAddr As Long ' Remote IP
dwRemotePort As Long ' Remote port
End Type Private Type MIB_UDPROW
dwLocalAddr As Long
dwLocalPort As Long
End TypePrivate Type MIB_TCPTABLE
dwNum_Of_Entries As Long ' 当前 TCP连接的总数
TCP_Table(120) As MIB_TCPROW ' 预留了120行的缓冲区
End TypePrivate Type MIB_UDPTABLE
dwNumEntries As Long
UDP_Table(120) As MIB_UDPROW
End TypePrivate Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable _
As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As LongPrivate Declare Function GetUdpTable Lib "iphlpapi.dll" (ByRef pUDPTable _
As MIB_UDPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef _
pDest As Any, ByRef pSource As Any, ByVal Length As Long)Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As LongPrivate Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPrivate Declare Function SetTcpEntry Lib "iphlpapi.dll" (ByRef pTcpTable _
As MIB_TCPROW) As LongDim Last_Num_Of_Entries As Long
Dim TCP1 As MIB_TCPTABLE
Dim UDP1 As MIB_UDPTABLEPrivate Sub Form_Load()
Form1.Caption = "黑客监控程序"
Form1.Icon = LoadPicture(App.Path + "\eye.ico")
Timer1.Interval = 10000 ' 定时监控
Timer1_Timer
End SubPrivate Sub Timer1_Timer()
Dim Return1, Return2 As Long, i As Long, Tmp1 As Long, Tmp2 As Long
Dim Ip_Buf(1 To 4) As Byte
Dim Win_Path As String, Tmp3 As String
Return1 = GetTcpTable(TCP1, Len(TCP1), 1) ' 返回 TCP连接表
Return2 = GetUdpTable(UDP1, Len(UDP1), 1) ' 返回 udp连接表If Last_Num_Of_Entries <> 0 And _
Last_Num_Of_Entries <> TCP1.dwNum_Of_Entries Then ' 有异常(相邻两次连接表中总数发生变化)时发出警告
Picture1.Visible = True ' 设置警告标志
On Error Resume Next
Win_Path = String(145, 0)
i = GetWindowsDirectory(Win_Path, 145) '可以使用环境变量%windir%或者%systemroot%,取得系统windows 目录
Win_Path = Left(Win_Path, i)
i = sndPlaySound(Win_Path + "\Media\Ding.wav", &H1) ' 发出报警声音
On Error GoTo 0
Else
If Picture1.Visible = True Then Picture1.Visible = False
End If
Last_Num_Of_Entries = TCP1.dwNum_Of_Entries
Select Case Return1 ' 判断返回值
Case 0&:
Text1 = "": Combo1.Clear
For i = 0 To TCP1.dwNum_Of_Entries - 1
Tmp3 = Str(i + 1) + " "
Select Case TCP1.TCP_Table(i).dwState ' 显示连接状态
Case 1: Tmp3 = Tmp3 + "CLOSED"
Case 2: Tmp3 = Tmp3 + "LISTENING"
Case 3: Tmp3 = Tmp3 + "SYN_SENT"
Case 4: Tmp3 = Tmp3 + "SYN_RCVD"
Case 5: Tmp3 = Tmp3 + "ESTABLISHED"
Case 6: Tmp3 = Tmp3 + "FIN_WAIT1"
Case 7: Tmp3 = Tmp3 + "FIN_WAIT2"
Case 8: Tmp3 = Tmp3 + "CLOSE_WAIT"
Case 9: Tmp3 = Tmp3 + "CLOSING"
Case 10: Tmp3 = Tmp3 + "LAST_ACK"
Case 11: Tmp3 = Tmp3 + "TIME_WAIT"
Case 12: Tmp3 = Tmp3 + "DELETE_TCB"
End Select
Combo1.AddItem Tmp3 ' 充实列表以供用户删除
Tmp3 = Tmp3 + ":" + vbCrLf + vbTab + "Local: " ' 本地IP‘经过换算得到本地地址’
CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwLocalAddr, 4 '写的是字节树组1,却对整个树组付值
Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4))
Tmp1 = TCP1.TCP_Table(i).dwLocalPort ' 本地端口
Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 '经过怎样的换算得到本地端口
Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbTab + "Remote: " ' 远程IP
CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwRemoteAddr, 4
Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." _
+ CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4))
Tmp1 = TCP1.TCP_Table(i).dwRemotePort ' 远程端口
Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256
Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbCrLf
Text1 = Text1 + Tmp3
Next i
Case 50&:
MsgBox "系统不支持该API函数": End
Case 87:
MsgBox "无效的参数": End
Case 111&:
MsgBox "缓冲区溢出": End
Case 232&:
MsgBox "无数据": End
End Select'udp监测部分
For i = 0 To UDP1.dwNumEntries - 1
CopyMemory Ip_Buf(1), UDP1.UDP_Table(i).dwLocalAddr, 4 '
Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4))
Tmp1 = UDP1.UDP_Table(i).dwLocalPort ' 本地端口
Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 '经过怎样的换算得到本地端口
Text1.Text = Text1.Text + "UDP" + Tmp3 + ":" + Str(Tmp2) + vbCrLf + vbTab ' 显示连接状态
Next i
End Sub
Private Sub 删除该连接_Click()
Dim Return1 As Long
If Combo1.ListIndex < 0 Then Exit Sub
' 将欲删连接的状态置为MIB_TCP_STATE_DELETE_TCB(值为12)
TCP1.TCP_Table(Combo1.ListIndex).dwState = 12
Return1 = SetTcpEntry(TCP1.TCP_Table(Combo1.ListIndex)) ' 执行删除
If Return1 = 0 Then
MsgBox "成功删除当前连接"
Else
MsgBox "删除连接失败"
End If
Timer1_Timer
End Sub
Please master told me how to programme