Communicate With Commercial T7 Credit Card Machine

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Advanced

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

This project is based on HyperCom v1.02 specification, and you will need a credit card machine connected to a PC serial port. The author mentions this project is suitable for use in point of sale systems. You will need to add a few controls to your form. 1 textBox, 2 labels, 1 command button, 1 timer contol and a MS Comm control, the latter which you can add from the components dialogue.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'------------------------------------------------------------- 'Accessible from your main application form ' 'Return CardNumber,CardType and CreditCardSuccess ' '------------------------------------------------------------- Option Explicit Global CreditCardAmount As Double Global CardNumber As String Global CreditCardPortNumber Global CreditCardSuccess As Boolean Global CardType As String

Code:

'-------------------------------------------------------------
'
'1. Create Label1 and Label2
'2. Create TextBox1 with MultiLine set to True
'3. Create Timer1 with Interval set to 3000
'4. Create MSComm1 with default settings
'5. Set CreditCardAmount variable to a purchase value
'
'Note: MSComm1 is MSComm32 ActiveX Control
'
'-------------------------------------------------------------

'HYPERCOM POS/MININAC INTERFACE
'MESSAGE SPECIFICATION V1.02 (11/07/1992)

'Version 1.01 - Formatting amount with trailing zero compulsory
'               Total price label at low left corner of form
'               Return success value
'               Detect card type
'               End the module procedurely

Dim SendArray(40), ReceiveArray(255)
Dim SendBuffer, ReceiveBuffer
Dim ResendTime
Dim CardDetail(35)
Dim CardLineNum
Dim Quit As Boolean

Sub GroupInfo(Position)
    Select Case Mid(ReceiveBuffer, Position + 1, 2)
        Case "30":
            CardDetail(CardLineNum) = "Card Number:"
        Case "02":
            CardDetail(CardLineNum) = "Response Text:"
        Case "03":
            CardDetail(CardLineNum) = "Transaction Date:"
        Case "04":
            CardDetail(CardLineNum) = "Transaction Time:"
        Case "06":
            CardDetail(CardLineNum) = "Merchant Number:"
        Case "07":
            CardDetail(CardLineNum) = "Store Number:"
        Case "08":
            CardDetail(CardLineNum) = "Terminal Number:"
        Case "10":
            CardDetail(CardLineNum) = "Agent Number:"
        Case "11":
            CardDetail(CardLineNum) = "Chain Number:"
        Case "12":
            CardDetail(CardLineNum) = "Merchant Name:"
        Case "13":
            CardDetail(CardLineNum) = "Merchant City:"
        Case "14":
            CardDetail(CardLineNum) = "Merchant State:"
        Case "15":
            CardDetail(CardLineNum) = "Merchant Location Number:"
        Case "16":
            CardDetail(CardLineNum) = "Terminal ID:"
        Case "17":
            CardDetail(CardLineNum) = "Cardholder ID Code:"
        Case "40":
            CardDetail(CardLineNum) = "Amount:"
        Case "41":
            CardDetail(CardLineNum) = "Tip:"
        Case "42":
            CardDetail(CardLineNum) = "Cash Back:"
        Case "43":
            CardDetail(CardLineNum) = "Tax:"
        Case "50":
            CardDetail(CardLineNum) = "Batch Number:"
        Case "51", "52", "53", "54"
            CardDetail(CardLineNum) = "Batch:"
        Case "65":
            CardDetail(CardLineNum) = "Invoice Number:"
        Case "60", "61:"
            CardDetail(CardLineNum) = "Telephone Number:"
        Case "67":
            CardDetail(CardLineNum) = "Employee Number:"
        Case "68":
            CardDetail(CardLineNum) = "Cardholder ID Data:"
        Case "69":
            CardDetail(CardLineNum) = "Check Acceptance ID:"
        Case "D0":
            CardDetail(CardLineNum) = "Merchant Name/Address:"
        Case "D1":
            CardDetail(CardLineNum) = "Merchant Number:"
        Case "D2":
            CardDetail(CardLineNum) = "Card Issuer Name:"
        Case "D3":
            CardDetail(CardLineNum) = "Retrieval Ref Number:"
        Case "D4":
            CardDetail(CardLineNum) = "Card Issuer ID:"
        Case "D5":
            CardDetail(CardLineNum) = "Card Holder Name:"
        Case "31":
            CardDetail(CardLineNum) = "Expiration Date:"
        Case "09":
            CardDetail(CardLineNum) = "Acquirer:"
        Case "66":
            CardDetail(CardLineNum) = "Card Range Selector:"
        Case "64":
            CardDetail(CardLineNum) = "Modem Mode:"
        Case "62":
            CardDetail(CardLineNum) = "Dial Type:"
        Case "70":
            CardDetail(CardLineNum) = "Date Data:"
        Case "72":
            CardDetail(CardLineNum) = "Transparent Data:"
        Case "D6":
            CardDetail(CardLineNum) = "Generic Data:"
        Case "71":
            CardDetail(CardLineNum) = "Hold Time:"
        Case "63":
            CardDetail(CardLineNum) = "PABX:"
        Case "32", "33":
            CardDetail(CardLineNum) = "Track Data:"
        Case "20":
            CardDetail(CardLineNum) = "Print Data:"
        Case "01":
            CardDetail(CardLineNum) = "Approval Code:"
    End Select
End Sub

Private Sub Command1_Click()
    If Command1.Caption = "Cancel" Then
        Quit = True
    Else
        Label1.Caption = "Cancelling..."
        Timer1.Enabled = False
        Unload Me
    End If
End Sub

Private Sub Form_Activate()
    On Error GoTo ErrHandler
    Dim PortNumber, DecPos, Recur, LRC
    Dim TotalStr As String
    Dim CardLine As String
    Dim CopyLine As Boolean
    Dim NumberField As Boolean

'Configure port number
    CreditCardAmount = 1
    PortNumber = 1 ' CreditCardPortNumber
    ResendTime = 0
    Text1.Text = ""
    Label2.Caption = "Total: " & Format(CreditCardAmount, "###,##0.00")
    CreditCardSuccess = False
    CardType = ""
    CardNumber = ""
    Quit = False

Label1.Caption = "Communicating with COM" & CStr(PortNumber)
    MSComm1.CommPort = PortNumber
    MSComm1.PortOpen = True
    Timer1.Enabled = False

If Not MSComm1.PortOpen Then
        MsgBox "Unable to open COM" & CStr(PortNumber)
        Unload Me
    End If

'SendArray contains numeric regardless represented in
    'hexadecimal or decimal form
    SendArray(0) = CLng(&H2)
    SendArray(1) = CLng(&H0)
    SendArray(2) = CLng(&H35)
    SendArray(3) = CLng(&H36)
    SendArray(4) = CLng(&H30)
    SendArray(5) = CLng(&H30)
    SendArray(6) = CLng(&H30)
    SendArray(7) = CLng(&H30)
    SendArray(8) = CLng(&H30)
    SendArray(9) = CLng(&H30)
    SendArray(10) = CLng(&H30)
    SendArray(11) = CLng(&H30)
    SendArray(12) = CLng(&H30)
    SendArray(13) = CLng(&H31)
    SendArray(14) = CLng(&H30)
    SendArray(15) = CLng(&H32)
    SendArray(16) = CLng(&H30)
    SendArray(17) = CLng(&H30)
    SendArray(18) = CLng(&H30)
    SendArray(19) = CLng(&H30)
    SendArray(20) = CLng(&H1C)
    SendArray(21) = CLng(&H34)
    SendArray(22) = CLng(&H30)
    SendArray(23) = CLng(&H0)
    SendArray(24) = CLng(&H12)
    SendArray(25) = CLng(&H30)
    SendArray(26) = CLng(&H30)
    SendArray(27) = CLng(&H30)
    SendArray(28) = CLng(&H30)
    SendArray(29) = CLng(&H30)
    SendArray(30) = CLng(&H30)
    SendArray(31) = CLng(&H30)
    SendArray(32) = CLng(&H30)
    SendArray(33) = CLng(&H30)
    SendArray(34) = CLng(&H30)
    SendArray(35) = CLng(&H30)
    SendArray(36) = CLng(&H30)
    SendArray(37) = CLng(&H1C)
    SendArray(38) = CLng(&H3)
    SendArray(39) = CLng(&H0)

'BCD - CStr
    'Normal - Val

TotalStr = Format(CreditCardAmount, "#####0.00")
    DecPos = InStr(1, TotalStr, ".", vbTextCompare)
    If DecPos > 0 Then
        TotalStr = Left(TotalStr, DecPos - 1) & Mid(TotalStr, DecPos + 1, 2)
    End If
    TotalStr = "000000000000" & TotalStr
    TotalStr = Right(TotalStr, 12)
    For Recur = 25 To 36
        SendArray(Recur) = Asc(Mid(TotalStr, Recur - 24, 1))
    Next
    For Recur = 2 To 38
        LRC = LRC Xor SendArray(Recur)
    Next
    SendArray(39) = LRC

Label1.Caption = "Trasmitting request..."
    SendBuffer = vbNullString
    For Recur = 0 To 39
        SendBuffer = SendBuffer & Chr(SendArray(Recur))
    Next
    MSComm1.Output = SendBuffer
    
    ReceiveBuffer = MSComm1.Input

Timer1.Enabled = True
    While ReceiveBuffer <> vbNullString
        If ReceiveBuffer = vbNullString Then
            GoTo ExitWhile1
        End If

Label1.Caption = "Waiting for response... (" & CStr(MSComm1.InBufferCount) + " bytes)" & " (Retry for " & CStr(ResendTime) & " times)"
        DoEvents
        If ResendTime > 10 Then
            Timer1.Enabled = False
            MsgBox "Timeout."
            Label1.Caption = "Transaction aborted."
            Command1.Caption = "Close"
            Exit Sub
        End If
        If Quit Then
            GoTo EndNow
        End If
    Wend
