60分求一个简单而完整的VB聊天程序

schumi35 2005-04-04 03:13:09
要求，用到VB的WINSCOCK，用TCP协议，A、B、C三台电脑，B和C通信，A是服务器。
B和C都是客户端，B（或C）通过A连接到C（或B）进行通信。
A：服务器端
--------------------------------------------------------------------------
Private ServerIndex As Long '表示有ServerIndex个winsock控件被载入

Private Sub closeCon_Click()
If serverWinsock(ServerIndex).State <> sckClosed Then
serverWinsock(ServerIndex).Close
End If
End Sub

Private Sub Form_Load()
'send.Enabled = False
ServerIndex = 0
'serverWinsock(0).Protocol = sckTCPProtocol
serverWinsock(0).LocalPort = 6000
serverWinsock(0).Listen
clientfrm1.Show
clientfrm2.Show
End Sub

Private Sub send_Click()
serverWinsock(ServerIndex).SendData sendmsg.Text
'MsgBox sendmsg.Text
End Sub

Private Sub serverWinsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)

'If serverWinsock.State <> sckClosed Then
'serverWinsock.Close
'serverWinsock.Accept requestID
'End If
Dim sip As String
sip = serverWinsock(0).RemoteHostIP '获得登录者的IP地址

If Index = 0 Then
ServerIndex = ServerIndex + 1
Load serverWinsock(ServerIndex)
'serverWinsock(ServerIndex).LocalPort = 0
serverWinsock(ServerIndex).Accept requestID
Else
'serverWinsock(ServerIndex).LocalPort = 0
serverWinsock(ServerIndex).Accept requestID
End If

MsgBox sip
End Sub

Private Sub serverWinsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strData As String
serverWinsock(ServerIndex).GetData strData
'MsgBox strData
msgoutput.Text = strData
End Sub

-------------------------------------------------------------------------------------

B或C：
--------------------------------------------------------------------------------
Private Sub connect_Click()
client1.connect
' MsgBox client1.State
If client1.State = 6 Then
connect.Enabled = False
send.Enabled = True
End If
End Sub

Private Sub Form_Load()
client1.RemoteHost = "192.168.34.71"
client1.RemotePort = 6000
send.Enabled = False
End Sub

Private Sub send_Click()
'MsgBox client1.State
On Error GoTo ErrorPro
If client1.State <> 8 Then
client1.SendData LocalIP & sendmsg.Text
MsgBox LocalIP
Exit Sub
End If
ErrorPro:
MsgBox "服务器断开连接或网络出错，请重新连接。"

End Sub
---------------------------------------------------------------------------------------
在线等，请帮忙修改和调试，给出可实现的代码就给分，谢谢各位。
...全文
347 26 打赏 收藏 转发到动态 举报
写回复
用AI写文章
26 条回复
切换为时间正序
请发表友善的回复…
发表回复
苍狼传说 2005-08-15
  • 打赏
  • 举报
 回复
up
wosirius 2005-07-04
  • 打赏
  • 举报
 回复
mm
zyg0 2005-04-18
  • 打赏
  • 举报
 回复
我这个temp的作用是为了资源的重复利用，如果有一个端口已经使用过，客户端已经下线的话，我会重复使用以前的端口
schumi35 2005-04-08
  • 打赏
  • 举报
 回复
周末了，最后一顶。
zyg0 2005-04-06
  • 打赏
  • 举报
 回复
1。这个处理是为了避免客户端发送过快照成的并发
，你不用管什么意思，用就好了 Len(clientDat) <> 0 是为了确定传过来数据
哦我写错了，应该是

Dim strRe（） As String
2。Clientsck是winsocke控件，看看你控件名是不是一样的，写得匆忙我没测试frmmain你可以都去掉的
schumi35 2005-04-06
  • 打赏
  • 举报
 回复
Private Sub Command1_Click()
frmmain.Clientsck.SendData SetMsge("sdfa", Text1.Text)
DoEvents
End Sub
-----------------------------------------------------------------------------
frmmain是窗口名称吧，但执行
-------------------------------------------------------------
Private Sub Form_Load()
Clientsck.RemoteHost = "192.168.34.71"
Clientsck.RemotePort = 8000
Clientsck.Connect
End Sub
----------------------------------------------------------------
怎么会说未找到方法和数据成员呢？

望解答，谢谢。
schumi35 2005-04-06
  • 打赏
  • 举报
 回复
影子大哥，在请教一个：Serversck(temp)和Serversck(index)的区别是什么？
zyg0 2005-04-05
  • 打赏
  • 举报
 回复
客户端：
Option Explicit
Dim other As String '接收方
Private Sub Command1_Click()

frmmain.Winsock1.SendData SetMsge("sdfa", Text1.Text)
DoEvents
End Sub

Private Sub Command2_Click()

'------------------------------------------------

