WinSock - Obousměrnost

Již dříve jsme vytvořili dvě aplikace - jednu, která odesílá zprávy a druhou, která je přijímá. Ale aplikace, která odesílá data nemůže zatím data přijímat a přijímací aplikace není schopna data odesílat. A člověk zrovna nemusí být Einstein aby věděl, že světem cloumá oboustranná komunikace. ICQ by rozhodně nemělo milióny členů, kdyby umožňovalo pouze zasílání zpráv jedním směrem.

Čili: založte projekt, přidejte odkaz na WinSock, na formulář přidejte WinSock (WinSock1), tlačítko pro odesílání zpráv (cmdSendMessage) a tři TextBoxy - txtAdress (Adresa), txtOutGoingMessage (Odesílaná zpráva) a txtIncommingMessage. Pak zapište tento kód:

Private Sub Form_Load()

   On Error GoTo PortErr

 Winsock1.LocalPort = 201
 Winsock1.Listen

' Používáme port 201. Aby to pracovalo, nemůžete již testovat tuto aplikaci
' na jedné a té samé mašině - jinak dojde ke konfliktu při obsazování portu.

 Exit Sub
    
PortErr:

    MsgBox "Jiná aplikace používá port 201. " & , vbCritical
        
    End

End Sub

Private Sub cmdSendMessage_Click()

    If Winsock1.State = sckConnected Then
        'Pokud jsme připojení, pošleme data
        Winsock1.SendData (txtOutgoingMessage.Text)
    Else
        If MsgBox("Nejste připojeni. " & _
            "Přejete si připojit se k " & txtAddress.Text & " ?", _
            vbYesNo + vbQuestion) = vbYes Then
            'Připojení na vzdálený počítač
            Winsock1.Close
            Winsock1.RemotePort = 201
            Winsock1.RemoteHost = txtAddress.Text
            Winsock1.Connect

            'Čekání na připojení
            Do Until Winsock1.State = sckConnected
                DoEvents: DoEvents: DoEvents: DoEvents
                If Winsock1.State = sckError Then
                    MsgBox "Chyba připojení !"
                    Exit Sub
                End If
            Loop

            'Odeslání dat
            Winsock1.SendData (txtOutgoingMessage)
        Else
            Call MsgBox("OK - nepřipojeno !", vbInformation)
        End If
    End If
        
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)

    'Akceptování příchozího požadavku na spojení
    
    If Winsock1.State <> sckClosed Then Winsock1.Close
    Winsock1.Accept requestID

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    
    'Zobrazení došlých dat
    
    Dim strIncoming As String
    Winsock1.GetData strIncoming
    txtIncomingMessage.Text = strIncoming
    
End Sub

Zpět Další