• Home
 · 
• Miscellaneous
 · 
• Communicate with commercial T7 credit card machine for purchasing mode only. Based on HyperCom v1.0

Communicate with commercial T7 credit card machine for purchasing mode only. Based on HyperCom v1.0

Communicate with commercial T7 credit card machine for purchasing mode only. Based on HyperCom v1.02 specification.

API Declarations


'Accessible from your application main form


Option Explicit
Global CreditCardAmount As Double
Global CardNumber As String
Global CreditCardPortNumber
Global CreditCardSuccess As Boolean
Global CardType As String




Rate Communicate with commercial T7 credit card machine for purchasing mode only. Based on HyperCom v1.0

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'
'1. Create Label1 and Label2
'2. Create TextBox1 with MultiLine set to True
'3. Create Timer with Interval set to 3000
'4. Create MSComm1 with default settings
'5. Set CreditCardAmount variable to a purchase value
'
'Note: MSComm1 is MSComm32 Active 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

    '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

        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
ExitWhile3:
    Timer1.Enabled = False

    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

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
    Unload Me
End Sub