chat.frm

vb中如何进行网络编程的示例,包括:UDP聊天,TCP聊天,UDP,TCP flood攻击等 非常棒

        outLight.Picture = ImgIcons.ListImages(mikeOFF).Picture ' Show done image
        outLight.Refresh                                ' Repaint image
        Screen.MousePointer = vbDefault                 ' Reset Mouse Pointer
        cmdTalk.Caption = "&Talk"                       ' Reset Button Status
        
        If Not wStream.Playing And _
               wStream.PlayDeviceFree And _
               wStream.RecDeviceFree Then               ' Is Audio Device Free?
            Call cmdTalk_Click                          ' Active Playback Of Any Inbound Messages...
        End If
    End If
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

Private Sub cmdTalk_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    wStream.Recording = False                           ' Stop Recording
End Sub

Private Sub connectionlist_Click()
    Tools.Buttons(tbHANGUP).Enabled = True
End Sub

'--------------------------------------------------------------
Private Sub ConnectionList_DblClick()
'--------------------------------------------------------------
    Dim MemberID As String                              ' (Server)(TCPidx)(RemoteIP)
    Dim Idx As Long                                     ' TCP idx
'--------------------------------------------------------------
    If (ConnectionList.Text = "") Then Exit Sub
    MemberID = ConnectionList.List(ConnectionList.ListIndex) ' Get The Conversation MemberID String From List Box
    
    Call GetIdxFromMemberID(TCPSocket, MemberID, Idx)  ' Get TCP idx From Member ID
    Call RemoveConnectionFromList(TCPSocket(Idx), ConnectionList) ' Clear ListBox Entry(s)...
    Call Disconnect(TCPSocket(Idx))                     ' Disconnect Socket Connection
    Unload TCPSocket(Idx)                               ' Destroy socket instance

    cmdTalk.Enabled = (ConnectionList.ListCount > 0)    ' Enable/Disable Talk Button...
    Tools.Buttons(tbHANGUP).Enabled = (ConnectionList.Text <> "")
    If Not cmdTalk.Enabled Then
        inLight.Picture = ImgIcons.ListImages(speakNO).Picture
        outLight.Picture = ImgIcons.ListImages(mikeNO).Picture
    End If
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub Form_Load()
'--------------------------------------------------------------
    Dim rc As Long                                      ' Return Code Variable
    Dim Idx As Long                                     ' Current TCP idx variable
    Dim TCPidx As Long                                  ' Newly created TCP idx value
'--------------------------------------------------------------
    CLOSINGAPPLICATION = False                          ' Set status to not closing
    Call InitServerList(txtServer)                      ' Get Common Servers List
    txtServer.Text = txtServer.List(0)                  ' Display First Name In The List
    imgStatus = ImgIcons.ListImages(phoneHungUp).Picture ' Change Icon To Phone HungUp
    
    Set wStream = CreateObject("WaveStreaming.WaveStream")
    Call wStream.InitACMCodec(WAVE_FORMAT_GSM610, TIMESLICE)
'   Call wStream.InitACMCodec(WAVE_FORMAT_ADPCM, TIMESLICE)
'   Call wStream.InitACMCodec(WAVE_FORMAT_MSN_AUDIO, TIMESLICE)
'   Call wStream.InitACMCodec(WAVE_FORMAT_PCM, TIMESLICE)

    cmdTalk.Enabled = False                             ' Disable Until Connect
    Tools.Buttons(tbHANGUP).Enabled = (ConnectionList.Text <> "")
    inLight.Picture = ImgIcons.ListImages(speakNO).Picture
    outLight.Picture = ImgIcons.ListImages(mikeNO).Picture

    Call Listen(TCPSocket(0))                           ' Listen For TCP Connection
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
'--------------------------------------------------------------
    Dim Idx As Long                                     ' TCP socket index
    Dim Socket As Winsock                                   ' TCP socket control
'--------------------------------------------------------------
    CLOSINGAPPLICATION = True                           ' Set status flag to closing...
    For Each Socket In TCPSocket                        ' For each socket instance
        Call Disconnect(Socket)                         ' Close connection/listen
    Next                                                ' Next Cntl
    Set wStream = Nothing
    End                                                 ' End Program
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------



'--------------------------------------------------------------
Private Sub TCPSocket_Close(Index As Integer)
' Closing Current TCP Connection...
'--------------------------------------------------------------
    Call RemoveConnectionFromList(TCPSocket(Index), ConnectionList) ' Remove Connection From List
    Call Disconnect(TCPSocket(Index))                           ' Close Port Connection...
    
    cmdTalk.Enabled = (ConnectionList.ListCount > 0)            ' Enable/Disable Talk Button...
    If Not cmdTalk.Enabled Then
        inLight.Picture = ImgIcons.ListImages(speakNO).Picture
        outLight.Picture = ImgIcons.ListImages(mikeNO).Picture
    End If
    
    Tools.Buttons(tbHANGUP).Enabled = (ConnectionList.Text <> "")
    If cmdTalk.Enabled Then
        imgStatus = ImgIcons.ListImages(phoneHungUp).Picture    ' Show Phone HungUp Icon...
    End If
    
    Unload TCPSocket(Index)                                     ' Destroy socket instance
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub TCPSocket_Connect(Index As Integer)
' TCP Connection Has Been Accepted And Is Open...
'--------------------------------------------------------------
    Call AddConnectionToList(TCPSocket(Index), ConnectionList) ' Add New Connection To List
    
    imgStatus = ImgIcons.ListImages(phoneRingIng).Picture   ' Show Phone Ringing Icon
    Call ResPlaySound(RingOutId)
    imgStatus = ImgIcons.ListImages(phoneAnswered).Picture  ' Show Phone Answered Icon
    cmdTalk.Enabled = True                                  ' Enabled For Connection...
    Tools.Buttons(tbHANGUP).Enabled = (ConnectionList.Text <> "")
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub TCPSocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
' Accepting Inbound TCP Connection Request...
'--------------------------------------------------------------
    Dim rc As Long
    Dim Idx As Long
    Dim RemHost As String
'--------------------------------------------------------------
    If (TCPSocket(Index).RemoteHost <> "") Then
        RemHost = UCase(TCPSocket(Index).RemoteHost)
    Else
        RemHost = UCase(TCPSocket(Index).RemoteHostIP)
    End If
    
    If (Tools.Buttons(tbAUTOANSWER).Value = tbrUnpressed) Then
        rc = MsgBox("Incomming call from [" & RemHost & "]..." & vbCrLf & _
                    "Do you wish to answer?", vbYesNo)          ' Prompt user to answer...
    Else
        rc = vbYes
    End If
                    
    If (rc = vbYes) Then
        Idx = InstanceTCP(TCPSocket)                            ' Instance TCP Control...
        If (Idx > 0) Then                                       ' Validate that control instance was created...
            TCPSocket(Idx).LocalPort = 0                        ' Set local port to 0, in order to get next available port.
            Call TCPSocket(Idx).Accept(requestID)               ' Accept connection
            Call AddConnectionToList(TCPSocket(Idx), ConnectionList) ' Add New Connection To List
            
            imgStatus = ImgIcons.ListImages(phoneRingIng).Picture  ' Show Phone Ringing Icon
            Call ResPlaySound(RingInId)
            imgStatus = ImgIcons.ListImages(phoneAnswered).Picture ' Show Phone Answered Icon
            cmdTalk.Enabled = True                                 ' Enabled For Connection...
            Tools.Buttons(tbHANGUP).Enabled = (ConnectionList.Text <> "")
        End If
    End If
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub TCPSocket_DataArrival(Index As Integer, ByVal BytesTotal As Long)
' Incomming Buffer On...
'--------------------------------------------------------------
    Dim rc As Long                                      ' Return Code Variable
    Dim WaveData() As Byte                              ' Byte array of wave data
    Static ExBytes(MAXTCP) As Long                      ' Extra bytes in frame buffer
    Static ExData(MAXTCP) As Variant                    ' Extra bytes from frame buffer
