' 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...