Socket and MultiThread

[ntaryl]

Good evening  
I play with a client server application  .
I  know is dificult to make the Server to use  more  than one thread(connection)at the same time .
I mean when i have 2 client connect in the Server . The First execute something and  the Second  Client  make  something  else  in the same time  
If  someone  can explain  the  logic  behind Multithread  or any  book  for  help  

P.s Saw Shark  have  Multithread  ..
   Sorry for my English  

[LeandroA]

are using some sort of loop, it would be good to see some of your code


[Spanish]
esta utilizando algun tipo de bucle, seria bueno ver parte de su codigo

[ntaryl]

Thanks for  the Reply  my Friend  
I will  read  
But is Difivuly yo me to make  something  
Iam  not so advance   ....
First  of all must understand  the Logic 
have a nice  day  

[WHK]

the multithreads in visual basic 6 is native:

pseudocode:

Código [Seleccionar] Expandir

while 10 {
load winsock(i) // when i is number of loop. the socket is a index.
}

while 10 {
connect winsock(i)
}

event connect winsock(id){
send data
}

[ntaryl]

Thanks man  for the Reply

Read  and  try to understand the  logic  

Questions
1) there  is a main Thread with the  Listen socket  ?
2)when  create  a  new  thread ?
3?How long  the  thread  stay  alive 


see  u  later  

[LeandroA]

Hello, This is a simple example of how to work with array of controls

Server

Código (vb) [Seleccionar] Expandir

Option Explicit
Dim ColSocket As Collection

Private Sub Form_Load()
    Set ColSocket = New Collection
    Winsock1(0).LocalPort = 100
    Winsock1(0).Listen  '<<< Main Conextion (don't close this connections!)
End Sub

Private Sub Winsock1_Close(Index As Integer)
    Unload Winsock1(Index)
    ColSocket.Remove "K" & Index
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
   
   
    Dim FreeIndex As Long, NewKey As String
   
    'FreeIndex = Winsock1.UBound + 1  'Maximum value of the array of controls <(Don't use this)
   
    FreeIndex = GetFreeIndex() '<(use This, prevents the increase of the array)
   
    NewKey = "K" & FreeIndex 'Unique key for control

    Load Winsock1(FreeIndex) 'load new control
   
    ColSocket.Add Winsock1(FreeIndex), NewKey 'Add the new control in the collection
   
    ColSocket(NewKey).Accept requestID 'The new control accept the new connections
   
    ColSocket(NewKey).SendData "hola mundo" & FreeIndex 'The new control send a message
   
   
End Sub

Private Function GetFreeIndex() As Long 'Get the free index in the controls array
    Dim i As Long, j As Long
   
    For i = 1 To ColSocket.Count
        For j = 1 To ColSocket.Count
            If ColSocket(j).Index = i Then
                GetFreeIndex = 0
                Exit For
            Else
                GetFreeIndex = i
            End If
        Next
        If GetFreeIndex <> 0 Then Exit For
    Next
   
    If GetFreeIndex = 0 Then GetFreeIndex = ColSocket.Count + 1
   
End Function

Private Sub Command1_Click()
    SendNewMessageForAllConection
End Sub

Private Sub SendNewMessageForAllConection()
    Dim i As Long
    For i = 1 To ColSocket.Count
       ColSocket(i).SendData "New Message for all Connections"
    Next
End Sub

Private Sub Command2_Click()
    CloseAllConnections
End Sub

Private Sub CloseAllConnections()
    Dim i As Long
    For i = ColSocket.Count To 1 Step -1
        ColSocket(i).Close
        Unload Winsock1(ColSocket(i).Index)
        ColSocket.Remove i
    Next
End Sub

'this works only if the data are small, otherwise it should be modulized or create array index data
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim Data As String
    Winsock1(Index).GetData Data 'or ColSocket("K" & Index).GetData Data
    Me.Print Data
End Sub

Client (compile it and run it several instances)

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
    Winsock1.Connect "127.0.0.1", 100
End Sub

Private Sub Winsock1_Close()
    Unload Me
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim Data As String
    Winsock1.GetData Data
    Me.Caption = Data
End Sub

[ntaryl]

Thanks Leandro   
I  have  not problem  to  cretae  a Server  with  socket  in array (accept  many Clients)
Normally  the  Server  wont  with a  client  in time
When  the  first Finish  go to the Next ...
Want to  make  the Server if  is  possible to  work  with  more  than  one  client   
Example 
If  Server  connecte  with  3  clients  .Then  When  the  number 1 send  screen..
the  second  send file 
the  Third  send   Avi  ..
All the clients  work  at  the  same  time   

If  iam  wrong  tell me 


thanks  for the reply 

[LeandroA]

Ok, voy a seguir en castellano después usted lo traduce

yo e solucionado eso de la siguiente manera

No envíe el archivo completo, envielo por trozos de 1 kb aproximadamente, cuando se dispara el evento SendComplete active un pulso de un timer para no crear un bucle y así poder formar algo parecido a un Multithreard.

un ejemplo que no lo he probado pero es para que usted tenga una idea de como funciona, es mas lento pero puede enviar varios archivos a la vez


Esto iria dentro de un modulo clase que representa una conexión con un modulo clase de socket y un modulo clase de un timer.

Código [Seleccionar] Expandir


Const SIZE_OF_BUFFER As Long = 1024

Dim LenData As Long
Dim bData() As Byte
Dim bBuffer() As Byte
Dim lChuncks As Long
Dim lReminder As Long
Dim lPos As Long
Dim SendFileComplete As Boolean

Private Sub SendFile(ByVal FileName As String)
   Dim FF As Integer
   FF = FreeFile
   
   Open FileName For Binary As #FF
     ReDim bData(LOF(FF))
     Get #FF, , bData
   Close #FF
   
   LenData = UBound(bData)
   ReDim bBuffer(SIZE_OF_BUFFER)
   lChuncks = LenData \ SIZE_OF_BUFFER
   lReminder = LenData - lChuncks * SIZE_OF_BUFFER
   SendFileComplete = False
   Call SendSegment
End Sub

       
Private Sub SendSegment()

   If SendFileComplete = True Then Exit Sub

   If lPos <= lChuncks Then
       CopyMemory bBuffer(0), bData(lPos), SIZE_OF_BUFFER
       lPos = lPos + SIZE_OF_BUFFER
       
       SendFileComplete = False
       
       If cSocket.State = 7 Then
           cSocket.SendData bBuffer
       End If
   Else

       If lReminder > 0 Then
           ReDim bBuffer(lReminder)
           CopyMemory bBuffer(0), bData(lPos), lReminder
           
           SendFileComplete = True
           
           If cSocket.State = 7 Then
               cSocket.SendData bBuffer
           End If
       Else
           SendFileComplete = True
       End If
   End If
End Sub

Private Sub cSocket_SendComplete()
   cTimer.StartTimer 1
End Sub

Private Sub cTimer_Timer()
   cTimer.StopTimer
   Call SendSegment
End Sub

[ntaryl]

Thanks for the time   
I will check  it  later