Отправляет email-рассылки с помощью сервиса Sendsay

Delphi для профессионалов

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

  Октябрь 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
24.10.2002
15:05:04
23:21:18
25
26
27
28
29
30
31
Автор
Ведущий

Статистика

8.943 подписчиков
-22 за неделю
←   Все выпуски   →

Delphi для профессионалов - Проверка кредитной карты


Информационный Канал Subscribe.Ru
eServer.ru :: Хостинг без ограничений!
Рассылка: Delphi для профессионалов

Количество подписчиков: 13
Рассылка 'Delphi для профессионалов'

Выберите действие:
Заглавие (одной строкой) :
Содержание :

От кого :
Не показывать мой e-mail другим пользователям

Проверка кредитной карты

unit CreditС;

{*****************************************************************************
 Модуль Delphi для проверки номера кредитной карты
 Версия: 1.1
 Дата: Декабрь 20, 1996

 Данный модуль создан на основе алгоритма ccard автора Peter Miller.
 Автор не против бесплатного использования, но резервирует все права на данный алгоритм.

 авторское право 1996 Shawn Wilson Harvell (shawn@inet.net)

 применение:
  Внесите данный модуль в список uses любого модуля, которому
  необходим доступ к функции проверки кредитной карты.
     IsValidCreditCardNumber( CardNumber, ReturnMessage ) returns Boolean
  например, используйте это для уведомления пользователя о недействительности карты.

 CardNumber    - строка, содержащая номер карты, которую необходимо проверить
 ReturnMessage - строка, с помощью которой функция может возвратить любое сообщение
                 (при этом старое содержимое строки стирается)
    возвращает True если номер карточки верен, False - в противном случае.

 Во входных параметрах функции допускаются тире и пробелы,
 если же возможно присутствие других символов, вы можете их удалить.
 Функция RemoveChar довольно легко позаботится об этом, просто
 передайте ей входную строку и символ, который вы хотите удалить.

 Пользователь может свободно изменять код модуля для собственных целей,
 но в случае его распространения он должен сообщить пользователям
 обо всех внесенных изменениях.

 Используйте модуль на свой страх и риск, поскольку он свободен от явных
 и неявных гарантий. Ответственность за какой-либо ущерб, причиненный
 данным модулем лежит на его пользователе.

 На момент написания модуля он устойчиво работал под Delphi версий 1 и 2,
 для Turbo Pascal необходимо внести некоторые несложные исправления (главным
 образом из-за различия реализации функций в модуле SysUtils).

 Если вы нашли этот модуль полезным, имеете какие-то пожелания или предложения,
 отправьте автору письмо по адресу электронной почты shawn@inet.net


 История изменений

  версия 1.1 -- Декабрь 20, 1996
    исправлена ошибка с Discover card: соответственно увеличина длина маски "database"

  версия 1.0 -- Октябрь 26, 1996
    первый выпуск

*****************************************************************************}

interface

uses SysUtils;

intreface

function IsValidCreditCardNumber( CardNumber: String; var MessageText: String ): Boolean;

implementation

const
  CardPrefixes: array[1..19] of string  =
     ('2014','2149','300','301','302','303','304','305','34','36','37',
      '38','4','51','52','53','54','55','6011');

  CardTypes: array[1..19] of String =
     ('enRoute', 'enRoute',
      'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche',
      'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche',
      'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche',
      'American Express', 'Diner Club/Carte Blanche',
      'American Express', 'Diner Club/Carte Blanche',
      'Visa', 'MasterCard', 'MasterCard', 'MasterCard',
      'MasterCard', 'MasterCard', 'Discover');

function RemoveChar(const Input: String; DeletedChar: Char):String;
var
  Index: Word;                             //переменная счетчика
begin
 //данная функция удаляет все вхождения указанного символа из переданной ей строки
  Result := Input;
  for Index := Length( Result ) downto 1 do
    if Result[Index] = DeletedChar then Delete(Result,Index,1);
end;

function ShiftMask(Input: Integer): Integer;
begin
  //простая оболочка для функции сдвига битов числа
  Result := (1 shl (Input-12));
end;

function ConfirmChecksum(CardNumber: String): Boolean;
var
  CheckSum   : Integer;                    //Содержит значение операции
  Flag       : Boolean;                    //флаг готовности
  Counter    : Integer;                    //индекс счетчика
  PartNumber : String;                     //используется для извлечения каждой цифры числа
  Number     : Integer;                    //исп-ся для преобразования каждой цифры в число
