1,502
社区成员
发帖
与我相关
我的任务
分享
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Type typTime
myMonth As String
myDay As String
myHour As String
myMinute As String
mySecond As String
End Type
Private mySelect As String
Private ErrNum As Integer
Private EvtNum As Integer
Private FlagLog As Boolean
Private LogName As String
Private FlagLinkState As Boolean
Private CurrItem As MSComctlLib.ListItem
Dim mode_str As String
Dim IPFlieName, strIP, strPort As String
Private Sub cmdLinked_Click()
Dim sA As String
IPFlieName = App.Path + "\csqzIP.ini"
Open IPFlieName For Binary As #1
sA = Space(LOF(1)) '用空格填充sA变量
Get #1, , sA '用Get语句获取文件全部内容
strPort = Trim(Mid(sA, 6, 4))
strIP = Trim(Mid(sA, 14, Len(sA) - 10))
Close #1
'txtRemoteIp.Text = sA
If FlagLinkState = False Then '没有连接那
If Winsock.State = 0 Then
'Winsock.Connect txtRemoteIp.Text, CInt(txtRemotePort.Text)
Winsock.Connect strIP, CInt(strPort)
TimerToCheckState.Enabled = True
cmdLinked.Caption = "正在连接"
Else
Winsock.Close
lstState.AddItem CStr(EvtNum) + "·用户强制关闭", 0
TimerToCheckState.Enabled = False
cmdLinked.Caption = "连接"
End If
Else
If Winsock.State = 7 Then '连接了
intresult = MsgBox("确定要断开连接么?", vbYesNo + vbInformation, "提示")
If intresult = vbYes Then
Winsock.Close
cmdLinked.Enabled = True
TimerToCheckState.Enabled = False
EvtNum = EvtNum + 1
lstState.AddItem CStr(EvtNum) + "·用户强制关闭", 0
cmdLinked.Caption = "连接"
FlagLinkState = False
End If
Else '没有连接
Winsock.Close
cmdLinked.Enabled = True
TimerToCheckState.Enabled = False
EvtNum = EvtNum + 1
lstState.AddItem CStr(EvtNum) + "·用户强制关闭", 0
cmdLinked.Caption = "连接"
FlagLinkState = False
End If
End If
End Sub
Private Sub TimerToCheckState_Timer()
Dim i As Integer
EvtNum = EvtNum + 1
Select Case Winsock.State
Case sckClosed '0 缺省的。关闭
Winsock.Connect strIP, CInt(strPort)
lstState.AddItem CStr(EvtNum) + "·WinSock目前关闭", 0
Beep
Case sckOpen '1 打开
lstState.AddItem CStr(EvtNum) + "·WinSock已经打开", 0
Case sckListening '2 侦听
lstState.AddItem CStr(EvtNum) + "·WinSock正在侦听", 0
Case sckConnectionPending ' 3 连接挂起
lstState.AddItem CStr(EvtNum) + "·连接挂起", 0
Case sckResolvingHost ' 4 识别主机
lstState.AddItem CStr(EvtNum) + "·识别主机", 0
Case sckHostResolved ' 5 已识别主机
lstState.AddItem CStr(EvtNum) + "·已识别主机", 0
Case sckConnecting ' 6 正在连接
lstState.AddItem CStr(EvtNum) + "·正在连接", 0
Case sckConnected '7 已连接
lstState.AddItem CStr(EvtNum) + "·已经连接", 0
TimerToCheckState.Enabled = False
cmdLinked.Caption = "断开"
FlagLinkState = True
Case sckClosing '8 同级人员正在关闭连接
lstState.AddItem CStr(EvtNum) + "·同级人员正在关闭连接", 0
Case sckError '9 错误
lstState.AddItem CStr(EvtNum) + "·出现错误", 0
Winsock.Close
End Select
If lstState.ListCount > 10 Then
lstState.RemoveItem lstState.ListCount - 1 '删除最后一个
End If
End Sub
Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ppstr As String
Dim i, CtrlDown As Integer
CtrlDown = (Shift And vbCtrlMask) > 0
If CtrlDown And KeyCode = vbKeyC Then
For i = 1 To 3
ppstr = ppstr & CurrItem.SubItems(i) & " "
Next i
Clipboard.SetText ppstr
End If
End Sub
Private Sub Option1_Click()
If (Winsock.State = 7) Then
Winsock.SendData "chinese"
End If
mode_str = "chinese"
End Sub
Private Sub Option2_Click()
If (Winsock.State = 7) Then
Winsock.SendData "english"
End If
mode_str = "english"
End Sub
Private Sub Winsock_Close() '处理服务器端关闭情况
EvtNum = EvtNum + 1
lstState.AddItem CStr(EvtNum) + "·Socket服务器端关闭!", 0
Winsock.Close
TimerToCheckState.Enabled = True
End Sub
Private Sub Winsock_Connect()
Winsock.SendData mode_str
End Sub
Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Dim strReceive As String '收到的字符串
Dim myTime As typTime '出错时间
Dim strThread As String '出错进程
Dim strMsg As String '出错信息
Dim NoNeed As String
Dim strSingleChar As Variant
Dim Flag As String
Dim tmpStr As String
Dim litem As ListItem
Dim tmpStr1 As String
Dim LongFlag As Long
Dim intbyte(8) As Byte
Do While (Winsock.BytesReceived >= 300) ' 有字符串到来
strThread = ""
strErrIndex = ""
strMsg = ""
strErrCode = ""
tmpStr1 = ""
myTime.myMonth = ""
myTime.myDay = ""
myTime.myHour = ""
myTime.myMinute = ""
myTime.mySecond = ""
For i = 0 To 20 '出错进程名
Winsock.GetData strSingleChar, vbString, 1
If Asc(strSingleChar) <> 0 Then
strThread = strThread + strSingleChar
Else
strThread = strThread + " "
End If
Next
Winsock.GetData strMsg, vbString, 6
Winsock.GetData strMsg, vbString, 1
Flag = Mid(strMsg, 1, 1)
Winsock.GetData strMsg, vbString, 1
Winsock.GetData strMsg, vbString, 256
For i = 1 To Len(strMsg)
If Asc(Mid(strMsg, i, 1)) = 0 Then
Exit For
End If
Next
tmpStr1 = myTime.myMonth + myTime.myDay + myTime.myHour + myTime.myMinute + myTime.mySecond
If ListView1.ListItems.Count > 6000 Then
ListView1.ListItems.Remove 1
End If
If (FlagLog) Then
RecordLog LogName, tmpStr1 + " " + strThread + " " + strErrCode + " " + strErrIndex + " " + strMsg
End If
Set iitem = ListView1.ListItems.Add
iitem.SubItems(1) = tmpStr1
iitem.SubItems(2) = strThread
iitem.SubItems(3) = strMsg
ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
Loop
End Sub