devxlogo

IsValidCreditCardNumber – Check whether a credit card number is valid

IsValidCreditCardNumber – Check whether a credit card number is valid

' Validate a credit card numbers' Returns True if valid, False if invalid'' Example:'  If IsValidCreditCardNumber(Value:="1234-123456-12345", IsRequired:=True)Function IsValidCreditCardNumber(Value As Variant, Optional ByVal IsRequired As _    Boolean = True) As Boolean    Dim strTemp As String    Dim intCheckSum As Integer    Dim blnDoubleFlag As Boolean    Dim intDigit As Integer    Dim i As Integer    On Error GoTo ErrorHandler    IsValidCreditCardNumber = True    Value = Trim$(Value)    If IsRequired And Len(Value) = 0 Then        IsValidCreditCardNumber = False    End If    ' If after stripping out non-numerics, there is nothing left,    '  they entered junk    For i = 1 To Len(Value)        If IsNumeric(Mid$(Value, i, 1)) Then strTemp = strTemp & Mid$(Value, i, _            1)    Next    If IsRequired And Len(strTemp) = 0 Then        IsValidCreditCardNumber = False    End If    'Handle different lengths for different credit card types    Select Case Mid$(strTemp, 1, 1)        Case "3"    'Amex            If Len(strTemp) <> 15 Then                IsValidCreditCardNumber = False            Else                Value = Mid$(strTemp, 1, 4) & "-" & Mid$(strTemp, 5, _                    6) & "-" & Mid$(strTemp, 11, 5)            End If        Case "4"    'Visa            If Len(strTemp) <> 16 Then                IsValidCreditCardNumber = False            Else                Value = Mid$(strTemp, 1, 4) & "-" & Mid$(strTemp, 5, _                    4) & "-" & Mid$(strTemp, 9, 4) & "-" & Mid$(strTemp, 13, 4)            End If        Case "5"    'Mastercard            If Len(strTemp) <> 16 Then                IsValidCreditCardNumber = False            Else                Value = Mid$(strTemp, 1, 4) & "-" & Mid$(strTemp, 5, _                    4) & "-" & Mid$(strTemp, 9, 4) & "-" & Mid$(strTemp, 13, 4)            End If        Case Else      'Discover - Dont know rules yet            If Len(strTemp) > 20 Then                IsValidCreditCardNumber = False            End If    End Select    'Now check for Check Sum (Mod 10)    intCheckSum = 0                                                ' Start with 0 intCheckSum    blnDoubleFlag = 0                                              ' Start with a non-doubling    For i = Len(strTemp) To 1 Step -1                   ' Working backwards        intDigit = Asc(Mid$(strTemp, i, 1))             ' Isolate character        If intDigit > 47 Then                           ' Skip if not a intDigit            If intDigit < 58 Then                intDigit = intDigit - 48                ' Remove ASCII bias                If blnDoubleFlag Then                                          ' If in the "double-add" phase                    intDigit = intDigit + intDigit      '   then double first                    If intDigit > 9 Then                        intDigit = intDigit - 9         ' Cast nines                    End If                End If                blnDoubleFlag = Not blnDoubleFlag       ' Flip doubling flag                intCheckSum = intCheckSum + intDigit    ' Add to running sum                If intCheckSum > 9 Then                 ' Cast tens                    intCheckSum = intCheckSum - 10      ' (same as MOD 10 but                                                         ' faster)                End If            End If        End If    Next    If intCheckSum <> 0 Then                            '  Must sum to zero        IsValidCreditCardNumber = False    End IfExitMe:    Exit FunctionErrorHandler:    Err.Raise Err.Number, "IsValidCreditCardNumber", Err.DescriptionEnd Function'###########################################################'#'#   This rountime has been brought to you by '#   Pragmatic Software Co. Inc, the creators of Defect Tracker, '#   the tool of choice for tracking functional specifications, '#   test cases and software bugs.'#   Learn more at http://www.DefectTracker.com.'#   Affiliate program also available at '#   http://www.PragmaticSW.com/AffiliateSignup.'#'###########################################################

devx-admin

Share the Post: