看吧:'--------------------------------------------- ' 局域网聊天程序 '--------------------------------------------- ' 洪恩在线 求知无限 '--------------------------------------------- Option Explicit Private IgnoreText As Boolean '----------------------各控件说明---------------------------- '--名称-------------类型---------------作用------------------ 'frmMain Form CHAT主窗体 'Winsock1 Winsock 连接控件 'Label1 Label CONNECT WITH IP标签 'Label2 Label LOCAL PORT标签 'Label3 Label REMOTE PORT标签 'txtRemoteIP TextBox 远程IP地址输入框 'txtLocalPort TextBox 本地PORT输入框 'txtRemotePort TextBox 远程PORT输入框 'cmdConnect CommandButton 连接CONNECT按钮 'Label4 Label Type your text and hit Enter to send it.标签 'Frame1(remoteip) Frame REMOTE IP 框架 'Frame2(host ip) Frame HOST IP 框架 'Text1 TextBox 显示对方(远程主机)发送的CHAT内容 'Text2 TextBox 输入己方(本地主机)要发送的CHAT内容,按ENTER键发送 'cmdClear CommandButton 清空输入框(TEXT2)和显示框(TEXT1)中的内容 'StatusBar1 StatusBar 状态栏'当CLEAR按钮按下时,清空TEXT1和TEXT2中的内容 Private Sub cmdClear_Click() On Error Resume Next Text1 = "" With Text2 '清空输入框 .Text = " " '并把焦点置于TEXT2 .SetFocus End With End Sub'当CONNECT按钮按下时,进行以下操作 Private Sub cmdConnect_Click() On Error GoTo ErrHandlerWith Winsock1 '设置 RemoteHost 属性 .RemoteHost = Trim(txtRemoteIP) '设置 RemotePort 属性 'RemotePort 属性的值应该等于 远程主机上的 LocalHost 属性的值 .RemotePort = Trim(txtRemotePort) 'LocalPort 属性的值是不能改变的,必须检查它是否已经被设置 '如果 LocalPort 属性为空(没有被设置),将其设为在LocalPort输入框中输入的数值 If .LocalPort = Empty Then .LocalPort = Trim(txtLocalPort) Frame2.Caption = .LocalIP '这是必须的,Bind 方法的作用是为控件“保留”一个本地端口,防止被其他用户调用。 .Bind .LocalPort End If End With'为了保证使用者不能改变LocalPort的值,将txtLocalPort输入框锁定 txtLocalPort.Locked = True '在状态栏中显示“正在连接”的状态 StatusBar1.Panels(1).Text = " 正在连接到 " & Winsock1.RemoteHost & " " '如果连接正常,做以下设置 Frame1.Enabled = True Frame2.Enabled = True Label4.Visible = True Frame1.Caption = Winsock1.RemoteHost Text2.SetFocus StatusBar1.Panels(1).Text = " 连接成功 " Exit Sub '如果在连接过程中出现错误,则转向ErrHandler:,并显示错误提示 ErrHandler: MsgBox "建立连接失败,按 F1 以获得帮助信息", vbCritical End Sub'当按下“F1”键时显示帮助信息 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then ChDir App.Path '调用外部程序notepad.exe来打开帮助文本文件 Shell "notepad.exe readme.txt", vbNormalFocus End IfEnd Sub'当窗体加载时显示提示信息并在 txtRemoteIP 框中显示本地主机的IP Private Sub Form_Load() Show txtRemoteIP = Winsock1.LocalIP End Sub'接收TEXT2输入框的按键,并做响应 Private Sub Text2_KeyPress(KeyAscii As Integer)'定义变量 Last_Line_Feed 来记录最后输入行的位置 Static Last_Line_Feed As Long '定义 New_Line 字符串记录新键入的一行文本的内容 Dim New_Line As String Dim HoneyName As String Dim InfoIndex As Integer '如果使用者按下CLEAR按钮对输入框内容清空,这时TEXT2为空,则重设最后输入行的位置为0 If Trim(Text2) = vbNullString Then Last_Line_Feed = 0 '传送昵称 HoneyName = Text3.Text '当使用者按下ENTER键时 If KeyAscii = 13 Then '取得最后输入行的内容并赋值给 New_Line 字符串 New_Line = Mid(Text2, Last_Line_Feed + 1) '重设最后输入行的位置 Last_Line_Feed = Text2.SelStart '如果昵称还没有传送,就先传送昵称 If InfoIndex = 0 Then Winsock1.SendData HoneyName InfoIndex = 1 'Winsock1.SendData New_Line End If '通过 WINSOCK 发送新输入的一行文本的内容 Winsock1.SendData New_Line Text1.SelText = HoneyName + "说:" + New_Line '在状态栏显示发送信息 StatusBar1.Panels(2).Text = " 发送 " & (LenB(New_Line) / 2) & " byte的消息 " End IfEnd Sub'当 WINSOCK 接收到新的数据(信息)时,进行以下响应 Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '定义 New_Text 字符串来记录新接收的信息 Dim New_Text As String Dim HoneyName As String Dim ReInfoIndex As Integer '先判断收到的是不是第一个信息,如果是就放到昵称里去 If ReInfoIndex = 0 Then Winsock1.GetData HoneyName ReInfoIndex = 1 End If '接收信息并赋值给 New_Text Winsock1.GetData New_Text New_Text = Mid(New_Text, 3, Len(New_Text) - 2) + Mid(New_Text, 1, 2) '在TEXT1显示框中显示新接收到的信息 'New_Text = HoneyName + "说:" + New_Text Text1.SelText = HoneyName + "说:" + New_Text 'Text3.Text = Len(New_Text) '去掉前面的回车符,但如果是第一个消息的话,那就要出错的,这里还要处理一下。'Text1.SelText = New_Text 'Frame1.Caption = Winsock1.RemoteHostIP '在状态栏中显示接收信息 StatusBar1.Panels(2).Text = " 接收到 " & bytesTotal & " byte的消息 " End Sub'--------------------------------------------------------------------------- '这就是一个最简单的CHAT程序,你可以在它的基础上加以改进,做出更实用的CHAT小软件。 '---------------------------------------------------------------------------
简单的聊天 服务段Private intmax As IntegerPrivate Sub Form_Load() intmax = 0 tcpServer(0).LocalPort = 1001 tcpServer(0).Listen Label1.Caption = "正在监听..." End SubPrivate Sub tcpServer_ConnectionRequest(index As Integer, ByVal requestID As Long) If index = 0 Then intmax = intmax + 1 Load tcpServer(intmax) tcpServer(intmax).LocalPort = 0 tcpServer(intmax).Accept requestIDLabel1.Caption = "有客户连接:" & requestID End If End SubPrivate Sub tcpServer_DataArrival(index As Integer, ByVal bytesTotal As Long) Dim strData As String tcpServer(index).GetData strData txtOutput.Text = strData End SubPrivate Sub txtSendData_Change() tcpServer.SendData txtSendData.Text End Sub
客户端 Private Sub Command1_Click() If tcpClient.State = sckConnected Then MsgBox "已经连接" 'Me.Enabled = False Exit Sub End If tcpClient.ConnectEnd SubPrivate Sub Form_Load() tcpClient.RemoteHost = "localhost" tcpClient.RemotePort = 1001 End SubPrivate Sub tcpClient_DataArrival(ByVal bytesTotal As Long) Dim strData As String tcpClient.GetData strData txtOutput.Text = strData End SubPrivate Sub txtSend_Change() tcpClient.SendData txtSend.Text End Sub
' 局域网聊天程序
'---------------------------------------------
' 洪恩在线 求知无限
'---------------------------------------------
Option Explicit
Private IgnoreText As Boolean
'----------------------各控件说明----------------------------
'--名称-------------类型---------------作用------------------
'frmMain Form CHAT主窗体
'Winsock1 Winsock 连接控件
'Label1 Label CONNECT WITH IP标签
'Label2 Label LOCAL PORT标签
'Label3 Label REMOTE PORT标签
'txtRemoteIP TextBox 远程IP地址输入框
'txtLocalPort TextBox 本地PORT输入框
'txtRemotePort TextBox 远程PORT输入框
'cmdConnect CommandButton 连接CONNECT按钮
'Label4 Label Type your text and hit Enter to send it.标签
'Frame1(remoteip) Frame REMOTE IP 框架
'Frame2(host ip) Frame HOST IP 框架
'Text1 TextBox 显示对方(远程主机)发送的CHAT内容
'Text2 TextBox 输入己方(本地主机)要发送的CHAT内容,按ENTER键发送
'cmdClear CommandButton 清空输入框(TEXT2)和显示框(TEXT1)中的内容
'StatusBar1 StatusBar 状态栏'当CLEAR按钮按下时,清空TEXT1和TEXT2中的内容
Private Sub cmdClear_Click()
On Error Resume Next
Text1 = ""
With Text2
'清空输入框
.Text = " "
'并把焦点置于TEXT2
.SetFocus
End With
End Sub'当CONNECT按钮按下时,进行以下操作
Private Sub cmdConnect_Click()
On Error GoTo ErrHandlerWith Winsock1
'设置 RemoteHost 属性
.RemoteHost = Trim(txtRemoteIP)
'设置 RemotePort 属性
'RemotePort 属性的值应该等于 远程主机上的 LocalHost 属性的值
.RemotePort = Trim(txtRemotePort)
'LocalPort 属性的值是不能改变的,必须检查它是否已经被设置
'如果 LocalPort 属性为空(没有被设置),将其设为在LocalPort输入框中输入的数值
If .LocalPort = Empty Then
.LocalPort = Trim(txtLocalPort)
Frame2.Caption = .LocalIP
'这是必须的,Bind 方法的作用是为控件“保留”一个本地端口,防止被其他用户调用。
.Bind .LocalPort
End If
End With'为了保证使用者不能改变LocalPort的值,将txtLocalPort输入框锁定
txtLocalPort.Locked = True
'在状态栏中显示“正在连接”的状态
StatusBar1.Panels(1).Text = " 正在连接到 " & Winsock1.RemoteHost & " "
'如果连接正常,做以下设置
Frame1.Enabled = True
Frame2.Enabled = True
Label4.Visible = True
Frame1.Caption = Winsock1.RemoteHost
Text2.SetFocus
StatusBar1.Panels(1).Text = " 连接成功 "
Exit Sub
'如果在连接过程中出现错误,则转向ErrHandler:,并显示错误提示
ErrHandler:
MsgBox "建立连接失败,按 F1 以获得帮助信息", vbCritical
End Sub'当按下“F1”键时显示帮助信息
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 Then
ChDir App.Path
'调用外部程序notepad.exe来打开帮助文本文件
Shell "notepad.exe readme.txt", vbNormalFocus
End IfEnd Sub'当窗体加载时显示提示信息并在 txtRemoteIP 框中显示本地主机的IP
Private Sub Form_Load()
Show
txtRemoteIP = Winsock1.LocalIP
End Sub'接收TEXT2输入框的按键,并做响应
Private Sub Text2_KeyPress(KeyAscii As Integer)'定义变量 Last_Line_Feed 来记录最后输入行的位置
Static Last_Line_Feed As Long
'定义 New_Line 字符串记录新键入的一行文本的内容
Dim New_Line As String
Dim HoneyName As String
Dim InfoIndex As Integer
'如果使用者按下CLEAR按钮对输入框内容清空,这时TEXT2为空,则重设最后输入行的位置为0
If Trim(Text2) = vbNullString Then Last_Line_Feed = 0
'传送昵称
HoneyName = Text3.Text
'当使用者按下ENTER键时
If KeyAscii = 13 Then
'取得最后输入行的内容并赋值给 New_Line 字符串
New_Line = Mid(Text2, Last_Line_Feed + 1)
'重设最后输入行的位置
Last_Line_Feed = Text2.SelStart
'如果昵称还没有传送,就先传送昵称
If InfoIndex = 0 Then
Winsock1.SendData HoneyName
InfoIndex = 1
'Winsock1.SendData New_Line
End If
'通过 WINSOCK 发送新输入的一行文本的内容
Winsock1.SendData New_Line
Text1.SelText = HoneyName + "说:" + New_Line
'在状态栏显示发送信息
StatusBar1.Panels(2).Text = " 发送 " & (LenB(New_Line) / 2) & " byte的消息 "
End IfEnd Sub'当 WINSOCK 接收到新的数据(信息)时,进行以下响应
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'定义 New_Text 字符串来记录新接收的信息
Dim New_Text As String
Dim HoneyName As String
Dim ReInfoIndex As Integer
'先判断收到的是不是第一个信息,如果是就放到昵称里去
If ReInfoIndex = 0 Then
Winsock1.GetData HoneyName
ReInfoIndex = 1
End If
'接收信息并赋值给 New_Text
Winsock1.GetData New_Text
New_Text = Mid(New_Text, 3, Len(New_Text) - 2) + Mid(New_Text, 1, 2)
'在TEXT1显示框中显示新接收到的信息
'New_Text = HoneyName + "说:" + New_Text
Text1.SelText = HoneyName + "说:" + New_Text
'Text3.Text = Len(New_Text)
'去掉前面的回车符,但如果是第一个消息的话,那就要出错的,这里还要处理一下。'Text1.SelText = New_Text
'Frame1.Caption = Winsock1.RemoteHostIP
'在状态栏中显示接收信息
StatusBar1.Panels(2).Text = " 接收到 " & bytesTotal & " byte的消息 "
End Sub'---------------------------------------------------------------------------
'这就是一个最简单的CHAT程序,你可以在它的基础上加以改进,做出更实用的CHAT小软件。
'---------------------------------------------------------------------------
服务段Private intmax As IntegerPrivate Sub Form_Load()
intmax = 0
tcpServer(0).LocalPort = 1001
tcpServer(0).Listen
Label1.Caption = "正在监听..."
End SubPrivate Sub tcpServer_ConnectionRequest(index As Integer, ByVal requestID As Long)
If index = 0 Then
intmax = intmax + 1
Load tcpServer(intmax)
tcpServer(intmax).LocalPort = 0
tcpServer(intmax).Accept requestIDLabel1.Caption = "有客户连接:" & requestID
End If
End SubPrivate Sub tcpServer_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim strData As String
tcpServer(index).GetData strData
txtOutput.Text = strData
End SubPrivate Sub txtSendData_Change()
tcpServer.SendData txtSendData.Text
End Sub
Private Sub Command1_Click()
If tcpClient.State = sckConnected Then
MsgBox "已经连接"
'Me.Enabled = False
Exit Sub
End If
tcpClient.ConnectEnd SubPrivate Sub Form_Load()
tcpClient.RemoteHost = "localhost"
tcpClient.RemotePort = 1001
End SubPrivate Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpClient.GetData strData
txtOutput.Text = strData
End SubPrivate Sub txtSend_Change()
tcpClient.SendData txtSend.Text
End Sub