begin
{**************************************************************************
Это, вероятно, самая запутанный код, который вы когда-либо видели, я и сам
запутался, когда работал над ним. Основное, что делает данная функция -
извлекает каждую цифру из номера карты для использования в формуле проверки
контрольной суммы, устанавливаемую компаниями. Алгоритм производит выборку,
начиная от последней цифры и заканчивая первой.
**************************************************************************}

  //получаем стартовое значение счетчика
  Counter := Length(CardNumber);
  CheckSum := 0;
  PartNumber := '';
  Number := 0;
  Flag := False;
  while ( Counter >= 1 ) do begin
    //получаем текущую цифру
    PartNumber := Copy(CardNumber,Counter,1);
    Number := StrToInt(PartNumber);   //преобразуем в число
    if Flag then begin                //только каждую вторую цифру
      Number := Number*2;
      if Number>=10 then Number := Number-9;
    end;
    CheckSum := CheckSum + Number;
    Flag := not Flag;
    Counter := Counter - 1;
  end;
  Result := ((CheckSum mod 10)=0);
end;

function GetMask(CardName: String): Integer;
begin
  //значение по умолчанию
  Result := 0;
  if CardName = 'MasterCard' then Result := ShiftMask(16);
  if CardName = 'Visa' then Result := ((ShiftMask(13) or ShiftMask(16));
  if CardName = 'American Express' then Result := ShiftMask(15);
  if CardName = 'Diner Club/Carte Blanche' then Result := ShiftMask(14);
  if CardName = 'Discover' then Result := ShiftMask(16);
end;

function IsValidCreditCardNumber(CardNumber: String; var MessageText: String ): Boolean;
var
  StrippedNumber  : String;                //используется для хранения числа без дополнительных символов
  Index           : Integer;               //универсальный счетчик для циклов и т.п.
  TheMask         : Integer;               //число, которое мы будем использовать для маски
  FoundIt         : Boolean;               //используется для индикации, когда что-либо найдено
  CardName        : String;                //хранит имя типа карты
  PerformChecksum : Boolean;               //тип enRoute карты если контрольная сумма не сошлась
begin
  //сначала избавимся от пробелов и тире
  StrippedNumber := RemoveChar(CardNumber,' ');
  StrippedNumber := RemoveChar(StrippedNumber,'-');

  //если строка была нулевой длины, то тоже OK
  if StrippedNumber='' then begin
    Result := True;
    exit;
  end;

  //инициализация возвращаемых переменных
  MessageText := '';
  Result := True;

  //устанавливаем нашу переменную-флаг
  FoundIt := False;

  //проверка правильности введенных символов в номере карты
  for Index := 1 to Length(StrippedNumber) do begin
    case StrippedNumber[Index] of
      '0'..'9': FoundIt:=FoundIt;   //другими словами не op
    else
      MessageText := 'Неверный введенный символ';
      Result := False;
      exit;
    end;
  end;

  //теперь давайте определим тип используемой карты
  for Index := 1 to 19 do begin
    if Pos(CardPrefixes[Index],StrippedNumber)=1 then begin
      //мы обнаружили правильный тип
      FoundIt := True;
      CardName := CardTypes[Index];
      TheMask := GetMask(CardName);
    end;
  end;

  //если тип карты не определен, указываем на это
  if not FoundIt then begin
    CardName := 'Unknown Card Type';
    TheMask := 0;
    MessageText := 'Неизвестный тип карты';
    Result := False;
    exit;
  end;

  //проверка длины
  if (Length(StrippedNumber)>28) and Result) then begin
    MessageText := 'Номер слишком большой';
    Result := False;
    exit;
  end;

  //проверка длины
  if ((Length(StrippedNumber)<12) or
     ((ShiftMask(Length(StrippedNumber)) and TheMask)=0)) then begin
    Messagetext := 'неверная длина числа';
    Result := false;
    exit;
  end;

  //проверяем вычисление контрольной суммы
  if CardName = 'enroute' then
    PerformChecksum := False
  else
    Performchecksum := True;
  if (performchecksum and (not confirmchecksum(strippednumber))) then begin
    messagetext := 'неверная контрольная сумма';
    result := false;
    exit;
  end;

  //если результат равен True, тогда все ok
  if Result then
    messagetext := 'номер верен: тип карты: ' + cardname;

  //если строка была нулевой длины, то тоже OK
  if strippednumber='' then
    Result := true;
end;

end.

Все вопросы присылайте по адресу: delphi-ask@igp.org.ua
Все ответы присылайте по адресу: delphi-reply@igp.org.ua
Все подсказки присылайте по адресу: delphi-hint@igp.org.ua
Со всем списком советов можно познакомиться по адресу: http://igp.org.ua/delphine/.
Наш проект Delphine можно найти по следующей ссылке: http://igp.org.ua/products/delphine/.

Заходите в наш форум: Форум Delphi-профессионалов. Адрес: http://igp.org.ua/cgi-bin/yabb/yabb.pl.
Здесь Вы найдете ответы на все Ваши вопросы!

Выберите действие:
Заглавие (одной строкой) :
Содержание :

От кого :
Не показывать мой e-mail другим пользователям

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное