Servern
Inledning Klienten

Gör detta först

Det första du måste göra är att ordna en referens till "Microsof Winsock Control", det gör du genom att trycka på Project + Components i menyn. Du måste också göra en referens till "Microsoft Rich Textbox Control".

Sedan kan vi utforma formen. Vi börjar med servern.

Du behöver

Två RichTextBox, två Label och en Winsock-kontroll. Placera dem efter eget tycke eller som på bilden.

Sedan kan vi sätta egenskaperna för kontrollerna.

En av textboxarna:

  • Name: TxtLog
  • Locked: True
  • Scrollbars: 3 - rtfBoth
  • Text: blank

Den andra textboxen:

  • Name: TxtText
  • Scrollbars: 3 - rtfBoth
  • Text: blank

Den ena labelkontrollen:

  • Name: LblSkriv
  • AutoSize: True
  • Caption: Skriv text och tryck Enter:

Den andra labelkontrollen:

  • Name: LblStatus
  • AutoSize: True
  • Caption: Status: Vilar

Winsockkontrollen:

  • Name: Socket
  • Index: 0

Koden för servern

Private Declare Function LockWindowUpdate Lib "user32" _ (ByVal hwndLock As Long) As Long

Const Port = "0" 'Den port som skall lyssnas på

Dim ShiftDown As Boolean

Const Port anger vilken port som servern skall lyssna på. 0 anger att den skall lyssna på en ledig port. Du kan också ange vilken den skall använda, genom att ändra 0 till exempelvis 3859. Funktionen är ett API som man kan använda för att låsa och låsa upp uppdateringen av fönstret.

Private Sub Form_Load()
With Socket(0)
.LocalPort = Port 'Anger vilken port servern ska lyssna på
.Listen 'Säger åt den att lyssna
End With
Me.Caption = "Server - Port:" & Socket(0).LocalPort & " - Local IP: " & Socket(0).LocalIP 'Ändrar formens titel
Status "Lyssnar" 'Sätter LblStatus till Lyssnar
End Sub

LocalPort anger vilken port servern skall lyssna på och vilken port som klienten skall ansluta till. Listen gör att servern börjar lyssna efter klienter.

Private Sub Socket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Load Socket(Socket.UBound + 1) 'Laddar en ny Socket i samlingen
Socket(Socket.UBound).Accept requestID 'Börjar lyssna
End Sub

Ovanstående kod laddar en ny socket i samlingen, så att flera klienter kan ansluta till servern samtidigt.

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = 0 To Socket.UBound 'Loopar igenom alla Socket
If Not Socket(i).State = sckClosed Then 'Kollar om socket är ansluten
If Socket(i).State = sckConnected Then Socket(i).SendData "Server: Servern stängs nu" 'Skicka ett meddelande om att servern stängs
DoEvents 'Väntar
Socket(i).Close 'Stänger Socket
End If
Next i
End Sub

Ovanstående kod loopar igenom alla sockets och skickar ett meddelande till klienterna om att servern stängs till dem som är anslutna.

Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String 'Där datan hammnar
Socket(Index).GetData data, vbString 'Hämta datan som skickades
Status "Bearbetar data" 'Ändrar status
If Mid(data, 1, 1) = Chr(1) Then 'Kolla om det första teknet var chr(1)
Select Case Mid(data, 2, 3) 'Kollar vilket kommando det är
Case "anv" 'Klienten vill ange/ändra sitt användarnamn
Socket(Index).Tag = Mid(data, 6, Len(data)) 'Ändrar användarnamnet
Case "tim" 'Klienten vill veta tiden
Socket(Index).SendData "Klockan: " & Time 'Skicka tiden
Case "log" 'Klienten vill hämta den aktuella konversationen
Socket(Index).SendData TxtLog.Text 'Skicka konversationen
Case "dat" 'Klienten vill veta datumet
Socket(Index).SendData "Datum: " & Date 'Skicka datum
End Select
Else 'Om det inte var ett kommando så är det vanlig text
SkickaVidare data, Socket(Index).Tag 'Skickar vidare texten till andra klienter
Dim Temp As String 'Här hamnar det nuvarande text som finns i TxtLog
LockWindowUpdate Me.hWnd 'Förhindra att Windows ritar om fönstret
Temp = TxtLog.Text 'Sätter Temp till texten i TxtLog
TxtLog.Text = Socket(Index).Tag & ": " & vbCrLf & data & vbCrLf & Temp & vbCrLf 'Sätter in den nya och den gamla texten i TxtLog
LockWindowUpdate 0& 'Säger åt Windows att rita om fönstret igen
End If
Status "Lyssnar" 'Ändrar status
End Sub

Ovanstående kod tar hand om all data som kommer från en klient, kollar om det är ett kommando och i så fall vilket.Om det inte var ett kommando skickar den datan vidare till de andra klienterna och visar det i TxtLog.

Sub SkickaVidare(Text As String, Användare As String)
Dim i As Integer
For i = 1 To Socket.UBound 'Om i börjar med 0 så händer ingenting
If Socket(i).State = sckConnected Then 'Kollar om klienten är ansluten
Socket(i).SendData Användare & ": " & vbCrLf & Text & vbCrLf 'Skickar texten
DoEvents 'Väntar till föregående skickade text är skickad, annars skickas det bara till en klient
End If
Next i
End Sub

Ovanstående kod koden skickar texten vidare till de andra anslutna klienterna.

Sub Status(Text As String)
LblStatus.Caption = "Status: " & Text 'Ändrar status
End Sub

Private Sub TxtText_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyShift Then ShiftDown = True 'Sätter ShiftDown till sant om man trycker ned shift
End Sub

Private Sub TxtText_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyShift Then ShiftDown = False 'Sätter ShiftDown till falskt om man släpper shift
End Sub

"Sub Status" ändrar texten som står i LblStatus och TxtText_KeyDown. TxtText_KeyUp ändrar värdet ShiftDown.

Private Sub TxtText_KeyPress(KeyAscii As Integer)
If Socket.UBound = 0 Then Exit Sub
If KeyAscii = 13 Then
If Not ShiftDown Then
LockWindowUpdate Me.hWnd
SkickaVidare TxtText.Text, "Server"
Dim Temp As String 'Här hamnar det nuvarande text som finns i TxtLog
Temp = TxtLog.Text 'Sätter Temp till texten i TxtLog
TxtLog.Text = "Server: " & vbCrLf & TxtText.Text & vbCrLf & Temp & vbCrLf 'Sätter in den nya och den gamla texten i TxtLog
TxtText.Text = "" 'Rensar TxtText
KeyAscii = 0 'Förhindrar att datorn piper
LockWindowUpdate 0& 'Säger åt Windows att rita om fönstret igen
End If
End If
End Sub

Ovanstående kod skickar serverns text vidare till de anslutna klienterna.

Därmed är servern klar, så kan vi gå över till Klienten
Inledning Klienten

© SupportData.Net