On Error Resume Next
If MsgBox("确实要退出吗？", vbApplicationModal + vbDefaultButton2 + vbYesNo + _
vbInformation, App.Title) = vbYes Then
Winsock1.Close
DoEvents
End
End Sub

Private Sub Form_Load()
Winsock1.RemoteHost = Hserverip
Winsock1.RemotePort = 1080
Winsock1.Connect
End Sub

'*************************************************************************
'**函 数 名：Winsock1_Connect
'**输 入：无
'**输 出：无
'**功能描述：连接成功触发
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 09:52:30
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
'Private Sub Winsock1_Connect()
' On Error GoTo errend
' Winsock1.SendData SetMsge("/sendonline", "")
' DoEvents
'Exit Sub
'
'errend:
' MsgBox "连接发生错误!数据发送失败！", vbOKOnly + vbExclamation, "TCP 错误信息"
'
'End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'获得数据
On Error Resume Next
Dim clientDat As String
Winsock1(index).GetData clientDat, vbString
If Len(clientDat) <> 0 Then
Dim strRe As String
strRe = Split(clientDat, "#$%@#$%@#&&#@")
For i = 0 To UBound(strRe) - 1
MsgBox Getmsgmsg(strRe(i))
Next
End If

End Sub



'**函 数 名：SetMsge
'**输 入：msge(String) -消息类型
'** ：msgmsg(String) -消息主体
'"#$%@#$%@#&&#@"-处理并发部分
'**输 出：(String) -
'**功能描述：发送消息的格式
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:33:44
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function SetMsge(msge As String, msgmsg As String) As String
Dim aa As String * 12
aa = msge
SetMsge = aa & msgmsg & "#$%@#$%@#&&#@"
End Function
'**函 数 名：Getmsgmsg
'**输 入：str(String) -
'**输 出：(String) -
'**功能描述：获得消息中的消息主体
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:34:01
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function Getmsgmsg(str As String) As String
Getmsgmsg = Trim(Mid(str, 13, Len(str) - 12))
End Function

'*************************************************************************
'**函 数 名：GetMsge
'**输 入：str(String) -
'**输 出：(String) -
'**功能描述：获得消息中的消息类型
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:31:58
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function GetMsge(str As String) As String
GetMsge = Trim(Mid(str, 1, 12))
End Function





有问题给我留言
zyg0 2005-04-05
  • 打赏
  • 举报
 回复
Private Sub Winsock1_DataArrival(index As Integer, ByVal bytesTotal As Long)
'获得数据
On Error Resume Next
Dim clientDat As String
Winsock1(index).GetData clientDat, vbString
If Len(clientDat) <> 0 Then
Dim strRe As String
strRe = Split(clientDat, "#$%@#$%@#&&#@")
For i = 0 To UBound(strRe)-1 '服务器这里应该-1，发错了
Call fjmsg(clientDat, index)
Next
End If

End Sub
zyg0 2005-04-05
  • 打赏
  • 举报
 回复
服务器
Option Explicit
Private intMax As Long 'winsock最大的下标

Private Sub Form_Load()
intMax = 0
Winsock1(0).LocalPort = 7699 '本地监听的端口
Winsock1(0).Listen

End Sub
'*************************************************************************
'**函 数 名：Winsock1_ConnectionRequest
'**输 入：Index(Integer) -
'** ：ByVal requestID(Long) -
'**输 出：无
'**功能描述：对方请求连接时候触发,当没有以前已经关闭的控件的winsock控件数组的话就创建
'**全局变量：
'**调用模块：
'**作 者 影子
'**日 期：2005-02-06 08:39:12
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Private Sub Winsock1_ConnectionRequest(index As Integer, ByVal requestID As Long)
On Error Resume Next
If index = 0 Then
Dim i As Integer
Dim temp As Integer
temp = 0
For i = 1 To intMax
If Winsock1(i).State = vbclose Then
temp = i
Exit For
End If
Next
If temp = 0 Then
intMax = intMax + 1
temp = intMax
End If
Load Winsock1(temp)

Winsock1(temp).LocalPort = 0

Winsock1(temp).Accept requestID
End If

End Sub
Private Sub Winsock1_DataArrival(index As Integer, ByVal bytesTotal As Long)
'获得数据
On Error Resume Next
Dim clientDat As String
Winsock1(index).GetData clientDat, vbString
If Len(clientDat) <> 0 Then
Dim strRe As String
strRe = Split(clientDat, "#$%@#$%@#&&#@")
For i = 0 To UBound(strRe)
Call fjmsg(clientDat, index)
Next
End If

