Attribute VB_Name = "modCreditCard" Option Explicit '============================================================================================================= ' ' modCreditCard Module ' -------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .NET ) ' ' Created On : October 14, 2003 ' Last Update : October 14, 2003 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : NOTHING ' ' Description : This module allows you to easily and quickly validate if a credit card is valid... and if ' it is valid, find out what type of credit card it is (VISA, MC, Discover, Amer Ex, or Diners Club) ' ' See Also : http://www.beachnet.com/~hstiles/cardtype.html ' ' WARNING : THIS MODULE ONLY VALIDATES THAT THE CREDIT CARD NUMBER SPECIFIED IS "WELL FORMED"... IT DOES ' NOT TELL YOU IF THE NUMBER IS VALID OR NOT. THIS MODULE SHOULD ONLY BE USED AS A PRELIMINARY ' VALIDATION TO MAKE SURE THE CREDIT CARD WAS TYPED IN CORRECTLY BY THE USER BEFORE BEING SENT ' TO A 3RD PARTY COMPANY TO MAKE SURE THAT THE ACCOUNT ACTUALLY EXISTS, IS VALID, AND HAS NOT ' EXPIRED. ' ' Example Use : ' ' Private Sub Form_Load() ' Dim objPicture As StdPicture ' Dim hBmpReturn As Long ' Set objPicture = LoadPicture("C:\TEST.BMP") ' If Not objPicture Is Nothing Then ' If BitmapEffect_Mosaic(objPicture.Handle, hBmpReturn, 55) = True Then ' Me.AutoRedraw = True ' RenderBitmap Me.hDC, hBmpReturn ' Me.Refresh ' End If ' End If ' If Not objPicture Is Nothing Then Set objPicture = Nothing ' If hBmpReturn <> 0 Then DeleteObject hBmpReturn ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= Public Enum CreditCardTypes CC_INVALID = 0 ' Invalid credit card number / type unknown CC_VISA = 1 ' VISA (http://www.visa.com/) CC_MASTERCARD = 2 ' MasterCard (http://www.mastercard.com/) CC_DISCOVER = 3 ' Discover (http://www.discovercard.com/) CC_AMEX = 4 ' American Express (http://www.americanexpress.com/) CC_DINERS_CLUB = 5 ' Diners Club (http://www.dinersclub.com/) End Enum ' Returns TRUE if the credit card number supplied is valid. Public Function IsCreditCardValid(ByVal strCreditCardNumber As String, Optional ByRef Return_CreditCardType As CreditCardTypes, Optional ByRef Return_CleanNumber As String) As Boolean On Error GoTo ErrorTrap: Dim lngCounter As Long Dim strLeft As String Dim strRight As String Dim strNumber As String Dim strReverse As String Dim lngSum As Long Dim lngTemp As Long Dim strTemp As String Dim blnOdd As Boolean ' Set default return values Return_CreditCardType = CC_INVALID Return_CleanNumber = "" ' If no credit card number is specified, exit strCreditCardNumber = Trim(strCreditCardNumber) If strCreditCardNumber = "" Then Exit Function ' Strip out non-valid characters For lngCounter = 1 To Len(strCreditCardNumber) strTemp = Mid(strCreditCardNumber, lngCounter, 1) Select Case strTemp Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0": strNumber = strNumber & strTemp End Select Next Return_CleanNumber = strNumber ' Check what type of card it is based on the first few numbers If Left(strNumber, 1) = "4" Then Return_CreditCardType = CC_VISA ElseIf Left(strNumber, 2) = "34" Or Left(strNumber, 2) = "37" Then Return_CreditCardType = CC_AMEX ElseIf CInt(Left(strNumber, 2)) >= 51 And CInt(Left(strNumber, 2)) <= 55 Then Return_CreditCardType = CC_MASTERCARD ElseIf Left(strNumber, 4) = "6011" Then Return_CreditCardType = CC_DISCOVER ElseIf (Left(strNumber, 2) = "36") Or (Left(strNumber, 2) = "38") Or (CInt(Left(strNumber, 3)) >= 300 And CInt(Left(strNumber, 3)) <= 305) Then Return_CreditCardType = CC_DINERS_CLUB Else Exit Function End If ' Make sure the credit card number length is valid for the type of card it is Select Case Return_CreditCardType Case CC_VISA If Len(strNumber) <> 13 And Len(strNumber) <> 16 Then Return_CreditCardType = CC_INVALID Exit Function End If Case CC_MASTERCARD, CC_DISCOVER If Len(strNumber) <> 16 Then Return_CreditCardType = CC_INVALID Exit Function End If Case CC_AMEX If Len(strNumber) <> 15 Then Return_CreditCardType = CC_INVALID Exit Function End If Case CC_DINERS_CLUB If Len(strNumber) <> 14 Then Return_CreditCardType = CC_INVALID Exit Function End If End Select ' Reverse the order of the For lngCounter = 0 To Len(strNumber) - 1 strReverse = strReverse & Mid(strNumber, Len(strNumber) - lngCounter, 1) Next ' Apply the "LUHN Formula" to the reversed number to validate it lngSum = CInt(Left(strReverse, 1)) strReverse = Right(strReverse, Len(strReverse) - 1) For lngCounter = 1 To Len(strReverse) If blnOdd = False Then blnOdd = True lngTemp = CInt(Mid(strReverse, lngCounter, 1)) * 2 If lngTemp > 9 Then lngTemp = (lngTemp - 10) + 1 lngSum = lngSum + lngTemp Else blnOdd = False lngSum = lngSum + CInt(Mid(strReverse, lngCounter, 1)) End If Next If lngSum Mod 10 <> 0 Then Return_CreditCardType = CC_INVALID Exit Function End If IsCreditCardValid = True Exit Function ErrorTrap: Err.Clear End Function