'**************************************
' Name: Credit Card Mod 10 Validation
' Description:This function validates if
' a credit card number "appears" to be val
' id, depending on the type of card, and a
' lso performing a Mod 10 check on the num
' bers.
' By: Lewis Moten
'
'
' Inputs:asCardType - Type of credit car
' d. (American Express, Discover, Visa, Ma
' sterCard)
anCardNumber - The number appearing On the card. Dashes and spaces are ok. Numbers are stripped from
the data provided.
'
' Returns:Returns a boolean (true/false)
' determining if the number appears to be
' valid or not.
'
'Assumes:The user needs to be able to lo
' ok through the code and determine wich s
' trings represent the cards. You can eith
' er type out the entire card name (i.e. "
' American Express") or type in just a let
' ter representing the card name (i.e. "a"
' )
'
'Side Effects:Just because the function
' returns that the card is valid, there ar
' e several other things that are not bein
' g validated.
Date - make sure the card has Not expired
Active Account - This script does Not communicate With any banks To determine If the account number is
active
Authorization - again, this script does Not communicate With any banks To determine If the card has
authorization to purchase a product.
'
'Warranty:
'code provided by Planet Source Code(tm)
' (www.Planet-Source-Code.com) 'as is', wi
' thout warranties as to performance, fitn
' ess, merchantability,and any other warra
' nty (whether expressed or implied).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************

Function IsCreditCard(ByRef asCardType, ByRef anCardNumber)
' Performs a Mod 10 check To make sure the credit card number
' appears valid
' Developers may use the following numbers as dummy data:
' Visa: 430-00000-00000
' American Express: 372-00000-00000
' Mastercard: 521-00000-00000
' Discover: 620-00000-00000

Dim lsNumber ' Credit card number stripped of all spaces, dashes,
etc.
Dim lsChar ' an individual character
Dim lnTotal ' Sum of all calculations
Dim lnDigit ' A digit found within a credit card number
Dim lnPosition ' identifies a character position In a String
Dim lnSum ' Sum of calculations For a specific Set

' Default result is False
IsCreditCard = False

' ====
' Strip all characters that are Not numbers.
' ====

' Loop through Each character inthe card number submited
For lnPosition = 1 To Len(anCardNumber)
' Grab the current character
lsChar = Mid(anCardNumber, lnPosition, 1)
' If the character is a number, append it To our new number
If IsNumeric(lsChar) Then lsNumber = lsNumber & lsChar

Next ' lnPosition

' ====
' The credit card number must be between 13 and 16 digits.
' ====
' If the length of the number is less Then 13 digits, then Exit the routine
If Len(lsNumber) < 13 Then Exit Function

' If the length of the number is more Then 16 digits, then Exit the routine
If Len(lsNumber) > 16 Then Exit Function


' ====
' The credit card number must start with:
' 4 For Visa Cards
' 37 For American Express Cards
' 5 For MasterCards
' 6 For Discover Cards
' ====

' Choose action based on Type of card
Select Case LCase(asCardType)
' VISA
Case "visa", "v"
' If first digit Not 4, Exit Function
If Not Left(lsNumber, 1) = "4" Then Exit Function
' American Express
Case "american express", "americanexpress", "american", "ax", "a"
' If first 2 digits Not 37, Exit Function
If Not Left(lsNumber, 2) = "37" Then Exit Function
' Mastercard
Case "mastercard", "master card", "master", "m"
' If first digit Not 5, Exit Function
If Not Left(lsNumber, 1) = "5" Then Exit Function
' Discover
Case "discover", "discovercard", "discover card", "d"
' If first digit Not 6, Exit Function
If Not Left(lsNumber, 1) = "6" Then Exit Function

Case Else
End Select ' LCase(asCardType)

' ====
' If the credit card number is less Then 16 digits add zeros
' To the beginning to make it 16 digits.
' ====
' Continue Loop While the length of the number is less Then 16 digits
While Not Len(lsNumber) = 16

' Insert 0 To the beginning of the number
lsNumber = "0" & lsNumber

Wend ' Not Len(lsNumber) = 16

' ====
' Multiply Each digit of the credit card number by the corresponding digit of
' the mask, and sum the results together.
' ====

' Loop through Each digit
For lnPosition = 1 To 16

' Parse a digit from a specified position In the number
lnDigit = Mid(lsNumber, lnPosition, 1)

' Determine If we multiply by:
' 1 (Even)
' 2 (Odd)
' based On the position that we are reading the digit from
lnMultiplier = 1 + (lnPosition Mod 2)

' Calculate the sum by multiplying the digit and the Multiplier
lnSum = lnDigit * lnMultiplier

' (Single digits roll over To remain single. We manually have to Do this.)
' If the Sum is 10 or more, subtract 9
If lnSum > 9 Then lnSum = lnSum - 9

' Add the sum To the total of all sums
lnTotal = lnTotal + lnSum

Next ' lnPosition

' ====
' Once all the results are summed divide
' by 10, If there is no remainder Then the credit card number is valid.
' ====
IsCreditCard = ((lnTotal Mod 10) = 0)

End Function ' IsCreditCard

ASP精品屋 from http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=4&txtCodeId=6267