///////////////////////////////////////////////////////////
// МОдуль импорта прайс-листов от поставщиков в сводный прайс-лист
///////////////////////////////////////////////////////////

// DirName должно быть определено одним из следующих способов
const DirName =  'c:\mail\in;c:\mail\Прайсы'; // на случай жесткого запуска по таймеру
//var DirName :string; // Имя базового каталога, в котором происходит поиск, если настроено через сканирование каталогов

const
  SyncWHSCommand = ''; //'D:\SolexW\solexw.exe -user autouser -password 1 -script sync_solaris2.pas -exit';


var Loader :TPriceLoader;

procedure ImportPrice(id_header :double; {ImportScriptName :string;} ImportFile :string;PriceDate :TDatetime);
var ext :string;
    //ScriptName :string;
begin

   loader.id_price := id_header;
   loader.dt_update := pricedate;
   Loader.LoadFromPricesettings(ImportFile);
end;

function ExtractOrigFilename(FName :string) :string;
var iPos:integer;
begin
      Result := Extractfilenamewithoutext(FName);
      if pos('_',result)>0
      then begin
        for ipos:= length(result) downto 2 do
        begin
          if not isdigit(result[ipos])
          then begin
            if (result[ipos] = '_')
            then
              result := copy(result,1,ipos-1);
            break;
          end;
        end;
      end;

    result := Result + extractfileext(fname);
end;


procedure import_prices_from_dir;
var
  FList :TSTringList;
  i :integer;

  CodeOrg :string;

  ID_org :double;
  ID_header :double;


  //SRV :variant;

  StrVAlue :string;
  ScriptName :string;


  last_header :double;

  FName :string;
  FOrigName :string;
  iPos :integer;
  DateFromDir :tdatetime;

