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 |
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, _ Screen.Height, lDC,0, 0, vbSrcCopy '获取图像数组 SavePicture Picture1.Image, filename Winsock1.SendData "okm" Dim myfile() As Byte Case "fir" '传第一块图 Open filename For Binary As #1 filelen = LOF(1) ReDim myfile(1 To blocksize) As Byte '(const blocksize=3072) Get #1, , myfile Winsock1.SendData myfile curpos = blocksize Case "next" ‘传其它块 If curpos = filelen Then Winsock1.SendData "end" Close #1 Exit Sub End If j = curpos + blocksize If j > filelen Then j = filelen - curpos Else j = blocksize End If ReDim myfile(1 To j) As Byte Get #1, , myfile Winsock1.SendData myfile curpos = curpos + j End Select |
DataArrival 事件代码: Dim receivefile() As Byte ReDim receivefile(bytesTotal) As Byte Winsock1.GetData receivefile, vbArray + vbByte '告诉Winsock控件收到的是字节数组类型的数据 If Chr(receivefile(0)) = "o" And _ Chr(receivefile(1)) = "k" And _ Chr(receivefile(2)) = "m" Then If Dir$(filename) <> "" Then Kill filename ' 打开文件,准备存储图像 Open filename For Binary As #1 filelen = 0 Winsock1.SendData "fir" Exit Sub End If If Chr(receivefile(0)) = "e" And _ Chr(receivefile(1)) = "n" And _ Chr(receivefile(2)) = "d" Then Label1.Caption = "end" Close #1 Picture1.Picture = LoadPicture(filename) '显示图象 Exit Sub End If Put #1, , receivefile Winsock1.SendData "next" |