# Senden und empfangen von nachrichten via Winsock



## MasterSHYBBY (7. Januar 2004)

Hallo Leute,

ich will via ein chatprogramm für mein netzwerk schreiben Das alles sollte mit winsock funltioniern! Ich habe jedoch nur beispiele gefunden welche die nachricht gleich erhalten wie wenn ich ein net send befehl ausführe, ich will die empfangenen nachrichten aber in einer listbox haben! und nicht ein in einem neuen fenster! Kann mir vielleicht einer ein Beispiel geben oder mir helfen?
Danke im Voraus.

Gruss
Master SHYBBY


----------



## Thomas Kuse (8. Januar 2004)

Du solltest in jedem Fall beim net recv einen Zeichenfolge zurückbekommen, die du dann beliebig einfügen kannst, in ein neues Fenster, eine Listbox oder als MessageBox.

Hier ein Winsock-Chat-Beispiel:
http://www.visualbasicforum.com/t127668.html


----------



## MasterSHYBBY (8. Januar 2004)

*Danke für die Hilfe*

danke für deine Hilfe werde das Beispiel anschauen!

Gruss
Master SHYBBY


----------



## daDom (9. Januar 2004)

Hi!

Ich habe vor einiger Zeit mal eins geschrieben.....

Es funktioniert auch ganz gut - auch über's Internet 

*Link zum Chatprogramm. *


----------



## MasterSHYBBY (12. Januar 2004)

*hallo,*

sorry aber ich kann deine Zip-datei nicht öffnen liegt das an mir?

Gruss 
Master SHYBBY


----------



## daDom (12. Januar 2004)

Hmm... .ein seltsamer Fehler....

Ich hab die Datei aktualisiert...


----------



## MasterSHYBBY (12. Januar 2004)

*Der fehlter hab ich immer noch*

Sorry wird mein pc sein kannst du mir die Datei kurz per e-mail senden an shybby@gmx.ch

danke

Gruss
Master SHYBBY


----------



## daDom (12. Januar 2004)

Ne, ich habe das ein bisschen verzögert....
Sorry.

Ich habs auf meinen Webspace hochgeladen...

Damit geht 100%ig


----------



## MasterSHYBBY (12. Januar 2004)

*danke*

nun hab ichs entlich geschaft danke funktioniert super gut. Danke
noch kurz ne frage geht das alles über Winsock?

Gruss
Master SHYBBY


----------



## daDom (12. Januar 2004)

Ja, alles über Winsock...

Wie findest du's?
habe es schon lange nicht mehr überarbeitet


----------



## MasterSHYBBY (13. Januar 2004)

tja bin noch in der testphase finde es bis anhin recht gut würde gerne mal dein source code ansehen

schreib wieder wenn ich mit dem test durch bin!

Gruss
Master SHYBBY


----------



## daDom (13. Januar 2004)

Jo 

Ich habe meinen Hauptteil auch von nem Bsp...
Glaube ich von ActiveVB


----------



## MasterSHYBBY (13. Januar 2004)

Da ich dein Programm sehr gut finde und den ganzen ablauf genauer verstehen wollte, wollte ich dich fragen ob ich mal deinen Source code haben könnte.

Gruss
Master SHYBBY


----------



## MasterSHYBBY (13. Januar 2004)

habe noch kurz eine frage hast du auch mal mit mereren benutzern gearbeitet? bei mir geht das nicht immer!

Gruss
Master SHYBBY


----------



## daDom (14. Januar 2004)

Klar!
Bei mir können 'unendlich' viele User online sein...

Aber ich habe heute in der Schule ein Beispiel von einem Server bekommen....
Er erstellt für jeden User, der sich neu anmeldet ein neues Winsock-Control...
Bei interesse könnte ich's mal vom Papier abschreiben...
Allerdings fehlt dir dann noch der Client...

Bei mi hast du beides in einem ;-]


----------



## MasterSHYBBY (14. Januar 2004)

also interesse am server hätte ich schon. das problem welches ich bei deinem programm habe ist, dass der zweite user keine nachrichten mehr sehen kann Ich hab jedoch keine ahnung warum

Gruss 
Master SHYBBY


----------



## daDom (15. Januar 2004)

Also ich habe schon mit mehreren Leuten gleichzeitig gechattet und da hatte keiner Probleme  

Ich muss mal gucken ob ich den Code vom Server auch kopieren kann, denn alles abzuschreiben erscheint mir etwas kompliziert...

gruß
daDom


----------



## MasterSHYBBY (15. Januar 2004)

tja muss in diesem fall noch mal testen! Frage kanst du mir dein sourcecode vielleicht auch mal schicken? 

Gruss
Master SHYBBY

P.s. Wenn das mit dem Server zu aufwendig ist, ist es nicht so schlimm versuch ichs irrgend wie anders


----------



## daDom (15. Januar 2004)

Hier der Code:

Allerdings nur von der Hauptframe...


```
'Für Sound
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'Für OnTop?
Private Declare Function GetActiveWindow Lib "user32" () As Long

'Für Titelleisten Blink
Private Declare Function FlashWindow Lib "user32.dll" (ByVal hwnd As Long, _
bInvert As Long) As Long


Dim counter As Integer
Dim myname As String
Dim namelist As String
Dim fserver As Boolean
Dim cname(100) As String
Dim PlayThis As Integer
Dim signal2timer2 As Integer


Private Sub client_Click()
Form2.Visible = True
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub programminfo_Click()
    frmAbout.Show
End Sub

Private Sub cmdMinimieren_Click()
    Me.WindowState = vbMinimized
End Sub

Private Sub exit_Click()
    If fserver = True Then
        serversend ("m-------------------------------------------Server disconnected!-------------------------------------------")
    End If
    Unload Form1
    Unload Form2
    Unload Form3
End Sub

Private Sub features_Click()
    Form4.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If fserver = True Then
        serversend ("mS-------------------------------------------Server disconnected!-------------------------------------------")
    End If
    DoEvents
    Unload Form1
    Unload Form2
    Unload Form3
End Sub

Private Sub hostname_Click()
    Form3.Visible = True
    DoEvents
    If fserver = True Then
        refreshlist
    End If
    
End Sub

'-------------------------------Was geht wenn nachricht kommt?----------------------

Public Function FensterImVordergrund(ByVal hwnd As Long) As Boolean
  If GetActiveWindow() = hwnd Then
    FensterImVordergrund = True
  Else
    FensterImVordergrund = False
  End If
End Function

Private Sub sounds_Click()
    Form5.Show
End Sub

Private Sub tmrBlink_Timer()
'Wenn Window minimiert, dann Titelleiste und Taskbar blinken lassen
    If PlayThis = True Then
        FlashWindow Me.hwnd, 1
    Else
        FlashWindow Me.hwnd, 0
    End If
    
End Sub

Private Sub Timer2_Timer()
'Wenn Fenster im Hintergrund dann abspielen möglich + blinken
If FensterImVordergrund(Me.hwnd) = False Then
    PlayThis = True
        If signal2timer2 = True Then
            tmrBlink.Enabled = True
        End If
    'Wenn Fenster im Vordergrund dann abspielen NICHT möglich + KEIN blinken
    Else
    PlayThis = False
    signal2timer2 = False
    tmrBlink.Enabled = False
  End If

End Sub

Private Sub RichTextBox1_Change()
'Wenn Window minimiert, dann Sound abspielen
    If PlayThis = True Then
        'Nur Sound spielen, wenn in Form5 das entsprechende Häkchen gesetzt ist
        If Form5.checkMsgHinweis.Value = 1 Then
            sound (Int((Rnd * 3) + 1))
        End If
        signal2timer2 = True
    End If
End Sub


Private Function sound(Zahl As Byte) As String
'Rnd Funktion für die Soundausgabe wenn nicht im Vordergrund
 Select Case Zahl
    Case 1
        Call sndPlaySound("sound/54a.wav", 1)
    Case 2
        Call sndPlaySound("sound/54b.wav", 1)
    Case 3
        Call sndPlaySound("sound/54c.wav", 1)
 End Select
End Function

'-------------------------------Was geht wenn nachricht kommt?----------------------

Private Sub sclient_Close()
server.Enabled = True
client.Enabled = True
disconnect.Enabled = False
sclient.Close
Text1.Enabled = False
List1.Clear
End Sub

Private Sub sclient_Connect()
disconnect.Enabled = True
server.Enabled = False
client.Enabled = False
Text1.Enabled = True
Form1.Caption = myname
fserver = False
RichTextBox1.Text = ""
Form1.sclient.SendData "n" & myname
Timer1.Enabled = False
Form2.ComboIP.AddItem Form2.ComboIP.Text
Open App.Path & "/ip" For Output As #1

If Form2.ComboIP.ListCount = 1 Then
    Write #1, Form2.ComboIP.Text
Else
    For i = 1 To Form2.ComboIP.ListCount - 1

        If Form2.ComboIP.Text = Form2.ComboIP.List(i) Then
            Form2.ComboIP.Text = ""
        End If
        Write #1, Form2.ComboIP.List(i)
    Next
    If Form2.ComboIP.Text <> "" Then
        Write #1, Form2.ComboIP.Text
    End If
End If
Close #1
End Sub


Private Sub sclient_Error(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)
    MsgBox "Fehler in der Verbindung:" + vbCrLf + vbCrLf + Description + vbCrLf + vbCrLf + "  --> Server aktiv", vbExclamation, "Verbindungsfehler"
End Sub

Private Sub sserver_Close(Index As Integer)
sserver(Index).Close
sserver(Index).Tag = 0
cname(Index) = ""
End Sub

Private Sub sserver_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)
    MsgBox "Fehler in der Verbindung:" + vbCrLf + vbCrLf + Description + vbCrLf + vbCrLf + "  --> Server aktiv", vbExclamation, "Verbindungsfehler"
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
        If fserver = False Then
        sclient.SendData "m" & myname & " : " & Text1.Text
    Else
        'Namen mit Text senden
        serversend ("m" & myname & " : " & Text1.Text)
'Eigene Nachricht adden + Rest dranhängen
          
        '***** Nickname fett drucken
        RichTextBox1.SelBold = True
        RichTextBox1.SelText = myname
        RichTextBox1.SelBold = False
        RichTextBox1.SelText = " : " & Text1.Text & vbCrLf
        RichTextBox1.SelLength = 0
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
        '***** Nickname fett drucken
    End If
    Text1.Text = ""
    
    KeyAscii = 0 'Unterdrückt das Beep beim Enterdrücken
End If

End Sub

Private Sub disconnect_Click()
If fserver = True Then
    Dim a As Integer
    serversend ("mServer disconnected")
    For a = 0 To counter Step 1
        'If sserver(a).State = sckConnected Then
            sserver(a).Close
        'End If
    Next a
End If
server.Enabled = True
client.Enabled = True
disconnect.Enabled = False

sclient.Close
Text1.Enabled = False
counter = 0
Timer1.Enabled = False
List1.Clear

RichTextBox1.Text = "-------------------------------------------Server disconnected!-------------------------------------------"
End Sub

Private Sub Form_Load()
disconnect.Enabled = False
myname = sclient.LocalHostName
counter = 0
txtIP.Text = sserver(0).LocalIP
Timer1.Enabled = False
lblInfo.Caption = "LANChat Version " & App.Major & "." & App.Minor & "." & App.Revision _
& vbCrLf & "powered by screen-style.de"
PlayThis = False
signal2timer2 = False
End Sub

Private Sub sclient_DataArrival(ByVal bytesTotal As Long)
Dim revmessage As String
sclient.GetData revmessage
If Left(revmessage, 1) = "m" Then

    '***** Nickname fett drucken
    revmessage = Mid(revmessage, 2)
    If InStr(1, revmessage, " : ") > 0 Then
      RichTextBox1.SelBold = True
      RichTextBox1.SelText = Mid$(revmessage, 1, InStr(1, revmessage, " : ") - 1)
      RichTextBox1.SelBold = False
      RichTextBox1.SelText = Mid$(revmessage, InStr(1, revmessage, " : ") + 1, Len(revmessage)) & vbCrLf
    End If
    '***** Nickname fett drucken
    
End If
If Left(revmessage, 1) = "n" Then
    revmessage = Mid(revmessage, 2)
    List1.Clear
    Dim pstart, pend, a As String
    Dim ffinish As Boolean
    pstart = 1
    a = 0
    ffinish = False
    While ffinish = False
        pend = InStr(pstart, revmessage, " ", 1)
        cname(a) = Trim(Mid(revmessage, pstart, pend))

        pstart = pend + 1
      
        List1.AddItem (cname(a))
        a = a + 1
        If pend >= Len(revmessage) Then
            ffinish = True
        End If
        
    Wend
End If
'Auch beim Empfangen und senden desClienten den Text mitscrollen!
        RichTextBox1.SelLength = 0
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
    
End Sub

Private Sub server_Click()
cname(0) = myname
sserver(0).LocalPort = 789
sserver(0).Listen
server.Enabled = False
client.Enabled = False
disconnect.Enabled = True
Form1.Caption = sserver(0).LocalIP
Text1.Enabled = True
fserver = True
'RichTextBox1.Text = "Server online!"

Timer1.Interval = 5000
Timer1.Enabled = True
refreshlist
End Sub

Private Sub sserver_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
    counter = counter + 1
    Load sserver(counter)
    sserver(counter).LocalPort = 0
    sserver(counter).Accept requestID
    sserver(counter).SendData "mWillkommen im chat"
    sserver(counter).Tag = 1
    
End If
End Sub

Private Sub sserver_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim revmessage As String
sserver(Index).GetData revmessage

If Left(revmessage, 1) = "m" Then
    revmessage = Mid(revmessage, 2)
    
    '***** neu
    RichTextBox1.SelBold = True
    RichTextBox1.SelText = Mid$(revmessage, 1, InStr(1, revmessage, " : ") - 1)
    RichTextBox1.SelBold = False
    RichTextBox1.SelText = Mid$(revmessage, InStr(1, revmessage, " : ") + 1, Len(revmessage)) & vbCrLf
    '***** neu
    
    serversend ("m" & revmessage)
End If

If Left(revmessage, 1) = "n" Then
    cname(Index) = Mid(revmessage, 2)
End If
        RichTextBox1.SelLength = 0
        RichTextBox1.SelStart = Len(RichTextBox1.Text)

End Sub

Public Sub changename(a As String)
    myname = a
    If fserver = False Then
        Form1.Caption = myname
        If disconnect.Enabled = True Then
            sclient.SendData "n" & myname
        End If
    Else
        cname(0) = a
        refreshlist
    End If
End Sub

Public Sub serversend(message As String)
Dim a As Integer
For a = 0 To counter Step 1
    
    If sserver(a).Tag = "1" Then
        sserver(a).SendData message
    End If
Next a
End Sub

Public Sub refreshlist()
List1.Clear
namelist = ""
Dim a As Integer
For a = 0 To counter
    
    If cname(a) <> "" Then
        namelist = namelist & cname(a) & " "
        List1.AddItem (cname(a))
    End If
Next a
serversend ("n" & namelist)
End Sub

Private Sub Timer1_Timer()
If fserver = True Then
    refreshlist
Else
    MsgBox ("Konnte keinen Server finden!")
    Timer1.Enabled = False
    sclient.Close
End If
End Sub
```


----------

