Rotina para validação de cartão de crédito

Segue abaixo a rotina para validação de cartão de crédito. ' 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

Quebra-Linha

Colaborador..: Ramon Dias de Azevedo
Categoria(s).: ASP; Programação;
Versão.......: 1.0
Data.........: 24/05/2002 17:01:33
Visualizado..: 1133 vezes
Fonte........: