Source code for Issue Number 119

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new module and paste this code into it. Call the module basCCValidate.

If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    CCValidate
'   Written By:     C&D Programming Corp.
'   Create Date:    1/2000
'   Copyright:      Copyright 2000 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------

Option Explicit
Private Const CARD_DELIM = "-"

Private Function StripAllButNumbers(sData As String) As String
    Dim sTemp As String
    Dim x As Long
    Dim sCh As String

    ' scan through the string and add all the numeric characters to
    ' temporary string.
    sTemp = ""
    For x = 1 To Len(sData)
        sCh = Mid$(sData, x, 1)
        If sCh >= "0" And sCh <= "9" Then
            sTemp = sTemp & sCh
        End If
    Next
    StripAllButNumbers = sTemp
End Function

'
' this algorithm requires you to double every other digit and add the sum of the
' results to a counter.  If the sum of the doubled number is greater than 9 then
' you add each digit separately to the total (for example if you are working with
' 12 you would add 1+2 to the sum).  For some good information about this,
' check out http://www.beachnet.com/~hstiles/cardtype.html
'
Public Function CreditCardValidate(sCardNumber As String) As Boolean
    Dim sCard As String
    Dim lSum As Long
    Dim lDigit As Long
    Dim x As Long

    ' create a fixed length string to make the calculations easier.
    sCard = StripAllButNumbers(sCardNumber)
    ' we always want a even length string to make this work correctly.
    If Len(sCard) Mod 2 = 1 Then
        sCard = "0" & sCard
    End If

    For x = Len(sCard) To 1 Step -1
        If x Mod 2 = 1 Then
            ' isolate the individual digits
            lDigit = Val(Mid$(sCard, x, 1)) * 2
            If lDigit > 9 Then
                ' if the digit doubled is 10 or more (the max it would be is eighteen)
                ' then the amount to add to the sum is 1 + (digit mod 10) which is the
                ' same as the (digit - 9)
                lSum = lSum + (lDigit - 9)
            Else
                lSum = lSum + lDigit
            End If
        Else
            lSum = lSum + Val(Mid$(sCard, x, 1))
        End If
    Next

    ' if the MOD 10 of the sum is equal to zero then the credit card
    ' is a valid number (although it can still be rejected by the
    ' credit card processor).
    CreditCardValidate = ((lSum Mod 10) = 0)
End Function