?? frmclient.frm
字號:
BackColor = &H00FFFFFF&
Caption = "C"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 255
Left = 2640
TabIndex = 16
Top = 240
Width = 255
End
End
Begin VB.TextBox txtSend
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 120
TabIndex = 2
Top = 2880
Width = 3135
End
Begin VB.TextBox txtOutput
BackColor = &H00FFFF00&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2055
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 240
Width = 3135
End
Begin MSWinsockLib.Winsock tcpClient
Left = 120
Top = 240
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HName As Boolean
Dim IfCliName As Boolean
Dim ServerRHName As String
Private Sub cmdClearCli_Click()
txtOutput.Text = ""
End Sub
Private Sub cmdClearSer_Click()
txtOutServer.Text = ""
End Sub
Private Sub cmdDisconnect_Click()
On Error Resume Next
tcpServer.SendData "!.EX!T.!"
tcpClient.SendData "!.EX!T.!"
cmdDisconnect.Visible = False
cmdConnect.Visible = True
Listen
End Sub
Private Sub cmdSendCli_Click()
SendClient
End Sub
Private Sub cmdSendSer_Click()
SendServer
End Sub
Private Sub Command1_Click()
cmdDisconnect_Click
Unload Me
End Sub
Private Sub Form_Resize()
On Error Resume Next
Frame3.Width = frmClient.Width - 100
Frame1.Width = frmClient.Width - 100
Frame2.Width = frmClient.Width - 100
Frame2.Height = frmClient.Height - Frame2.Top - 400
Frame1.Height = frmClient.Height - Frame1.Top - 400
txtSend.Top = Frame1.Height - 120 - txtSend.Height
txtSendData.Top = Frame2.Height - 120 - txtSendData.Height
txtSend.Width = Frame1.Width - 240
txtSendData.Width = Frame2.Width - 240
Frame4.Top = Frame1.Height - 1150
Frame5.Top = Frame2.Height - 1150
Frame4.Width = Frame1.Width - 240
Frame5.Width = Frame2.Width - 240
txtOutput.Height = Frame1.Height - 1350
txtOutServer.Height = Frame2.Height - 1350
txtOutput.Width = Frame1.Width - 240
txtOutServer.Width = Frame2.Width - 240
End Sub
Private Sub Form_Terminate()
cmdDisconnect_Click
End Sub
Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
HName = True
frmClient.WindowState = 0
frmClient.Width = 3510
frmClient.Height = 4965
frmClient.SetFocus
'cmdConnect.Enabled = False
cmdConnect.Visible = False
cmdDisconnect.Visible = True
Frame2.Visible = True
Frame1.Visible = False
Frame2.Left = 0
Frame2.Top = 1080
End Sub
Private Sub txtSend_KeyPress(KeyAscii As Integer)
On Error GoTo ErrPara
If KeyAscii = 13 Then
If IfCliName Then
tcpClient.SendData Format(Len(tcpClient.LocalHostName), "000") & tcpClient.LocalHostName & txtSend.Text
IfCliName = False
Else
tcpClient.SendData txtSend.Text
End If
txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.LocalHostName & " : " & txtSend.Text
txtOutput.SelLength = Len(txtOutput.Text)
txtSend.Text = ""
End If
Exit Sub
ErrPara:
MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
Listen
End Sub
Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
On Error GoTo ErrPara
Dim LenOfName As Integer
Dim strData As String
tcpServer.GetData strData
If InStr(1, strData, "!.EX!T.!") <> 0 Then
Listen
cmdConnect.Visible = True
cmdDisconnect.Visible = False
Exit Sub
End If
If HName = True Then
LenOfName = CInt(Mid(strData, 1, 3))
ServerRHName = Mid(strData, 4, LenOfName)
txtOutServer.Text = txtOutServer.Text & vbCrLf & ServerRHName & " #: " & Right(strData, Len(strData) - 3 - LenOfName)
HName = False
Else
txtOutServer.Text = txtOutServer.Text & vbCrLf & ServerRHName & " #: " & strData
End If
txtOutServer.SelLength = Len(txtOutServer.Text)
frmClient.WindowState = 0
frmClient.SetFocus
Exit Sub
ErrPara:
MsgBox "ERROR IN RECEIVING MESSAGE" & vbCrLf & "Probably you are disconnected"
Listen
End Sub
Private Sub Form_Load()
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.LocalPort = 995
tcpServer.Listen
frmClient.Width = 3510
frmClient.Height = 1515
End Sub
Private Sub cmdConnect_Click()
On Error GoTo ErrPara
tcpClient.Close
tcpServer.Close
tcpClient.RemoteHost = Text1.Text
tcpClient.RemotePort = 995
''''''''''Code for server
tcpServer.LocalPort = 995
tcpServer.Listen
tcpClient.Connect
frmClient.Width = 3510
frmClient.Height = 4965
cmdConnect.Enabled = False
cmdConnect.Visible = False
cmdDisconnect.Visible = True
Frame1.Visible = True
Frame2.Visible = False
txtOutServer.Text = ""
txtOutput.Text = ""
txtSend.Text = ""
txtSendData.Text = ""
IfCliName = True
Exit Sub
ErrPara:
MsgBox "Enter a valid computer name. CONNECTION FAILURE"
cmdConnect.Visible = True
cmdConnect.Enabled = True
cmdDisconnect.Visible = False
End Sub
Private Sub tcpClient_DataArrival _
(ByVal bytesTotal As Long)
On Error GoTo ErrPara
Dim strData As String
tcpClient.GetData strData
If InStr(1, strData, "!.EX!T.!") <> 0 Then
Listen
cmdConnect.Visible = True
cmdDisconnect.Visible = False
Exit Sub
End If
txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.RemoteHost & " #: " & strData
frmClient.WindowState = 0
frmClient.SetFocus
txtOutput.SelLength = Len(txtOutput.Text)
Exit Sub
ErrPara:
MsgBox "ERROR IN REVEIVING MESSAGE" & vbCrLf & "Probably you are disconnected"
Listen
End Sub
Private Sub txtSendData_KeyPress(KeyAscii As Integer)
On Error GoTo ErrPara
If KeyAscii = 13 Then
tcpServer.SendData txtSendData.Text
txtOutServer.Text = txtOutServer.Text & vbCrLf & tcpServer.LocalHostName & " :" & txtSendData.Text
txtSendData.Text = ""
txtOutServer.SelLength = Len(txtOutServer.Text)
End If
Exit Sub
ErrPara:
MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
Listen
End Sub
Private Sub Listen()
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.LocalPort = 995
tcpServer.Listen
cmdConnect.Enabled = True
frmClient.Width = 3510
frmClient.Height = 1515
cmdDisconnect.Visible = False
cmdConnect.Visible = True
End Sub
Private Sub SendClient()
On Error GoTo ErrPara
If IfCliName Then
tcpClient.SendData Format(Len(tcpClient.LocalHostName), "000") & tcpClient.LocalHostName & txtSend.Text
IfCliName = False
Else
tcpClient.SendData txtSend.Text
End If
txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.LocalHostName & " : " & txtSend.Text
txtOutput.SelLength = Len(txtOutput.Text)
txtSend.Text = ""
Exit Sub
ErrPara:
MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
Listen
End Sub
Private Sub SendServer()
On Error GoTo ErrPara
tcpServer.SendData txtSendData.Text
txtOutServer.Text = txtOutServer.Text & vbCrLf & tcpServer.LocalHostName & " :" & txtSendData.Text
txtSendData.Text = ""
txtOutServer.SelLength = Len(txtOutServer.Text)
Exit Sub
ErrPara:
MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
Listen
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -