'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