// Скрипт для оплаты чека кредитной картой Сбербанка с помощью OLE-сервера (SBRF.dll)
// Имена процедур прописаны жестко в программе.

// первая часть оплаты чека, происходит до печати чека в ККМ: переводим оплату в режим ожидания, идем печатать на принтер.
// Разделение нужно, потому что, если не удалась печать чека, то надо отказываться от оплаты. Однако, если вторая процедура (см. ниже), не прописана,
// то предполагается, что обходимся только первым этапом.
// Если программа не находит данной процедуры, то выполняет просто скрипт.
// procedure RTLCC_Execute;

// вторая часть оплаты чека, происходит после успешной печати чека в ККМ: подтверждение оплаты. Происходит, если печать чека в ККМ произошла успешно.
// Если не получено подтверждение, то сумма в банке отменится. 
// procedure RTLCC_Commit;

// Функция отмены чека
// procedure RTLCC_Repeal;

// Функция X-отчет по картам. Если прописана, то проводится одновременно с X-отчетом по кассе
// procedure RTLCC_XReport;

// Функция Z-отчет по картам (итоги дня). Если прописана, то проводится одновременно с Z-отчетом по кассе
// procedure RTLCC_ZReport;

// Переменная CardsPrintChequeDriver CARDSPRINTCHEQUEDRIVER должна быть определена в настройках программы на закладке "Переменные".
// Переменная определяет драйвер, который печатает чеки и отчеты. Если не указано, то печати не будет.
// На данный момент переменная может принимать значения:
// ATOL,АТОЛ - для общего драйвера АТОЛ,
// SHTRIH,SHTRIH-M,ШТРИХ,ШТРИХ-М - для общего драйвера ККМ Штрих-М
// Текст чека или отчета так же возвращается в переменной ChequeString

var
    RTLCC_PrintCutLineLength :integer = 6; // сколько надо пропустить, чтобы линия отреза была там, где надо
    RTLCC_PrintCutLine :boolean = true; // Надо ли резать (некоторые аппараты не поддерживают. по-умолчанию - true
    RTLCC_PrintCutLineSleep :integer = 0; // на месте отреза сделать слип, в секундах. Требуется, если аппарат не имеет отрезки, тогда эти секунды дадут возможность оторвать руками
    RTLCC_2Steps :boolean = true; // проводить ли оплату в 2 этапа (рекомендуется)
    RTLCC_Return2Steps :boolean = false; // проводить ли возврат в 2 этапа (рекомендуется), однако из=за неясной ошибки транзакции в 6003 пока отключены, операция проводится в один этап через 4002
    RTLCC_RepeatPrint :integer = 1; // число повторов слипа (если поступил одинарный слип, то повторим его печать)
    RTLCC_REPORTS_AUTO :boolean = true; // генерировать и печатать автоматически X и Z отчеты вместе с отчетами по кассам. Функции RTLCC_ZREport и RTLCC_XReport вызываются в любом случае, а их работа или не работа определяется этой переменной

var
    RTLCC_Logging :boolean = false; // Сохранять лог операции (для тестирования
    RTLCC_LOGGING_CHEQUESTRING :boolean = true; // сохранять текст чека в текстовом файле

var
  DATASET :TDataset = nil; // датасет с товарами. Набор полей смотрите в чеке розницы
  Summary :Currency = 0; // сумма по чеку
  PaySummary :Currency = 0; // Внесено денег
  Discount   :double =0; // процент надбавки/скидки
  DiscountSummary :double =0; // сумма надбавки/скидки
  ClientName :string = ''; // имя контрагента
  ClientID :integer = 0; // код контрагента
  AddInfo :string = ''; // доп. инфо к контрагенту
  Doc_Reason :string = ''; // код основания в чеке
  Doc_Reason_Name :string = ''; // наименование основания в чеке

  VarDevice :Variant = null; // сервер устройства печати. если не указан, то вручную запускается
  Server : variant = null; // сервер драйвера платежных карт

var
  // Возвращаемые параметры, могут быть использованы вызывающим скриптом или программой. В принципе, они не нужны, ибо скрипт везде возвращает исключения в случае ошибок
  ResultCode : integer =0; // результат, код ошибки, если не 0
  // Переменная ResultDescription возвращает текст кода Result
  ResultDescription :string = '';

  TermNum :string = ''; // Номер терминала: Результат выполнения функции 4000 - отправки суммы
  ClientCard :string = ''; // Номер карты: Результат выполнения функции 4000 - отправки суммы
  CardName :string = ''; // Название карты (Viza, Mastercard ....) : Результат выполнения функции 4000 - отправки суммы
  CardType :string = ''; // Тип карты
  CardExpiryDate :string = ''; // Дата окончания действия карт: Результат выполнения функции 4000 - отправки суммы
  AuthCode :string = ''; // Какой-то код авторизации (пинкод?): Взято из пример. Результат выполнения функции 4000 - отправки суммы
  MerchantTSN :string = ''; // Номер транзакции в пакете терминала
  MerchantBatchNum :string = ''; // Номер пакета терминала по магн.картам

  ChequeString :string = ''; // Возвращенный код чека (строка с переносами): его надо распечатать на ККМ или чем-то еще, и отдать клиенту

  RTLCC_PRINTERNAME :string = 'АТОЛ';
  RTLCC_OLE_SERVERNAME :string = 'SBRFSRV.Server';

var
  RTLCC_CutLineText :string = '====='; // строка, означающая линию отреза



procedure RTLCC_InitVars;
begin
   RTLCC_Logging :=  appinifile.readbool('advanced','RTLCC_LOGGING',dbinifile.readBool('advanced','RTLCC_LOGGING',RTLCC_LOGGING));
   RTLCC_LOGGING_CHEQUESTRING :=  appinifile.readbool('advanced','RTLCC_LOGGING_CHEQUESTRING',dbinifile.readBool('advanced','RTLCC_LOGGING_CHEQUESTRING',RTLCC_LOGGING_CHEQUESTRING));
   RTLCC_CutLineText :=  appinifile.readstring('advanced','RTLCC_CUTLINETEXT',dbinifile.readstring('advanced','RTLCC_CUTLINETEXT',RTLCC_CutLineText));
   RTLCC_PRINTERNAME := uppercase(appinifile.readstring('advanced','RTLCC_PRINTERNAME',dbinifile.readstring('advanced','RTLCC_PRINTERNAME',appinifile.readstring('ADVANCED','CardsPrintChequeDriver',RTLCC_PRINTERNAME))));
   RTLCC_OLE_SERVERNAME := appinifile.readstring('advanced','RTLCC_OLE_SERVERNAME',dbinifile.readstring('advanced','RTLCC_OLE_SERVERNAME',RTLCC_OLE_SERVERNAME));

   RTLCC_RepeatPrint := strtointprotected(appinifile.readstring('advanced','RTLCC_REPEATPRINT',dbinifile.readstring('advanced','RTLCC_REPEATPRINT',inttostr(RTLCC_REPEATPRINT))));
   RTLCC_PrintCutLineLength := strtointprotected(appinifile.readstring('advanced','RTLCC_PRINTCUTLINELENGTH',dbinifile.readstring('advanced','RTLCC_PRINTCUTLINELENGTH',AppiniFile.readstring('advanced','CardsPrintCutLineLength',inttostr(RTLCC_PRINTCUTLINELENGTH)))));
   RTLCC_PrintCutLine := strtoboolprotected(appinifile.readstring('advanced','RTLCC_PrintCutLIne',dbinifile.readstring('advanced','RTLCC_PrintCutLine',AppiniFile.readstring('advanced','CardsPrintCutLine',ifthen_string(RTLCC_PRINTCUTLINE,'1','0')))));
   RTLCC_PrintCutLineSleep := strtointprotected(appinifile.readstring('advanced','RTLCC_PRINTCUTLINESLEEP',dbinifile.readstring('advanced','RTLCC_PRINTCUTLINESLEEP',AppiniFile.readstring('advanced','CardsPrintCutLineSleep',inttostr(RTLCC_PRINTCUTLINESLEEP)))));
   RTLCC_2STEPS := appinifile.readbool('advanced','RTLCC_2STEPS',dbinifile.readBool('advanced','RTLCC_2STEPS',RTLCC_2STEPS));
   RTLCC_RETURN2STEPS := appinifile.readbool('advanced','RTLCC_RETURN2STEPS',dbinifile.readBool('advanced','RTLCC_RETURN2STEPS',RTLCC_RETURN2STEPS));
   RTLCC_REPORTS_AUTO := appinifile.readbool('advanced','RTLCC_REPORTS_AUTO',dbinifile.readBool('advanced','RTLCC_REPORTS_AUTO',RTLCC_REPORTS_AUTO));
end;


procedure RTLCC_SaveLog(StrValue :string);
var LogFilename :string;
    list :tstringlist;
begin
  if not RTLCC_Logging then exit;
  LogFileName := includetrailingpathdelimiter(getappLocalDataFolder)+'cashcreditcardsbrf.log';
  list := tstringlist.create;
  try
    if fileexists(LogFilename) then List.loadfromfile(logfilename);
    while list.count>1000 do List.Delete(0);

    List.add(Formatdatetime('dd.mm.yyyy hh:nn:ss : ',now())+StrValue);
    List.savetofile(LogFileName);
  finally
    List.free
  end;
end;

procedure RTLCC_Save_ChequeString;
var LogFilename :string;
begin
  if not RTLCC_Logging_ChequeString then exit;
  LogFileName := includetrailingpathdelimiter( includetrailingpathdelimiter(getappLocalDataFolder)+'CashCreditCards')
                   +'cc_'+formatdatetime('yyyy.mm.dd.hh.nn.ss',now)+'.txt';
 
  forcedirectories(extractfilepath(logfilename));
  StringToFile(logfilename,ChequeString);
end;

procedure RTLCC_CheckError(RCode :integer; Comment :string); // Проверка ошибки драйвера. Вылетаем на exception, если была ошибка
begin
  ResultCode := RCODE;
  ResultDescription := Comment+': '+RTLCC_REsultDescription(RCode);
  if (RCode<>0) then raiseException('Ошибка работы с кредитными картами: ' + Comment+ ': '+inttostr(rcode) + ': ' + resultDescription);
end;


procedure RTLCC_CheckServer;
begin
   try
     if varisnull(server) then Server:=CreateOleObject(RTLCC_OLE_SERVERNAME);
   except
     RaiseException('Ошибка запуска сервера '+RTLCC_OLE_SERVERNAME+': '+exceptmessage);
   end;
end;

procedure RTLCC_CheckErrorAtol; // Проверка ошибки драйвера АТОЛ
begin
    RTLCC_SaveLog('RTLCC_CheckErrorAtol');
    if VArDevice.resultcode <> 0 then raiseException('Ошибка печати чека по кредитной карте драйвером АТОЛ:(' + inttostr(VarDevice.resultcode) + ') - ' + VarDevice.resultDescription);
end;

procedure RTLCC_CheckErrorShtrihM; // Проверка ошибки драйвера Штрих-м
begin
    RTLCC_SaveLog('RTLCC_CheckErrorShtrihM');
    if VArDevice.resultcode <> 0 then raiseException('Ошибка печати чека по кредитной карте драйвером Штрих-М:(' + inttostr(VarDevice.resultcode) + ') - ' + VarDevice.ResultCodeDescription);
end;

procedure RTLCC_ShowProperties; // Если функция прописана, то срабатывает по кнопке "настройки" рядом с полем настройки имени скрипта
begin
  CreateHintE('Для этого драйвера нет процедуры настроек');
end;


// печать текста с помощью драйвера АТОЛ, используется в процедуре печати текста общей PrintCheque
procedure RTLCC_PrintChequeAtol(CutAfter :boolean);
var List :tstringlist;
    i :integer;
    k :integer;
    incCutLine :integer;
    NeedCutLine :boolean; // Надо резать, после того, как IncCutLIne станет равной CardsPrintCutLineLength
begin
  if ChequeString ='' then exit;
  RTLCC_SaveLog('PrintChequeAtol');
  RTLCC_SaveLog(ChequeString);

  List := tstringlist.create;
  try
    List.text := ChequeString;

    RTLCC_SaveLog('PrintChequeAtol:1');
    if varIsNull(VarDevice) then
    begin
      RTLCC_SaveLog('PrintChequeAtol:1.1');
      VarDevice := CreateOleObject('AddIn.fprnM45');
      RTLCC_SaveLog('PrintChequeAtol:1.2');
      VarDevice.ApplicationHandle := Application.Handle;
    end;

    RTLCC_SaveLog('PrintChequeAtol:2');
    VarDevice.DeviceEnabled := true; RTLCC_CheckErrorAtol;
    VarDevice.TextWrap := 1; RTLCC_CheckErrorAtol;//Перенос текста по словам
    VarDevice.Alignment := 0;  RTLCC_CheckErrorAtol; // выравнивание текста в строке


    for k := 1 to RTLCC_RepeatPrint do
    begin
      NeedCutLine := false;
      incCutLine := 0;
      RTLCC_SaveLog('PrintChequeAtol:3');
      for i := 0 to list.count-1 do
      begin
        RTLCC_SaveLog('PrintChequeAtol:3.1.'+inttostr(i));
        VarDevice.Caption := List[i]; RTLCC_CheckErrorAtol;
        RTLCC_SaveLog('PrintChequeAtol:3.2.'+inttostr(i));
        VArDevice.PrintString;   RTLCC_CheckErrorAtol;
        if pos(RTLCC_CutLineText,list[i])=1
        then begin
          NeedCutLine := true;
          IncCutLine := 1;
        end
        else if NeedCutLIne then
        begin
          inc(IncCutLine);
          if IncCutLine>=RTLCC_PrintCutLineLength
          then begin
            if RTLCC_PrintCutLine then
            begin
              RTLCC_SaveLog('PrintChequeAtol:3.3.'+inttostr(i));
              VarDevice.PartialCut; RTLCC_CheckErrorAtol;// отрезка
            end;
            if RTLCC_PrintCutLineSleep>0 then Sleep(RTLCC_PrintCutLineSleep*1000);
            NeedCutLine := false;
            IncCutLine := 0;
          end;
        end;
      end;
  
      RTLCC_SaveLog('PrintChequeAtol:4');
      if CutAfter and NeedCutLine and (IncCutLine<RTLCC_PrintCutLineLength)
      then begin
        //VarDevice.StringQuantity:=CardsPrintCutLineLength-IncCutLine; //пропустить строки
        //VarDevice.FeedDocument;
        for i := 1 to (RTLCC_printcutlinelength-IncCutLine) do
        begin
          RTLCC_SaveLog('PrintChequeAtol:4.1.'+inttostr(i));
          VarDevice.Caption := ''; RTLCC_CheckErrorAtol;
          RTLCC_SaveLog('PrintChequeAtol:4.2.'+inttostr(i));
          VArDevice.PrintString;   RTLCC_CheckErrorAtol;
        end;
        if RTLCC_PrintCutLine then
        begin
          //VarDevice.CutType:=False; // false полная отрезка, true - неполная
          //VarDevice.CutCheck; // отрезка
        end;
        if RTLCC_PrintCutLineSleep>0 then Sleep(RTLCC_PrintCutLineSleep*1000);
      end;
    end;
    RTLCC_SaveLog('PrintChequeAtol:5');
    VarDevice.PrintHeader;   RTLCC_CheckErrorAtol;
    RTLCC_SaveLog('PrintChequeAtol:6');
    if RTLCC_PrintCutLine then
    begin
      VarDevice.partialcut;   RTLCC_CheckErrorAtol;
    end;
    if RTLCC_PrintCutLineSleep>0 then Sleep(RTLCC_PrintCutLineSleep*1000);
    RTLCC_SaveLog('PrintChequeAtol:7');
    VarDevice.DeviceEnabled := false; RTLCC_CheckErrorAtol;
    RTLCC_SaveLog('PrintChequeAtol:exit');
  finally
    list.free
  end;
end;


// печать текста с помощью драйвера Штрих-М, используется в процедуре печати текста общей PrintCheque
procedure RTLCC_PrintChequeShtrihM(CutAfter :boolean);
var List :tstringlist;
    i :integer;
    k :integer;
    incCutLine :integer;
    NeedCutLine :boolean; // Надо резать, после того, как IncCutLIne станет равной MaxCutLines


