VBA class for CommWeb Virtual Payment Client
on May 26 in blog posted 2 Party, CommWeb, credit card, creditcard, Microsoft, MOTO, Office, VBA, Virtual Payment Client, Visual Basic for Applications, XML 4.0 by admin
A simple VBA class (Version 1.0) that will let you process 2-Party credit card transactions securely through the CommonWealth Bank’s CommWeb VPC merchant facility. This is primarily for MOTO transactions (Mail Order / Telephone Order) where the purchaser isn’t directly involved in the purchase/refund.
You need to include the Microsoft XML 4.0 library in your references options for this to work out of the box.
I also use a public module called settings that provides global access to system wide variables like settings.merchant_id, I think that part is pretty self explanatory.
Option Compare Database
Option Explicit
Private vpc_version As String '1-8
Private vpc_command As String '1-16
Private vpc_merch_txn_ref As String '1-40
Private vpc_access_code As String '8
Private vpc_merchant As String '1-16
Private vpc_order_info As String '1-34
Private vpc_amount As Long '1-10
Private vpc_card_num As String '15-40
Private vpc_card_exp As String '4
Private vpc_user As String 'used to refund
Private vpc_password As String 'used to refund
Private vpc_transaction_no As String 'used to refund
Private vrs_authorise_id As String
Private vrs_transaction_no As String
Private vrs_response_code As String
Private vrs_receipt_no As String
Private vrs_txn_response_code As String
Private vrs_message As String
Private vrs_merch_txn_ref As String '1-40
Private vrs_order_info As String '1-34
Private vrs_amount As Long '1-10
Private h As MSXML2.ServerXMLHTTP40
Private errorExists As Boolean
Private message As String
Private exception As String
Private Sub Class_Initialize()
Set h = New MSXML2.ServerXMLHTTP40
vpc_version = "1"
vpc_merchant = settings.merchant_id
vpc_access_code = settings.moto_username
vpc_user = settings.creditcard_refund_username
vpc_password = settings.creditcard_refund_password
End Sub
Private Function refund_data() As String
Dim buf As String
buf = "vpc_Version=" & vpc_version & "&vpc_Command=refund"
buf = buf & "&vpc_MerchTxnRef=" & vpc_merch_txn_ref
buf = buf & "&vpc_AccessCode=" & vpc_access_code
buf = buf & "&vpc_Merchant=" & vpc_merchant
buf = buf & "&vpc_TransNo=" & vpc_transaction_no
buf = buf & "&vpc_Amount=" & vpc_amount
buf = buf & "&vpc_User=" & vpc_user
buf = buf & "&vpc_Password=" & vpc_password
refund_data = buf
End Function
Private Function payment_data() As String
Dim buf As String
buf = "vpc_Version=" & vpc_version & "&vpc_Command=pay"
buf = buf & "&vpc_AccessCode=" & vpc_access_code
buf = buf & "&vpc_Amount=" & vpc_amount
buf = buf & "&vpc_CardExp=" & vpc_card_exp
buf = buf & "&vpc_CardNum=" & vpc_card_num
buf = buf & "&vpc_Merchant=" & vpc_merchant
buf = buf & "&vpc_OrderInfo=" & URLEncode(vpc_order_info)
buf = buf & "&vpc_MerchTxnRef=" & URLEncode(vpc_merch_txn_ref)
payment_data = buf
End Function
Public Function process_transaction(cc_number As String, cc_exp As Date, Amount As Currency, our_ref As String) As Boolean
'pre-load
process_transaction = True
'prepare
vpc_merch_txn_ref = our_ref
vpc_card_num = cc_number
vpc_card_exp = Format(cc_exp, "yymm")
vpc_amount = (Round(Amount, 2) * 100)
'process
If Not Err Then
h.Open "POST", "https://migs.mastercard.com.au/vpcdps", False
h.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
h.Send payment_data()
If Len(h.responseText) = 0 Then
errorExists = True
message = "No response from the Virtual Payment Client (The Bank)"
process_transaction = False
Exit Function
End If
End If
'parse results
parse_results
'post-transaction clean up
If errors_returned() Then
process_transaction = False
Exit Function
End If
End Function
Public Function refund_transaction(our_ref As String, transaction As String, Amount As Currency) As Boolean
'pre-load
refund_transaction = True
'prepare
vpc_command = "refund"
vpc_merch_txn_ref = our_ref
vpc_transaction_no = transaction
vpc_amount = (Round(Amount, 2) * 100)
vrs_authorise_id = "0" 'for those times when the provider doesn't give and auth number
'process
If Not Err Then
h.Open "POST", "https://migs.mastercard.com.au/vpcdps", False
h.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
h.Send refund_data()
If Len(h.responseText) = 0 Then
errorExists = True
message = "No response from the Virtual Payment Client (The Bank)"
refund_transaction = False
Exit Function
End If
End If
'parse results
parse_results
'post-transaction clean up
If errors_returned() Then
refund_transaction = False
Exit Function
End If
End Function
Private Sub parse_results()
' The content returned by the VPC is a HTTP POST, so the content will
' be in the format parameter1=value¶meter2=value¶meter3=value,
' i.e. key/value pairs separated by ampersands "&".
Dim results() As String
Dim pair() As String
Dim i As Long
results = Split(h.responseText, "&")
For i = 0 To UBound(results)
pair = Split(results(i), "=")
Select Case (pair(0))
Case "vpc_Amount"
vrs_amount = CCur(pair(1)) / 100
Case "vpc_AuthorizeId"
vrs_authorise_id = pair(1)
Case "vpc_ReceiptNo"
vrs_receipt_no = pair(1)
Case "vpc_transactionNo"
vrs_transaction_no = pair(1)
Case "vpc_AcqResponseCode"
vrs_response_code = pair(1)
Case "vpc_TxnResponseCode"
vrs_txn_response_code = pair(1)
Case "vpc_Message"
vrs_message = URLDecode(pair(1))
Case Else
'I'm not interested in other fields at this stage
'MsgBox "unexpected pair: " & results(i)
End Select
Next
End Sub
Private Function errors_returned() As Boolean
errors_returned = True
If Len(vrs_txn_response_code) = 0 Then
' Display an Error Page as the QSIResponseCode could not be retrieved
message = "(23) No result for this field: 'TxnResponseCode'" & vbCrLf & "Bank responded: " & vrs_message
Else
Select Case vrs_txn_response_code
Case "0" 'Transaction Succesful
Case "1" 'Unknown Error
message = "Transaction could not be processed (Unknown Error)"
Case "2", "E" 'Bank Declined Transaction
message = "Bank declined transaction (Customer should contact their Bank)"
Case "3" 'No reply from Bank
message = "No reply from Bank"
Case "4" 'Expired Card
message = "Expired Card"
Case "5" 'Insufficient Funds
message = "Insufficient Funds in Account"
Case "6" 'Error Communicating with Bank
message = "Error communicating with Bank"
Case "7" 'Payment Server System Error"
message = "Payment Server system error"
Case "8" 'Transaction Type not supported
message = "Transaction type not supported"
Case "9" 'Bank Declined Transaction
message = "Bank Declined Transaction"
Case Else
message = "Unknown Error: " & vrs_txn_response_code
End Select
' Check if the result contains an error message
If vrs_txn_response_code <> "0" Then
Dim result As String
' Get the error returned from the Payment Client
result = vrs_message
' check if result contains a value
If Len(result) <> 0 Then
' there is an error message so generate an Error Page
exception = result
End If
Else
errors_returned = False
End If
End If
End Function
Public Function get_result_transaction_id() As String
get_result_transaction_id = vrs_transaction_no
End Function
Public Function get_result_amount() As Currency
get_result_amount = vrs_amount
End Function
Public Function get_result_receipt() As String
get_result_receipt = vrs_receipt_no
End Function
Public Function get_authorise_id() As String
get_authorise_id = vrs_authorise_id
End Function
Public Function show_errors() As String
If Len(message) Then
show_errors = message
If Len(exception) > 0 Then
show_errors = message & " - " & exception
End If
Else
show_errors = "There was an error but no messages for it"
End If
End Function
Private Sub Class_Terminate()
Set h = Nothing
End Sub