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
83
84
85
86
87
88
89
90
91
92
93
94
95
96


FUNCTION ValidateCreditCard 
LPARAMETERS tcCCnumber, tcCCtype, tcError 
* tcCCnumber 	- CC #
* tcCCtype 	- optional, passed by reference, populated with card type
* tcError 	- optional, passed by reference, populated with error message, if any

LOCAL lcCCnumber, lnCClen, llCCok, lcCCtype, lcError, lnSum, lnTemp, lvRet , lnI
 
lcCCnumber = ALLTRIM(tcCCnumber) 
lnCClen = LEN(lcCCnumber) 
 
llCCok = EMPTY( CHRTRAN(lcCCNumber, "0123456789", "") ) 
 
lcCCtype = "UNKNOWN" 
lcError = "" 
 
DO CASE 
CASE NOT llCCok 
    * CC # is already invalid 
    lcError = "NON-DIGIT" 
CASE lnCClen = 16 
    DO CASE 
    CASE BETWEEN( LEFT(lcCCnumber,2) , "51", "55") 
        lcCCtype = "MASTERCARD" 
    CASE lcCCnumber = "4" 
        lcCCtype = "VISA" 
    CASE lcCCnumber = "6011" 
        lcCCtype = "DISCOVER" 
    CASE lcCCnumber = "3" 
        lcCCtype = "JCB" 
    OTHERWISE    
        llCCok = .F. 
        lcError = "INCORRECT LEN" 
    ENDCASE  
CASE lnCClen = 15 
    DO CASE 
    CASE INLIST( LEFT(lcCCnumber,2) , "34", "37") 
        lcCCtype = "AMEX" 
    CASE INLIST( LEFT(lcCCnumber,4) , "2131", "1800") 
        lcCCtype = "JCB" 
    OTHERWISE    
        llCCok = .F. 
        lcError = "INCORRECT LEN" 
    ENDCASE  
CASE lnCClen = 14 
    DO CASE 
    CASE BETWEEN( LEFT(lcCCnumber,3) , "300", "305") OR ; 
        INLIST( LEFT(lcCCnumber,2) , "36", "38") 
        lcCCtype = "DINERS CLUB" 
    OTHERWISE    
        llCCok = .F. 
        lcError = "INCORRECT LEN" 
    ENDCASE  
CASE lnCClen = 13 
    DO CASE 
    CASE lcCCnumber = "4" 
        lcCCtype = "VISA" 
    OTHERWISE    
        llCCok = .F. 
        lcError = "INCORRECT LEN" 
    ENDCASE  
OTHERWISE    
    llCCok = .F. 
    lcError = "INCORRECT TYPE" 
ENDCASE 

IF llCCok 
	* Now verify control digits 
    lnSum = 0 
 
    FOR lnI =  1 TO lnCClen 
        lnTemp = VAL( SUBSTR( lcCCnumber, lnCClen - lnI + 1,1))  
        IF (lnI % 2) = 0 
            lnTemp = lnTemp * 2 
        ENDIF 
        IF lnTemp > 9 
            lnTemp = lnTemp - 9 
        ENDIF 
        lnSum = lnSum + lnTemp 
    ENDFOR 
    llCCok = ( lnSum % 10 = 0)   
    IF NOT llCCok 
        lcError = "CONTROL DIGIT"    
    ENDIF 
ENDIF 
 
IF PCOUNT() > 1 
    tcCCtype = lcCCtype 
ENDIF    
 
IF PCOUNT() > 2 
    tcError  = lcError 
ENDIF    
 
RETURN llCCok