begin
  //CreateHint('PrintChequeShtrihM TextValue =: '+TextValue,'Тест',60);
  //StringToFile('c:\temp\1.txt',TExtVAlue);
  RTLCC_SaveLog('PrintChequeShtrihM');
  RTLCC_SaveLog(ChequeString);


  RTLCC_SaveLog('PrintChequeShtrihM:1');
  if ChequeString ='' then exit;
  list := tstringlist.create;
  try
    List.Text := ChequeString;

    RTLCC_SaveLog('PrintChequeShtrihM:1.1');
    if varIsNull(VarDevice) then
    begin
      VarDevice := CreateOleObject('AddIn.DrvFR');
      //VarDevice.ApplicationHandle := Application.Handle;
    end;
    RTLCC_SaveLog('PrintChequeShtrihM:2');
    if VarDevice.Password = 0 then VarDevice.Password :=  30; RTLCC_CheckErrorShtrihM;
    VarDevice.Connect; RTLCC_CheckErrorShtrihM;

    VarDevice.UseReceiptRibbon:=True; RTLCC_CheckErrorShtrihM;
    VarDevice.UseJournalRibbon:=False; RTLCC_CheckErrorShtrihM;

    for k := 1 to RTLCC_RepeatPrint do
    begin
  
      NeedCutLine := false;
      incCutLine := 0;
      for i := 0 to list.count-1 do
      begin
        RTLCC_SaveLog('PrintChequeAtol:2.1.'+inttostr(i));
        VarDevice.StringForPrinting:=list[i]; RTLCC_CheckErrorShtrihM;
        RTLCC_SaveLog('PrintChequeAtol:2.2.'+inttostr(i));
        VarDevice.PrintString; RTLCC_CheckErrorShtrihM;
        //VarDevice.PrintWideString
        if pos(RTLCC_CutLineText,list[i])=1 //if list[i] = RTLCC_CutLineText
        then begin
          NeedCutLine := true;
          IncCutLine := 1;
        end
        else if NeedCutLIne then
        begin
          inc(IncCutLine);
          if IncCutLine>=RTLCC_PrintCutLineLength
          then begin
            if RTLCC_PrintCutLine then
            begin
              RTLCC_SaveLog('PrintChequeAtol:2.3');
              VarDevice.CutType:=False; // false полная отрезка, true - неполная
              RTLCC_SaveLog('PrintChequeAtol:2.4');
              VarDevice.CutCheck; // отрезка
            end;
            if RTLCC_PrintCutLineSleep>0 then Sleep(RTLCC_PrintCutLineSleep*1000);
            NeedCutLine := false;
            IncCutLine := 0;
          end;
        end;
      end;
  
      RTLCC_SaveLog('PrintChequeShtrihM:3');
  
  
      if CutAfter and NeedCutLine and (IncCutLine<RTLCC_PrintCutLineLength)
      then begin
        RTLCC_SaveLog('PrintChequeAtol:4');
        VarDevice.StringQuantity:=RTLCC_PrintCutLineLength-IncCutLine; //пропустить строки
        RTLCC_SaveLog('PrintChequeAtol:5');
        VarDevice.FeedDocument;
        if RTLCC_PrintCutLine then
        begin
          RTLCC_SaveLog('PrintChequeAtol:6');
          VarDevice.CutType:=False; // false полная отрезка, true - неполная
          RTLCC_SaveLog('PrintChequeAtol:7');
          VarDevice.CutCheck; // отрезка
        end;
        if RTLCC_PrintCutLineSleep>0 then Sleep(RTLCC_PrintCutLineSleep*1000);
      end;
    end;


    //VarDevice.UseSlipDocument:=false;
    //VarDevice.StringQuantity:=3; //пропустить строки
    //VarDevice.FeedDocument;

    //VarDevice.CutType:=False; // false полная отрезка, true - неполная
    //VarDevice.PrintDocumentTitle;
    //VrDevice.CutCheck; // отрезка

    // Проверка PrintCliche, раскомментировать три строки здесь
    //VarDevice.CutType:=False; // false полная отрезка, true - неполная
    //VarDevice.PrintCliche;
    //VarDevice.CutCheck; // отрезка

    RTLCC_SaveLog('PrintChequeShtrihM:exit');
  finally
    list.free
  end;
end;

// процедура печати текста общая. Использует разные драйверы, в зависимости от настроек программы
// Если тип драйвера не указан, то ничего не происходит
procedure RTLCC_PrintCheque(CutAfter :boolean);
var StrvAl :string;
begin
  //CreateHint('PrintCheque TExtValue : '+TExtValue,'Тест',60);
  RTLCC_SAVE_CHEQUESTRING;
  
  RTLCC_SaveLog('PrintCheque');
  if ChequeString='' then exit;

  //CreateHint('PrintCheque CardsPrintChequeDriver : '+strval,'Тест',60);
  if RTLCC_PRINTERNAME >'' // указан драйвер печати чека, печатаем
  then begin
     case RTLCC_PRINTERNAME of
       'АТОЛ','ATOL' : RTLCC_PrintChequeATOL(CutAfter);
       'SHTRIH','SHTRIH-M','ШТРИХ','ШТРИХ-М' : RTLCC_PrintChequeShtrihM(CutAfter);
       'MESSAGE' : bvmessage(ChequeString);
       'HINT' : createhint(ChequeString);
       else raiseException('Вариант "'+RTLCC_PRINTERNAME+'" не запрограммирован. Обратитесь в техподдержку!');
     end;
  end;
  RTLCC_SaveLog('PrintCheque:exit');
end;


procedure RTLCC_Execute;
var strvalue :string;
begin
   RTLCC_SaveLog('RTLCC_Execute');
   with TMyWait.create('Идет обработка оплаты по карте',selfscript) do
   try
     RTLCC_SaveLog('RTLCC_Execute:1');
     RTLCC_CheckServer;
     RTLCC_SaveLog('RTLCC_Execute:2');

     Server.Clear;
     Server.SParam('Amount',round(Summary * 100));

     RTLCC_SaveLog('RTLCC_Execute:3');
     RTLCC_CheckError(Server.NFun(4000),'Списание суммы'); // списание суммы
     RTLCC_SaveLog('RTLCC_Execute:3.1');

     if RTLCC_2STEPS then
     try
       RTLCC_SaveLog('RTLCC_Execute:3.2');
       RTLCC_CheckError(Server.NFun(6003),'Режим ожидания'); // перевод оплаты в режим ожидания, вплоть до  подтверждения 6001 либо отмены 6004, либо автоматической отмены чека при следующем сеансе связи
       RTLCC_SaveLog('RTLCC_Execute:3.3');
     except
        strvalue := exceptmessage; // надо отмну сделать, а потом проведем exception
        try
          RTLCC_SaveLog('RTLCC_ExecuteReturn:3.4');
          RTLCC_Checkerror(Server.NFun(6004),'Отмена после сбоя режима ожидания'); // отмена оплаты
          RTLCC_SaveLog('RTLCC_ExecuteReturn:3.5');
        except
          strvalue := exceptmessage+'; '+strvalue; // передадим текст обеих ошибок
        end;
        raiseexception(strvalue);
     end;

     TermNum := ''; //asstring(Server.GParamSTring('TermNum'));
     ClientCard := asstring(Server.GParamSTring('ClientCard'));
     CardName := Server.GParamSTring('CardName');
     CardType := asstring(Server.GParamString('CardType'));
     CardExpiryDate := Server.GParamSTring('ClientExpiryDate');
     AuthCode := asstring(Server.GParamSTring('AuthCode'));

     MerchantTSN := asstring(Server.GParamString('MerchantTSN'));
     MerchantBatchNum := asstring(Server.GParamString('MerchantBatchNum'));


    // если потребуется дополнительная инфо в чеке, например, номер торговой точки, то делается это тут, в переменной PayInfo
    // и именно в такой последовательности. Взято из примера в описании
    //Server.SParam('PayInfo','Дополнительная информация в чеке');
    //Server.NFun(7005); // Добавление информации к чеку

     ChequeString := Server.GParamSTring('Cheque');

     try
       RTLCC_PrintCheque(false);
     except
       strvalue := exceptmessage;

       if RTLCC_2STEPS then // если в 1 шаг, то уже отменить нельзя
       try
         rtlcc_checkerror(Server.NFun(6004),'Отмена чека после сбоя печати на кассовом аппарате'); // отмена оплаты
       except
         strvalue := exceptmessage+'; '+strvalue; // передадим текст предыдущей ошибки также
       end;
       RaiseException(strvalue);
     end;

     // в примерах можно было бы обойтись только функцией 4000, но нам нужно сначала успешно пробить чек в кассе,
     // поэтому мы сначала вводим транзакцию в режим ожидания функцией 6003, а потом либо подтверждаем 6001 в функции RTLCC_Commit,
     // либо откатываем функцией 6004 в функции RTLCC_Repeal, но в документации написано, что это и не обязательно,
     // не подтвержденная транзакция отменится сама собой в следующем сеансе работы.

     createhint('Введена оплата по карте','Подтверждение');

     //Server.Clear;
     RTLCC_SaveLog('RTLCC_Execute:exit');
   finally
     free
   end;
end;

procedure RTLCC_Commit;
var strvalue :string;
begin
  RTLCC_SaveLog('RTLCC_Commit');
  RTLCC_CheckServer;
  RTLCC_SaveLog('RTLCC_Commit:1');

  if RTLCC_2STEPS then // функция работает только, когда прописано в 2 этапа работать
  with TMyWait.create('Подтверждение оплаты по карте',selfscript) do
  try
     //Server.Clear;
     try
       RTLCC_SaveLog('RTLCC_Commit:2');
       RTLCC_Checkerror(Server.NFun(6001),'Подтверждение оплаты'); // подверждение оплаты
       RTLCC_SaveLog('RTLCC_Commit:3');
     except
       strvalue := ExceptMessage;
       try
         RTLCC_SaveLog('RTLCC_Commit:4');
         RTLCC_CheckError(Server.NFun(6004),'Отмена оплаты'); // отмена оплаты
         RTLCC_SaveLog('RTLCC_Commit:5');
       except
         strvalue := exceptMessage+'; '+strvalue;
       end;
       raiseexception(strvalue);
     end;
     Server.Clear;
     RTLCC_SaveLog('RTLCC_Commit:6');
     createhint('Оплата по карте подтверждена')
  finally
    free
  end;
  RTLCC_SaveLog('RTLCC_Commit:exit');
end;

procedure RTLCC_ExecuteReturn;
var strvalue :string;
begin
   RTLCC_SaveLog('RTLCC_ExecuteReturn');
   with TMyWait.create('Идет обработка возврата по карте',selfscript) do
   try
     RTLCC_CheckServer;

     Server.Clear;
     Server.SParam('Amount',round(Summary * 100));

     RTLCC_SaveLog('RTLCC_ExecuteReturn:1');
     RTLCC_CheckError(Server.NFun(4002),'Возврат суммы'); // возврат суммы
     RTLCC_SaveLog('RTLCC_ExecuteReturn:2');

     if RTLCC_RETURN2STEPS then
     begin
         try
           RTLCC_SaveLog('RTLCC_ExecuteReturn:3.1');
           RTLCC_CheckError(Server.NFun(6003),'Режим ожидания'); // перевод оплаты в режим ожидания, вплоть до  подтверждения 6001 либо отмены 6004, либо автоматической отмены чека при следующем сеансе связи
           RTLCC_SaveLog('RTLCC_ExecuteReturn:3.2');
         except
            strvalue := exceptmessage; // надо отмну сделать, а потом проведем exception
            try
              RTLCC_SaveLog('RTLCC_ExecuteReturn:3.3');
              RTLCC_Checkerror(Server.NFun(6004),'Отмена после сбоя режима ожидания'); // отмена оплаты
              RTLCC_SaveLog('RTLCC_ExecuteReturn:3.4');
            except
              strvalue := exceptmessage+'; '+strvalue; // передадим текст обеих ошибок
            end;
            raiseexception(strvalue);
         end;
     end;

        // в примерах можно было бы обойтись только функцией 4000, но нам нужно сначала успешно пробить чек в кассе,
        // поэтому мы сначала вводим транзакцию в режим ожидания функцией 6003, а потом либо подтверждаем 6001 в функции RTLCC_Commit,
        // либо откатываем функцией 6004 в функции RTLCC_Repeal, но в документации написано, что это и не обязательно,
        // не подтвержденная транзакция отменится сама собой в следующем сеансе работы.

     TermNum := ''; //asstring(Server.GParamSTring('TermNum'));
     ClientCard := Server.GParamSTring('ClientCard');
     CardName := Server.GParamSTring('CardName');
     CardType := asstring(Server.GParamString('CardType'));
     CardExpiryDate := Server.GParamSTring('ClientExpiryDate');
     AuthCode := Server.GParamSTring('AuthCode');

     MerchantTSN := asstring(Server.GParamString('MerchantTSN'));
     MerchantBatchNum := asstring(Server.GParamString('MerchantBatchNum'));


     // если потребуется дополнительная инфо в чеке, например, номер торговой точки, то делается это тут, в переменной PayInfo
     // и именно в такой последовательности. Взято из примера в описании
     //Server.SParam('PayInfo','Дополнительная информация в чеке');
     //Server.NFun(7005); // Добавление информации к чеку

     ChequeString := Server.GParamSTring('Cheque');

     
     try
       RTLCC_PrintCheque(false);
     except
       strvalue := exceptmessage;
       try
         if RTLCC_RETURN2STEPS then 
         begin
           RTLCC_SaveLog('RTLCC_ExecuteReturn:4.1');
           RTLCC_CheckError(Server.NFun(6004),'Отмена чека после сбоя печати на кассовом аппарате'); // отмена оплаты
           RTLCC_SaveLog('RTLCC_ExecuteReturn:4.2');
         end;
       except
         strvalue := exceptmessage+'; '+strvalue;
       end;
       RaiseException(strvalue);
     end;

     createhint('Введен возврат по карте');
   finally
     free
   end;
   RTLCC_SaveLog('RTLCC_ExecuteReturn:exit');
end;

procedure RTLCC_CommitReturn;
var strvalue :string;
begin
  RTLCC_SaveLog('RTLCC_CommitReturn');

  RTLCC_CheckServer;

  if rtlcc_return2steps then  
  with TMyWait.create('Подтверждение возврата по карте',selfscript) do
  try
     //Server.Clear;
     try
       RTLCC_CheckError(Server.NFun(6001),'Подтверждение возврата'); // подверждение оплаты
     except
       strvalue := exceptmessage;
       try
         RTLCC_CheckError(Server.NFun(6004),'Отмена возврата'); // подверждение оплаты
       except
         strvalue := exceptmessage+'; '+strvalue;
       end;
       raiseexception(strvalue);
     end;
     Server.Clear;
  	 createhint('Операция возврата по карте подтверждена')
  finally
     free
  end;

  RTLCC_SaveLog('RTLCC_CommitReturn:exit');
end;

procedure RTLCC_Repeal;
begin
   RTLCC_SaveLog('RTLCC_CommitRepeal');
   RTLCC_CheckServer;

   with TMyWait.create('Отмена операции по карте',selfscript) do
   try
     //Server.Clear;
     RTLCC_CheckError(Server.NFun(6004),'Отмена операции по карте'); // отмена оплаты
     Server.Clear;
   finally
     free;
   end;
   RTLCC_SaveLog('RTLCC_CommitRepeal:exit');
end;

procedure RTLCC_XReport_Internal;
begin
  RTLCC_SaveLog('RTLCC_xReport_internal');
  RTLCC_CheckServer;
  RTLCC_SaveLog('RTLCC_xReport_internal:1');
  Server.Clear;
  RTLCC_CheckError(Server.NFun(6002),'Отчет без гашения');
  RTLCC_SaveLog('RTLCC_xReport_internal:2');
  ChequeString := Server.GParamSTring('Cheque');
  RTLCC_SaveLog('RTLCC_xReport_internal:2');
  Server.Clear;
  RTLCC_SaveLog('RTLCC_xReport_internal:exit');
end;

procedure RTLCC_XReport;
begin
  RTLCC_SaveLog('RTLCC_xReport');
  if not RTLCC_REPORTS_AUTO then exit;
  RTLCC_SaveLog('RTLCC_xReport:1');
  with TMyWait.create('X-отчет по картам оплаты',selfscript) do
  try
     RTLCC_XReport_Internal;   
     RTLCC_SaveLog('RTLCC_xReport:2');
     RTLCC_PrintCheque(true);  
     RTLCC_SaveLog('RTLCC_xReport:3');
  finally
     free
  end;
  RTLCC_SaveLog('RTLCC_xReport:exit');
end;

procedure RTLCC_ZReport_Internal;
begin
  RTLCC_SaveLog('RTLCC_zReport_internal');
  RTLCC_CheckServer;
  RTLCC_SaveLog('RTLCC_zReport_internal:1');
  Server.Clear;
  RTLCC_CheckError(Server.NFun(6000),'Отчет с гашением');
  RTLCC_SaveLog('RTLCC_zReport_internal:2');
  ChequeString := Server.GParamSTring('Cheque');
  RTLCC_SaveLog('RTLCC_zReport_internal:2');
  Server.Clear;
  RTLCC_SaveLog('RTLCC_zReport_internal:exit');
end;

procedure RTLCC_ZReport;
begin
   RTLCC_SaveLog('RTLCC_ZReport');
   if not RTLCC_REPORTS_AUTO then exit;
   RTLCC_SaveLog('RTLCC_ZReport:1');
   with TMyWait.create('Z-отчет по картам оплаты',selfscript) do
   try
     RTLCC_ZReport_Internal;
     RTLCC_SaveLog('RTLCC_ZReport:2');
     RTLCC_PrintCheque(true);
     RTLCC_SaveLog('RTLCC_ZReport:3');
   finally
     free
   end;
   RTLCC_SaveLog('RTLCC_ZReport:exit');
end;

