Calculos - validacao de cartao de credito

Top  Previous  Next

// Retorna:

//  0: Invalido ou Desconhecido

//  1: American Express

//  2: Visa

//  3: MasterCard

function ValidaCartaoCredito(const C: string): Integer;

var

  Card, Cstr : string[21];

  VCard      : array[0..21of Byte absolute card;

  XCard, Y, X: Integer;

begin

  CStr := '';

  FillChar(VCard, 22#0);

  Card := C;

  for X := 1 to 20 do

    if (VCard[X] in [48..57]) then

      CStr := CStr + Char(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

    Result := Ord(CStr[1]) - Ord('2')

  else

    Result := 0;

end;

 

=====================================================

                      ANOTHER

=====================================================

 

type 

   

  TCreditCardType = (cctUnknown, 

                     cctMastercard, 

                     cctVisa, 

                     cctAmex, 

                     cctDinersClub, 

                     cctJCB, 

                     cctDiscover, 

                     cctEnroute); 

 

function IsNumeric(ch: char): boolean; 

begin 

  Result := ch in ['0'..'9']; 

end

 

function IsNumericStr( value : string) : boolean; 

var i : Cardinal; 

begin 

  for i := 1 to Length(Value) do 

    begin 

      if not IsNumeric(Value[I]) then 

        begin 

          Result := False; 

          Exit

        end

    end

  Result := True; 

end

 

function  CheckCreditCardNumber ( var CType : TCreditCardType; Number : String ) 

: boolean; 

var checksum, i : integer; 

 

begin 

  CType := cctUnknown; 

 

  Result := False; 

 

  Number := StripChars (Number, ' ' ); 

 

  if not IsNumericStr(Number) then 

    exit

 

  if Length(Number) < 13 then exit

 

  if (Length(Number) = 15and  ((StrToIntDef(Copy(Number, 14), 0) = 2014or 

                                 (StrToInt(Copy(Number, 14)) = 2149)) then 

     CType := cctEnroute 

  else 

    begin 

      checkSum := 0

      for i := 1 to Length(Number) do 

        begin 

          if not IsNumeric(Number[i]) or (Length(Number) < 13) then 

            begin 

              checkSum := -1

              break; 

            end 

          else 

            begin 

              if (i + Length(Number)) mod 2 = 0 then 

                CheckSum := CheckSum + Ord(Number[i]) - Ord('0'

              else 

                CheckSum := CheckSum + (2 * (Ord(Number[i]) - Ord('0'))) div 10 + 

(2 * (Ord(Number[i]) - Ord('0'))) mod 10

             end

         end

 

        If CheckSum mod 10 <> 0 then Exit

 

        If (Length(Number)=16and (StrToInt(Copy(Number,1,2))>=51and 

(StrToInt(Copy(Number,1,2))<=55) then 

          CType := cctMASTERCARD 

        else if ((Length(Number)=13or (Length(Number)=16)) and (Number[1]='4'

then 

          CType := cctVISA 

        else If (Length(Number)=15and ((StrToInt(Copy(Number,1,2))=34or 

(StrToInt(Copy(Number,1,2))=37)) then 

          CType := cctAMEX 

         else If (Length(Number)=14and ((((StrToInt(Copy(Number,1,2))=36or 

(StrToInt(Copy(Number,1,2))=38))) or ((StrToInt(Copy(Number,1,2))>=300and 

(StrToInt(Copy(Number,1,3))<=305))) then 

          CType := cctDinersClub 

        else If (Length(Number)=16and (Number[1]='3') then 

          CType := cctJCB 

        else If (Length(Number)=15and ((StrToInt(Copy(Number,1,4))=2131or 

(StrToInt(Copy(Number,1,4))=1800)) then 

          CType := cctDiscover 

    end

 

  Result := CType <> cctUnknown; 

 

end;

 

StrToIntDef(Copy(Number, 14), 0) = 2014 

can just be: 

Copy(Number, 14)='2014'