Форум: "Сети";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];

Вниз

pop3 получение вложения   Найти похожие ветки 

← →
ilias1979   (2005-06-16 15:43) [0]

Стоит задача автоматически получить почту, отфильтровать вложения, и те которые соответствуют определенным критериям переложить в специальную папку. В принципе она решается установкой MS OUTLOOK Он легко автоматизируется и я знаю как из D7 решить с помощью него свою проблему. Проблема в том что речь идет о сервере и есть противники установки на нем office
Нашел в сети несколько статей о компоненте NMPOP3 со страницы  FastNet который позволяет сделать все вышеописанное, но хоть убейте никак не могу найти у себя в D7 ни эту страницу ни этот компонент. Или эта страница была только в старых версиях или вообще fastnet надо дополнительно устанавливать. Скиньте мне пожалуйста кто знает или ссылки на этот FastNet или может есть другие удобные компоненты для работы с почтовыми вложениями и POP3

---

← →
имя   (2005-06-16 15:50) [1]

Удалено модератором

---

← →
АНТИСпаммер   (2005-06-25 00:28) [2]

FastNet только в D6
Используй TIdPOP3

---

← →
Slym ©   (2005-06-28 11:13) [3]

Моя очень старая прога: получает почту-> архивирует с паролем-> отправляет на др. почтовый ящик (вырезано- не влазит в форум).... Переделать в сервис осталось чтоб на сервере крутился

program MailRobot;

uses
 Windows,
 Messages,
 SysUtils,
 Classes,
 IniFiles,
 IdSMTP,
 IdPOP3,
 IdMessage;
type
 TMRState=(emrStart,emrGetMail,emrProcessMail,emrSendMail,emrStop);

var
 IniFile:TIniFile;
 IdPOP31: TIdPOP3;
 IdSMTP1: TIdSMTP;

 LogFile,CmdLine:string;
 MailPath,ArcPath,SendedPath:string;
 FromName,FromAddress,ToAddress,Subject,Body:string;
 NotifyWndName,NotifyWndClass:string;

procedure LogMessage(const FileName,Msg:string);
var
 hFile,len:DWORD;
 TSMsg:string;
begin
 hFile:=CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_ALWAYS,0,0);
 if hFile=INVALID_HANDLE_VALUE then exit;
 try
   SetFilePointer(hFile,-1,nil,FILE_END);
   TSMsg:=DateTimeToStr(Now)+#9+Msg+#13#10#0;
   WriteFile(hFile,PChar(TSMsg)^,Length(TSMsg),len,nil);
 finally
   CloseHandle(hFile);
 end;
end;

procedure Notify(step:TMRState;code:integer);
var hWnd:longint;
begin
 if (length(NotifyWndClass)=0) or (length(NotifyWndName)=0) then exit;
 hWnd:=FindWindow(PChar(NotifyWndClass),PChar(NotifyWndName));
 PostMessage(hWnd,WM_USER+1024,integer(step),code);
end;

procedure EnumFiles(const Where,Mask:string;OEM:boolean;FileList:TStringList);
var
 Path:string;
 EMode:Dword;
 OemStr:array[0..511] of Char;
 FD:TWin32FindData;
 hSearch:DWORD;
begin
 Path:=IncludeTrailingPathDelimiter(Where);
 FileList.Clear;
 EMode:=SetErrorMode(SEM_FAILCRITICALERRORS);
 try
   hSearch:=FindFirstFile(PChar(Path+mask),FD);
   if hSearch=INVALID_HANDLE_VALUE then exit;
   try
     repeat
       if FD.dwFileAttributes<>FILE_ATTRIBUTE_DIRECTORY then
       begin
         if OEM then
         begin
           CharToOem(PChar(Path+FD.cFileName),OemStr);
           FileList.Add(StrPas(OemStr));
         end else
           FileList.Add(Path+FD.cFileName);
       end;
     until not FindNextFile(hSearch,FD);
   finally
     Windows.FindClose(hSearch);
   end;
 finally
   SetErrorMode(EMode);
 end;
end;

procedure InitSettings;
begin
 with IniFile do
 begin
   NotifyWndClass:=ReadString("TRAYAGENT","NotifyWndClass","");
   NotifyWndName:=ReadString("TRAYAGENT","NotifyWndName","");
   CmdLine:=ReadString("ARC","CmdLine","");
   LogFile:=ReadString("STORAGE","LogFile","log.txt");
   MailPath:=ReadString("STORAGE","MailPath","Recv");
   ArcPath:=ReadString("STORAGE","ArcPath","Arc");
   SendedPath:=ReadString("STORAGE","SendedPath","Sended");

   FromName:=ReadString("SMTP","FromName","");
   FromAddress:=ReadString("SMTP","FromAddress","");
   ToAddress:=ReadString("SMTP","ToAddress","");
   Subject:=ReadString("SMTP","Subject","");
   Body:=ReadString("SMTP","Body","");
 end;
end;

procedure GetMail;
 function GetID(const MessageId:string):string;
 var b,e:integer;
 begin
   b:=pos("<",MessageId)+1;
   e:=pos("@",MessageId);
   result:=copy(MessageId,b,e-b);
 end;
