资源描述
华南农业大学理学院
课程实验(设计)报告
专业年级: 11信息与计算科学
学生学号: 201130760
学生学号: 201130760
学生姓名:
学生姓名:
实验题目: Socket应用程序设计
指导老师:
实验时间:2013年11月1日-2013年11月29日
目 录
1实验内容和要求 1
1.1实验内容 1
1.2实验要求 1
1.3实验实现的功能 1
2实验过程 2
2.1系统需求分析 2
2.1.1客户端 2
2.1.2服务器 2
2.2系统的概要设计 3
2.3具体实现 4
2.3.1客户端 4
2.3.1.1登陆功能 4
2.3.1.2聊天功能 6
2.3.1.3离线聊天功能 8
2.3.1.4接受离线信息功能 9
2.3.1.5聊天记录功能 10
2.3.1.6显示用户状态功能 12
2.3.1.7文件传输功能 13
2.3.2服务器 19
2.3.2.1登录、注册验证功能 19
2.3.2.2群聊功能 21
2.3.2.3用户信息管理功能 21
3实验结果 23
4讨论与总结 24
5参考文献 24
6小组分工 25
1实验内容和要求
1.1实验内容
在学习完TCP/IP协议组后,要求掌握基于此协议实现网络通信,理解TCP与UDP的不同特征以及实现方式。基于Windows平台建立一个基于TCP/IP协议的网络通讯小应用,实验可采用UDP或TCP实现。
1.2实验要求
(1)能够进行用户管理,所有用户必须登录到服务器,有服务器维护在线信息;
(2)IM功能:用户登录后能够进行实时多方点到点短信息通信,如聊天;
(3)能够选择要求服务器进行转发服务;
(4)能够保存通信记录到数据库(SQL Server或者其他桌面型数据库或数据文件);
(5)能进行双方文件传输,能够显示进度;
*(6)支持断点重传,检查时需有功能随时中断传送,并在下次启动时能显示重传状态;
*(7)数据包加密;
*(8)实时语音双向传送功能;
*(9)多方通话功能;
(10)界面设计要求布局合理,信息清晰。
(11)自加功能。
(*为选做内容)
1.3实验实现的功能
(1)服务器能够进行用户管理,所有用户必须登录到服务器,有服务器维护在线信息;
(2)IM功能:用户登录后能够进行实时多方点到点短信息通信,如聊天;
(3)服务器离线转发功能;
(4)客户端保存群聊天记录;
(5)能进行双方文件传输,能够显示进度;
(10)界面设计要求布局合理,信息清晰。
2实验过程
2.1系统需求分析
2.1.1客户端
(1)登陆功能:在用户填写相关的账户和密码时,客户端能够发送连接客户端要求,当,连上客户端的时候,客户端能够将账号和密码信息发送到服务器进行核对,并返回信心
(2)聊天功能:在客户端中,用户有权选择群聊还是与某在线用户私聊
(3)离线聊天功能:在线的用户可能通过服务器将信息发给离线的用户
(4)接受离线信息共能:当用户上线时,接收其他用户的离线信息
(5)聊天记录功能:客户端能自动将群聊的信息保存在相应的数据库当中
(6)显示用户状态功能:对于在线的用户和离线的用户能够及时显示在表格当中
2.1.2服务器
(1)维护用户功能:添加新用户,修改用户密码,删除用户
(2)更新用户状态功能:通知客户端更新成员状态和相应的列表
(3)离线功能:为离线用户保存离线信息,并且在用户上线的时发送相应的离线信息
(4)检验用户信息功能:验证用户的账号和密码的正确性,并禁止用户异地同时登陆
(5)显示群聊记录:在服务器中几时显示群聊的信息
2.2系统的概要设计
图2.1软件功能模块图
图2.2服务器与客户端功能的设计
图2.3服务器与客户端数据流程图
2.3具体实现
2.3.1客户端
2.3.1.1登陆功能
图2.4登陆界面
(1)在按下登陆按钮的时候,程序获取界面中的服务器中IP地址和端口号,同时检验账号和密码是否有误。若账号和密码填写上没有错误,进行连接服务器。
代码如下:
Private Sub Command1_Click() '点击登陆按钮
Form2.login = False '设置能否登陆标志为“不能”
If Form1.Username.Text = "" Or Form1.Usercode.Text = "" Then '检查账号和密码填写是否有空
MsgBox "请输入账号和密码"
Else
Call tcpClient_Connect '连接服务器
DoEvents
If Form2.tcpClient.State = 7 Then '若连接上服务器则发送账号和密码
Form2.tcpClient.SendData "|" & "***" & Form1.Username.Text & "***" & "###" & Form1.Usercode.Text & "###" & "|" '***账号***###密码###
DoEvents
Else
MsgBox "没有服务器"
End If
Timer1.Enabled = True
End If
End Sub
Public Sub tcpClient_Connect()
If Form2.tcpClient.State <> 7 Then
Form2.tcpClient.Close
Form2.tcpClient.RemoteHost = Form1.txtHost.Text
Form2.tcpClient.RemotePort = Form1.txtPort.Text
Form2.tcpClient.Connect
DoEvents
End If
End Sub
(2)当连接成功后,发送账号和密码,用相关的已经定义好协议进行封装发送给服务器。协议是***账号***###密码###
代码如下:
If Form2.tcpClient.State = 7 Then '若连接上服务器则发送账号和密码
Form2.tcpClient.SendData "|" & "***" & Form1.Username.Text & "***" & "###" & Form1.Usercode.Text & "###" & "|" '***账号***###密码###
(3)当客户端收到的服务器的协议信息是密码和账号是正确的时候才能进行真正的登录。
协议是:当收到*#时,代表登录成功。当收到*ERROR时,代表没有这账号。当收到#ERROR时,代表密码错误。当收到*ONLINE时,代表账号已经登录。
代码如下:
If InStr(sData, "*#") <> 0 Then
login = True
ElseIf InStr(sData, "*ERROR") <> 0 Then
MsgBox "没有这账号"
ElseIf InStr(sData, "#ERROR") <> 0 Then
MsgBox "密码错误"
ElseIf InStr(sData, "*ONLINE") <> 0 Then
MsgBox "账号已经登录"
End If
2.3.1.2聊天功能
(1)群聊天。在图2.2的文本框中输入字符,便可以发送信息。发送的协议:$$$群聊天信息$$$,通过进行过协议封装的聊天信息,能够让服务器进行识别,别且转发给在线用户。
图2.5聊天窗口
Private Sub cmdSend_Click()
If txtOut.Text = "" Then
MsgBox "发送内容不能为空"
Exit Sub
End If
tcpClient.SendData "$$$" + Form1.Username.Text + " : " & txtOut.Text + "$$$"
'============================================插入聊天记录
a = CStr(Now()) + Chr(10) + Form1.Username.Text + " : " + txtOut.Text + Chr(10)
Set rs = cn.Execute("insert into data (tcp_data) values ('" & a & "')") 'tcp_data是表的列名
'============================================插入聊天记录
rtbIn.Text = rtbIn.Text & Chr(10) + CStr(Now()) + Chr(10) + Form1.Username.Text + " : " + txtOut.Text + Chr(10)
txtOut.Text = ""
rtbIn.SelStart = Len(rtbIn.Text)
End Sub
(2)发送私聊信息。在listviews中点击相应的用户名字就可以进行私聊,在登陆的时候已经设置好TCP控件的端口号。
代码如下:
Public Sub set_privatechat()
For i = 1 To Form2.ListView1.ListItems.Count
Private_Chat(i).ClientSer.Close
Private_Chat(i).ClientSer.LocalPort = 8080 + i
Private_Chat(i).ClientSer.Listen
Next
End Sub
(3)接收在线私聊信息。
Private Sub ClientCli_DataArrival(ByVal bytesTotal As Long)
ClientCli.GetData str, vbString
Text1.Text = Text1.Text & str
Text1.SelStart = Len(Text1.Text)
'If Me.WindowState = 1 Then
'Timer2.Enabled = True
'End If
End Sub
Private Sub ClientSer_DataArrival(ByVal bytesTotal As Long)
ClientSer.GetData str, vbString
Text1.Text = Text1.Text & str
Text1.SelStart = Len(Text1.Text)
'If Me.WindowState = 1 Then
'Timer2.Enabled = True
'End If
End Sub
2.3.1.3离线聊天功能
在输入框中输入私聊信息时,先判断是否在线,假如是在线的话直接利用已经和对方连接的TCP控件进行发送信息。假如是离线用户的话,利用协议将封装好的离线信息发送给服务器,在通过服务器发送给离线的用户。离线信息协议:%**1发送者账号**1**2接收者账号**2**$$离线的信息**$$%
代码如下:
Private Sub Command1_Click()
Dim str As String
If Len(Text2.Text) = 0 Then
MsgBox ("发送内容不能为空!")
Exit Sub
End If
str = Form1.Username.Text & " " & Time & Chr(13) & Chr(10) & Text2.Text
str = str & Chr(13) & Chr(10) & Chr(13) & Chr(10)
If ClientSer.State = 7 Then
ClientSer.SendData str
'MsgBox "已连接上对方"
ElseIf ClientCli.State = 7 Then
ClientCli.SendData str
End If
If ClientCli.State <> 7 And ClientSer.State <> 7 Then '离线信息设置
Form2.tcpClient.SendData "%" + "**1" + Label2.Caption + "**1" + "**2" + Label3.Caption + "**2" + "**$$" + str + "**$$" + "%"
DoEvents
End If
Text1.Text = Text1.Text & str
Text1.SelStart = Len(Text1.Text)
Text2.Text = ""
End Sub
图2.6私聊对话框
2.3.1.4接受离线信息功能
接收离线私聊信息。当收到服务器的离线信息时,对发送过来的字符串进行信息提取,提取出发送者、接收者和信息。
Function check_outlinemessage(message As String)
sender_where1 = 0
reciever_where1 = 0
outmessage_where1 = 0
sender_where2 = 0
reciever_where2 = 0
outmessage_where2 = 0
If InStr(message, "**2") <> 0 Then
Do
sender_where1 = InStr(sender_where2 + 1, message, "**1")
sender_where2 = InStr(sender_where1 + 1, message, "**1")
sender = Mid(message, sender_where1 + 3, sender_where2 - sender_where1 - 3)
outmessage_where1 = InStr(outmessage_where2 + 1, message, "**$$")
outmessage_where2 = InStr(outmessage_where1 + 1, message, "**$$")
outmessage = Mid(message, outmessage_where1 + 4, outmessage_where2 - outmessage_where1 - 4)
For n = 1 To Form2.ListView1.ListItems.Count
If Form2.ListView1.ListItems(n).Text = sender Then
Private_Chat(n).Text1.Text = Private_Chat(n).Text1.Text & outmessage
Private_Chat(n).Text1.SelStart = Len(Private_Chat(n).Text1.Text)
Form2.ListView1.ListItems(n).ForeColor = vbRed Form2.ListView1.ListItems(n).ListSubItems.Item(1).ForeColor = vbRed
Form2.ListView1.ListItems(n).ListSubItems.Item(2).ForeColor = vbRed End If
Next
Loop Until InStr(sender_where2 + 1, message, "**1") = 0
End If
End Function
2.3.1.5聊天记录功能
(1)读取数据库中的聊天信息。添加VB的控件ADO,ADO控件建立起读取聊天记录的桌面型数据库access,读取数据库中信息,如图2.4。
代码如下:
Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Sub adddata()
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.mdb;Persist Security Info=False"
cn.Open
Set rs = cn.Execute("select * from data")
End Sub
图2.7数据库的信息
当按下群聊天记录的时候弹出对应的RichTextBox控件如下图
图2.8群聊天记录对话框
(2)将群聊天信息加入到数据库。提取$$$与$$$之间的群聊天信息
If InStr(sData, "$$$") <> 0 Then
group_chat1 = InStr(sData, "$$$")
group_chat2 = InStr(group_chat1 + 1, sData, "$$$")
ssData = Mid(sData, group_chat1 + 3, group_chat2 - group_chat1 - 3)
'============================================插入聊天记录
a = CStr(Now()) + Chr(10) + ssData + Chr(10)
Set rs = cn.Execute("insert into data (tcp_data) values ('" & a & "')") 'tcp_data是表的列名
'============================================插入聊天记录
rtbIn.Text = rtbIn.Text + Chr(10) + CStr(Now()) + Chr(10) + ssData + Chr(10)
rtbIn.SelStart = Len(rtbIn.Text)
End If
Call check_useronline(sData)
Call set_privatechat
2.3.1.6显示用户状态功能
(1)当用户登录的时候,服务器会发送当前用户列表的信息给客户端,协议为***用户名***@@@IP地址@@@,当IP地址为NULL时,客户端识别为没有上线,只有不是NULL的时候才是真正有上线,对于上线的用户,在listview中的状态会由0变为1,表示已经上线。同时会清空listview,将所以的用户进行重新的加载。如图2.6.
代码如下:
Public Sub check_useronline(gData As String)
account_where1 = 0
IP_where1 = 0
account_where2 = 0
IP_where2 = 0
If InStr(gData, "***") >= 1 Then
Form2.ListView1.ListItems.Clear '清空列表
Do
account_where1 = InStr(account_where2 + 1, gData, "***")
account_where2 = InStr(account_where1 + 1, gData, "***")
Username = Mid(gData, account_where1 + 3, account_where2 - account_where1 - 3)
IP_where1 = InStr(IP_where2 + 1, gData, "@@@")
IP_where2 = InStr(IP_where1 + 1, gData, "@@@")
UserIP = Mid(gData, IP_where1 + 3, IP_where2 - IP_where1 - 3)
Set itmx = Form2.ListView1.ListItems.Add(1, , Username)
itmx.SubItems(2) = UserIP
If UserIP <> "NULL" Then
itmx.SubItems(1) = 1
Else
itmx.SubItems(1) = 0
End If
Loop Until InStr(account_where2 + 1, gData, "***") = 0
End If
End Sub
图2.9用户状态列表
(2)当用户退出的时候,会发送Q的字符串给服务器,告诉服务器退出,并且让服务器发送用户状态信息给各个在线用户,再次刷新用户。
代码如下:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
tcpClient.SendData "Q" & CStr(Now())
DoEvents
Unload Form3
Unload Form2
Form1.Show
End Sub
2.3.1.7文件传输功能
基于TCP/IP协议的通信,需要分别建立客户端应用程序和服务器段应用程序,大致流程如图4-1
图2.10客户端与服务器数据流图
实现原理:发送方先获取待传输文件的基本信息,主要是文件名及文
件长度(用于创建数据缓冲区);然后,将其发送给接收方;接着,建立和
文件一样大小的数据缓冲区,并将文件读入;最后,将数据缓冲区中的数据
发送给接收方。与此同时,当接收方接收到文件名和文件长度之后,就为其
创建新的文件和数据缓冲区;然后,接收传输的文件数据,并将其放在数据
缓冲区中;最后,依次将数据缓冲区的数据写入新创建的文件中。这样便完
成了不同计算机之间的文件传输。
在本次实验中,于私人聊天模式里,当勾上“打开文件传输通道后”,右边button将变为可用,
如下图:
,
图2.11文件传输
此时点击“发送文件”按钮,便会弹出窗体
图2.12文件传输界面
这时窗体里的winsock控件(数组)将处于监听状态,执
行代码如下
For j = 1 To Form2.ListView1.ListItems.Count
Private_send(j).wskServer.Close
Private_send(j).wskServer.LocalPort = 8000 + j
Private_send(j).wskServer.Listen
Next j
并且若此时点击“浏览”时,将会调用系统里的控件“Comdlg”,
执行下段代码
Private Sub Command1_Click()
With Comdlg
.CancelError = True
On Error GoTo OpenErr
.DialogTitle = “打开一个测试文件…”
.Filter = “所有文件 (*.*)|*.*”
.Flags = &H4
.ShowOpen
Text3.Text = .FileName
End With
OpenErr:
End Sub
若此时选择的文件正确(路径,文件存在),将可以点击“发送按钮”,已
连接的对方的winsock将会发生”请求”事件,接受“请求”的话,将发生“数据到达”,相关代码如下所示:
Private Sub wskServer_ConnectionRequest(ByVal equested As Long)
If Private_send(SelectNo).wskServer.State <> sckClosed Then Private_send(SelectNo).wskServer.Close
Private_send(SelectNo).wskServer.Accept equested
List1.Clear
List1.AddItem “已连接…”
Command2.Enabled = True
End Sub
Private Sub wskServer_DataArrival(ByVal bytesTotal As Long)
Dim WskChat As String
Private_send(SelectNo).wskServer.GetData WskChat
If WskChat = “NoThanks” Then
MsgBox “对方拒收你发送的文件.”, vbExclamation, “Server”
ElseIf WskChat = “OkSend” Then
MsgBox “对方接受了你的文件.” & vbCrLf & vbCrLf & “单击“确定”开始传送…”, vbInformation, “Server”
GetFileNum = FreeFile
LenFile = FileLen(Text3.Text)
‘------------------
ProBarLen = LenFile
VarPlus = 0
‘------------------
Open Text3.Text For Binary As #GetFileNum
OnSend = True
Command2.Enabled = False
Call TCPSendFile(Private_send(SelectNo).wskServer, GetFileNum, SplitFile)
End If
End Sub
若没有连接上,我们添加了Timer控件,来监控状态,若处于“连接关闭”状态,将重置winsock,并显示相应信息给用户(例如“传送”按钮不可用等),
如下图:
图2.13文件传输中载入文件
相关代码如下:
Private Sub Timer1_Timer()
If Private_send(SelectNo).wskServer.State = sckClosing Then
List1.Clear
List1.AddItem "对方的连接已关闭..."
Private_send(SelectNo).wskServer.Close
Private_send(SelectNo).wskServer.LocalPort = 8000 + SelectNo
Private_send(SelectNo).wskServer.Listen
Command2.Enabled = False
End If
End Sub
根据上面所述的原理,是使用内存来存储数据,然而,当需要传送的数据比较大时,就不能像以上介绍的那样,直接将整个文件放入数据缓冲区中了,我们的内存是无法忍受用一个几百MB甚至上GB的空间去存储那些临时数据的。显然,这种做法已远不能满足我们的需求,这时可以将文件按照一定的大小,分成若干个数据包(远小于内存的容量)。首先,设置数据包的大小(如64K),根据文件的基本信息(主要文件的长度),计算出总共需要的数据包数;然后,依次读取同数据包一样大小的数据到数据缓冲区中;接着,将数据缓冲区中的数据,发送到指定的计算机上;同时在另一端,建立一个数据缓冲区,缓冲区的大小要根据接收到的数据来确定,依次接收客户端传输过来的数据包,并将数据缓冲区的数据写入相应的文件中,这样就很容易实现大文件的传输了,这是一种较为常用的方法(较为容易实现断点续传),不过本次采用的是一种“迭代递归”的思想,
使用自己编写的函数SplitFile()来稍微简单实现传输大文件,但断点重传功能将受到限制,相关代码如下:
Private Function SplitFile() As Long
Dim GetCount As Long
If LenFile >= 8192 Then
GetCount = 8192
LenFile = LenFile - GetCount
Else
GetCount = LenFile
LenFile = LenFile - GetCount
End If
VarPlus = VarPlus + GetCount
ProBar.Value = (VarPlus / ProBarLen) * 100
SplitFile = GetCount
End Function
Private Sub TCPSendFile(objWinSock As Winsock, FileNumber As Integer, SendLen As Long)
Dim FileByte() As Byte, i As Long
ReDim FileByte(SendLen - 1)
Get #FileNumber, , FileByte
objWinSock.SendData FileByte
End Sub
至于显示进度,在私聊和传送文件窗体里,我们添加了VB自带的控件progressbar,进度也根据以传送文件的大小和总大小作简单除法:
ProBar.Value = (VarPlus / ProBarLen) * 100来显示,图示效果如下:
图2.14文件传输接收完毕
图2.15文件传输发送完毕
2.3.2服务器
2.3.2.1登录、注册验证功能
双击服务器.exe,进入初始界面,这里winsock将初始化,得到IP地址并且设置端口等,并对客户端管理界面进行初始化(此时该界面不显示但却已执行相关操作,点击“客户端”界面时显现):
图2.16服务器界面
图2.17客户端管理界面
当有客户端请求连接服务器时,同意的话,发生”事件到达”,服务器采取机制:判断数据种类,并采取相关操作。
代码如下:
Dim sData As String
Dim sName As String
tcpServer(Index).GetData sData
rtbSave.SelStart = Len(rtbSave.Text)
'客户端向服务器发送已经登录和退出信息
'===========================================================
sName = Left(sData, 1)
If sName = "C" Then
tcpServer(Index).SendData "C_OK"
DoEvents
ElseIf sName = "Q" Then
tcpServer(Index).SendData "Q_OK."
DoEvents
Call del_IP(tcpServer(Index).RemoteHostIP) '在客服端管理中删除已退出客户端的IP地址和上线记录
tcpServer(Index).Close
NumOnline = NumOnline - 1
End If
'===========================================================
'客户端向服务器发送账号和密码,服务器提取账号和密码
'===========================================================
If InStr(sData, "|") Then
account_where1 = InStr(sData, "***")
account_where2 = InStr(account_where1 + 1, sData, "***")
user(0).uName = Mid(sData, account_where1 + 3, account_where2 - account_where1 - 3) '***用户名***
password_where1 = InStr(sData,
展开阅读全文