//******************************** // Скрипт импорта заявок, поступающих из М-Аптека - ИП Алашников // Настраивается в параметре "Скрипт импорта почты" в адресной книге //******************************** const CreateNewFileNameIfExists = true; // создавать ли новое имя, если уже существует старое. Если нет, то одноименные файлы будут потерты более свежими версиями PreqTag = 'Заказ'; // Эта метка должна стоять для всех заказов. иначе это что-то другое и тогда не юзать. UseStoreAsSubdir = true; SYSTAGDELIMITER='//BVSOFT'; // в первой строке текста будем делать вставку с тэгами, // сообщающими нужные сведения скрипту импорта из фармнета // какие бывают тэги - смотреть можно в файле скрипта импорта из фармнета SYSTAGNN='{NN}'; // Тэг, указывающий, что в качестве кода товара используется поле tovar.nn (а не tovar.id, как по-умолчанию делается фармнетом) SYSTAGID_ORG='{ID_ORG}'; // код организации в нашем справочнике SYSTAGID_ORG1='{ID_ORG1}'; // код грузополучателя в нашем справочнике 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 :boolean; // константа, передает настройку соляриса "создавать подкаталоги, соответствующие дате письма VARADDRESSBOOK_ID :int64; // ID контрагента из адресной книге, по которому отрабатывает данный скрипт VARADDRESSBOOK_NAME :string; // имя контрагента в адресной книге VARADDRESSBOOK_ENABLED :boolean; // активен ли данный контрагент VARADDRESSBOOK_MAIL :string; // адрес контрагента VARADDRESSBOOK_EXTERNAL_CODES :string; // внешние коды контрагента (могут быть перечислены через запятую или точку с запятой) VARADDRESSBOOK_AUTOMAIL_SCRIPT :string; // собственно скрипт, который сейчас и исполняется var Message :TMailMessage; i :integer; Dir :string; S :string; S1 :string; S2 :string; SenderName :string; PreqTagPos :integer; List1 :TSTringLIst; List2 :tstringlist; List3 :tstringlist; FileList :TStringList; FLI :integer; fname :string; tmpDir :string = ''; //Table :TAdoTable; Table :TDBF; ORGNAME :string; strval :string; begin Message := TMailMessage.create; 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; // если количество вложение не 1, то это не заявка, выходим // формируем каталог, куда будем класть заявку 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); s1 := Message.Subject; delete(s1,1 ,PreqTagPos); // удаляем, собственно, тэг, зачем он нам // пример темы из их писем: Заказ ИП Алашников К.В. Бульвар Энгельса 22а // поскольку они пока что не дают разделителей между названием и адресом, то используем всю строку и как название и как адрес, пожалуй. // позже ,если дадут разделитель, то переделаем orgname := s1; //Dir := includetrailingpathdelimiter(dir + trim(correctfilename( orgname))); if UseStoreAsSubDir // негде тут склад взять пока что, пропускаем then begin end; if VARUse_Date_As_SubDir // делаем, как настроено в майлпроцессоре - с датами-подкаталогами then Dir := includetrailingpathdelimiter(Dir + formatdatetime('yyyy-mm-dd',date)); ForceDirectories(Dir); // проверка каталога на наличие и создание, если не существует s := Message.AttachmentNames; FileList := Tstringlist.create; try StringToList(s,FileList); for fli := 0 to Filelist.count-1 do begin S := Filelist[fli]; // читаем файл, переводим в наш формат if extractfileext(uppercase(s))='.TXT' then begin 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); list1 := tstringlist.create; // сюда считаем файл list2 := tstringlist.create; // сюда запишем файл list3 := tstringlist.create; // сюда будем считывать содержимое каждой строки try list1.loadfromfile(tmpdir+S); if list1.count=0 then begin createhintw('файл вложения '+S+' пуст!'); exit; end; stringtolist(list1[0],list3,';'); // считаем первую строку в list3, разделитель - ';' { 1-я строка: 1) Комментарии 2) Код точки доставки в системе поставщика 3) Число заказанных позиций (строк в заказе) 4) Номер документа в нашей системе (разный для разных заказов) 5) Дата и время заказа 6) Дата прайс-листа (если поставщик выдавал, иначе пусто) 2-я и последующие строки - данные по заказанным позициям } if list3.count<6 then begin createhintw('Первая строка заявки '+S+' имеет неправильный формат'); exit; end; list2.add('Заказчик : '+Orgname + SYSTAGDELIMITER + SYSTAGNN+{SYSTAGID_ORG+INTTOSTR(ID_ORG)+} SYSTAGID_ORG1+list3[1]); List2.add('Комментарий к заявке: '+ list3[0]); list2.add('Время отправления : '+list3[4]); // создаем тело заявки for i := 1 to list1.count-1 do begin stringtolist(list1[i],list3,';'); if list3.count<3 then begin createhintw('Строки заявки имеют неправильное количество полей'); exit; end; list2.add(list3[1]+#9+list3[0]+#9+''+#9+''+#9+''+#9+list3[2]); // название товара нам не указали, как и производителя, так что выдаем пустые строки. Но в заявке видно все, когда есть код end; LIST2.savetofile(tmpdir+s); finally list3.free; list2.free; list1.free; end; if not CreateNewFileNameIfExists and fileexists(Dir+S) then begin DeleteFile(Dir+S1); //movefile - не затрет сам end; MoveFile(TmpDir + S,Dir+S1); end else begin createhintw('Скрипт рассчитан на прием текствого файла, обратитесь в техподдержку. '+#13+'Файл: '+S); exit; end; end finally FileList.free; end; CreateHintI('Поступила заявка от '+Message.Sender+'. Вложения сохранены в '+dir); Message.IsProcessed := true; result := 0; // письмо обработано, дальне обслуживатьь скриптами его не нужно finally //AddressBook := nil; //Message := nil; if tmpdir >'' then deletedir(tmpdir); Message.free; end; end.