现在的位置: 首页 > 综合 > 正文

.net中的socket异步通信实现–服务器端代码

2018年05月04日 ⁄ 综合 ⁄ 共 25765字 ⁄ 字号 评论关闭

http://www.cnblogs.com/yyshenren/archive/2008/07/10/1240114.html

这是很久以前做的一个项目中的一部分代码,和项目业务逻辑相关的部分代码已经删去了,留下的这些仅仅和异步通信有关。
提前声明,这些源代码当时是根据网上的一段socket通信代码修改后的版本。俗话说,copy+修改=创新!
当时,项目的需求是这样的:
1.需要能够实现多个工作站互相进行异步数据传输
2.能够根据不同工作站的配置情况选择从哪个工作站申请数据
3.能够及时收获各工作站的配置变更和在线情况
4.收到的数据信息量较大,需要进行处理后送到其他模块备用。
根据这些需求让我觉得我要做的这部分程序有点像QQ的功能,因此我需要在服务器端程序建立一个服务程序。
各工作站通过服务程序获得其他工作站的在线列表和每个工作站的配置信息,所有工作站的配置一旦更新,全部上传到服务器端保留。
在这里就不讨论如何做服务程序了,这个太简单了,大家可以在网上搜到一堆例程。
服务程序代码如下:客户端代码将在下一篇接进行介绍


Imports System.ServiceProcess
Imports System.Net.Sockets
Imports System.Net
Imports System.Threading
Imports System.Collections
Imports System.Text
Imports System.IO

Public Class Server
    
Inherits System.ServiceProcess.ServiceBase

#Region "全局变量"
    
Dim ServerSocket As New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
    
Dim ipep As IPEndPoint = New IPEndPoint(IPAddress.Any, 11000)
    
Dim htUserList As New Hashtable  '用来保存在线用户和用户的"IP和端口" 
    Dim userName(0As String
    
Dim userIPEP(0As IPEndPoint
    
Dim userTime(0As Integer
    
Dim DataServerInfor(0As String
    
Dim DataServerSaveEnd(0As Boolean
    
Dim timerDelegate As New TimerCallback(AddressOf onLineTimeOut)
    
Dim sw As StreamWriter
    
Dim movelenth As Integer = 512 '最大为512,乘以2为传送的最大字节数:1024
    Private Shared LongSendID As Integer = 0
    
Private LongSendMax As Integer = 50
    
Private dealing As Boolean = False
    
Private ReceiveDataList As DataQueue
#End Region

#Region "参数"

    '以下是客户端到服务器端的消息开头 
    Const LOGININ As String = "10" '请求登陆的消息|||消息形式:10+自己的用户名 
    Const LOGINOUT As String = "11" '请求登出的消息|||消息形式:11+自己的用户名 
    Const GETULIST As String = "12" '请求获得在线用户列表|||消息形式:12 
    Const P2PCONN As String = "13" '请求P2P连接的消息|||消息形式:13+自己的用户名+|+对方的用户名 
    Const HOLDLINE As String = "14" '保持连接.|||消息开式:14+自己的用户名 

    
'以下是服务器到客户端的消息开头 
    Const HVUSER As String = "20" '用户名已存在 
    Const GETUSER As String = "21" '在线用户列表|||消息格式:21+用户名+EP 
    Const MAKHOLD As String = "22" '打洞命令|||消息格式:22+IP 
    Const LOGINOK As String = "23" '登陆成功 
    Const SERVCLS As String = "24" '服务器关闭 
    Const MSGEND As String = "25" '消息结束 
    Const ONEOFF As String = "26" '一个客户端下线

    
'以下是服务器端的命名 
    Const EXITPRO As String = "EXIT" '退出命令 
    Const SHOWULIST As String = "SHOWUSER" '显示在线用户 
    Const HELP As String = "HELP" '显示帮助 

    
'以下是工作站发送给服务器的消息开头:
    Const RECDEVINFO As String = "45" '工作站发送给服务器的设备配置信息

    
'以下是ICU客户端发送给本服务器程序的命令:
    Const GETDATASERVER As String = "50"        '获取当前在线的数据服务器(即工作站)
    Const SHOWDATASERVER As String = "51"       '将在线的数据服务器
    Const GETDSERVERINFOR As String = "52"      '获取某个数据服务器的配置信息

#End Region

#Region " 组件设计器生成的代码 "

    Public Sub New()
        
MyBase.New()

        ' 该调用是组件设计器所必需的。
        InitializeComponent()

        ' 在 InitializeComponent() 调用之后添加任何初始化

    
End Sub

    'UserService 重写 dispose 以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        
If disposing Then
            
If Not (components Is NothingThen
                components.Dispose()
            
End If
        
End If
        
MyBase.Dispose(disposing)
    
End Sub

    ' 进程的主入口点
    <MTAThread()> _
    
Shared Sub Main()
        
Dim ServicesToRun() As System.ServiceProcess.ServiceBase

        ' 在同一进程中可以运行不止一个 NT 服务。若要将
        ' 另一个服务添加到此进程,请更改下行以
        ' 创建另一个服务对象。例如,
        '
        '   ServicesToRun = New System.ServiceProcess.ServiceBase () {New Service1, New MySecondUserService}
        '
        ServicesToRun = New System.ServiceProcess.ServiceBase() {New Server}
        System.ServiceProcess.ServiceBase.Run(ServicesToRun)
    
End Sub

    '组件设计器所必需的
    Private components As System.ComponentModel.IContainer

    '注意: 以下过程是组件设计器所必需的
    ' 可以使用组件设计器修改此过程。
    ' 不要使用代码编辑器修改它。
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        
'
        'Server
        '
        Me.ServiceName = "Cyber Service"

    End Sub

#End Region

    Protected Overrides Sub OnStart(ByVal args() As String)
        
' 在此处添加启动服务的代码。此方法应设置具体的操作
        ' 以便服务可以执行它的工作。
        '获得服务器的IP地址
        Try
            sw 
= New StreamWriter("C:/log.log"True)       '开启log文件
            '获取第一个可用网卡作为传输用:
            Dim addressList As System.Net.IPAddress() = Dns.GetHostByName(Dns.GetHostName()).AddressList
            
Dim ServerIP As IPAddress = addressList(0)
            ServerSocket.Bind(ipep) 
'绑定此地址和端口
            ReceiveDataList = New DataQueue
            
Dim listenTH As New Thread(AddressOf listen)
            listenTH.Start() 
'启用监听的线程 
            WriteLog("服务器启动成功:" & Now.ToString)
            
Dim timer As New Timer(timerDelegate, Nothing05000)
        
Catch ex As Exception
            WriteLog(
"OnStart:" & Err.Description)
        
End Try
    
End Sub

    Protected Overrides Sub OnStop()
        
' 在此处添加代码以执行停止服务所需的关闭操作。
        sw.Write("服务器正常退出:" & Now.ToString & Chr(10& Chr(13))
        sw.Flush()
        sw.Close()
        sw 
= Nothing
    
End Sub

    '服务器监听函数
    Sub listen()
        
While True      '无限循环侦听
            Try
                
Dim recv As Integer = 0
                
Dim data As [Byte]() = New Byte(1024) {}
                
Dim sender As New IPEndPoint(IPAddress.Any, 0)
                
Dim tempRemoteEP As EndPoint = CType(sender, EndPoint)
                recv 
= ServerSocket.ReceiveFrom(data, tempRemoteEP)         '从缓冲区中获取收到的信息
                Dim tmpdata As New DeclearData(data, tempRemoteEP, recv)    '装进信息块中
                ReceiveDataList.AddItem(tmpdata)                            '将信息块装进本程序自己的缓冲区
                If Not dealing Then
                    
Dim dealdatathread As New Thread(AddressOf DealData)
                    dealdatathread.Name 
= "dealdata"
                    dealdatathread.Start()
                
End If
            
Catch e As Exception
                
Dim OutPutString As String = ""
                OutPutString 
= "Error: " & Err.Description
                WriteLog(OutPutString)
                OutPutString 
= ""
            
End Try
        
End While
    
End Sub

    Private Sub DealData()
        
If Not dealing Then
            dealing 
= True
            
Dim tmpdata As DeclearData
            
While ReceiveDataList.count > 0
                
Try
                    tmpdata 
= ReceiveDataList.GetFirstItem
                    
'可以侦听到的命令:
                    Debug.WriteLine("收到:" & tmpdata.datastr)
                    
Dim msgHead As String = tmpdata.datastr.Substring(02)
                    
Select Case msgHead
                        
Case LOGININ        '登录:
                            userLogin(tmpdata.datastr, tmpdata.fromip)
                        
Case LOGINOUT       '注销:
                            userloginout(tmpdata.datastr)
                        
Case GETULIST       '获得当前在线人名单:
                            Dim userinfo As String = getUserList()
                            sendMsg(userinfo, tmpdata.fromip)
                            WriteLog(
"<" & Now.ToString & " IP: " & tmpdata.fromip.ToString & " Ope:获取在线人员名单>")
                        
Case P2PCONN        '向其它用户发送消息
                            questP2PConn(tmpdata.datastr)
                        
Case HOLDLINE       '表示该用户仍然在线
                            holdOnLine(tmpdata.datastr)
                        
Case GETDATASERVER  '某个客户端请求当前在线的设备列表
                            ShowDataServerOnLine(tmpdata.fromip)
                        
Case RECDEVINFO         '某个工作站发送来了设备的信息:
                            ReceiveDataServerInfor(tmpdata.datastr, tmpdata.fromip)
                        
Case GETDSERVERINFOR
                            SendDeviceInforToClient(tmpdata.datastr, tmpdata.fromip)
                        
Case Else
                            WriteLog(
"未知信息:" & tmpdata.datastr)
                    
End Select
                
Catch ex As Exception
                    Debug.WriteLine(
"错误的数据:" & tmpdata.datastr)
                    Debug.WriteLine(
"DealData:" & Err.Description)
                    WriteLog(
"错误的数据:" & tmpdata.datastr)
                    WriteLog(
"DealData:" & Err.Description)
                
Finally
                    ReceiveDataList.Remove()
                
End Try
            
End While
            dealing 
= False
        
End If
    
End Sub

    '接收到某个客户端发送的配置信息
    '这个信息存放在服务器端,所有客户端从服务器端获取设备信息
    '不存在多点接收的问题,因为是根据工作站来分流的
    Private Sub ReceiveDataServerInfor(ByVal data As StringByVal tempremoteep As IPEndPoint)
        
Dim i As Integer
        
Dim flag As String = data.Substring(21)
        
Dim infodata As String = data.Substring(3, data.Length - 3)
        
For i = 0 To userIPEP.Length - 1
            
If (Not userName(i) Is NothingAndAlso (Not userIPEP(i) Is NothingAndAlso userName(i).IndexOf("DataServer"= 0 Then     '是在线的工作站
                If userIPEP(i).ToString.Equals(tempremoteep.ToString) Then                                              '的确是这个工作站发送来的
                    If DataServerSaveEnd(i) And flag = "0" Then          '判断是否为更换信息的第一波数据
                        DataServerSaveEnd(i) = False                     '以后的只能追加
                        DataServerInfor(i) = infodata
                    
Else
                        DataServerInfor(i) 
&= infodata
                    
End If
                    
If flag = "1" Then
                        DataServerSaveEnd(i) 
= True                              '信息已经接收结束
                        SendDeviceInforToClient(i)                               '将这个工作站的配置信息发送给所有客户端
                        WriteLog("收到配置信息,来自:" & userName(i))
                    
End If
                    
Exit Sub
                
End If
            
End If
        
Next
    
End Sub

    '将某个工作站的配置信息发送给所有客户端
    '格式:45+登录名+|+配置信息
    Private Sub SendDeviceInforToClient(ByVal index As Integer)
        
Try
            
Dim i As Integer
            
Dim tmpstr As String = RECDEVINFO & userName(index) & "|" & DataServerInfor(index)
            
For i = 0 To userName.Length - 1
                
If (Not userName(i) Is NothingAndAlso (Not userIPEP(i) Is NothingAndAlso userName(i).IndexOf("DataClient"= 0 Then     '是在线的客户端
                    SendlangData(tmpstr, userIPEP(i))
                
End If
            
Next
            WriteLog(
"向所有客户端发送" & userName(index) & "的配置信息")
            index 
= Nothing
            tmpstr 
= Nothing
        
Catch ex As Exception
            WriteLog(
"SendDeviceInforToClient1: " & Err.Description)
        
End Try
    
End Sub

    '将所有工作站的配置信息发送给某个客户端
    '格式:45+登录名+|+配置信息
    Private Sub SendDeviceInforToClient(ByVal TheClient As IPEndPoint)
        
Try
            
Dim i As Integer
            
Dim tmpstr As String
            
For i = 0 To userName.Length - 1
                
If (Not userName(i) Is NothingAndAlso (Not userIPEP(i) Is NothingAndAlso userName(i).IndexOf("DataServer"= 0 AndAlso DataServerSaveEnd(i) = True Then
                    
'是在线的工作站
                    tmpstr = RECDEVINFO & userName(i) & "|" & DataServerInfor(i)
                    SendlangData(tmpstr, TheClient)     
'将本工作站的数据配置信息发送给这个客户端
                    WriteLog("" & TheClient.ToString & "发送工作站 " & userName(i) & " 的配置信息")
                
End If
            
Next
            tmpstr 
= Nothing
            TheClient 
= Nothing
        
Catch ex As Exception
            WriteLog(
"SendDeviceInfoToClient2: " & Err.Description)
        
End Try
    
End Sub

    '将某个工作站的配置信息发送给所有客户端
    Private Sub SendDeviceInforToClient(ByVal ServerName As StringByVal TheClient As IPEndPoint)
        
Try
            
Dim i As Integer
            
Dim tmpstr As String = RECDEVINFO
            ServerName 
= ServerName.Substring(2, ServerName.Length - 2)
            
For i = 0 To userName.Length - 1
                
If (Not userName(i) Is NothingAndAlso (Not userIPEP(i) Is NothingAndAlso userName(i) = ServerName Then
                    SendlangData(tmpstr 
& userName(i) & "|" & DataServerInfor(i), TheClient)
                    WriteLog(
"" & TheClient.ToString & "发送工作站" & userName(i) & " 的配置信息")
                    
Exit Sub
                
End If
            
Next
            ServerSocket.SendTo(Encoding.Unicode.GetBytes(RECDEVINFO 
& "NoInfor " & ServerName), TheClient)
        
Catch ex As Exception
            WriteLog(
"SendDeviceInforToClient3:" & Err.Description)
        
End Try
    
End Sub

    '将大量数据分包发送的函数
    '除了短小的命令,其他的都用此函数发送
    '这个函数仅仅服务器程序能用
    '格式:头+编号+|+开始/结束标志+内容
    Private Sub SendlangData(ByVal tmpstr As StringByVal sendtoep As IPEndPoint)
        
Try
            
Dim head As String              '标头
            Dim TempSend As String          '暂时发送内容
            Dim sendBytes() As Byte         '用于发送的字节数组
            '#用于防止多个本程序向同一个客户端发送有同样标头的内容而进行的屏蔽
            '#若sendid相同,则说明是同一个信息的不同部分段
            Dim sendid As Integer
            
'###################################################
            Dim datalength As Integer       '允许传送的字符串最大长度
            If LongSendID < LongSendMax Then                                    '同时能够容纳LongSendMax个设备更新他们的信息
                sendid = LongSendID
                LongSendID 
+= 1
            
Else
                sendid 
= 0
                LongSendID 
= 0
            
End If
            head 
= tmpstr.Substring(02)                                       '获取头信息,例如:RECDEVINFO
            head &= sendid & "|"                                                '头+编号+|
            tmpstr = tmpstr.Substring(2)
            datalength 
= movelenth - head.Length - 1                            '获取数据段的最大长度
            If tmpstr.Length > datalength Then
                
'原始数据的长度太长,需要进行分段发送,这里是第一段:
                TempSend = head & "0" & tmpstr.Substring(0, datalength)         '添加0,表示数据的起始
                tmpstr = tmpstr.Substring(datalength, tmpstr.Length - datalength)
                sendBytes 
= Encoding.Unicode.GetBytes(TempSend)
                ServerSocket.SendTo(sendBytes, sendtoep)
                Thread.Sleep(
100)
            
End If
            
'经过一次分割后,如果剩下的部分长度仍然超过最大限度,需要继续切割,直到长度小于最大长度(datalength):
            While tmpstr.Length > datalength                                    '如果数据大小大于可以发送的字节数,则拆分
                '发送:
                TempSend = head & "2" & tmpstr.Substring(0, datalength)         '添加2,表示数据未结束,是中间段
                tmpstr = tmpstr.Substring(datalength, tmpstr.Length - datalength)
                sendBytes 
= Encoding.Unicode.GetBytes(TempSend)
                ServerSocket.SendTo(sendBytes, sendtoep)
                Thread.Sleep(
100)
            
End While
            
If tmpstr.Length >= 0 Then                                           '发送最后一段信息
                TempSend = head & "1" & tmpstr
                sendBytes 
= Encoding.Unicode.GetBytes(TempSend)
                ServerSocket.SendTo(sendBytes, sendtoep)
                Thread.Sleep(
100)
            
End If
            tmpstr 
= Nothing
            sendtoep 
= Nothing
            head 
= Nothing
            TempSend 
= Nothing
            sendBytes 
= Nothing
            sendid 
= Nothing
            datalength 
= Nothing
        
Catch ex As Exception
            WriteLog(
"SendlangData: " & Err.Description)
        
End Try
    
End Sub

    '某个客户端要求获取当前在线的工作站列表:
    '将所有在线工作站以:名称;IP|名称;IP 的形式发送 
    Private Sub ShowDataServerOnLine(ByVal ToEP As IPEndPoint)
        
Try
            
Dim i As Integer
            
Dim flag As Boolean = False
            
Dim tmpstr As String = SHOWDATASERVER
            
If Not userName Is Nothing Then
                
For i = 0 To userName.Length - 1
                    
'遍历所有在线的数据服务器:
                    If (Not userName(i) Is NothingAndAlso (Not userIPEP(i) Is NothingAndAlso userName(i).IndexOf("DataServer"= 0 Then
                        tmpstr 
&= userName(i) & ";" & userIPEP(i).Address.ToString & "|"
                        flag 
= True
                    
End If
                
Next
            
End If
            
If flag Then
                tmpstr 
= tmpstr.Substring(0, tmpstr.Length - 1)
            
Else
                tmpstr 
= SHOWDATASERVER
            
End If
            SendlangData(tmpstr, ToEP)
            WriteLog(
"" & ToEP.ToString & "发送数据服务器在线列表")
            tmpstr 
= Nothing
            ToEP 
= Nothing
            i 
= Nothing
            flag 
= Nothing
        
Catch ex As Exception
            WriteLog(
"ShowDataServerOnLine:" & Err.Description)
        
End Try
    
End Sub

    '转发P2P连接请求 
    Private Sub questP2PConn(ByVal data As String)
        
Dim OutPutString As String = ""
        
Dim recvStr As String = data.Substring(2, data.Length - 2'Encoding.Unicode.GetString(data, 4, recv - 4)
        Dim split() As String = recvStr.Split("|")
        
Dim fromEP As IPEndPoint
        
Dim toEP As IPEndPoint
        
Dim i As Integer
        
For i = 0 To userName.Length - 1
            
If userName(i) = split(0Then
                fromEP 
= userIPEP(i)
            
End If
            
If userName(i) = split(1Then
                toEP 
= userIPEP(i)
            
End If
        
Next
        OutPutString 
&= "<" & Now.ToString & " IP: " & fromEP.ToString & " 向 " & "IP:" & toEP.ToString & " 请求连接>"
        
Dim holdbytes() As Byte = Encoding.Unicode.GetBytes(MAKHOLD & fromEP.ToString)
        ServerSocket.SendTo(holdbytes, toEP)
        WriteLog(OutPutString)
    
End Sub

    '函数.返回所有在线用户.其格式:用户名+|+用户IPEP+| 
    Private Function getUserList() As String
        
Dim userInfo As String = GETUSER
        
Dim i As Integer
        
For i = 0 To userName.Length - 1
            
If userName(i) <> "" Then
                userInfo 
+= userName(i) & "|" & userIPEP(i).ToString & "|"
            
End If
        
Next
        
Return userInfo
    
End Function

    '用户登陆,直接返回登陆是否成功的值
    '向所有节点报告本次登陆信息
    '如果是客户端,则向其发送所有工作站的配置信息
    Private Sub userLogin(ByVal data As StringByVal userEP As IPEndPoint)
        
Try
            
Dim OutPutString As String = ""
            
Dim Uname As String = data.Substring(2, data.Length - 2).Trim
            
Dim Uinfobytes() As Byte
            
Dim i As Integer
            
Dim j As Integer
            OutPutString 
&= "<" & Now.ToString & " IP:" & userEP.ToString & " Ope:Login"
            
For i = 0 To userName.Length - 1
                
If (Not userName(i) Is NothingAndAlso Uname = userName(i) Then      '用户名存在,依然算作登录成功
                    Uinfobytes = Encoding.Unicode.GetBytes(LOGININ & userName(i) & "|" & userIPEP(i).ToString)
                    OutPutString 
&= "重复登录>"
                    WriteLog(OutPutString)
                    
If Uname.IndexOf("DataClient"= 0 Then
                        userIPEP(i) 
= New IPEndPoint(userEP.Address, 5556)
                    
ElseIf Uname.IndexOf("DataServer"= 0 Then
                        userIPEP(i) 
= New IPEndPoint(userEP.Address, 5555)
                    
Else
                        userIPEP(i) 
= userEP
                    
End If
                    userTime(i) 
= 60
                    DataServerSaveEnd(i) 
= True
                    DataServerInfor(i) 
= ""
                    
For j = 0 To userName.Length - 1
                        
If userName(j) <> "" And userName(j) <> Uname Then
                            ServerSocket.SendTo(Uinfobytes, userIPEP(j))
                        
End If
                    
Next
                    OutPutString 
&= Uname.Trim & " 登录成功!>"
                    WriteLog(OutPutString)
                    sendMsg(LOGINOK, userEP)
                    
Exit Sub
                
End If
            
Next
            
'没有找到与这个用户名一致的在线用户,说明是头一次登陆到本服务器
            For i = 0 To userName.Length - 1    '用户登录成功,向客户端发送用户登录成功消息
                If userName(i) = "" Then        '如果之前有的用户退出,则将新的用户名插入到它的位置上 
                    userName(i) = Uname
                    userIPEP(i) 
= userEP
                    userTime(i) 
= 60
                    DataServerSaveEnd(i) 
= True
                    DataServerInfor(i) 
= ""
                    Uinfobytes 
= Encoding.Unicode.GetBytes(LOGININ & userName(i) & "|" & userIPEP(i).ToString)
                    
For j = 0 To userName.Length - 1
                        
If userName(j) <> "" And userName(j) <> Uname Then
                            ServerSocket.SendTo(Uinfobytes, userIPEP(j))
                        
End If
                    
Next
                    OutPutString 
&= Uname.Trim & " 登录成功!>"
                    WriteLog(OutPutString)
                    sendMsg(LOGINOK, userEP)
                    
Exit Sub
                
End If
            
Next        '之前用户名全满:需要重新定义用户名数组
            Dim userCount As Integer = userName.Length
            
ReDim Preserve userName(userCount)
            
ReDim Preserve userIPEP(userCount)
            
ReDim Preserve userTime(userCount)
            
ReDim Preserve DataServerSaveEnd(userCount)
            
ReDim Preserve DataServerInfor(userCount)
            userName(userName.Length 
- 1= Uname
            userIPEP(userIPEP.Length 
- 1= userEP
            userTime(userTime.Length 
- 1= 60
            DataServerSaveEnd(DataServerSaveEnd.Length 
- 1= True
            DataServerInfor(DataServerInfor.Length 
- 1= ""
            Uinfobytes 
= Encoding.Unicode.GetBytes(LOGININ & userName(userName.Length - 1& "|" & userIPEP(userName.Length - 1).ToString)
            
For j = 0 To userName.Length - 1
                
If userName(j) <> "" And userName(j) <> Uname Then
                    ServerSocket.SendTo(Uinfobytes, userIPEP(j))
                
End If
            
Next
            OutPutString 
&= Uname.Trim & " 登录成功!>"
            WriteLog(OutPutString)
            sendMsg(LOGINOK, userEP)
            
Exit Sub
        
Catch ex As Exception
            WriteLog(
"userLogin:" & Err.Description)
        
End Try
    
End Sub

    '用户登出 
    Private Sub userloginout(ByVal data As String)
        
Dim OutPutString As String = ""
        
Dim i As Integer
        
Dim Uname As String = data.Substring(2, data.Length - 2)
        
For i = 0 To userName.Length - 1
            
If Uname = userName(i) Then
                
Dim loginOutMsg As String = LOGINOUT & userName(i)
                OutPutString 
&= "<" & Now.ToString & " IP:" & userIPEP(i).ToString & " Ope:LogOut"
                userName(i) 
= ""
                userIPEP(i) 
= Nothing
                userTime(i) 
= 0
                DataServerSaveEnd(i) 
= True
                DataServerInfor(i) 
= ""
                
Dim j As Integer
                
For j = 0 To userName.Length - 1
                    
If userName(j) <> "" Then
                        sendMsg(loginOutMsg, userIPEP(j))
                    
End If
                
Next
                OutPutString 
&= Uname & "下线了!>"
                WriteLog(OutPutString)
                
Exit For
            
End If
        
Next
    
End Sub

    '保持用户在线的过程 
    Private Sub holdOnLine(ByVal data As String)
        
Dim Uname As String = data.Substring(2, data.Length - 2'Encoding.Unicode.GetString(data, 4, recvCount - 4)
        Dim i As Integer
        
For i = 0 To userName.Length - 1
            
If Uname = userName(i) Then
                userTime(i) 
= 60
                
Exit For
            
End If
        
Next
    
End Sub

    '用户超时退出
    '如果是客户端的超时推出,则向所有工作站发送消息:此客户端下线
    Private Sub onLineTimeOut(ByVal state As [Object])
        
Dim OutPutString As String = ""
        
Dim i As Integer
        
For i = 0 To userName.Length - 1
            
If userTime(i) > 0 Then
                userTime(i) 
-= 5
                
If userTime(i) <= 0 Then
                    
Dim loginoutmsg As String = LOGINOUT & userName(i)
                    OutPutString 
&= "<" & Now.ToString & " IP:" & userIPEP(i).ToString & "Ope:超时下线!>"
                    userName(i) 
= ""
                    userIPEP(i) 
= Nothing
                    DataServerSaveEnd(i) 
= True
                    DataServerInfor(i) 
= ""
                    
Dim ULoginOutbytes() As Byte = Encoding.Unicode.GetBytes(loginoutmsg)
                    
Dim j As Integer
                    
For j = 0 To userName.Length - 1
                        
If userName(j) <> "" Then
                            
If userIPEP(j) Is Nothing Then
                            
Else
                                ServerSocket.SendTo(ULoginOutbytes, userIPEP(j))
                            
End If
                        
End If
                    
Next
                
End If
            
End If
        
Next
        
'WriteLog(OutPutString)
    End Sub

    '发送消息的函数 
    Sub sendMsg(ByVal msg As StringByVal remoteEP As IPEndPoint)
        
Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(msg)
        
Try
            ServerSocket.SendTo(sendBytes, remoteEP)
        
Catch e As Exception
            WriteLog(
"sendMsg:" & Err.Description)
        
End Try
    
End Sub

    Sub WriteLog(ByVal msg As String)
        Debug.WriteLine(msg)
        sw.WriteLine(msg)
        sw.Flush()
    
End Sub

End Class

'将数据和ip地址进行封装的数据结构--权宜之计
Public Class DeclearData
    
Public datastr As String
    
Public fromip As IPEndPoint

    Public Sub New(ByVal data() As ByteByVal ip As IPEndPoint, ByVal length As Integer)
        datastr 
= Encoding.Unicode.GetString(data, 0, length)
        fromip 
= ip
    
End Sub
End Class

'数据队列--用于扩展
Public Class DataQueue
    
Private datalist As ArrayList

    Public Sub New()
        datalist 
= New ArrayList
    
End Sub

    Public ReadOnly Property count() As Integer
        
Get
            
Return datalist.Count
        
End Get
    
End Property

    Public Function AddItem(ByVal item As DeclearData) As Integer
        
Return datalist.Add(item)
    
End Function

    Public Function GetFirstItem() As DeclearData
        
Return datalist.Item(0)
    
End Function

    Public Function Remove() As Boolean
        
If datalist.Count > 0 Then
            datalist.RemoveAt(
0)
            
Return True
        
Else
            
Return False
        
End If
    
End Function
End Class

Tag标签: .net,异步,socket
0
0

(请您对文章做出评价)
posted on 2008-07-10 16:36 TQ 阅读(2348) 评论(7)  编辑 收藏 网摘 所属分类: Socket编程


FeedBack:

2008-07-10 17:12 | Solog      
看不懂VB.NET的。。。。
  回复  引用  查看    
2008-07-10 17:16 | 黄页[未注册用户]
很有用处,谢谢了
  回复  引用    
2008-07-10 21:52 | 安眠花      
额,是VB写的啊

  回复  引用  查看    
2008-07-10 22:57 | alonesword[未注册用户]
似曾相似。

在 codeproject 上有一个 chart 的异步传输的东西,应该是差不多的。
  回复  引用    

#5楼[楼主]
2008-07-11 09:05 | TQ      
@alonesword
嗯,我说过了,这段代码本身是对网上的一段代码修改后的成果,但是基本上已经改的面目全非了。
大的改动有一下几个方面:
1.将程序改为服务程序
2.将管理方式变成了类似于QQ的模式
3.增加了对大块文件的拆分发送
4.添加了缓冲区,用于对数据的处理(这个是比较基础的东西,不知道原来的程序为什么没有)
可惜,原来的程序已经找不到了,要不然,大家可以一起比较一下。
不过还是那句话,这段code可以给我们一种程序设计的思路,希望对大家能够有所帮助。

  回复  引用  查看    
2008-07-12 14:12 | 沉没的青蛙      
vb的看着有点晕,还是转成c#看着爽~
http://labs.developerfusion.co.uk/convert/vb-to-csharp.aspx
谢谢博主共享~

抱歉!评论已关闭.