Validar Cartao de Credito

' Valida numero de cartao de credito
' Retorna True se valido, False se invalido
'
' Exemplo:
'  If ValidaCartaoCredito(Value:="1234-123456-12345") Then

Function ValidaCartaoCredito(Value As Variant) 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

    ValidaCartaoCredito = True
    Value = Trim$(Value)

    If Len(Value) = 0 Then
        ValidaCartaoCredito = False
 Exit function
    End If

    ' Se mesmo depois de retirar nao-numericos, nao sobrou nada, foi digitado lixo
    For i = 1 To Len(Value)
        If IsNumeric(Mid$(Value, i, 1)) Then strTemp = strTemp & Mid$(Value, i, _
            1)
    Next
    If Len(strTemp) = 0 Then
        ValidaCartaoCredito = False
    End If

    'Diferentes tamanhos para diferentes bandeiras de CC
    Select Case Mid$(strTemp, 1, 1)
        Case "3"    'Amex
            If Len(strTemp) <> 15 Then
                ValidaCartaoCredito = 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
                ValidaCartaoCredito = 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
                ValidaCartaoCredito = False
            Else
                Value = Mid$(strTemp, 1, 4) & "-" & Mid$(strTemp, 5, _
                    4) & "-" & Mid$(strTemp, 9, 4) & "-" & Mid$(strTemp, 13, 4)
            End If
        Case Else      'Lixo - nao e numero de cartao de credito
            If Len(strTemp) > 20 Then
                ValidaCartaoCredito = False
            End If
    End Select

    'Check Sum (Mod 10)
    intCheckSum = 0                                    
    blnDoubleFlag = 0                                  

    For i = Len(strTemp) To 1 Step -1                  
        intDigit = Asc(Mid$(strTemp, i, 1))             ' Isola o caracter

        If intDigit > 47 Then                           ' Pula se nao e um inteiro

            If intDigit < 58 Then
                intDigit = intDigit - 48                ' Remove ASCII bias

                If blnDoubleFlag Then                  
                    intDigit = intDigit + intDigit      ' primeiro duplica-o

                    If intDigit > 9 Then
                        intDigit = intDigit - 9        
                    End If

                End If
                blnDoubleFlag = Not blnDoubleFlag      
                intCheckSum = intCheckSum + intDigit   

                If intCheckSum > 9 Then                
                    intCheckSum = intCheckSum - 10      ' (mesmo que MOD 10 mas mais rapido)
                End If
            End If
        End If
    Next

    If intCheckSum <> 0 Then                            '  Deve totalizar zero
        ValidaCartaoCredito = False
    End If

ErrorHandler:
    Err.Raise Err.Number, "ValidaCartaoCredito", Err.Description

End Function

Esta matéria foi postada originalmente no ASP4Developers por Valmir Cinquini (site), que na época era "Analista/Programador C#, VB.Net, ASP, VB, Javascript e T-SQL

www.cinquini.com.br/vcinquini>". Hoje, vai saber...