home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0038_Credit Card check.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  3.3 KB  |  148 lines
  1.  
  2.   {$F+,D+,L+}
  3.  
  4. unit Vericard;
  5.  
  6. interface
  7.  
  8.   function Vc(c : string) : char;
  9.  
  10. implementation
  11.  
  12.   function Vc(c : string) : char;
  13.   var
  14.     card : string[21];
  15.     Vcard : array[0..21] of byte absolute card;
  16.     Xcard : integer;
  17.     Cstr : string[21];
  18.     y, x : integer;
  19.   begin
  20.     x := 0;
  21.     Cstr := '                ';
  22.     Cstr := '';
  23.     fillchar(Vcard, 22, #0);
  24.     card := c;
  25.     for x := 1 to 20 do
  26.       if (Vcard[x] in [48..57]) then
  27.         Cstr := Cstr + chr(Vcard[x]);
  28.     card := '';
  29.     card := Cstr;
  30.     Xcard := 0;
  31.     if NOT odd(length(card)) then
  32.       for x := (length(card) - 1) downto 1 do
  33.         begin
  34.           if odd(x) then
  35.             y := ((Vcard[x] - 48) * 2)
  36.           else
  37.             y := (Vcard[x] - 48);
  38.           if (y >= 10) then
  39.             y := ((y - 10) + 1);
  40.           Xcard := (Xcard + y)
  41.         end
  42.     else
  43.       for x := (length(card) - 1) downto 1 do
  44.         begin
  45.           if odd(x) then
  46.             y := (Vcard[x] - 48)
  47.           else
  48.             y := ((Vcard[x] - 48) * 2);
  49.           if (y >= 10) then
  50.             y := ((y - 10) + 1);
  51.           Xcard := (Xcard + y)
  52.         end;
  53.     x := (10 - (Xcard mod 10));
  54.     if (x = 10) then
  55.       x := 0;
  56.     if (x = (Vcard[length(card)] - 48)) then
  57.       Vc := Cstr[1]
  58.     else
  59.       Vc := #0
  60.   end;
  61.  
  62. END.
  63.  
  64. { .....................DRIVER EXAMple........  }
  65.  
  66. {$A-,B+,D-,E-,F-,I+,L-,N-,O-,R+,S+,V+}
  67. {$M 2048,0,4096}
  68.  
  69. program ValiCard;
  70.  
  71.   { Test routine for the Mod 10 Check Digit CC validator... }
  72.  
  73. uses
  74.   dos,
  75.   crt,
  76.   VeriCard;
  77.  
  78. var
  79.   card : string[22];
  80.   k : char;
  81.  
  82.   procedure Squawk(Noise : byte);
  83.   begin
  84.     case Noise of
  85.       1 : begin
  86.             Sound(400);
  87.             Delay(200);
  88.             Sound(200);
  89.             Delay(200);
  90.             Nosound
  91.           end;
  92.       2 : begin
  93.             Sound(392);
  94.             Delay(55);
  95.             Nosound;
  96.             Delay(30);
  97.             Sound(523);
  98.             Delay(55);
  99.             Nosound;
  100.             Delay(30);
  101.             Sound(659);
  102.             Delay(55);
  103.             Nosound;
  104.             Delay(30);
  105.             Sound(784);
  106.             Delay(277);
  107.             Nosound;
  108.             Delay(30);
  109.             Sound(659);
  110.             Delay(55);
  111.             Nosound;
  112.             Delay(30);
  113.             Sound(784);
  114.             Delay(1200);
  115.             Nosound
  116.           end
  117.     end                                { case }
  118.   end;
  119.  
  120. BEGIN
  121.   k := #0;
  122.   clrscr;
  123.   fillchar(card, 22, #0);
  124.   writeln('VC: Integer Modulo-10 Visa/Mastercard/Amex Check-Digit');
  125.   writeln('    verification routine. (c) 1990 Daniel J. Karnes');
  126.   writeln;
  127.   write('    Please enter a Credit Card number: ');
  128.   readln(card);
  129.   writeln;
  130.   writeln;
  131.   if (length(card) > 12) then
  132.     k := Vc(card);
  133.   if (k in ['3', '4', '5']) then
  134.     Squawk(2)
  135.   else
  136.     Squawk(1);
  137.   case k of
  138.     #0 : writeln('    Could NOT verify this number with any card type.')
  139.     '3' : writeln('    Card was verified as a valid Amex Card Number.');
  140.     '4' : writeln('    Card was verified as a valid VISA Card Number.');
  141.     '5' : writeln('    Card was verified as a valid Mastercard Number.')
  142.   end
  143. END.
  144.  
  145. ...................
  146. Hope that helps. I've only tried it on one card number BUT it did work
  147. for the one and the info was received from someone in the business.
  148.