'server
Dim nextrow As Integer
Dim message As String
Dim part() As String
Dim timesplit() As String


Private Function findip(ip As String, port As Integer)
Dim i As Integer, inloop As Boolean, hit As Boolean
    hit = False
    i = 1
    If nextrow > 1 Then
        inloop = True
        Else
        inloop = False
    End If
    While inloop
        MSF1.Row = i
        MSF1.Col = 0
        thisip = MSF1.Text
        MSF1.Col = 1
        thisport = MSF1.Text
        If thisip = ip And thisport = port Then
            inloop = False
            hit = True
        Else
            If i = nextrow - 1 Then
                inloop = False
            Else
                i = i + 1
            End If
        End If
    Wend
    If hit Then
        findip = i
    Else
        findip = nextrow
        MSF1.Row = nextrow
        MSF1.Col = 0
        MSF1.Text = Winsock1.RemoteHostIP

        MSF1.Col = 1
        MSF1.Text = Str(Winsock1.RemotePort)
        nextrow = nextrow + 1
            
    End If
    
End Function

Private Sub plogin(rownum)
MSF1.Row = rownum
MSF1.Col = 0
'Winsock1.RemoteHost = MSF1.Text
MSF1.Col = 1
'Winsock1.RemotePort = MSF1.Text

If UBound(part()) > 0 Then

    okay = False
    searchst = "staffID=" + Chr(39) + part(1) + Chr(39)
    Adostaff.Recordset.MoveFirst
    Adostaff.Recordset.Find searchst

    If Not Adostaff.Recordset.EOF Then
       If Adostaff.Recordset!givenname = part(2) Then
            
           If Adostaff.Recordset!StatusUWC = "S" Then
            okay = True
            
            Winsock1.SendData "OKAY" & ":"
            Winsock1.SendData Adostaff.Recordset!familyname
            ' only allow autogenerate after a login
            Command1.Enabled = True
            
            Else
            Winsock1.SendData "REJECT" & ":"
            Winsock1.SendData "Reject,Not Scheduler"
            End If
        
        Else
        okay = False
        Winsock1.SendData "REJECT" & ":"
        Winsock1.SendData "Reject,Incorrect User P"

       End If
    
    Else
    Winsock1.SendData "REJECT" & ":"
    Winsock1.SendData "Error,unrecognised msg"
    Rem incorrect message format
    
End If
End If

End Sub





Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()

Winsock1.Close ''Close connection
Winsock1.RemoteHost = Winsock1.LocalIP 'Get IP address of PC
Winsock1.RemotePort = Winsock1.LocalPort 'Port number - in Port.Text (TextBox)
Winsock1.Connect ''Set Connection

Form1.Visible = True

Do
    If Winsock1.State <> sckConnected And Winsock1.State <> sckListening Then 'Is the connection available or do we listen to the port?
        Winsock1.Close 'All the connections are switched off
        Winsock1.Listen ''Listen port 6800
    End If
    DoEvents
Loop

Adoproduct.Recordset.MoveFirst
While Not Adoproduct.Recordset.EOF
    List4.AddItem Adoproduct.Recordset!ProductID
    Adoproduct.Recordset.MoveNext
Wend
Adostaff.Recordset.MoveFirst
While Not Adostaff.Recordset.EOF
    If Adostaff.Recordset!StatusUWC = "C" Then
        List2.AddItem Adostaff.Recordset!staffID
    End If
    If Adostaff.Recordset!StatusUWC = "U" Then
        List3.AddItem Adostaff.Recordset!staffID
    End If
    If Adostaff.Recordset!StatusUWC = "W" Then
        List7.AddItem Adostaff.Recordset!staffID
    End If
    
    Adostaff.Recordset.MoveNext
Wend

nextrow = 1
MSF1.Row = 0
MSF1.Col = 0
MSF1.Text = "IP Addrees"
MSF1.Col = 1
MSF1.Text = "IP Port"
MSF1.Col = 2
MSF1.Text = "Player ID"
MSF1.Col = 3
MSF1.Text = "Known As"
MSF1.Col = 4
MSF1.Text = "Status"

Winsock1.Bind 6800


End Sub



