AvBrand Exploring Technology
AvBrand Exploring Technology
All Projects Car PC Thermostat Power Monitor Toilet Dog Dish PopCARD 

PopCARD: Pop Machine Cash Card - Server Source Code

This code is copyright © 2011 Avatar-X. If you use it, please let me know.

MySQL Table definitions:
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;

VB6 Source Code:
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
copyright © 2013 AvBrand.com - sitemap