WinSock_Close(Index As Integer)

En lidt klam løsning, som ikke svare på det du sprøger om, men som løser problemet:

  On Error goto ErrorLine 
  For T = 1 To Instances
    If (WinSock(T).State = 7) And T = Index Then
    ...
ErrorLine:
  Next T

prøv sådan:

Private Sub WinSock_Close(Index As Integer)
  If Index <> 0 Then
    WinSock(Index).Close  'Close
      Do Until WinSock(Index).State = sckClosed
        DoEvents: DoEvents
      Loop
    Unload WinSock(Index) 'Unload.
  End If
End Sub

Hejsa.

Jeg synes at deter en dum måde at i laver jeres "chat-sjov" på. Det virker sikkert udemærket, men er detikke besværligt?

Jeg laver det sådan her.

www.friserverplads.dk/northcode/opgaver/chat.zip

Jeg bruger kun en winsock kontrol og med den sender jeg til alle klienter og modtager fra alle klienter. Når en ny klient opkoples gemmes han i en variabel.

ex (i winsock arrivial)

dim tekst as string
winsock.getdata tekst

if mid(tekst,1,2) = "01" then
  antalklienter = antalklienter + 1
  klient(antalklienter) = mid(tekst,3,len(tekst)-3)
  msgbox "En ny klient er addet"
end if


-i klienten når programmet startes-

winsock.senddata "01" & winsock.localhost


Og på den måde kan der komme uendelige klienter opkoplet til en server. Jeg har ikke mere tid til at forklarer, men du kan lave det påden måde at severen hele tiden sender antalklienter til klienterne og så adder klienterne den tekst til en listbox (som hele tiden cleares)..

Men jeghar ikke mere tid.

Held og lykke

Mvh.
NorthCode

martin_moth:
Prøvede din løsningsmodel, den virkede for de klienter der havde et lavere Index nr. end den klient der disconnectede, f.eks. hvis der var 5 klienter og klient 3 disconectede, så virkede kun klient 1 og 2, ved du hvad jeg kan gøre for at 'lukke' hullet ?

sjh:
Jeg har ikke problemer med at unloade mit Winsock objekt, jeg har problemer med at når jeg har lukket det så kommer jeg til at sende til klienter der har disconnected..

kantoraza:
Jeg syntes at jeg har set dit svar et par gange før, hvad gør du hvis en masse klienter sender noget på nøjaktigt samme tidspunkt ? jeg modtager fra 1-20  klienter 50-70 gange i sekundet, så sansyneligheden for at 2 klienter sender noget samtidigt er 100%, jeg vil downloade dit eksempel og teste det:)


Jeg har ingen points givet endnu, jeg giver pointsne til den der kommer med at svar jeg kan arbejde videre på!

okay.

Men du kunne jo bygge dit program om til kun at fx sende en gang i sekuntet.

Prøv med noget ala dette:

  For T = 1 To WinSock.Count
    If (WinSock(T).State = 7) And T = Index Then

  Next T


Private Sub WinSock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  If Index = 0 Then
    If IsError(Winsock(requestID)) = False Then
      Load Winsock(requestID)
        DoEvents
      Winsock(requestID).Accept requestID
    End If
  End If
End Sub

sjh:
Jeg tror sørme at du er på sporet men jeg får det dog ikke til at virke, jeg vedlægger hele sourcen, hvis du gider kigge på den så bliver jeg en lykkelig lille Winsock nørd :))

----------- VB Source ---------------
Option Explicit

Private Instances As Long
Private IntFps As Integer
Private StrPakker As String
Private StrLukkede As String
Private ArrLukkede As Variant

Private Type KlientClass
    ID As String
    X As String
    Y As String
End Type

Private ArrKlient(1 To 12) As KlientClass

Private Sub Form_Load()
    Instances = 0
    IntFps = 0
    StrPakker = 0
    WinSock(0).LocalPort = 8765
    WinSock(0).Listen
    Timer1.Interval = 0
End Sub

Private Sub Timer1_Timer()
    Dim T As Integer
   
    txtFps.Text = IntFps
    txtKlienter.Text = Instances
   
    txtPakker.Text = StrPakker
    IntFps = 0

    'txtBillede.Text = ""
    'For T = 1 To Instances
    '    txtBillede.Text = txtBillede.Text & vbNewLine & vbNewLine & ArrKlient(T).ID & vbNewLine
    '    txtBillede.Text = txtBillede.Text & "X: " & ArrKlient(T).X & vbNewLine
    '    txtBillede.Text = txtBillede.Text & "Y: " & ArrKlient(T).Y & vbNewLine
    'Next
End Sub

Private Sub WinSock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    If Index = 0 Then
        Instances = Instances + 1
   
        Load WinSock(Instances)
        WinSock(Instances).LocalPort = 0
        WinSock(Instances).Accept requestID
    End If
End Sub

Private Sub WinSock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim ArrPakke As Variant
    Dim StrTekst As String
    Dim StrPakkeTekst As String
    Dim T As Integer
    Dim T2 As Integer
   
    IntFps = IntFps + 1
   
    WinSock(Index).GetData StrTekst, vbString
   
    ' Klient kan sende genstart kommando
    If InStr(StrTekst, "restart") Then Call Restarter
   
    ' Generer pakke indhold til hver klient
    For T = 1 To Instances
        On Error GoTo ErrorLine
        If (WinSock(T).State = 7) And T = Index Then
            ' Generer klient pakke
            If InStr(StrTekst, "*") Then
                StrTekst = Left(StrTekst, InStr(StrTekst, "*") - 1)
                ArrPakke = Split(StrTekst, ",")
            Else
                If InStr(StrTekst, ",") Then
                    ArrPakke = Split(StrTekst, ",")
                Else
                    ArrPakke = Split("0,0,", ",")
                End If
            End If
           
            ' Indrapportering af data
            ArrKlient(T).ID = T
            ArrKlient(T).X = Trim(ArrPakke(0))
            ArrKlient(T).Y = Trim(ArrPakke(1))
           
            For T2 = 1 To UBound(ArrKlient)
                If ArrKlient(T2).ID = "" And ArrKlient(T2).X = "" And ArrKlient(T2).Y = "" Then
                Else
                    StrPakkeTekst = StrPakkeTekst & "K:" & ArrKlient(T2).ID
                    StrPakkeTekst = StrPakkeTekst & "X" & ArrKlient(T2).X
                    StrPakkeTekst = StrPakkeTekst & "Y:" & ArrKlient(T2).Y
                End If
            Next
           
            StrPakkeTekst = StrPakkeTekst & Chr(0)
           
            WinSock(T).SendData StrPakkeTekst
           
            StrPakkeTekst = ""
        End If
       
' Forsøg på Fejlhåndtering
ErrorLine:
    If Err = 340 Then
        'MsgBox Err
        'Instances = Instances - 1
        'WinSock(Index + 1) = WinSock(Index + 2)
        'Unload WinSock(Index + 1)
    End If
   

   
    Next T
   
    ' Tæl pakkerne
    StrPakker = Int(StrPakker) + 1
End Sub

Private Sub WinSock_Close(Index As Integer)
    Instances = Instances - 1
    Unload WinSock(Index)
End Sub

Private Sub WinSock_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)
    txtFejl.Text = txtFejl.Text & "Fejl opstået for Klient nr. " & Index & vbNewLine & "Fejlen er: " & Description & vbNewLine & vbNewLine
End Sub

Private Function Restarter()
    Timer1.Interval = 0
    Instances = 1
    IntAntalKlienter = 1
    IntFps = 0
    StrPakker = "0"
    StrLukkede = "0"
    Set ArrLukkede = Nothing
    Timer1.Interval = 1000
    txtFejl.Text = txtFejl.Text & "Server genstartet af klient" & vbNewLine & vbNewLine
End Function
-------------------------------------

strcoder< Det er fint nok, men hvad skal det bruges til og hvordan virker din clint?

sjh:
Min klient sender data til serveren, dataene sendes så ud til alle klienterne, det skal bruges til et spil jeg arbejder på.

Ingen af jeres svar løser mit problem, og der er derfor ingen points, sjh for dog halvdelen af pointsne da han er nogenlunde på sporet af en løsning.

Hmm, jeg kan ikke give halvdelen, så jeg giver det jeg kan...

Prøv at lave det sådan:

Private Sub Form_Load()
  WinSock(0).LocalPort = 12345
  WinSock(0).Listen
End Sub

Private Sub WinSock_Close(Index As Integer)
  If Index <> 0 Then
    WinSock(Index).Close
      Do Until WinSock(Index).State = sckClosed
        DoEvents: DoEvents
      Loop
    Unload WinSock(Index)
  End If
End Sub

Private Sub WinSock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  If Index = 0 Then
    If IsError(WinSock(requestID)) = False Then
      Load WinSock(requestID)
        DoEvents
      WinSock(requestID).Accept requestID
    End If
  End If
End Sub

Private Sub WinSock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strTekst As String
Dim WS As WinSock
  WinSock(Index).GetData strTekst, vbString, bytesTotal
  For Each WS In WinSock
    If WS.Index <> 0 Then
      DoEvents: WinSock(WS.Index).SendData strTekst
    End If
  Next
End Sub

sjh:
Jeg har ikke været på eksperten de sidste par dage så jeg har først lige set dit seneste svar, jeg prøver det når jeg kommer hjem fra slaveanstalten :)