Private Declare Function GetTcpTable Lib "iphlpapi. dll" (ByRef pTcpTable As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long |
Private Declare Function SetTcpEntry Lib "iphlpapi. dll" (ByRef pTcpTable As MIB_TCPROW) As Long |
Private Sub Timer1_Timer() Dim Return1 As Long, i As Long Dim 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) 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) '利用API函数GetWindowsDirectory获得当前系统目录 i = GetWindowsDirectory(Win_Path, 145) Win_Path = Left(Win_Path, i) '利用API函数sndPlaySound发出报警声音 i = sndPlaySound(Win_Path + "\Media\Ding.wav", &H1) On Error GoTo 0 Else If Picture1.Visible = True Then Picture1.Visible = False End If 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 ' 填充列表以供用户删除 ' 本地IP Tmp3 = Tmp3 + ":" + vbCrLf + vbTab + "Local: " 'CopyMemory为API函数 CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwLocalAddr, 4 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 ' 远程IP Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbTab + "Remote: " 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 End Sub |
Private Sub delete_Click() Dim Return1 As Long If Combo1.ListIndex < 0 Then Exit Sub ' 将欲删连接的状态置为值为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 |
2、屏幕监控
当服务器系统发现TCP异常连接时,可通过屏幕监控功能将局域网中被监控工作站的屏幕画面抓取到服务器中并实施相应措施,如对工作站锁机或关机等。此处用到WINSOCK控件,其通讯原理请参阅相关资料,屏幕监控功能用到TCP协议,为了达到更好的效果,可在窗体中加入TIMER控件,设定TIMER事件。
(1) 工作站端
侦听并响应服务器端发出的连接请求和屏幕抓取。其中屏幕抓取功能可通过API函数实现:
Dim a As String Winsock1.GetData a, vbString Select Case a Case "zp" Picture1.AutoRedraw = True Picture1.ScaleMode = 1 lDesktop = GetDesktopWindow() lDC = GetDC(lDesktop) BitBlt Picture1.hdc, 0, 0, Screen.Width, _ |