var
 MsgCount,i:longint;
 AMsg: TIdMessage;
 Buf:TMemoryStream;
 FileName:string;
 error:boolean;
begin
 error:=false;
 try
   IdPOP31.Connect;
   MsgCount:=IdPOP31.CheckMessages;
   if MsgCount>0 then
   begin
     AMsg:=TIdMessage.Create(nil);
     try
       Buf:=TMemoryStream.Create;
       try
         for i:=1 to MsgCount do
         begin
           Buf.Clear;
           try
             if not IdPOP31.RetrieveHeader(i,AMsg) then Abort;
             if not IdPOP31.RetrieveRaw(i,Buf) then Abort;
             FileName:=GetID(AMsg.MsgId)+".eml";
             Buf.SaveToFile(MailPath+FileName);
             if not IdPOP31.Delete(i) then
             begin
               DeleteFile(MailPath+FileName);
               Abort;
             end;
             LogMessage(LogFile,"RECV"+#9+FileName+#9+"FROM"+#9+AMsg.From.Address);
           except
             on E:Exception do
             begin
               LogMessage(LogFile,"RECV Error! "+E.Message);
               error:=true;
             end;
           end;
         end;
       finally
         Buf.Free;
       end;
     finally
       AMsg.Free;
     end;
   end;
   if error then Abort;
   Notify(emrGetMail,0)
 except
   on E:Exception do
   begin
     if not(E is EAbort) then
       LogMessage(LogFile,"POP3 ConnectionFailed! "+E.Message);
     Notify(emrGetMail,1)
   end;
 end;
 IdPOP31.DisconnectSocket;
end;

procedure ProcessMail;
var
 ArcName,NCmdLine,Files:string;
 MailList:TStringList;
 SI:TStartupInfo;
 PI:TProcessInformation;
 i:integer;
 err:boolean;
 ExitCode:DWORD;
begin
 err:=false;
 MailList:=TStringList.Create;
 try
   EnumFiles(MailPath,"*.eml",true,MailList);
   if MailList.Count>0 then
   begin
     Files:=ExtractFilePath(ParamStr(0))+"files.log";
     MailList.SaveToFile(Files);
     ArcName:=ExtractFilePath(ArcPath)+FormatDateTime("ddMMyy_hhnnss",Now)+".rar";

     NCmdLine:=StringReplace(CmdLine,"<ARCFILE>","""+ArcName+""",[rfReplaceAll, rfIgnoreCase]);
     NCmdLine:=StringReplace(NCmdLine,"<LISTFILE>","""+Files+""",[rfReplaceAll, rfIgnoreCase]);

     FillChar(SI,Sizeof(SI),#0);
     SI.cb:=Sizeof(SI);
     SI.wShowWindow:=SW_HIDE;//SW_SHOW;
     SI.dwFlags:=STARTF_USESHOWWINDOW;
     if CreateProcess(nil,PChar(NCmdLine),nil,nil,false,0,nil,PChar(ExtractFilePath(ParamStr(0))),SI,PI) then
       if WaitForSingleObject(PI.hProcess,INFINITE)=WAIT_OBJECT_0 then
       begin
         GetExitCodeProcess(PI.hProcess,ExitCode);
         if ExitCode<>0 then
         begin
           err:=true;
           LogMessage(LogFile,"ARC"+#9+"ERROR"+#9+"RAR EXIT CODE:"+#9+IntToStr(ExitCode));
         end else
           for i:=0 to MailList.Count-1 do
             LogMessage(LogFile,"ARC"+#9+ExtractFileName(MailList[i])+#9+"IN"+#9+ExtractFileName(ArcName));
       end
       else err:=true
     else err:=true;
   end;
 finally
   MailList.Free;
 end;
 if err then Notify(emrProcessMail,1)
 else  Notify(emrProcessMail,0);
end;

begin
 IniFile:=TIniFile.Create(ExtractFilePath(ParamStr(0))+"settings.ini");
 try
   InitSettings;
   LogMessage(LogFile,"Runing...");
   Notify(emrStart,0);

   IdPOP31:=TIdPOP3.Create(nil);
   try
     IdPOP31.Host:=IniFile.ReadString("POP","Host","");
     IdPOP31.Username:=IniFile.ReadString("POP","UserID","");
     IdPOP31.Password:=IniFile.ReadString("POP","Password","");
     GetMail;
   finally
     IdPOP31.Free;
   end;

   ProcessMail;

   IdSMTP1:=TIdSMTP.Create(nil);
   try
     IdSMTP1.MailAgent:="XMail Robot";
     IdSMTP1.Host:=IniFile.ReadString("SMTP","Host","");
     IdSMTP1.Username:=IniFile.ReadString("SMTP","UserID","");
     if IniFile.ReadBool("SMTP","Auth",false) then
     begin
       IdSMTP1.AuthenticationType:=atLogin;
       IdSMTP1.Password:=IniFile.ReadString("SMTP","Password","");
     end;
     SendMail;
   finally
     IdSMTP1.Free;
   end;
 finally
   IniFile.Free;
 end;
 LogMessage(LogFile,"Stoped...");
 Notify(emrStop,0);
end.


---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.052 c