高分求教语音通信

Option Explicit
Private myname As String, strzjdk As String, intcount As Integer, i As Integer
Private filenum As Integer, intIp As Integer, intDk As Integer, intI As Integer, strName As String, intNum As Integer
Private intJishu As Integer, j As Integer '---------------------j用来记录数组位置
Private strNeirong(0 To 100)  As String '------------------------保存发送内容
Private intIndex(0 To 100) As Integer '--------------------------保存发送者的index
Private Sub chkAll_Click()
Dim p As Integer
p = 1
On Error Resume Next
If chkAll.Value = 1 Then
    Do While (p <= intJishu)
        chkZxyh(p).Value = 1
        p = p + 1
    Loop
Else
    Do While (p <= intJishu)
        chkZxyh(p).Value = 0
        p = p + 1
    Loop
End If
End SubPrivate Sub cmdSend_Click()
Dim i As Integer
Dim aa As String
i = 1
On Error GoTo Gnext
Do While (i <= intJishu)
If chkZxyh(i).Value = 1 Then
txtggxx.Text = txtggxx.Text + Chr(13) + Chr(10) + "(" + chkZxyh(0).Caption + " 对 " + chkZxyh(i).Caption + "说：" + ")" + txtsend.Text + "(" + CStr(Now) + ")" + Chr(13) + Chr(10)
'MsgBox "发送一个，确认一下！"
strNeirong(j) = "(" + chkZxyh(0).Caption + " 对 " + chkZxyh(i).Caption + "说：" + ")" + txtsend.Text + "(" + CStr(Now) + ")" + Chr(13) + Chr(10)
intIndex(j) = i
aa = strNeirong(j)
j = j + 1 '---------------将发送的内容保存在数组中，等待发送
tmrDelay.Enabled = True
End If
Gnext:
i = i + 1
Loop
txtsend.Text = ""
End Sub
Private Sub Form_Load()
Dim filenum As Integer
For j = 0 To 100
    strNeirong(j) = ""
    intIndex(j) = 0
Next j '-----------------对数组做一个初始化
j = 0 '--------------------初始化完毕，j归0
i = 1 '------------------为增加控件做准备
filenum = FreeFile
Open App.Path + "\LSWJ" For Append As #filenum
Write #filenum, intIp, intDk, intI, strName
Close #filenum '------------------------------建一个临时文件！On Error GoTo cwpd
filenum = FreeFile
Open App.Path + "\YHXX" For Input As #filenum
Input #filenum, myname, strzjdk
Close #filenum
winserver(0).LocalPort = strzjdk
chkZxyh(0).Caption = myname
lblZjipdk.Caption = "主机IP：" + winserver(0).LocalIP + "    主机端口：" + CStr(winserver(0).LocalPort)
winserver(0).Listen
Exit Sub
cwpd:
Select Case Err.Number
Case 53
    MsgBox "第一次使用，请先进行系统设置！", 64
    filenum = FreeFile
Open App.Path + "\YHXX" For Append As #filenum
Write #filenum, myname, strzjdk
Close #filenum
Case 13
    MsgBox "请输入主机IP及端口，否则无法建立联接！", 16
End Select
End SubPrivate Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Kill App.Path + "\LSWJ"
End SubPrivate Sub fraZxyh_DragDrop(Source As Control, X As Single, Y As Single)End SubPrivate Sub mnuExit_Click()
Unload frmFwq
End SubPrivate Sub mnuYhgm_Click()
Dim filenum As Integer
filenum = FreeFile
myname = InputBox("请输入新的用户名：", 46)
Open App.Path + "\YHXX" For Output As #filenum
Write #filenum, myname, strzjdk
Close #filenum
Form_Load
End SubPrivate Sub mnuZjdk_Click()
Dim filenum As Integer
Dim ipdk As String
filenum = FreeFile
On Error GoTo jinggao
ipdk = InputBox("请输入主机端口：", 48)
If CInt(ipdk) > 1000 And CInt(ipdk) < 8999 Then
    strzjdk = ipdk
    Open App.Path + "\YHXX" For Output As filenum
    Write #filenum, myname, strzjdk
    Close #filenum
    Form_Load
Else
    MsgBox "输入有误，请重输！", 32