ExitWhile1:
    Timer1.Enabled = False
    
    ResendTime = 0

Timer1.Enabled = True
    While Left(ReceiveBuffer, 1) <> Chr(6)
        If Left(ReceiveBuffer, 1) = Chr(6) Then
            GoTo ExitWhile2
        End If
        
        Label1.Caption = "Waiting for acknowledgement" & " (Retry for " & CStr(ResendTime) & " times)"
        DoEvents
        If ResendTime > 10 Then
            Timer1.Enabled = False
            MsgBox "Timeout."
            Label1.Caption = "Transaction aborted."
            Command1.Caption = "Close"
            Exit Sub
        End If
        If Quit Then
            GoTo EndNow
        End If
    Wend
ExitWhile2:
    Timer1.Enabled = False

MsgBox "Please swipe the credit card now." & vbNewLine _
        & "Press Enter when ready.", vbInformation + vbOKOnly, "Credit Card"
    
    ResendTime = 0
    ReceiveBuffer = MSComm1.Input

Timer1.Enabled = True
    While Left(ReceiveBuffer, 1) <> Chr(2)
        If Left(ReceiveBuffer, 1) = Chr(2) Then
            GoTo ExitWhile3
        End If

Select Case Mid(ReceiveBuffer, 18, 2)
        Case "00":
            Label1.Caption = "Transaction completed successfully."
            CreditCardSuccess = True
        Case "ND":
            Label1.Caption = "Transaction declined."
        Case "NA":
            Label1.Caption = "Transaction not available."
        Case Else:
            Label1.Caption = "Error " & Mid(ReceiveBuffer, 18, 2) & " (Len=" & CStr(Len(ReceiveBuffer)) & ")"
    End Select

If Mid(ReceiveBuffer, 18, 2) = "00" Then
        Recur = 1
        CopyLine = False
        CardLineNum = 0
        NumberField = False
        While Recur <= Len(ReceiveBuffer)
            If Mid(ReceiveBuffer, Recur, 1) = Chr(&H1C) Then
                If Not CopyLine Then
                    GroupInfo (Recur)
                    Recur = Recur + 5
                    CopyLine = True
                Else
                    If InStr(1, CardDetail(CardLineNum), "Card Number", vbTextCompare) > 0 Then
                        CardNumber = CardLine
                    End If
                    If InStr(1, CardDetail(CardLineNum), "Transaction Date", vbTextCompare) > 0 Then
                        CardLine = Right(CardLine, 2) & "/" & Mid(CardLine, 3, 2) & "/" & Left(CardLine, 2) & " (DD/MM/YY)"
                    End If
                    If InStr(1, CardDetail(CardLineNum), "Transaction Time", vbTextCompare) > 0 Then
                        CardLine = Left(CardLine, 2) & ":" & Mid(CardLine, 3, 2) & ":" & Right(CardLine, 2)
                    End If
                    If InStr(1, CardDetail(CardLineNum), "Card Issuer ID", vbTextCompare) > 0 Then
                        Select Case CardLine
                            Case "02"
                                CardType = "VISA"
                            Case "03"
                                CardType = "EXEC"
                            Case "05"
                                CardType = "AMEX"
                            Case "06"
                                CardType = "DINERS"
                            Case "07"
                                CardType = "MASTER"
                            Case "01"
                                CardType = "KAWANKU"
                            Case "27"
                                CardType = "VISA TEST CARD"
                            Case Else
                                CardType = "(Unknown)"
                        End Select
                    End If
                    CardDetail(CardLineNum) = CardDetail(CardLineNum) & vbTab & CardLine
                    CardLineNum = CardLineNum + 1
                    GroupInfo (Recur)
                    Recur = Recur + 5
                    CardLine = vbNullString
                End If
            End If
            If CopyLine Then
                CardLine = CardLine & Mid(ReceiveBuffer, Recur, 1)
            End If
            Recur = Recur + 1
        Wend
    
        For Recur = 0 To (CardLineNum - 1)
            Text1.Text = Text1.Text & CardDetail(Recur) & vbNewLine
        Next
        Me.Caption = Me.Caption & " (" & CardNumber & ")"
    End If

Command1.Caption = "Close"
    Exit Sub

ErrHandler:
    If Err <> 8018 Then
        MsgBox "Failure in communicating with T7 device." _
            & vbNewLine & "Error " & CStr(Err.Number) & ": " & _
            Err.Description, vbCritical + vbOKOnly, "Credit Card"
    End If
EndNow:
    Unload Me
End Sub

Private Sub Timer1_Timer()
    On Error GoTo ErrHandler
    Label1.Caption = "Resend request..."
    SendBuffer = vbNullString
    For Recur = 0 To 39
        SendBuffer = SendBuffer & Chr(SendArray(Recur))
    Next
    MSComm1.Output = SendBuffer
    ResendTime = ResendTime + 1
    ReceiveBuffer = MSComm1.Input
    Exit Sub