Credit Card & SIN Number Validation

Category:

Office/VBA

Type:

Snippets

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6, Visual Basic 5, Visual Basic.NET

More information:

Although there are numerous versions of this validation routine on this site, this one is uses current card carrier information and is all-encompassing. It: a) checks ALL (Credit,debit,Airline,etc) cards using the LUHN algorithm b) checks whether the first four digits are valid for that specific card carrier (i.e. Visa, MasterCard, AMEX, etc) c) and, checks the validity of a Canadian Social Insurance Number (SIN) d) makes use of an ENUM of all valid card carriers to ease the function deployment in other modules e) Optionally, returns the appropriate name for the Card f) describes (in simple terms) how the LUHN algorithm works f) is relatively well documented Do not let the length of the function deter you; 80% of it is doumentation

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

Declarations:
Public Enum NumericFunctions_CardType VISA = 1 MasterCard = 2 DinersClub = 3 CanadianSocialInsuranceNumber = 4 enRoute = 5 Discover = 6 Novus = 6 AmericanExpress = 7 AMEX = 7 carteBlanche = 8 [JCB (Japanese Credit Bureau)] = 9 [Australian BankCard] = 10 [Other (Gas,Retail,Debit,etc)] = 99 End Enum

Code:

Public Function IsValidCard(ByVal CardNumber As String, CCType As NumericFunctions_CardType, _
                                        Optional ReturnCardNameIfValid As Boolean = False) As Variant
' --------------------------------'
' By Robert R. Thele
' RDM Management Group
' RDMmgmt@msn.com
' --------------------------------'
    Dim X As Long
    Dim Total As Long
    Dim CardNumberLength As Long
    Dim Temp As String
    Dim RevCardNumber As String
    Dim ParsedCardNumber As String
    Dim Character As String
    Dim Digit As Long
    Dim FirstDigit As Long
    Dim FirstFourDigits As Long
    Dim DigitsOK As Boolean
    Dim LengthOK As Boolean
    
'LUHN Formula (in quasi-LaymanTerms)
'1. Reverse the card number
'2. Starting with the FIRST DIGIT of the reversed
'    card number, write the value of that digit
'    on a piece of paper.
'    Do the same for the 3rd digit, 5th, 7th, etc.....
'    writing each value after the previous one
'    (in essence creating a string of numbers)
'3. Then, starting at the SECOND DIGIT of the
'    reversed card number, DOUBLE the value of
'    that digit; append the doubled value to the
'    string of numbers from Step 2.
'    Do the same for the 4th digit, 6th, 8th, etc.....
'4. Add all the numbers from your string of numbers together.
'    If this total ENDS IN ZERO, the card number is valid.

'Prepare the default return value
    If ReturnCardNameIfValid Then
            IsValidCard = ""
        Else
            IsValidCard = False
    End If
    
'Parses all non-numeric characters from
'CardNumber into a temporary string
    For X = 1 To Len(CardNumber)
        Character = Mid$(CardNumber, X, 1)
        Temp = Temp & IIf(IsNumeric(Character), Character, "")
    Next
    ParsedCardNumber = Temp
        
'Save the length of the card number length for later use
'in editting the card carrier
    CardNumberLength = Len(Temp)
        
    
'Exit if number of digits is not in range of testable Card numbers
    If CardNumberLength < 9 Or CardNumberLength > 19 Then
        Exit Function
    End If
    
'Save specific leading digits for later use in editting the card carrier
    FirstDigit = CLng(Left$(Temp, 1))
    FirstFourDigits = CLng(Left$(Temp, 4))
    
    Select Case CCType
        Case VISA
            DigitsOK = (FirstFourDigits >= 4000) And _
                            (FirstFourDigits <= 4999)
            LengthOK = (CardNumberLength = 13) Or _
                            (CardNumberLength = 16)
        Case MasterCard
            DigitsOK = (FirstFourDigits >= 5100) And _
                            (FirstFourDigits <= 5599)
            LengthOK = (CardNumberLength = 16)
        Case enRoute
            DigitsOK = (FirstFourDigits = 2014) Or _
                            (FirstFourDigits = 2149)
            LengthOK = (CardNumberLength = 15)
        Case Discover
            DigitsOK = (FirstFourDigits = 6011)
            LengthOK = (CardNumberLength = 16)
        Case DinersClub
            DigitsOK = ((FirstFourDigits >= 3000) And _
                            (FirstFourDigits <= 3059)) Or _
                            ((FirstFourDigits >= 3600) And _
                            (FirstFourDigits <= 3699)) Or _
                            ((FirstFourDigits >= 3800) And _
                            (FirstFourDigits <= 3889))
            LengthOK = (CardNumberLength = 14)
        Case carteBlanche
                DigitsOK = (FirstFourDigits >= 3890) And _
                                (FirstFourDigits <= 3899)
                LengthOK = (CardNumberLength = 14)
        Case AmericanExpress, AMEX
                DigitsOK = ((FirstFourDigits >= 3400) And _
                                (FirstFourDigits <= 3499)) Or _
                                ((FirstFourDigits >= 3700) And _
                                (FirstFourDigits <= 3799))
                LengthOK = (CardNumberLength = 15)
        Case CanadianSocialInsuranceNumber
                DigitsOK = Not (FirstDigit = 0) Or _
                                Not (FirstDigit = 8)
                LengthOK = (CardNumberLength = 9)
        Case [JCB (Japanese Credit Bureau)]
                DigitsOK = (FirstFourDigits >= 3528) And _
                                (FirstFourDigits <= 3589)
                LengthOK = (CardNumberLength = 16)
        Case [Australian BankCard]
                DigitsOK = (FirstFourDigits = 5610)
                LengthOK = (CardNumberLength = 16)
        Case [Other (Gas,Retail,Debit,etc)]
                DigitsOK = True
                LengthOK = True
        Case Else
                DigitsOK = False
                LengthOK = False
    End Select
    
'If the number sequence and/or card number length
'do not match the requirements the
'requirements of the carrier; Exit
    If Not DigitsOK Or Not LengthOK Then
        Exit Function
    End If
    
'Reverse the CardNumber
    For X = 1 To Len(Temp)
        RevCardNumber = Mid$(Temp, X, 1) & RevCardNumber
    Next
    
'Iterate through the reversed number; Add the
'calculated totals to string for subsequent summation.
'The equation  = (1 + (X - 1) Mod 2) below will result '
'in a multiplier of 1 if the element is odd (i.e. 1st digit, 3rd, 5th, etc)
'or a multiplier of 2 if the element is even (i.e. 2nd digit, 4th, 6th, etc)
    Temp = ""
    For X = 1 To Len(RevCardNumber)
        Digit = CLng(Mid$(RevCardNumber, X, 1))
        Temp = Temp & (Digit * (1 + (X - 1) Mod 2))
    Next
    
'Iterate through the string just created and total
'the individual numbers in each character of the string
    For X = 1 To Len(Temp)
        Total = Total + CLng(Mid$(Temp, X, 1))
    Next
    
'If the total of the added elements ends in zero, '
'the card number is valid
    IsValidCard = CBool(Total Mod 10 = 0)
    
    If IsValidCard And ReturnCardNameIfValid Then
        IsValidCard = GetCardName(ParsedCardNumber, CCType)
    End If
End Function

Private Function GetCardName(CardNumber As String, CCType As NumericFunctions_CardType) As String
    If CCType = CanadianSocialInsuranceNumber Then
        GetCardName = "SIN number"
        Exit Function
    End If
    
    Select Case Left$(CardNumber, 4)
        Case 1800
            GetCardName = "JCB (Japanese Credit Bureau)"
        Case 2014
            GetCardName = "enRoute"
        Case 2131
            GetCardName = "JCB (Japanese Credit Bureau)"
        Case 2149
            GetCardName = "enRoute"
        Case 3000 To 3059
            GetCardName = "Diners Club"
        Case 3400 To 3499
            GetCardName = "American Express"
        Case 3528 To 3589
            GetCardName = "JCB (Japanese Credit Bureau)"
        Case 3600 To 3699
            GetCardName = "Diners Club"
        Case 3700 To 3799
            GetCardName = "American Express"
        Case 3800 To 3889
            GetCardName = "Diners Club"
        Case 3890 To 3899
            GetCardName = "carteBlanche"
        Case 4000 To 4999
            GetCardName = "VISA"
        Case 5100 To 5599
            GetCardName = "MasterCard"
        Case 5610
            GetCardName = "Australian BankCard"
        Case 6011
            GetCardName = "Discover"
        Case Else
                Select Case Left$(CardNumber, 1)
                    Case 1 'Airline
                        GetCardName = "Other (Airline)"
                    Case 2 'Airline and other industry assignments
                        GetCardName = "Other (Airline and other idustries)"
                    Case 3 'Travel/Entertainment
                        GetCardName = "Other (Travel/Entertainment)"
                    Case 4 'Banking and financial
                        GetCardName = "Other (Banking/Financial)"
                    Case 5 'Banking and financial
                        GetCardName = "Other (Banking/Financial)"
                    Case 6 'Merchandising and banking
                        GetCardName = "Other (Merchandising/Banking)"
                    Case 7 'Petroleum
                        GetCardName = "Other (Gas Company)"
                    Case 8 'HealthCare/Telecommunications and other
                        GetCardName = "Other (HealthCare/Telecomm/Etc)"
                    Case 9 'National assignment
                        GetCardName = "Other [Card Carrier Unknown]"
                    Case 0 'ISO/TC 68 and other industry assignments
                        GetCardName = "Other [Card Carrier Unknown]"
            End Select
    End Select

End Function