'--------------------------------------------------------------
With wStream
    If (TCPSocket(Index).BytesReceived > 0) Then        ' Validate that bytes where actually received
        Do While (TCPSocket(Index).BytesReceived > 0)   ' While data available...
            If (ExBytes(Index) = 0) Then                ' Was there leftover data from last time
                If (.waveChunkSize <= TCPSocket(Index).BytesReceived) Then ' Can we get and entire wave buffer of data
                    Call TCPSocket(Index).GetData(WaveData, vbByte + vbArray, .waveChunkSize) ' Get 1 wave buffer of data
                    Call .SaveStreamBuffer(Index, WaveData) ' Save wave data to buffer
                    Call .AddStreamToQueue(Index)       ' Queue current stream for playback
                Else
                    ExBytes(Index) = TCPSocket(Index).BytesReceived ' Save Extra bytes
                    Call TCPSocket(Index).GetData(ExData(Index), vbByte + vbArray, ExBytes(Index)) ' Get Extra data
                End If
            Else
                Call TCPSocket(Index).GetData(WaveData, vbByte + vbArray, .waveChunkSize - ExBytes(Index)) ' Get leftover bits
                ExData(Index) = MidB(ExData(Index), 1) & MidB(WaveData, 1) ' Sync wave bits...
                Call .SaveStreamBuffer(Index, ExData(Index)) ' Save the current wave data to the wave buffer
                Call .AddStreamToQueue(Index)           ' Queue the current wave stream
                ExBytes(Index) = 0                      ' Clear Extra byte count
                ExData(Index) = ""                      ' Clear Extra data buffer
            End If
        Loop                                            ' Look for next Data Chunk
        
        If (Not .Playing And .PlayDeviceFree And _
            Not .Recording And .RecDeviceFree) Then     ' Check Audio Device Status
            Call cmdTalk_Click                          ' Start PlayBack...
        End If
    End If
End With
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

Private Sub TCPSocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
TCPSocket(Index).Close                                  ' Close down socket
    
    Debug.Print "TCPSocket_Error: Number:", Number
    Debug.Print "TCPSocket_Error: Scode:", Hex(Scode)
    Debug.Print "TCPSocket_Error: Source:", Source
    Debug.Print "TCPSocket_Error: HelpFile:", HelpFile
    Debug.Print "TCPSocket_Error: HelpContext:", HelpContext
    Debug.Print "TCPSocket_Error: Description:", Description
    Call DebugSocket(TCPSocket(Index))
End Sub

'--------------------------------------------------------------
Private Sub Tools_ButtonClick(ByVal Button As Button)
'--------------------------------------------------------------
    Dim rc As Long                                      ' Return Code Variable
    Dim Idx As Long                                     ' TCP Socket control index
    Dim LocalPort As Long                               ' LocalPort Setting
    Dim RemotePort As Long                              ' RemotePort Setting
'--------------------------------------------------------------
    Select Case Button.Index
    Case tbCALL
        Idx = InstanceTCP(TCPSocket)                        ' Instance TCP Control...
        
        If (Idx > 0) Then                                   ' Did control instance get created???
            Button.Enabled = False                          ' Disable Connect Button
            ConnectionList.Enabled = False                  ' Disable connection list box
            
            On Error Resume Next
            If Not Connect(TCPSocket(Idx), txtServer.Text, VOICEPORT) Then ' Attempt to connect
                Unload TCPSocket(Idx)                       ' Connect failed unload control instance
            End If
            
            ConnectionList.Enabled = True                   ' Renable connection list box
            Button.Enabled = True                           ' Enable Connect Button
        End If
    Case tbHANGUP
        ConnectionList_DblClick
    Case tbAUTOANSWER
        If (Button.Value = tbrPressed) Then
            Button.Image = phoneHungUp
        Else
            Button.Image = phoneAnswered
        End If
    End Select
End Sub

'--------------------------------------------------------------
Private Sub txtServer_KeyPress(KeyAscii As Integer)
'--------------------------------------------------------------
    Dim Conn As Long                                        ' Index counter
'--------------------------------------------------------------
    If (KeyAscii = vbKeyReturn) Then                        ' If Return Key Was Pressed...
        For Conn = 0 To txtServer.ListCount                 ' Search Each Entry In ListBox
            If (UCase(txtServer.Text) = UCase(txtServer.List(Conn))) Then Exit Sub
        Next                                                ' If Found Then Exit
        txtServer.AddItem UCase(txtServer.Text)             ' Add Server To List
    End If
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------