1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
| Public Function ValidCard(ByVal CardNumber As String) As Boolean
Dim intCount As Integer
Dim intValue As Integer
Dim intArr() As Integer
Dim intStart As Integer
Dim intArrValue As Integer
ValidCard = False
If Not IsNumeric(CardNumber) Then Exit Function
If Left(CardNumber, 4) = 2131 Or Left(CardNumber, 4) _
= 1800 Then
'JCB
If Len(CardNumber) <> 15 Then Exit Function
ElseIf Left(CardNumber, 4) = 2149 Or _
Left(CardNumber, 4) = 2014 Then
'enroute
If Len(CardNumber) = 15 Then
ValidCard = True
End If
Exit Function
ElseIf Left(CardNumber, 4) = 6011 Then
'discover
If Len(CardNumber) <> 16 Then Exit Function
ElseIf (Left(CardNumber, 3) >= 300 And _
Left(CardNumber, 3) <= 305) Or _
Left(CardNumber, 2) = 36 Or Left(CardNumber, 2) = 38 Then
'diners club
If Len(CardNumber) <> 14 Then Exit Function
ElseIf Left(CardNumber, 2) = 34 Or _
Left(CardNumber, 2) = 37 Then
'amex
If Len(CardNumber) <> 15 Then Exit Function
ElseIf Left(CardNumber, 2) >= 51 And _
Left(CardNumber, 2) <= 55 Then
'mastercard
If Len(CardNumber) <> 16 Then Exit Function
ElseIf Left(CardNumber, 1) = 4 Then
'visa
If Not (Len(CardNumber) = 13 Or Len(CardNumber) = 16) _
Then Exit Function
ElseIf Left(CardNumber, 1) = 3 Then
'jcb (2)
If Len(CardNumber) <> 16 Then Exit Function
Else
'unknown card.....
Exit Function
End If
ReDim intArr(Len(CardNumber))
For intCount = Len(CardNumber) - 1 To 1 Step -2
intValue = Mid(CardNumber, intCount, 1) * 2
intArr(intCount) = intValue
Next intCount
intValue = 0
If Len(CardNumber) Mod 2 = 0 Then
intStart = 2
Else
intStart = 1
End If
For intCount = intStart To Len(CardNumber) Step 2
intValue = intValue + Mid(CardNumber, intCount, 1)
intArrValue = intArr(intCount - 1)
If intArrValue < 10 Then
intValue = intValue + intArrValue
Else
intValue = intValue + Left(intArrValue, 1) + _
Right(intArrValue, 1)
End If
Next intCount
If intValue Mod 10 <> 0 Then
Exit Function
Else
ValidCard = True
End If
End Function |
Partager