End If
Exit Sub
jinggao:
MsgBox "输入有误，请重输！", 32
End SubPrivate Sub tmrDelay_Timer()
j = 0
On Error Resume Next
Do While (strNeirong(j) <> "")
'MsgBox "已经发送了！", 4096
    winserver(intIndex(j)).SendData strNeirong(j) '-----这里主要是为了廷时
    strNeirong(j) = ""
    intIndex(j) = 0
    j = j + 1
Loop
j = 0
tmrDelay.Enabled = False
End Sub
Private Sub winserver_Close(Index As Integer)
Dim temp As Integer
Dim intI As Integer
Dim k As Integer
If Index <> 0 Then
On Error Resume Next
intI = 1
Do While (intI <= intJishu + 1)
    strNeirong(j) = "¤" + chkZxyh(Index).Caption '-------------告诉每个客户端，下线的用户是几号
    intIndex(j) = intI
    j = j + 1 '---------------将发送的内容保存在数组中，等待发送
    tmrDelay.Enabled = True
    'MsgBox chkZxyh(Index).Caption + "--下线了！", 4096  '+++++++++++++这里为什么要中断以后才能好使？？？？？？
    intI = intI + 1
Loop
k = Index
Do While (k <= intJishu)
    chkZxyh(k).Top = chkZxyh(k).Top - chkZxyh(k).Height
    k = k + 1
Loop
Unload chkZxyh(Index)
Unload winserver(Index)
'intJishu = intJishu - 1---------------没有，intJishu 只用来标识当前控件安数组最大标识号
jieshu:
End If
End Sub
Private Sub winserver_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim zhuangtai As String
Dim filenum As Integer
Dim intChknum As Integer
Static strZxyh As String
If winserver(0).State = 8 Then
    winserver(0).Close
    winserver(0).Listen
End If '-------------------------------如果 winserver(0)出错，就让它恢复！
Select Case Index
Case 0
    If winserver(0).State <> sckClosed Then winserver(0).Close
        winserver(0).Accept requestID
        intcount = i
        Load chkZxyh(i)
        Load winserver(i)
        chkZxyh(i).Caption = winserver(0).RemoteHostIP '------------取得客户IP
        chkZxyh(i).Top = chkZxyh(intJishu).Top + chkZxyh(intJishu).Height
        chkZxyh(i).Visible = True
        chkZxyh(i).Enabled = True
        winserver(i).LocalPort = Int(Rnd() * 8000)
        filenum = FreeFile
        Open App.Path + "\LSWJ" For Append As #filenum
        Write #filenum, chkZxyh(i).Caption, winserver(i).LocalPort, i, strName
        Close #filenum '-----------------将这个新用户保存在临时用户文件中！
        winserver(0).SendData "∮" + CStr(winserver(i).LocalPort)
        winserver(i).Listen
        intJishu = i '--------------------用来记录winsock控件的个数
Case i
    strZxyh = ""
    If winserver(Index).State <> sckClosed Then winserver(Index).Close
        winserver(Index).Accept requestID
        intChknum = 0
    On Error Resume Next '-----------------------有可能i号端口下线了，所以要做错误判断
    Do While (intChknum < i)
        strZxyh = strZxyh + chkZxyh(intChknum).Caption + "￡"
        intChknum = intChknum + 1
    Loop '---------------------------------------完成对新客户端的在线用户更新
         '--------------------------------------待加入
    winserver(i).SendData "￡" + strZxyh
    intNum = 1 '---------------------------------设定为1，不从0号端口扫描

    Do While (intNum < i)
        'MsgBox "发送了！", 4096
        intIndex(j) = intNum
        strNeirong(j) = "￡" + chkZxyh(i).Caption + "￡" '---这里和客户端的用法相一致
        tmrDelay.Enabled = True
        j = j + 1
        intNum = intNum + 1
    Loop
    i = i + 1 '--------------------这样做可以防止再次执行 i的操作
Case Else
    If winserver(Index).State <> sckClosed Then winserver(Index).Close
            winserver(Index).Accept requestID
End Select
End Sub
Private Sub winserver_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim temp As String
Dim intP As Integer
Dim intk As Integer
Dim i As Integer
intP = 1
Dim strUser() As String
winserver(Index).GetData temp
If Index = 0 Then
    chkZxyh(intJishu).Caption = temp