Private Sub Timer1_Timer()
'Ordered,<OrderNo>,<ProductID>,<quant>,<ProductID>,<Quant>...
Adoordur.Recordset.AddNew
Adoordur.Recordset!tabulID = Str(Int(Rnd(1) * 15) + 1)
Adoordur.Recordset!Date = Int(Date)
Adoordur.Recordset!Time = Date - Int(Date)
List7.ListIndex = Int(Rnd(1) * List7.ListCount)
Adoordur.Recordset!staffID = List7.Text
Adoordur.Recordset.Update
Adoordur.Recordset.MoveLast
unikey = Adoordur.Recordset!orderID
' lines of an order must have the ID for the ordur table
' and then unique values for productID
numlin = Int(Rnd(1) * 3) + 2
' clear list5, repopulate with all products from list4

List5.Clear
messij = "ORDERED," + Str(unikey) + "," + Str(Adoordur.Recordset!tabulID)
For i = 0 To List4.ListCount - 1
    List4.ListIndex = i
    List5.AddItem List4.Text
Next
' then remove products from list5 when they are added to order
For i = 1 To numlin
    List5.ListIndex = Int(Rnd(1) * List5.ListCount)
    Adoorderitems.Recordset.AddNew
    Adoorderitems.Recordset!orderID = unikey
    Adoorderitems.Recordset!ProductID = List5.Text
    messij = messij + "," + List5.Text
    List5.RemoveItem (List5.ListIndex)
    Adoorderitems.Recordset!quantity = Int(Rnd(1) * 3) + 1
    messij = messij + "," + Str(Adoorderitems.Recordset!quantity)
    Adoorderitems.Recordset!Status = "P"
    Adoorderitems.Recordset.Update
Next i
' call sendall(messij)
Winsock1.SendData messij
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close 'Listen close
Winsock1.Accept requestID 'Let's tap a Client with the number of his request.
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim ip As String
Dim port As Integer
Dim whichip As Integer
Dim i As Integer, j As Integer
Winsock1.GetData message


If message = "DISH" Then

Adoproduct.Recordset.MoveFirst
While Not Adoproduct.Recordset.EOF
 
    Winsock1.SendData Adoproduct.Recordset!ProductID & ","
    Adoproduct.Recordset.MoveNext

Wend
End If


If message = "LUNCH" Then

    If Winsock1.State <> sckConnected Then Exit Sub ''Test connecting
    Winsock1.SendData "LUNCH" & ":"
    
    Adoproduct.Recordset.MoveFirst
    While Not Adoproduct.Recordset.EOF
 
    Winsock1.SendData Adoproduct.Recordset!ProductID & "  "
    Adoproduct.Recordset.MoveNext

    Wend

        Else
        If message = "DINNER" Then
    
        Winsock1.SendData "DINNER" & ":"
    
        Adoproduct.Recordset.MoveFirst
        While Not Adoproduct.Recordset.EOF
 
        Winsock1.SendData Adoproduct.Recordset!ProductID & "   "
        Adoproduct.Recordset.MoveNext
        
        'If (Adoproduct.Recordset!ProductID = "QGH") Then
        'Adoproduct.Recordset.Delete (["QGH" as AffectEnum = adAffectCurrent])
        'End If

        Wend

    Else
    If message = "SUPPER" Then
        If message = "SUPPER" Then
    
        Winsock1.SendData "SUPPER" & ":"
    
        Adoproduct.Recordset.MoveFirst
        While Not Adoproduct.Recordset.EOF
 
        Winsock1.SendData Adoproduct.Recordset!ProductID & ","
        Adoproduct.Recordset.MoveNext


        Wend

    End If
    End If
    End If
End If


List1.AddItem message + Str(Winsock1.RemotePort)
part() = Split(message, ",")


For i = LBound(part()) To UBound(part())
    'part(i) = UCase(part(i))
    List1.AddItem UCase(part(i))
Next i
ip = Winsock1.RemoteHostIP
port = Winsock1.RemotePort
whichrow = findip(ip, port)
Rem need this for some VB Op sys combinations
'Winsock1.RemoteHost = ip


If part(0) = "LOGIN" Then
     Call plogin(whicrow)
End If
    
If part(0) = "STAFF" Then
     Call stafflist
End If
If part(0) = "ONEPRODUCT" Then
    Call oneprod
End If
If part(0) = "PRODUCTS" Then
    Call prodlist
End If
If part(0) = "TABLES" Then
    Call tablelist
End If
If part(0) = "ORDERS" Then
    Call ordlist
End If
If part(0) = "STAFFMAKE" Then
    Call staffmake
End If
If part(0) = "TIMEBOOKED" Then
    Call timebooked
End If
End Sub

Private Sub stafflist()

List2.ListIndex = 0
strchef = List2.Text
For i = 1 To List2.ListCount - 1
    List2.ListIndex = i
    strchef = strchef + "," + List2.Text
Next i
Winsock1.SendData "Chef," + strchef
List3.ListIndex = 0
strchef = List3.Text
For i = 1 To List2.ListCount - 1
    List3.ListIndex = i
    strchef = strchef + "," + List3.Text
Next i
Winsock1.SendData "Underchef," + strchef
End Sub
Private Sub oneprod()
Adoproduct.Recordset.MoveFirst
myfind = "ProductID=" + Chr(39) + part(1) + Chr(39)
Adoproduct.Recordset.Find (myfind)
If Adoproduct.Recordset.EOF Then
    Winsock1.SendData "Error,incorrect product code"
Else
    mystr = "Product," + part(1) + "," + Str(Adoproduct.Recordset!howlong)
    Winsock1.SendData mystr
End If
End Sub
Private Sub prodlist()
Adoproduct.Recordset.MoveFirst
While Not Adoproduct.Recordset.EOF
    mystr = "Product," + Adoproduct.Recordset!ProductID + ","
    mystr = mystr + Str(Adoproduct.Recordset!howlong) + "," + Adoproduct.Recordset!whocooksUC
    Winsock1.SendData mystr
    Adoproduct.Recordset.MoveNext
Wend
End Sub
Private Sub tablelist()
Adotabul.Recordset.MoveFirst
While Not Adotabul.Recordset.EOF
    mystr = "Table," + Str(Adotabul.Recordset!tabulID) + ","
    mystr = mystr + Adotabul.Recordset!roomID + ","
    mystr = mystr + Adotabul.Recordset!roomsectorXY
    Winsock1.SendData mystr
    Adotabul.Recordset.MoveNext
Wend
End Sub
Private Sub ordlist()
' Ordered,<OrderNo>,<table>,<ProductID>,<quant>,<ProductID>,<Quant>...
Dim jimcon As New ADODB.Connection
Dim jimcmd As New ADODB.Command
Dim jimrs As New ADODB.Recordset
jimcon.Open Adostaff.ConnectionString
jimcon.CursorLocation = adUseClient
Set jimcmd.ActiveConnection = jimcon

Adoordur.Recordset.MoveFirst
While Not Adoordur.Recordset.EOF
    cmda = "select * from orderitems where orderID="
    cmdb = Str(Adoordur.Recordset!orderID) + "and status="
    cmdc = Chr(39) + "P" + Chr(39)
    
    jimcmd.CommandText = cmda + cmdb + cmdc
    jimcmd.Execute

    jimrs.Open jimcmd
    If Not jimrs.EOF Then
        strsend = "Ordered," + Str(Adoordur.Recordset!orderID)
        strsend = strsend + "," + Str(Adoordur.Recordset!tabulID)
        While Not jimrs.EOF
            strsend = strsend + "," + jimrs!ProductID
            strsend = strsend + "," + Str(jimrs!quantity)
            jimrs.MoveNext
        Wend
        Winsock1.SendData strsend
    End If
    jimrs.Close
    Adoordur.Recordset.MoveNext
Wend


End Sub
Private Sub staffmake()
'Staffmake,<staffId>,<ProductID>,<quant>,<startat>,<duration>,
'<OrderID>,<OrderID>....<OrderID>

Dim bookedtime As Date
Dim jimcon As New ADODB.Connection
Dim jimcmd As New ADODB.Command
Dim jimrs As New ADODB.Recordset
jimcon.Open Adostaff.ConnectionString
jimcon.CursorLocation = adUseClient
Set jimcmd.ActiveConnection = jimcon
cmda = "select * from stafftask where "
cmdb = "staffid=" + part(1)
jimcmd.CommandText = cmda + cmdb
jimcmd.Execute
jimrs.Open jimcmd
okay = True
' need to convert string to mins
timesplit() = Split(part(4), ":")
wantedmins = 60 * Val(timesplit(0)) + Val(timesplit(1))
wantendmins = wantedmins + Val(part(5))
If Not jimrs.EOF Then
    While Not jimrs.EOF
        ' need to convert database time to mins
        bookedtime = Adostafftask.Recordset!startat
        ' convert to mins as integer
        ' remove any date vale
        dectime = bookedtime - Int(bookedtime)
        minsbooked = Int(dectime * 24 * 60)
        minsbookend = minsbooked + Adostafftask.Recordset!duration
        ' if requested start time is in range already booked, not okay
        If wantedmins > minsbooked And wantedmins < minsbookend Then
            okay = False
        End If
        ' if requested end time is in range already booked, not okay
        If wantendmins > minsbooked And wantendmins < minsbookend Then
            okay = False
        End If
        jimrs.MoveNext
    Wend
End If
    If okay Then
        Winsock1.SendData "Staffokmake," + part(1)
        Call proccstafftask
       
    Else
        ' part(1) is staffID
        Winsock1.SendData "StaffNomake," + part(1)
    End If

End Sub
Private Sub proccstafftask()

' update database stafftask
Adostafftask.Recordset.AddNew
Adostafftask.Recordset!staffID = part(1)
Adostafftask.Recordset!ProductID = part(2)
Adostafftask.Recordset!quantity = Val(part(3))
Adostafftask.Recordset!timesent = Date
Adostafftask.Recordset!startat = part(4)
Adostafftask.Recordset!duration = part(5)
Adostafftask.Recordset.Update
' now go back to it to find staffmakeID
' technique safe on server !!!
Adostafftask.Recordset.MoveLast
unikey = Adostafftask.Recordset!stafftaskID
' use this to generate part of compound key
' in new record in makeorder

' parts(0)-parts(5) are data
' parts(6) until upper bound are orderitems
totsofar = 0
Adoorderitems.Recordset.Sort = "orderID"
For i = 6 To UBound(part())
    Adomakeorder.Recordset.AddNew
    Adomakeorder.Recordset!stafftaskID = unikey
    Adomakeorder.Recordset!orderID = part(i)
    Adomakeorder.Recordset.Update
    ' and now find quantity value from orderitem
    
    myfilt = "OrderID=" + part(i) + " and productID=" + Chr(39) + part(2) + Chr(39)
    Adoorderitems.Recordset.Filter = myfilt
    
   
    If Not Adoorderitems.Recordset.EOF Then
        
        totsofar = totsofar + Adoorderitems.Recordset!quantity
        Adoorderitems.Recordset!Status = "S"
        Adoorderitems.Recordset.Update
    Else
        Winsock1.SendData "orderitemnotfound"
    End If

Next i
Adoorderitems.Refresh
' totsofar should = part(3), but could be lower, not greater than
If totsofar > Val(part(3)) Then
    Winsock1.SendData "Quantity Low,ignore"
End If
'Winsock1.SendData message
' send message to all
' message is globally defined
Call sendall(message)
End Sub
Private Sub timebooked()
'TimeBooked,<StaffID>,<start_time>,<duration>
Dim mins(120) As String
Dim bookedtime As Date
For i = 0 To 119
    mins(i) = "A"
Next i
timesplit() = Split(part(2), ":")
wantedmins = 60 * Val(timesplit(0)) + Val(timesplit(1))
wantendmins = wantedmins + Val(part(3))
myfilt = "StaffID=" + part(1)
Adostafftask.Recordset.Filter = myfilt
While Not Adostafftask.Recordset.EOF
    ' for each record read, check if it affects time data required
     ' need to convert database time to mins
    bookedtime = Adostafftask.Recordset!startat
    ' convert to mins as integer
    ' remove any date vale
    dectime = bookedtime - Int(bookedtime)
    minsbooked = Int(dectime * 24 * 60)
    minsbookend = minsbooked + Adostafftask.Recordset!duration
    For i = minsbooked To minsbookend
        If i >= wantedmins And i < wantendmins Then
            mins(i - wantedmins) = "B"
        End If
    Next i
    Adostafftask.Recordset.MoveNext
Wend
bookstr = ""
For i = 0 To Val(part(3))
    bookstr = bookstr + mins(i)
Next i
Winsock1.SendData "TIMED," + part(1) + "," + part(2) + "," + bookstr
' clear filter
Adostafftask.Refresh

End Sub
Private Sub sendall(mymess)
actmess = mymess
For i = 1 To nextrow - 1
    MSF1.Row = i
    MSF1.Col = 0
    Winsock1.RemoteHost = MSF1.Text
    MSF1.Col = 1
    Winsock1.RemotePort = MSF1.Text

    Winsock1.SendData actmess
   
Next i
End Sub