End Sub
Private Sub fjmsg(str As String, index As Integer)
For i = 1 To intMax
If Winsock1(i).State = 7 Then
Winsock1(i).SendData str & "#$%@#$%@#&&#@"
DoEvents
End If
Next
End Sub
'*************************************************************************
'**函 数 名：SetMsge
'**输 入：msge(String) -消息类型
'** ：msgmsg(String) -消息主体
'"#$%@#$%@#&&#@"-处理并发部分
'**输 出：(String) -
'**功能描述：发送消息的格式
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:33:44
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function SetMsge(msge As String, msgmsg As String) As String
Dim aa As String * 12
aa = msge
SetMsge = aa & msgmsg & "#$%@#$%@#&&#@"
End Function
'**函 数 名：Getmsgmsg
'**输 入：str(String) -
'**输 出：(String) -
'**功能描述：获得消息中的消息主体
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:34:01
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function Getmsgmsg(str As String) As String
Getmsgmsg = Trim(Mid(str, 13, Len(str) - 12))
End Function

'*************************************************************************
'**函 数 名：GetMsge
'**输 入：str(String) -
'**输 出：(String) -
'**功能描述：获得消息中的消息类型
'**全局变量：
'**调用模块：
'**作 者：影子
'**日 期：2005-02-06 08:31:58
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function GetMsge(str As String) As String
GetMsge = Trim(Mid(str, 1, 12))
End Function
schumi35 2005-04-05
  • 打赏
  • 举报
 回复
影子大哥有没有来上班啊？我等着呢
schumi35 2005-04-05
  • 打赏
  • 举报
 回复
Private Sub Winsock1_DataArrival(index As Integer, ByVal bytesTotal As Long)
'获得数据
On Error Resume Next
Dim clientDat As String
Winsock1(index).GetData clientDat, vbString ’这里GetData得到的是所有客户端发送的
If Len(clientDat) <> 0 Then ’数据吗？否则下面为什么要
Dim strRe As String ’For i = 0 To UBound(strRe)-1？
strRe = Split(clientDat, "#$%@#$%@#&&#@")
For i = 0 To UBound(strRe)-1
Call fjmsg(clientDat, index)
Next
End If

End Sub
schumi35 2005-04-04
  • 打赏
  • 举报
 回复
好的，谢谢，我明天继续上来哈。
zyg0 2005-04-04
  • 打赏
  • 举报
 回复
明天上班的吧，今天要下班了，明天头午给你写个小例子
schumi35 2005-04-04
  • 打赏
  • 举报
 回复
谢谢捧场，影子大哥请帮忙调调哈，把代码粘上来就行了。
zyg0 2005-04-04
  • 打赏
  • 举报
 回复

Private Sub Form_Load()
'1秒执行一次
SetTimer Me.hwnd, 0, 1000, AddressOf TimerProc
end sub
------------------模块中
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Dim Tel As Long'记录时间
'这里写 执行代码
Public Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

If Tel = 30 Then'30秒执行一次,可以改这个数字到任何大小,long类型


Tel = 0
End If
Tel = Tel + 1

End Sub
zyg0 2005-04-04
  • 打赏
  • 举报
 回复
其实你不用考虑ip的问题,只要b,c登陆 a的作用只是转发
schumi35 2005-04-04
  • 打赏
  • 举报
 回复
怎么转交啊，是不是B和C都要设成监听的啊？大哥能不能直接在我的代码上加一点啊？谢谢
jlum99 2005-04-04
  • 打赏
  • 举报
 回复
在B,C登陆以后向 A提交各自IP,PORT信息.然后由A转交.再由B,C建立连接.这时候可以用UDP连接.又快又方便.
schumi35 2005-04-04
  • 打赏
  • 举报
 回复
哦，谢谢，好象是听说过，是从1025开始配吧。

还请大哥帮我修改一下程序，实现B和C通信的功能，谢谢谢谢。
加载更多回复（6）
vb 简单聊天程序
vb 聊天通信程序，winsocket 控件编程。对刚接触网络编程的人很有学习帮助。
简单VB聊天程序
本次实验是采用TCP协议，服务器程序设置本Scoket的监听端口（LocalPort），然后调用Listen方法；当客户要求建立一个连接时，服务器方产生ConnectionRequest事件，如果服务器想完成连接，则调用Accept方法认可。一旦连接建立成功，双方计算机都能利用SendData方法发送。当接收到数据时，发生DataArrival事件，我们可以在此事件中调用GetData方法接收数据。
VB简单聊天程序.rar
VB Winsock点对点发消息聊天（超简单），可以实现实时的对话和聊天功能，供大家参考，有问题随时联系。
vb聊天程序(server+多client)
自己写的简单聊天程序,可以用在外网和内网的通讯.主要使用winsock控件实现.同时使用了UPD和TCP,实现了 一个服务器,多个客户端的聊天..这个程序只实现了群聊.
VB6.0使用winsock控件实现聊天程序（源代码）
使用vb6.0开发的一个聊天程序，支持多客户端互相通信，有些类似QQ的聊天窗口。 注意：程序不支持win7系统，以前在xp下开发的，运行正常。
控件

1,453

社区成员

41,351

社区内容

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章