[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

      {$F+,D+,L+}

    unit Vericard;

    interface

      function Vc(c : string) : char;

    implementation

      function Vc(c : string) : char;
      var
        card : string[21];
        Vcard : array[0..21] of byte absolute card;
        Xcard : integer;
        Cstr : string[21];
        y, x : integer;
      begin
        x := 0;
        Cstr := '                ';
        Cstr := '';
        fillchar(Vcard, 22, #0);
        card := c;
        for x := 1 to 20 do
          if (Vcard[x] in [48..57]) then
            Cstr := Cstr + chr(Vcard[x]);
        card := '';
        card := Cstr;
        Xcard := 0;
        if NOT odd(length(card)) then
          for x := (length(card) - 1) downto 1 do
            begin
              if odd(x) then
                y := ((Vcard[x] - 48) * 2)
              else
                y := (Vcard[x] - 48);
              if (y >= 10) then
                y := ((y - 10) + 1);
              Xcard := (Xcard + y)
            end
        else
          for x := (length(card) - 1) downto 1 do
            begin
              if odd(x) then
                y := (Vcard[x] - 48)
              else
                y := ((Vcard[x] - 48) * 2);
              if (y >= 10) then
                y := ((y - 10) + 1);
              Xcard := (Xcard + y)
            end;
        x := (10 - (Xcard mod 10));
        if (x = 10) then
          x := 0;
        if (x = (Vcard[length(card)] - 48)) then
          Vc := Cstr[1]
        else
          Vc := #0
      end;

    END.

    { .....................DRIVER EXAMple........  }

    {$A-,B+,D-,E-,F-,I+,L-,N-,O-,R+,S+,V+}
    {$M 2048,0,4096}

    program ValiCard;

      { Test routine for the Mod 10 Check Digit CC validator... }

    uses
      dos,
      crt,
      VeriCard;

    var
      card : string[22];
      k : char;

      procedure Squawk(Noise : byte);
      begin
        case Noise of
          1 : begin
                Sound(400);
                Delay(200);
                Sound(200);
                Delay(200);
                Nosound
              end;
          2 : begin
                Sound(392);
                Delay(55);
                Nosound;
                Delay(30);
                Sound(523);
                Delay(55);
                Nosound;
                Delay(30);
                Sound(659);
                Delay(55);
                Nosound;
                Delay(30);
                Sound(784);
                Delay(277);
                Nosound;
                Delay(30);
                Sound(659);
                Delay(55);
                Nosound;
                Delay(30);
                Sound(784);
                Delay(1200);
                Nosound
              end
        end                                { case }
      end;

    BEGIN
      k := #0;
      clrscr;
      fillchar(card, 22, #0);
      writeln('VC: Integer Modulo-10 Visa/Mastercard/Amex Check-Digit');
      writeln('    verification routine. (c) 1990 Daniel J. Karnes');
      writeln;
      write('    Please enter a Credit Card number: ');
      readln(card);
      writeln;
      writeln;
      if (length(card) > 12) then
        k := Vc(card);
      if (k in ['3', '4', '5']) then
        Squawk(2)
      else
        Squawk(1);
      case k of
        #0 : writeln('    Could NOT verify this number with any card type.')
        '3' : writeln('    Card was verified as a valid Amex Card Number.');
        '4' : writeln('    Card was verified as a valid VISA Card Number.');
        '5' : writeln('    Card was verified as a valid Mastercard Number.')
      end
    END.

    ...................
    Hope that helps. I've only tried it on one card number BUT it did work
    for the one and the info was received from someone in the business.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]