Else
    intk = InStrRev(temp, "¤") '-------------------过滤除去不正确信息！
    If intk Then
        strUser() = Split(temp, "¤")
        On Error GoTo jieshu '--------------------------这里为防止动态数组出现下标越界
        Do While (strUser(intP) <> "")
            For i = 0 To intJishu
                If chkZxyh(i).Caption = strUser(intP) Then Exit For
            Next i '-----------------------------------------取得要发送者index的值
            txtggxx.Text = txtggxx.Text + Chr(13) + Chr(10) + "(" + chkZxyh(Index).Caption + " 对 " + chkZxyh(i).Caption + "  说：" + ")" + strUser(0) + "(" + CStr(Now) + ")" + Chr(13) + Chr(10)
            If i = 0 Then GoTo xiayige
            'MsgBox "已经通过服务器转发了！", 4096
            intIndex(j) = i
            strNeirong(j) = "(" + chkZxyh(Index).Caption + " 对 " + chkZxyh(i).Caption + "  说：" + ")" + strUser(0) + "(" + CStr(Now) + ")"
            tmrDelay.Enabled = True
            j = j + 1
xiayige: '--------------------------------------------------这里对i=0的特殊情况在了处理，使不会因为出错而退出

            intP = intP + 1
        Loop
jieshu:
    End If
End If
End SubPrivate Sub winserver_SendComplete(Index As Integer)
If Index <> 0 Then
    lblGrlan.Caption = "对--" + chkZxyh(CStr(Index)).Caption + "--发送了信息！"
End If
End Sub
基本客户端如上
错了，上面那个是客户服务端，客户服务段程序如下：
Option Explicit
Private myname As String, strzjdk As String, zjip As String, intNum As IntegerPrivate Sub chkAll_Click()
Dim p As Integer
p = 1
On Error Resume Next
If chkAll.Value = 1 Then
    Do While (p <= intNum)
        chkZxyh(p).Value = 1
        p = p + 1
    Loop
Else
    Do While (p <= intNum)
        chkZxyh(p).Value = 0
        p = p + 1
    LoopEnd If
End SubPrivate Sub cmdDklj_Click()
cmdDklj.Enabled = False
cmdLjfwq.Caption = "连接服务器"
cmdLjfwq.Enabled = True
Winsend(0).Close
End SubPrivate Sub cmdLjfwq_Click()
Winsend(0).Connect
End Sub
Private Sub cmdSend_Click()
Dim i As Integer
Dim strtext As String
strtext = txtsend.Text
On Error GoTo hulue
For i = 1 To intNum
    If chkZxyh(i).Value = 1 Then
        txtggxx.Text = txtggxx.Text + "(" + chkZxyh(0).Caption + " 对 " + chkZxyh(i).Caption + "  说：" + ")" + txtsend.Text + "(" + CStr(Now) + ")" + Chr(13) + Chr(10) + Chr(13) + Chr(10)
        strtext = strtext + "¤" + chkZxyh(i).Caption
    End If
