BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "credit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Public errorMessage As String
Public CardName As String
Private Function CCValidationSolution(ByVal Number As String) As Boolean
On Error Resume Next
Dim NumberLength As Integer
Dim ShouldLength As Integer
Dim Missing As Integer
Dim returnVal As Variant
returnVal = ""
errorMessage = ""
'1) Get rid of spaces and non-numeric characters.
Number = OnlyNumericSolution(Number)
returnVal = False
'2) Do the first four digits fit within proper ranges?
' If so, who's the card issuer and how long should the number be?
NumberLength = Len(Number)
Select Case Left(Number, 4)
Case 3000 To 3059, 3600 To 3699, 3800 To 3889
CardName = "Diners Club"
ShouldLength = 14
Case 3400 To 3499, 3700 To 3799
CardName = "American Express"
ShouldLength = 15
Case 3528 To 3589
CardName = "JCB"
ShouldLength = 16
Case 3890 To 3899
CardName = "Carte Blache"
ShouldLength = 14
Case 4000 To 4999
CardName = "Visa"
Select Case NumberLength
Case Is > 14
ShouldLength = 16
Case Is < 14
ShouldLength = 13
Case Else
errorMessage = "The Visa number you typed in is 14 digits long." + Chr(13) + "Visa cards usually have 16 digits, though some have 13." + Chr(13) + Chr(13) + "Please check the number and try again."
returnVal = False
End Select
Case 5100 To 5599
CardName = "MasterCard"
ShouldLength = 16
Case 5610
CardName = "Australian BankCard"
ShouldLength = 16
Case 6011
CardName = "Discover/Novus"
ShouldLength = 16
Case Else
errorMessage = "The first four digits of the number entered are " + Left(Number, 4) + "." + Chr(13) + "If that's correct, we don't accept that type of credit card." + Chr(13) + "If it's wrong, please try again."
returnVal = False
End Select

'3) Is the number the right length?
If NumberLength <> ShouldLength Then
Missing = NumberLength - ShouldLength
If Missing < 0 Then
errorMessage = "The " + CardName + " number entered, " + Number + ", is missing " + Abs(Missing) + " digit(s)." + Chr(13) + Chr(13) + "Please check the number and try again."
returnVal = False
Else
errorMessage = "The " + CardName + " number entered, " + Number + ", has " + Missing + " too many digit(s)." + Chr(13) + Chr(13) + "Please check the number and try again."
returnVal = False
End If
End If

'4) Does the number pass the Mod 10 Algorithm Checksum?
If Mod10Solution(Number) = True And errorMessage = "" Then
returnVal = True
Else
errorMessage = "The " + CardName + " number entered, " + Number + ", is invalid." + Chr(13) + Chr(13) + "Please check the number and try again."
returnVal = False
End If
CCValidationSolution = returnVal
End Function

Private Function OnlyNumericSolution(ByVal Number As String)
On Error Resume Next
Dim Location As Integer
Dim NumberLength As Integer
Dim CurrentOutput As String
Dim CurrentCharacter As String * 1

NumberLength = Len(Number)
If NumberLength > 50 Then
' Avoids system overload from hacking via super long input.
NumberLength = 50
End If
' Go through each number in the string.
For Location = 1 To NumberLength
CurrentCharacter = Mid(Number, Location, 1)
Select Case Asc(CurrentCharacter)
Case 48 To 57
' This character is a number,
' append it to the variable we're going to output.
CurrentOutput = CurrentOutput + CurrentCharacter
End Select
Next
OnlyNumericSolution = CurrentOutput
End Function

Private Function Mod10Solution(ByVal Number As String) As Boolean
'This works for numbers up to 255 characters long.
'For longer numbers, increase variable data types as needed.
On Error Resume Next
Dim NumberLength As Byte 'Up to 255 digits.
Dim Location As Byte 'Up to 255 digits.
Dim Checksum As Integer 'Up to 3,640 digits.
Dim Digit As Byte

NumberLength = Len(Number)

'Add even digits in even length strings
'or odd digits in odd length strings.
For Location = 2 - (NumberLength Mod 2) To NumberLength Step 2
Checksum = Mid(Number, Location, 1) + Checksum
Next Location

'Analyze odd digits in even length strings
'or even digits in odd length strings.
For Location = (NumberLength Mod 2) + 1 To NumberLength Step 2
Digit = Mid(Number, Location, 1) * 2
If Digit < 10 Then
Checksum = Digit + Checksum
Else
Checksum = Digit - 9 + Checksum
End If
Next Location

'Is the checksum divisible by ten?
Mod10Solution = (Checksum Mod 10 = 0)
End Function
Public Function isValid(ByVal Number As String) As Boolean
Dim CCVSAnswer As String
CCVSAnswer = CCValidationSolution(Number)
If CCVSAnswer = True Then
Number = OnlyNumericSolution(Number)
isValid = True
Else
errorMessage = CCVSAnswer
isValid = False
End If
End Function