Multiple sockets

[TheBoy]

I have a program that works fine when there is only 1 socket. However, I am trying to adapt the program so that it can receive multiple connections. This part wokrs fine, it is when the server tries and sends a file back to the client that doesn't work.

The code is quite moderatley long, so if anyone would care to take a look, I would appreciate it.

This is the code

Option Explicit
Private Const chunkSize     As Long = 3072 ' 3Kb chunk size
Private blnTransferring     As Boolean     ' status flag
Private lngFilePos          As Long        ' current vb file position
Private strFilename         As String      ' current string being sent
Private filePath            As String
Dim loopcount As Integer
Dim serverIndex As Long
Dim sckIndex As Long
 
Private Sub Form_Load()
filePath = App.Path & "\Test.jpg"
loopcount = 0
serverIndex = 0
Call startServer
End Sub
 
Private Sub sck_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'With sck(0)
 '   Call .Close
  '  Call .Accept(requestID)
'End With
 
Dim i As Long, place As Long, freeSock As Long, itemx As Object
    
    ' Search through the array to see if there is a closed
    '  control that we can re-use.
    freeSock = 0
    For i = 1 To serverIndex
        If sck(i).State = sckClosed Then
            freeSock = i
            Exit For
        End If
    Next i
    ' If freeSock is still zero there are no free controls
    '  so load a new one.
    '
    If freeSock = 0 Then
        serverIndex = serverIndex + 1
        Load sck(serverIndex)
    
        sck(serverIndex).Accept requestID
        place = serverIndex
    Else
        sck(freeSock).Accept requestID
        place = freeSock
    End If
    '  If there were not free controls then we added one above
    '   so create an entry in the ListView control for the new
    '   control.  In either case set the state of the new
    '   connection to sckConnected.
    '
    'If freeSock = 0 Then
    '    Set itemx = lstStates.ListItems.Add(, , _
     '       sockServer(serverIndex).RemoteHostIP)
    'Else
    '    Set itemx = lstStates.ListItems.Item(freeSock + 2)
     '   lstStates.ListItems.Item(freeSock + 2).Text = _
    '        sockServer(freeSock).RemoteHostIP
    'End If
    'itemx.SubItems(2) = sockServer(place).RemotePort
End Sub
 
Private Sub sck_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim macAdd As String
Dim strData As String
 
sckIndex = Index
'For the first piece of data arrival the loopcount will be equal to 0
'and ready to accept the MAC address
'If loopcount = 0 Then
    'Recieve the MAC address
    Call sck(Index).GetData(macAdd)
    'Increase loopcount
 '   loopcount = 1
 
    If macAdd = "00:11:50:33:CE:B1" Then
        Call sck(Index).SendData("ACCEPT")
    Else
        loopcount = 0
        Call sck(Index).SendData("CLOSE")
    End If
 
'Else if the MAC address has already been recieved and is valid then send the advert
'ElseIf loopcount = 1 Then
    Call SendFile(filePath)
    'Increase loopcount so doesnt resend file
 '   loopcount = 2
'Else
    'Get incoming data and check it
    Call sck(Index).GetData(strData)
    Call SendNextChunk
'End If
End Sub
 
Private Sub Timer1_Timer()
Call updateState
End Sub
 
Private Sub updateState()
Text1.Text = serverIndex
Text2.Text = sckIndex
 
Select Case sck(0).State
    Case 0
        lblState.Caption = "0 - socket closed"
    Case 1
        lblState.Caption = "1 - socket open"
    Case 2
        lblState.Caption = "2 - socket listening"
    Case 3
        lblState.Caption = "3 - socket connection pending"
    Case 4
        lblState.Caption = "4 - socket resolving host"
    Case 5
        lblState.Caption = "5 - socket host resolved"
    Case 6
        lblState.Caption = "6 - socket connecting"
    Case 7
        lblState.Caption = "7 - socket connected"
    Case 8
        lblState.Caption = "8 - socket closing"
        Call startServer
        
    Case 9
        lblState.Caption = "9 - socket error"
End Select
End Sub
 
Private Sub startServer()
With sck(0)
    Call .Close
    .LocalPort = 10101
    Call .Listen
End With
'loopcount = 0
End Sub
 
Private Sub SendFile(ByVal strFile As String)
   ' Store the filename
   strFilename = strFile
 
   'txtStatus.Text = txtStatus.Text & vbCrLf & "Sending File"
   'Call lstEvents.AddItem("Sending BOF: " & strFilename)
   
   ' Set the transferring flag, and send the BOF
   ' marker - tell the remote host that a file is coming.
   blnTransferring = True
   Call sck(sckIndex).SendData("BOF" & strFilename)
   DoEvents
End Sub
 
Private Sub SendNextChunk()
   
Dim hFile         As Long
Dim lngChunkSize  As Long
Dim strData       As String
   
   ' If not transferring and or not connected
   If (Not blnTransferring) Then Exit Sub
   
   ' Open the file in Binary mode (generic for file format)
   hFile = FreeFile
   Open strFilename For Binary As #hFile
   
   ' Read next unset piece of the file, move vb file position to after what already read,
   ' then read into strData next bytes
   If (lngFilePos = 0) Then lngFilePos = 1
   Seek hFile, lngFilePos
   
   ' Work out size of this chunk
   ' Normally set in declerations, if less to send than chunksize hen adjust
   lngChunkSize = LOF(hFile) + 1 - lngFilePos
   If (lngChunkSize > chunkSize) Then lngChunkSize = chunkSize
   
   ' If the chunksize is 0, no data left to send,
   ' transfer complete
   If (lngChunkSize = 0) Then
      
      ' Send EOF marker so the remote host knows thats all the data
      strData = "EOF"
      blnTransferring = False
      'txtStatus.Text = txtStatus.Text & vbCrLf & "Transfer Completed"
      'Call lstEvents.AddItem("0 bytes, transfer completed. Sending EOF.")
      
      ' Send the data to the remote host
      Call sck(sckIndex).SendData(strData)
      DoEvents
      Call startServer
    Else
    
      ' Take data from file, increment file pointer for next read
      strData = String$(lngChunkSize, 0)
      Get #hFile, , strData
      lngFilePos = lngFilePos + lngChunkSize
      
      ' Send the data to the remote host
      Call sck(sckIndex).SendData(strData)
      
      'Call lstEvents.AddItem("Sent " & lngChunkSize & " bytes")
      DoEvents
      
   End If

Close #hFile

End Sub