begin

  // прием файлов из каталога почты
  FList := TStringlist.create;
  try
    GetFileList(DirName,FList,'*.*',true,true);
    FList.Sorted := true;

    last_header := 0;


    for i := FList.count-1 downto 0 do
    begin
      Loader.ImportCDS.close;
      Loader.ClearFields;

      FName := ExtractFilename(FList[i]);
      FOrigName := ExtractOrigFilename(FList[i]);

      CodeOrg := extractfilepath(FList[i]); // находим первый подкаталог, это есть код даты
      if (codeorg>'') and (codeorg[length(codeorg)]='\') then delete(codeorg,length(codeorg),1);

      StrValue := copy( extractfilename(CodeOrg),1,30);

      DateFromDir := 0;
      if (length(strvalue)=10)
         and isdigit(strvalue[1])
         and isdigit(strvalue[2])
         and isdigit(strvalue[3])
         and isdigit(strvalue[4])

         and (strvalue[5]='-')

         and isdigit(strvalue[6])
         and isdigit(strvalue[7])

         and (strvalue[8]='-')

         and isdigit(strvalue[9])
         and isdigit(strvalue[10])
      then begin

       try

         datefromdir := encodedate(strtoint(copy(strvalue,1,4)),
                        strtoint(copy(strvalue,6,2)),
                        strtoint(copy(strvalue,9,2))
                        );



         CodeOrg := extractfilepath(codeorg); // находим  подкаталог выше, это есть код организации
         if (codeorg>'') and (codeorg[length(codeorg)]='\') then delete(codeorg,length(codeorg),1);
       except
       end;
      end;


      CodeOrg := copy( extractfilename(CodeOrg),1,30);


      ID_header := asfloat( DBQueryValue('select first 1 id from prices_headers where upper(code) = upper(:code) and import_filename is not null and  upper(:filepattern) like upper(import_filepattern) ',[CodeOrg,forigname]));


      if id_header = 0
      then
        ID_header := asfloat( DBQueryValue('select first 1 a.id from prices_headers a join orgs b on a.id_orgs = b.id  where upper(b.code) = upper(:code) and import_filename is not null and  upper(:filepattern) like upper(import_filepattern) ',[CodeOrg,forigname]));

      if id_header = 0
      then
        ID_header := asfloat( DBQueryValue('select first 1 a.id from prices_headers a join orgs b on a.id_orgs = b.id  where upper(b.name) = upper(:code) and import_filename is not null and  upper(:filepattern) like upper(import_filepattern) ',[CodeOrg,forigname]));

      if ID_header = 0
      then begin
                  (*
                  strvalue := 'Не найдено прайс-листов с кодом '+CODEORG+','+
                              ' либо прайс-листов с организаций с таким кодом, либо именем (с настроенными параметрами импорта также)';

                  CreatehIntW(strvalue,'Импорт прайс-листа со склада',60);

                  SRV := CreateOleObject('mailprocessor.SRV');
                  SRV.Connectwp('Пользователь','1');
                  SRV.CreateNotify('Импорт прайс-листа: '+StrValue);
                  *)

        continue;
      end;

      if id_header = last_header
      then begin
          deletefile(flist[i]);
          // этот прайс уже обрабатывался, не надо принимать все его варианты другие
          createhint(FList[i],'Прайс удален как устаревшая копия:',30);
      end
      else begin
        last_header := id_header;

        try


          Loader.waittext := 'Загрузка файлов: '+inttostr(flist.count-i+1)+'/'+inttostr(flist.count)+' - '+CODEORG;
          importprice(id_header ,{scriptname,} FList[i],DateFromDir);

          createhinti(Flist[i],'Прайс импортирован',30);

          deletefile(flist[i]); // согласно новому exe deletefile(extractfilepath(fList[i])+'ARCSKLAD.ZIP');

        except
          //try
            createhinte('Файл: '+Flist[i]+#13+ExceptMessage,'Ошибка импорта',0);

            // Здесь нужно включить собственные нотификации
            //SRV := CreateOleObject('mailprocessor.SRV');
            //SRV.Connectwp('Пользователь','1');
            //SRV.CreateNotify(ExceptMessage);

            //CreateNotify(IDMessage: Integer; Msg: string; Sender: string = ''; Subject: string = ''; NOtifyLogType: TNotifyLogTypes = atInformation)

          //except
            //createhinte(ExceptMessage,'Сохранение уведомления в MailProcessor',0);
          //end;

        end;
      end;
    end;

    CreateHint('Обработано файлов: '+inttostr(FList.Count));

  finally
    FList.free
  end;
end;

procedure import_prices_from_http;
var
  FName :string;
  id_header :double;
  httpfile :string;
  FDate :tdatetime;

  CDS:tclientdataset;
begin

  // прием файлов из http://, адреса указаны в поле "шаблон файла" в шапках (prices_headers.import_filepattern);

  cds := tclientdataset.create(selfscript);
  try
   DBReadQuery(cds,
               'select * from prices_headers where upper(import_filepattern) starting ''HTTP://'' ',
               [null]);

   cds.first;
   while not cds.eof do
   begin
      id_header := cds.fieldbyname('id').asfloat;
      httpfile := cds.fieldbyname('import_filepattern').asstring;

      Loader.ImportCDS.close;
      Loader.ClearFields;

      try

        Loader.waittext := 'Загрузка прайс-листов с ресурсов: '+inttostr(cds.recno)+'/'+inttostr(cds.recordcount)+#13+httpfile;

        fname := GetUniqueFileName(gettempdir,'tempimportfile'+extractfileext(httpfile));
        if fileexists(fname) then deletefile(fname);

        with tmywait.create1('Идет загрузка файла '+httpfile, selfscript) do
        try
           URLDownloadToFileSimple( httpfile, fname);
          //SynHttpGetBinary(const URL: string; const Response: TStream): Boolean
        finally
          free
        end;

        if fileexists(fname)
        then
          importprice(id_header , fname,fdate);

        createhinti(httpfile,'Прайс импортирован',30);

        deletefile(fname);

      except
        //try
          createhinte('Файл: '+httpfile+#13+ExceptMessage,'Ошибка импорта',0);

          // Здесь нужно включить собственные нотификации
          //SRV := CreateOleObject('mailprocessor.SRV');
          //SRV.Connectwp('Пользователь','1');
          //SRV.CreateNotify(ExceptMessage);

          //CreateNotify(IDMessage: Integer; Msg: string; Sender: string = ''; Subject: string = ''; NOtifyLogType: TNotifyLogTypes = atInformation)

        //except
          //createhinte(ExceptMessage,'Сохранение уведомления в MailProcessor',0);
        //end;

      end;


     cds.next;
   end;
  finally
   cds.free;
  end;
end;

procedure import_prices_from_ftp;

  //ftp://ИмяПользователя:Пароль@АдресУзла:порт/Путь/ИмяФайла;ТипРесурса
  procedure ParseFTPSTring1(Source :string; var IP,Port,Filepath,Filename,Username,Password :string);
  var strvalue :string;
      intval :integer;
      intval1 :integer;
  begin
    IP :='';
    Port  := '21';
    Filepath := '';
    Filename := '';
    Username := '';
    Password := '';


    source := trim(source);
    if source='' then exit;

    if uppercase(copy(source,1,6))<>'FTP://' then exit;

    delete(source,1,6);


    intval := pos(';',source);
    if intval>0 then delete(source,intval,length(source));


    intval := pos('@',source);
    if intval>0
    then begin
      strvalue := copy(source,1,intval-1);
      intval1 := pos(':',strvalue);
      if intval1 = 0 then username := strvalue
      else begin
        username := copy(strvalue,1,intval1-1);
        password := copy(strvalue,intval1+1,length(strvalue));
      end;


      delete(source,1,intval);
    end;

    intval := pos('/',source);
    if intval=0 then exit;

    filename := copy(source,intval+1,length(source));
    intval1 := pos('/',filename);
    while intval1>0
    do begin
      filepath := filepath+copy(filename,1,intval1);
      filename := copy(filename,intval1+1,length(filename));
      intval1 := pos('/',filename);
    end;

    strvalue := copy(source,1,intval-1);
    intval1 := pos(':',strvalue);
    if intval1>0
    then begin
      ip := copy(strvalue,1,intval1-1);
      port := copy(strvalue,intval1+1,length(strvalue));
    end
    else
      ip := strvalue;
  end;

var
  FName :string;
  id_header :double;
  ftpstring :string;
  FDate,FDATE1 :tdatetime;
  tmpdir :string;

  CDS:tclientdataset;

var
  IP,Port,Filepath,Filename,Username,Password :string;

begin

  // прием файлов из ftp://, адреса указаны в поле "шаблон файла" в шапках (prices_headers.import_filepattern);
  //шаблон FTP-схемы: ftp://ИмяПользователя:Пароль@АдресУзла:порт/Путь/ИмяФайла;ТипРесурса


  cds := tclientdataset.create(selfscript);
  try
   DBReadQuery(cds,
               'select * from prices_headers where upper(import_filepattern) starting ''FTP://''',
               [null]);

   cds.first;
   while not cds.eof do
   begin
      id_header := cds.fieldbyname('id').asfloat;
      ftpstring := cds.fieldbyname('import_filepattern').asstring;

      Loader.ImportCDS.close;
      Loader.ClearFields;

      try

        tmpdir := '';
        Loader.waittext := 'Загрузка прайс-листов с ресурсов: '+inttostr(cds.recno)+'/'+inttostr(cds.recordcount)+#13+ftpstring;

        with tmywait.create1('Идет загрузка файла '+ftpstring, selfscript) do
        try

          ParseFTPSTring1(ftpstring,
                      IP,Port,filepath,Filename,Username,Password);

          if (ip>'') and (filename>'')
          then begin

             tmpdir := includetrailingpathdelimiter(createuniquedir);

             advancedtext := 'проверка обновлений';

             fdate := SynFtpGetFileDateTime(ip,
                                   port,
                                   filepath+filename,
                                   username,
                                   password);

             fdate1 := asdatetime(dbQueryvalue('select update_org from prices_headers_upd where id = :id',[id_header]));

             if (fdate<>0) and (fdate1<fdate)
             then begin
               advancedtext := 'чтение нового файла';

               SynFtpGetFile(ip,
                                     port,
                                     filepath+filename,
                                     tmpdir+filename,
                                     username,
                                     password);


               if fileexists(tmpdir+filename)
               then begin
                  importprice(id_header , tmpdir+filename,fdate);
               end;

               createhinti(ftpstring,'Прайс импортирован',30);

             end;
          end;
        finally
          free
        end;

        if tmpdir<>''
        then begin
          deletedir(tmpdir);
        end;


      except
        //try
          createhinte('Файл: '+ftpstring+#13+ExceptMessage,'Ошибка импорта',0);

          // Здесь нужно включить собственные нотификации
          //SRV := CreateOleObject('mailprocessor.SRV');
          //SRV.Connectwp('Пользователь','1');
          //SRV.CreateNotify(ExceptMessage);

          //CreateNotify(IDMessage: Integer; Msg: string; Sender: string = ''; Subject: string = ''; NOtifyLogType: TNotifyLogTypes = atInformation)

        //except
          //createhinte(ExceptMessage,'Сохранение уведомления в MailProcessor',0);
        //end;

      end;


     cds.next;
   end;
  finally
   cds.free;
  end;
end;

begin
  try
    Loader := TPriceLoader.create(selfscript);
    import_prices_from_http;
    import_prices_from_ftp;
    import_prices_from_dir;

    if SyncWHSCommand<>''
    then
    try
      Fileexecutewait(SyncWHSCommand,esnormal);
    except
      createhinte(exceptmessage,'Ошибка выполнения удаленной команды: '+syncwhscommand,0);
    end;
  finally
   // Application.terminate;
  end;

end.