CREATE TABLE `buys` ( `transID` int(11) NOT NULL AUTO_INCREMENT, `cardID` varchar(20) NOT NULL, `TTime` datetime NOT NULL, `Amount` float NOT NULL, `product` tinyint(4) NOT NULL, PRIMARY KEY (`transID`) ) ENGINE=MyISAM AUTO_INCREMENT=668 DEFAULT CHARSET=latin1; CREATE TABLE `products` ( `selID` tinyint(4) NOT NULL, `selName` varchar(50) NOT NULL, `selPrice` int(11) NOT NULL, `soldOut` int(11) NOT NULL, `soldOutChange` datetime NOT NULL, `lastSoldOut` int(11) NOT NULL, PRIMARY KEY (`selID`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1; CREATE TABLE `users` ( `cardID` varchar(20) NOT NULL, `DisplayName` varchar(16) NOT NULL, `Credit` float NOT NULL, `LastSeen` datetime NOT NULL, `UseCount` int(11) NOT NULL, PRIMARY KEY (`cardID`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1;

Option Explicit Private lastPing As Date Private Const OneSecond = 1 / 24 / 60 / 60 Private Const oneMinute = 1 / 24 / 60 Private Buffer As String Private MySQL As AvMySQL Private LastScanAt As Date Private LastScanID As String Private LastTransID As Long Private UserIDs As New Collection Private Sub Form_Load() On Error GoTo Form_Load_Error TCP1.LocalPort = 6643 TCP1.Listen Set MySQL = New AvMySQL On Error Resume Next MySQL.configureConnection "server", "database", "username", "password", "MySQL ODBC 5.1 Driver" MySQL.checkDBConnection On Error GoTo 0 Exit Sub Form_Load_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of Form Form1", vbCritical, App.ProductName & " ERROR" End Sub Private Sub TCP1_ConnectionRequest(ByVal requestID As Long) On Error GoTo TCP1_ConnectionRequest_Error Debug.Print "CONNECTION REQUEST", TCP1.RemoteHostIP TCP2.Close TCP2.Accept requestID lastPing = 0 Buffer = "" On Error GoTo 0 Exit Sub TCP1_ConnectionRequest_Error: End Sub Private Sub TCP2_DataArrival(ByVal bytesTotal As Long) Dim a As String On Error GoTo TCP2_DataArrival_Error TCP2.GetData a Buffer = Buffer & a checkBuffer On Error GoTo 0 Exit Sub TCP2_DataArrival_Error: End Sub Private Sub Timer1_Timer() On Error GoTo Timer1_Timer_Error If Now - lastPing > OneSecond * 10 Then ' Send a ping. lastPing = Now sendData "P", "" End If On Error GoTo 0 Exit Sub Timer1_Timer_Error: End Sub Private Sub sendData(cmd As String, Data As String) ' FORMAT: ' 0x02 - Command byte - Data data data data - 0x03 If TCP2.State = sckConnected Then Debug.Print "SENDING", cmd, Data TCP2.sendData Chr(2) & cmd & Data & Chr(3) End If End Sub Private Sub checkBuffer() Dim e As Long Dim f As Long ' Look for the end of transmission command. Do e = InStr(1, Buffer, Chr(3)) If e > 0 Then f = InStr(1, Buffer, Chr(2)) If f < e Then ' Found a valid data piece. Pull it out. checkData Mid(Buffer, f + 1, e - f - 1) Else ' Throw the whole thing away End If Buffer = Right(Buffer, Len(Buffer) - e) End If Loop Until e = 0 End Sub Private Sub checkData(DataIn As String) Debug.Print "DATA IN", DataIn Dim cmd As String, d As String Dim RS As ADODB.Recordset Dim RS2 As ADODB.Recordset Dim itemCost As Long If Len(DataIn) > 0 Then cmd = Left(DataIn, 1) d = Right(DataIn, Len(DataIn) - 1) Select Case cmd Case "S" ' A card has been scanned. Send the user data. LastTransID = 0 ' Check the database for this If MySQL.checkDBConnection Then Set RS = MySQL.Execute("SELECT * FROM users WHERE cardid='" & MySQL.fixitApos(d) & "'") If Not RS.EOF Then LastScanID = d LastScanAt = Now ' FOUND THE USER. Send the data. sendData "N", MySQL.fixIt(RS("DisplayName")) ' Username sendData "C", MySQL.fixIt(RS("Credit")) ' Amount of money MySQL.Execute "UPDATE users SET useCount=useCount+1, LastSeen=NOW() WHERE cardid='" & MySQL.fixitApos(d) & "'" Else ' Tell them UNKNOWN CARD sendData "R", "" End If End If Case "B" ' Request for credit. Make sure there is enough credit available. ' Request how much credit he has again. Set RS = MySQL.Execute("SELECT * FROM users WHERE cardid='" & MySQL.fixitApos(LastScanID) & "'") If Not RS.EOF Then ' How much money does the selection they want, cost? Set RS2 = MySQL.Execute("SELECT * FROM products WHERE selID='" & Left(d, 1) & "'") If Not RS2.EOF Then itemCost = val(RS2("selPrice")) Debug.Print "BUYING " & RS2("selName") ' Do we have enough money to buy this? If val(MySQL.fixIt(RS("Credit"))) >= itemCost Then ' Take away the cost. MySQL.Execute "UPDATE users SET Credit=Credit-" & itemCost & " WHERE cardid='" & MySQL.fixitApos(LastScanID) & "'" ' Add to the transaction record. MySQL.Execute "INSERT INTO buys (cardID, TTime, Amount, product) VALUES ('" & MySQL.fixitApos(LastScanID) & "', NOW(), " & -itemCost & ", '" & Left(d, 1) & "')" Set RS2 = MySQL.Execute("SELECT LAST_INSERT_ID() AS id") ' Send them the amount. sendData "Y", CStr(itemCost) ' Y means yes, go ahead. Also subtract $1 from the stores. Else ' You can't afford this! sendData "X", "" ' Tell them they don't have enough money. End If Else ' Some kind of error with finding the product. sendData "X", "" End If End If Case "L" ' Sold out status Dim selID As Long selID = val(Mid(d, 1, 1)) MySQL.Execute "UPDATE products SET soldout='" & IIf(Mid(d, 2, 1) = "Y", "1", "0") & "', soldOutChange='" & MySQL.makeMySqlDate(Now) & "' WHERE selID='" & Left(d, 1) & "'" Label3 = val(Label3) + 1 End Select End If End Sub