hulue:
Next i
Winsend(0).SendData strtext
txtsend.Text = ""
End Sub
Private Sub Form_Load()
Dim filenum As Integer
filenum = FreeFile
Open App.Path + "\LSWJ" For Append As #filenum
Close #filenum '建立一个临时文件，用于保存在线用户信息！On Error GoTo cwpd
Open App.Path + "\KHXX" For Input As #filenum
Input #filenum, myname, zjip, strzjdk
Close #filenum
Winsend(0).RemotePort = strzjdk
Winsend(0).RemoteHost = zjip
chkZxyh(0).Caption = myname
lblZjipdk.Caption = "主机IP：" + Winsend(0).LocalIP + "    主机端口：" + CStr(Winsend(0).RemotePort)
Close
Exit Sub
cwpd:
Select Case Err.Number
Case 53
MsgBox "第一次使用，请先进行系统设置！", 64
filenum = FreeFile
Open App.Path + "\KHXX" For Append As #filenum
Write #filenum, myname, zjip, strzjdk
Close #filenum
Case 13
MsgBox "请输入主机IP及端口，否则无法建立联接！", 48
Case Else
MsgBox "未知错误！", 16
End Select
Close
End SubPrivate Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Kill App.Path + "\LSWJ" '删除临时文件！
Winsend(0).Close
End SubPrivate Sub fraZxyh_DragDrop(Source As Control, X As Single, Y As Single)End SubPrivate Sub mnuExit_Click()
Unload frmKhd
End SubPrivate Sub mnuYhgm_Click()
Dim filenum As Integer
filenum = FreeFile
myname = InputBox("请输入新的用户名：", 46)
chkZxyh(0).Caption = myname
Open App.Path + "\KHXX" For Output As #filenum
Write #filenum, myname, zjip, strzjdk
Close #filenum
Form_Load
End Sub
Private Sub mnuZjdk_Click()
Dim strDk As String
Dim filenum As Integer
On Error GoTo jingao
strDk = InputBox("请输入主机端口：", 46)
If CInt(strDk) >= 0 And CInt(strDk) <= 9000 Then
strzjdk = strDk
filenum = FreeFile
Open App.Path + "\KHXX" For Output As #filenum
Write #filenum, myname, zjip, strzjdk
Close #filenum
Else
jingao:
MsgBox "你的输入有误，请重输！", 46
End If
Form_Load
End SubPrivate Sub mnuZjip_Click()
Dim strIp() As String
Dim strIpdz As String
Dim filenum As Integer
On Error GoTo jieshu
strIpdz = InputBox("请输入主机IP：", 46)
strIp() = Split(strIpdz, ".")
If (CInt(strIp(0)) >= 0 And CInt(strIp(0)) <= 255) And (CInt(strIp(1)) >= 0 And CInt(strIp(1)) <= 255) And (CInt(strIp(2)) >= 0 And CInt(strIp(2)) <= 255) And (CInt(strIp(3)) >= 0 And CInt(strIp(3)) <= 255) Then
zjip = strIpdz
filenum = FreeFile
Open App.Path + "\KHXX" For Output As #filenum
Write #filenum, myname, zjip, strzjdk
Else
MsgBox "IP地址非法，请重输！", 48
End If
Exit Sub
jieshu:
MsgBox "你的输入有误，主核对后再输！", 48
End SubPrivate Sub Winsend_Close(Index As Integer)
cmdLjfwq.Caption = "连接服务器"
cmdLjfwq.Enabled = True
cmdDklj.Visible = False
End SubPrivate Sub Winsend_Connect(Index As Integer)
cmdLjfwq.Caption = "已经连接"
cmdLjfwq.Enabled = False
cmdDklj.Visible = True
If Index = 0 Then
Winsend(0).SendData myname
End If
End SubPrivate Sub Winsend_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim temp As String, intI As Integer, intP As Integer, strK As String, intK As Integer
Dim strtext() As String
Dim k As Integer
Winsend(Index).GetData temp
Select Case Left$(temp, 1)
Case "∮"
    Winsend(0).Close '----------------改变winsock远程端口前必须先关闭连接！！！！
    Winsend(0).RemotePort = CInt(Right$(temp, Len(temp) - 1))
    Winsend(0).Connect
Case "￡"
    If Right$(temp, 1) <> "￡" Then
    strtext() = Split(temp, "￡")
    temp = Right$(temp, Len(temp) - 1)
    On Error GoTo qudexiabiao
    intK = 1
    Do While (strtext(intK) <> "")
    intK = intK + 1
    Loop
qudexiabiao:
    intK = intK - 1
    temp = strtext(intK)
    GoTo jieshou
    End If '------------------错处理
    intNum = intNum + 1
    Dim strZxyh() As String
    temp = Right$(temp, Len(temp) - 1)
    strZxyh() = Split(temp, "￡")
    Do While (strZxyh(intI) <> "")
    Load chkZxyh(intNum)
    chkZxyh(intNum).Top = chkZxyh(intNum - 1).Top + chkZxyh(intNum - 1).Height
    chkZxyh(intNum).Visible = True
    chkZxyh(intNum).Enabled = True
    chkZxyh(intNum).Caption = strZxyh(intI) '----实时更新在线用户
    intI = intI + 1
    intNum = intNum + 1
    Loop
    intNum = intNum - 1 '---保证索引的正确，否则出现控件数组不存在的错误
Case "¤"
    Label1.Caption = "已经发过来了！"
    strK = Right$(temp, Len(temp) - 1)
    intP = intNum
    For k = 0 To intNum
    If strK = chkZxyh(k).Caption Then Exit For
    Next k
    On Error Resume Next
    Do While (k <= intNum)
    chkZxyh(k).Top = chkZxyh(k).Top - chkZxyh(k).Height
    k = k + 1
    Loop
    Unload chkZxyh(intK) '---实现删除下线用户的目的Case Else
jieshou:
    txtggxx.Text = txtggxx.Text + temp + Chr(13) + Chr(10)
    txtsend.Text = ""
End Select
jieshu:
End Sub

调试易

高分求教语音通信

解决方案 »