function RTLCC_ResultDescription(pResult :integer) :string; // внутренняя функция, внешнему модулю не нужна, внешний модуль получает описание через переменную ResultDescription
begin
  RTLCC_SaveLog('RTLCC_ResultDescription');
  case pResult of
    12: Result := 'Неверный тип пинпада, либо проблема с портом';
      //Ошибка возникает обычно в ДОС-версиях. Возможных причин две:
      // 1.	В настройках указан неверный тип пинпада. Должно быть РС-2, а указано РС-3.
      // 2.	Если ошибка возникает неустойчиво, то скорее всего виноват СОМ-порт. Он или нестандартный, или неисправный. Попробовать перенести пинпад на другой порт, а лучше – на USB.
    12: Result := 'Нарушился контакт с пинпадом, либо невозможно открыть указанный СОМ-порт (он или отсутствует в системе, или захвачен другой программой).';

    361, 362, 363, 364: Result := 'Нарушился контакт с чипом карты. Чип не читается. Попробовать вставить другую карту. Если ошибка возникает на всех картах – неисправен чиповый ридер пинпада.';
    403: Result := 'Клиент ошибся при вводе ПИНа (СБЕРКАРТ)';
    405: Result := 'ПИН клиента заблокирован  (СБЕРКАРТ)';
    444,  507: Result := 'Истек срок действия карты  (СБЕРКАРТ)';
    518: Result := 'На терминале установлена неверная дата';
    521: Result := 'На карте недостаточно средств  (СБЕРКАРТ)';
    572: Result := 'Истек срок действия карты  (СБЕРКАРТ)';
    574, 579: Result := 'Карта заблокирована  (СБЕРКАРТ)';
    584, 585: Result := 'Истек период обслуживания карты  (СБЕРКАРТ)';
    705, 706, 707: Result := 'Карта заблокирована  (СБЕРКАРТ)';
    708, 709: Result := 'ПИН клиента заблокирован  (СБЕРКАРТ)';
    2000: Result := 'Операция прервана нажатием клавиши ОТМЕНА. Другая возможная причина – не проведена предварительная сверка итогов, и на терминале еще нет сеансовых ключей.';
    2002: Result := 'Клиент слишком долго вводит ПИН. Истек таймаут.';
    2004, 2005, 2006, 2007, 2405, 2406, 2407: Result := 'Карта заблокирована (СБЕРКАРТ)';
    3001: Result := 'Недостаточно средств для загрузки на карту  (СБЕРКАРТ)';
    3002: Result := 'По карте клиента числится прерванная загрузка средств  (СБЕРКАРТ)';
    3019, 3020, 3021: Result := 'На сервере проводятся регламентные работы  (СБЕРКАРТ)';
    4100: Result := 'Нет связи с банком при удаленной загрузке. Возможно, на терминале неверно задан параметр «Код региона и участника для удаленной загрузки».';
    4101, 4102: Result := 'Карта терминала не проинкассирована';
    4103, 4104: Result := 'Ошибка обмена с чипом карты';
    4108: Result := 'Неправильно введен или прочитан номер карты (ошибка контрольного разряда)';
    4110, 4111, 4112: Result := 'Требуется проинкассировать карту терминала (СБЕРКАРТ)';
    4113, 4114: Result := 'Превышен лимит, допустимый без связи с банком (СБЕРКАРТ)';
    4115: Result := 'Ручной ввод для таких карт запрещен';
    4116: Result := 'Введены неверные 4 последних цифры номера карты';
    4117: Result := 'Клиент отказался от ввода ПИНа';
    4119: Result := 'Нет связи с банком.';
            //Другая возможная причина – неверный ключ KLK для пинпада Verifone pp1000se или встроенного пинпада Verifone.
            //Если терминал Verifone работает по Ethernet, то иногда избавиться от ошибки можно, понизив скорость порта с 115200 до 57600 бод.
    4120: Result := 'В пинпаде нет ключа KLK.';
    4121: Result := 'Ошибка файловой структуры терминала. Невозможно записать файл BTCH.D.';
    4122: Result := 'Ошибка смены ключей: либо на хосте нет нужного KLK, либо в настройках терминала указан неверный мерчант.';
    4123: Result := 'На терминале нет сеансовых ключей';
    4124: Result := 'На терминале нет мастер-ключей';
    4125: Result := 'На карте есть чип, а прочитана была магнитная полоса';
    4128: Result := 'Неверный МАС-код при сверке итогов. Вероятно, неверный ключ KLK.';
    4130: Result := 'Память терминала заполнена. Пора делать сверку итогов (лучше несколько раз подряд, чтобы почистить старые отчеты).';
    4131: Result := 'Установлен тип пинпада РС-2, но с момента последней прогрузки параметров пинпад был заменен (изменился его серийный номер). Необходимо повторно пргрузить TLV-файл или выполнить удаленную загрузку.';
    4132: Result := 'Операция отклонена картой. Возможно, карту вытащили из чипового ридера до завершения печати чека. Повторить операцию заново. Если ошибка возникает постоянно, возможно, карта неисправна.';
    4134: Result := 'Слишком долго не выполнялась сверка итогов на терминале (прошло более 5 дней с момента последней операции).';
    4135: Result := 'Нет SAM-карты для выбранного отдела (СБЕРКАРТ)';
    4136: Result := 'Требуется более свежая версия прошивки в пинпаде.';
    4137: Result := 'Ошибка при повторном вводе нового ПИНа.';
    4138: Result := 'Номер карты получателя не может совпадать с номером карты отправителя.';
    4139: Result := 'В настройках терминала нет ни одного варианта связи, пригодного для требуемой операции.';
    4140: Result := 'Неверно указаны сумма или код авторизации в команде SUSPEND из кассовой программы.';
    4141: Result := 'Невозможно выполнить команду SUSPEND: не найден файл SHCN.D.';
    4142: Result := 'Не удалось выполнить команду ROLLBACK из кассовой прграммы.';
    4143: Result := 'На терминале слишком старый стоп-лист.';
    4144, 4145, 4146, 4147: Result := 'Неверный формат стоп-листа на терминале (для торговли в самолете без авторизации).';
    4148: Result := 'Карта в стоп-листе.';
    4149: Result := 'На карте нет фамилии держателя.';
    4150: Result := 'Превышен лимит, допустимый без связи с банком (для торговли на борту самолета без авторизации).';
    4151: Result := 'Истек срок действия карты (для торговли на борту самолета без авторизации).';
    4152: Result := 'На карте нет списка транзакций (ПРО100).';
    4153: Result := 'Список транзакций на карте имеет неизвестный формат (ПРО100).';
    4154: Result := 'Невозможно распечатать список транзакций карты, потому что его можно считать только с чипа, а прочитана магнитная полоса (ПРО100).';
    4155: Result := 'Список транзакций пуст (ПРО100).';
    4160: Result := 'Неверный ответ от карты при считывании биометрических данных';
    4161: Result := 'На терминале нет файла с биометрическим сертификатом BSCP.CR';
    4162, 4163, 4164: Result := 'Ошибка расшифровки биометрического сертификата карты. Возможно, неверный файл BSCP.CR';
    4165, 4166, 4167: Result := 'Ошибка взаимной аутентификации биосканера и карты. Возможно, неверный файл BSCP.CR';
    4168, 4169: Result := 'Ошибка расшифровки шаблонов пальцев, считанных с карты.';
    4171: Result := 'В ответе хоста на запрос enrollment’a нет биометрической криптограммы.';
    4202: Result := 'Сбой при удаленной загрузке: неверное смещение в данных.';
    4203: Result := 'Не указанный или неверный код активации при удаленной загрузке.';
    4208: Result := 'Ошибка удаленной загрузки: на сервере не активирован какой-либо шаблон для данного терминала.';
    4209: Result := 'Ошибка удаленной загрузки: на сервере проблемы с доступом к БД.';
    4211: Result := 'На терминале нет EMV-ключа с номером 62 (он нужен для удаленной загрузки).';
    4300: Result := 'Недостаточно параметров при запуске модуля sb_pilot. В командной строке указаны не все требуемые параметры.';
    4301: Result := 'Кассовая программа передала в UPOS недопустимый тип операции';
    4302: Result := 'Кассовая программа передала в UPOS недопустимый тип карты';
    4303: Result := 'Тип карты, переданный из кассовой программы, не значится в настройках UPOS. Возможно, на диске кассы имеется несколько каталогов с библиотекой UPOS. Банковский инженер настраивал один экземпляр, а кассовая программа обращается к другому, где никаких настроек (а значит, и типов карт) нет.';
    4305: Result := 'Ошибка инициализации библиотеки sb_kernel.dll. Кассовая программа ожидает библиотеку с более свежей версией.';
    4306: Result := 'Библиотека sb_kernel.dll не была инициализирована.';
                      //Эта ошибка может разово возникать после обновления библиотеки через удаленную загрузку. Нужно просто повторить операцию.
    4308: Result := 'В старых версиях этим кодом обозначалась любая из проблем, которые сейчас обозначаются кодами    4331-4342';
    4309: Result := 'Печатать нечего. Эта ошибка возникает в интегрированных решениях, которые выполнены не вполне корректно: в случае любой ошибки (нет связи, ПИН неверен, неверный ключ KLK и т.д.) кассовая программа все равно запрашивает у библиотеки sb_kernel.dll образ чека для печати. Поскольку по умолчанию библиотека при отказах чек не формирует, то на запрос чека она возвращает кассовой программе код 4309 – печатать нечего, нет документа для печати. Исходный код ошибки (тот, который обозначает причину отказа) кассовая программа при этом забывает.';
    4310: Result := 'Кассовая программа передала в UPOS недопустимый трек2.';
    4313: Result := 'В кассовой программе значится один номер карты, а через UPOS считан другой.';
    4314: Result := 'Кассовая программа передала код операции «Оплата по международной карте», а вставлена была карта СБЕРКАРТ.';
    4332: Result := 'Сверка итогов не выполнена (причина неизвестна, но печатать в итоге нечего).';
    4333: Result := 'Распечатать контрольную ленту невозможно (причина неизвестна, но печатать в итоге нечего).';
    4334: Result := 'Карта не считана. Либо цикл ожидания карты прерван нажатием клавиши ESC, либо просто истек таймаут.';
    4335: Result := 'Сумма не введена при операции ввода слипа.';
    4336: Result := 'Из кассовой программы передан неверный код валюты.';
    4337: Result := 'Из кассовой программы передан неверный тип карты.';
    4338: Result := 'Вызвана операция по карте СБЕРКАРТ, но прочитать карту СБЕРКАРТ не удалось.';
    4339: Result := 'Вызвана недопустимая операция по карте СБЕРКАРТ.';
    4340: Result := 'Ошибка повторного считывания карты СБЕРКАРТ.';
    4341: Result := 'Вызвана операция по карте СБЕРКАРТ, но вставлена карта другого типа, либо не вставлена никакая.';
    4342: Result := 'Ошибка: невозможно запустить диалоговое окно UPOS (тред почему-то не создается).';
    4400..4499:	Result := 'От фронтальной системы получен код ответа '+inttostr(pResult-4400);
    5002: Result := 'Карта криво выпущена и поэтому дает сбой на терминалах, поддерживающих режим Offline Enciphered PIN.';
    5026: Result := 'Ошибка проверки RSA-подписи. На терминале отсутствует (или некорректный) один из ключей из раздела «Ключи EMV».';
    5063: Result := 'На карте ПРО100 нет списка транзакций.';
    5100..5108: Result := 'Нарушены данные на чипе карты';
    5109: Result := 'Срок действия карты истек';
    5110: Result := 'Срок действия карты еще не начался';
    5111: Result := 'Для этой карты такая операция не разрешена';
    5116, 5120: Result := 'Клиент отказался от ввода ПИНа';
    5133: Result := 'Операция отклонена картой.';
    4325: Result := 'Неизвестная ошибка (нулевая сумма?)';
    0: Result := 'Ошибок нет';
    else begin
      Result := 'Неизвестная ошибка '+inttostr(pResult);
    end
  end;
  RTLCC_SaveLog('RTLCC_ResultDescription:exit');
end;


begin
  // инициализация переменных, в том числе тех, что инициализируются дефолтовыми значениями. Всегда запускается программой перед вызовом остальных процедур
  RTLCC_InitVars;
end.