//********************************
// Скрипт импорта почты, не являющейся стандартной с точки зрения MailProcessor
// Все вложения в поступающей почте извлекаются в каталог импорта согласно настройкам адресной книги
//********************************

var
    Result :integer; // предопределенная переменная.
    VARID :double; // предопределенная переменная. ID письма.
    VARExport_dir :string; // каталог экспорта
    VARUse_Date_As_Subdir :boolean;

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


const UseAddressBookControl = false; // использовать ли контроль адресной книгой, то есть удалять ли письма, если они от неизвестного адресата
      //UseDateAsSubdir = true; // создавать ли подкаталог в виде даты

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


      AutoUnpackCommand = '' ;//"c:\program files\7-zip\7z.exe" x -y "%s" -o"%s"'; // указать команду распаковки (если не указывать, то пропускаем). Файл распаковки указывается как %s, например:  '7z.exe -e %s'. Второй знак %s будет использоваться (если он указан, под имя экспортного каталога)
      ExecState = esNormal; // статус выполнения процесса autounpackcommand (удобно для отладки). Варианты - esHidden,EsMaximized, EsMinimized,esNormal
      ArchiveTypes = 'RAR;ZIP;7Z'; // типы архивов, которые будут распаковываться, через запятую или точку с запятой


      (*
      UseFarmnetOrders = true; // включить специальную автоматизацию импорта заявок из фармнета. отличие от стандартного метода тем, что в каталоге "Фармнет" создаются дополнительные подкаталоги согласно теме письма
      FarmnetAddress = 'order@farmnet.ru'; // адрес фармнета. в адресную книгу вносить его не нужно.
      FarmnetName = 'Фармнет';
      FarmnetTag = '(FarmNet Order system)'; // Эта метка должна стоять для всех заказов. иначе это что-то другое и тогда не юзать.
      FarmnetUseFilialAsSubdir = false;


      UseInfoASOrders = true; // включить специальную автоматизацию импорта заявок из ИнфоАналитСистемы. отличие от стандартного метода тем, что в каталоге "ИНФОАС" создаются дополнительные подкаталоги согласно имени заказчика
      InfoASAddress = 'orders@infoas.biz'; // адрес системы, откуда поступают заказы. в адресную книгу вносить его не нужно.
      InfoASName = 'ИнфоАС';
      InfoASTag = 'Заказ №'; // Эта метка должна стоять в теме для всех заказов. иначе это что-то другое и тогда не юзать.
      InfoAsUseNameFromSubj = false;
      InfoAsUseFilialAsSubdir = false;
      *)

//var
//    CurrUseDateAsSubdir :boolean = VAR_Use_Date_As_Subdir;

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 //Message :Variant;
    Message :TMailMessage;


    //AddressBook :Variant;
    i :integer;

    Dir :string;
    List :tstringlist;
    S :string;
    S1 :string;
    S2 :string;
    SenderName :string;

    //FarmnetTagPos :integer;
    //INFOASTagPos :integer;

    List1 :TSTringLIst;
    fname :string;

    tmpDir :string = '';

begin

  //ID := 910;


  result := 0;
  List := Tstringlist.create;
  Message := TMailMessage.create; // CreateOleObject('MailProcessor.MPMailMessage');
  //if useaddressbookcontrol then AddressBook := CreateOleObject('MailProcessor.AddressBook');
  try


    Message.ID := VARID;

    {
    FarmnetTagPos := pos(FarmnetTag,Message.Subject);
    InfoASTagPos :=  pos(INFOASTAG,Message.subject);

    if useFarmnetOrders and ( Message.SenderAddress = FarmnetAddress) and (FarmnetTagPos>0)
    then begin
      SenderName := FarmnetName;
    end
    else if useInfoASOrders and ( Message.SenderAddress = InfoASAddress) and (InfoASTagPos>0)
    then begin
      SenderName := INFOASName;
    end
    else }
    if useaddressbookcontrol
    then begin
      SenderName := asstring(DBQueryValue('select name from addressbook where mail = :mail',[Message.SenderAddress]));

    end
    else SenderName := '';


    if not useaddressbookcontrol or (SenderName<>'')
    then begin
       if Message.AttachmentCount>0
       then begin

         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);

         //showmessage(farmnetaddress+' : '+message.senderaddress);
         {
         if UseFarmnetOrders
            and (Message.SenderAddress = FarmnetAddress)
            and (FarmnetTagPos>0)
         then begin
            s1 := Message.Subject;
            delete(s1,FarmnetTagPos,1000);

            Dir := includetrailingpathdelimiter(dir + trim(correctfilename( S1)));
            //showmessage('2:'+dir);

         end
         else if UseINFOASOrders
                and (Message.SenderAddress = INFOASAddress)
                and (InfoASTagPos>0)
                and (message.AttachmentCount=1)
         then begin
            //createhinti('1');
            fname := gettempdir + Message.Attachmentnames;
            deletefile(fname);

            Message.SaveAttachment(Message.AttachmentNames,gettempdir);
            list.loadfromfile(fname);
            deletefile(fname);
            if list.count>1
            then begin

              s1 := list[0]; //Заказчик : ООО "Пациент" (Филиал: Пациент )
              delete(s1,1,11);

              Dir := includetrailingpathdelimiter(dir + trim(correctfilename( S1)));

            end;
         end;
         }

         if VARUse_Date_As_SubDir
         then
           Dir := includetrailingpathdelimiter(Dir + formatdatetime('yyyy-mm-dd',date));

         //showmessage(dir);
         ForceDirectories(Dir);
         //if directoryexists(Dir) then Showmessage(Dir+ ' : Exists') else ShowMessage(Dir+ ' :  not exists');
         //showmessage('1');

         StringtoList(Message.AttachmentNames,List);

         for i := 0 to List.count-1 do begin
           s := list[i];
           if CreateNewFileNameIfExists and fileexists(Dir+S)
           then begin
             S1 := extractfilename(GetUniqueFileName(Dir,S));
           end
           else begin
             s1:= S;
           end;

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

           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)));



           try
             if (autounpackcommand>'') and (ArchiveTypes >'')
             then begin
               List1 := Tstringlist.create;
               try
                 stringtoList(ansiuppercase(ArchiveTypes),List1,';,');

                 S2 := Ansiuppercase(ExtractFileExt(S1));
                 if pos('.',S2)=1 then delete(s2,1,1);

                 if List1.indexof( S2)>=0
                 then begin
                   //createhinti(format( AutoUnpackCommand,[Dir+S1,Dir]));
                   FileExecuteWait(format( AutoUnpackCommand,[Dir+S1,Dir]), ExecState);
                 end;
               finally
                 List1.free;
               end;
             end;
           except
             CreateHIntE(ExceptMessage,'Ошибка при распаковке файла');
           end
         end;

         CreateHintI('Поступила почта от '+Message.Sender+'. Вложения сохранены в '+dir);
         Message.IsProcessed := true;
       end
       else begin
         CreateHIntW('Письмо от '+Message.SenderName+' не содержит вложений, помечено как "обработанное"');
         Message.IsProcessed := true;
       end;
    end
    else begin
      CreateHintW('Письмо от неизвестного адресата, удаляем');
      Message.delete;
    end;
  finally
    //AddressBook := nil;
    //Message := nil;
    if tmpdir >'' then deletedir(tmpdir);
    Message.free;
    List.free;
  end;
end.