//********************************
// Скрипт импорта заявок, поступающих от Аббат
// Настраивается в параметре "Скрипт импорта почты" в адресной книге
//********************************


const
      CreateNewFileNameIfExists = true; // создавать ли новое имя, если уже существует старое

      PreqTag = 'Заказ'; // Эта метка должна стоять в теме для всех заказов. иначе это что-то другое и тогда не юзать.
      UseStoreAsSubdir = true;


      SYSTAGDELIMITER='//BVSOFT';
      SYSTAGNN_PRODUCER='{NN_PRODUCER}';

const
    DoLogFile = false; // вести лог экспорта по контрагентам

procedure AddStringToLog(Value :string);
var Fname :string ;
    List :TStringList;
begin
  Fname := GetAppLocaldataFolder + 'ExtractFilesLog.log';
  List := tstringlist.create;
  try
    if fileexists(FName) then List.loadfromfile(FName);
    List.add(datetimetostr(now)+' : '+Value);
    List.SaveToFile(FName);
  finally
    list.free;
  end;

end;



var
    Result :integer;
      //возврат - result 0,1,... 0 - ничего не делать, предполагается. что скрипт все сам сделал.
      //1 - стандартно, скрипт или ничего не сказал или не отработал.


    VARID :int64; // предопределенная переменная. ID письма.
    VARExport_dir :string; // каталог экспорта
    VARUSE_Date_As_Subdir :string;
    VARADDRESSBOOK_ID :int64;
    VARADDRESSBOOK_NAME :string;
    VARADDRESSBOOK_ENABLED :boolean;
    VARADDRESSBOOK_MAIL :string;
    VARADDRESSBOOK_EXTERNAL_CODES :string;
    VARADDRESSBOOK_AUTOMAIL_SCRIPT :string;


var
    Message :TMailMessage;

    i,i1 :integer;

    Dir :string;
    FileText :tstringlist;
    S :string;
    S1 :string;
    S2,s3 :string;
    SenderName :string;

    PreqTagPos :integer;

    fname :string;
    tmpdir :string = '';

begin

  Message := TMailMessage.create; // CreateOleObject('MailProcessor.MPMailMessage');
  try


     Message.ID := asfloat(VARID);

     PreqTagPos := pos(PreqTag,Message.Subject);
     if  (PreqTagPos=0) then exit;

     SenderName := VARADDRESSBOOK_EXTERNAL_CODES;
     repeat // возьмем последний из кодов для этой процедуры
       i := pos(',',sendername);
       if i=0 then i:= pos(';',sendername);
       if i>0 then sendername := copy(sendername,i+1,length(sendername));
     until i=0;
     if (SenderName='') then exit;


     if Message.AttachmentCount<>1 then exit;

     Dir := Includetrailingpathdelimiter(VARExport_Dir);

     if SenderName >'' then Dir := Dir + SenderName
     else if Message.SenderName>'' then Dir := Dir + Message.SenderName
     else Dir := Dir + Message.SenderAddress;

     Dir := IncludeTrailingpathdelimiter(Dir);

     // окончательный каталог будет сформирован после чтения файла, ибо в теме не дается уточнения по филиалу


     begin
       s := Message.AttachmentNames;

       tmpdir := includetrailingpathdelimiter(createuniquedir);
       Message.SaveAttachment(S,tmpdir);

       FileText := tstringlist.create;
       try
         filetext.loadfromfile(tmpdir+s);


         //Заказчик : ООО "АББат М"  (Филиал: Основной)
         //Комментарий к заявке : апт 350, г.Саратов, пр-т 50 лет Октября, 116 А
         if filetext.count<2 then exit;
         S2 := copy(filetext[0],12,length(filetext[0]));
         i := pos('(',s2);
         if i>0 then s2 := copy(s2,1,i-1);

         if trim(s2)='' then exit;

         //filetext[0] := filetext[0]+ SYSTAGDELIMITER + SYSTAGNN_PRODUCER;
         //Filetext.SaveToFile(tmpdir+s);


         S3 := trim(correctfilename(copy(filetext[1],23,length(filetext[1]))));
         if s3='' then exit;

         if not UseStoreAsSubDir
         then begin
           Dir := includetrailingpathdelimiter(dir + trim(correctfilename( S2 + ' ' +S3)))
         end
         else begin
             Dir := includetrailingpathdelimiter(
                       dir +
                       includetrailingpathdelimiter(trim(correctfilename( S2)))
                    );

             if s3>'' then Dir := includetrailingpathdelimiter(dir + s3);
         end;

       finally
         filetext.free
       end;

       forcedirectories(Dir);;

       if CreateNewFileNameIfExists and fileexists(Dir+S)
       then begin
         S1 := extractfilename(GetUniqueFileName(Dir,S));
       end
       else begin
         s1:= S;
       end;


       if not CreateNewFileNameIfExists and fileexists(Dir+S)
       then begin
         DeleteFile(Dir+S1); //movefile - не затрет сам
       end;

       MoveFile(tmpdir + S,Dir+S1);
       if DoLogFile then AddStringToLog(Dir+S1+ ' ,exists: '+asstring(fileexists(Dir+S1)));
     end;

     CreateHintI('Поступила заявка из Медзаказ от '+Message.Sender+'. Вложения сохранены в '+dir);
     Message.IsProcessed := true;

     result := 0; // письмо обработано, дальне обслуживатьь скриптами его не нужно



  finally
    //AddressBook := nil;
    //Message := nil;
    if tmpdir >'' then deletedir(tmpdir);
    Message.free;
  end;
end.
