| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
pop3 получение вложения [D7, Win2k, WinXP]
ilias1979 © (2005-06-16 15:43:00)Стоит задача автоматически получить почту, отфильтровать вложения, и те которые соответствуют определенным критериям переложить в специальную папку. В принципе она решается установкой MS OUTLOOK Он легко автоматизируется и я знаю как из D7 решить с помощью него свою проблему. Проблема в том что речь идет о сервере и есть противники установки на нем office
Нашел в сети несколько статей о компоненте NMPOP3 со страницы FastNet который позволяет сделать все вышеописанное, но хоть убейте никак не могу найти у себя в D7 ни эту страницу ни этот компонент. Или эта страница была только в старых версиях или вообще fastnet надо дополнительно устанавливать. Скиньте мне пожалуйста кто знает или ссылки на этот FastNet или может есть другие удобные компоненты для работы с почтовыми вложениями и POP3
Slym (2005-06-28 11:13:00) [1]Моя очень старая прога: получает почту-> архивирует с паролем-> отправляет на др. почтовый ящик (вырезано- не влазит в форум).... Переделать в сервис осталось чтоб на сервере крутился
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.
АНТИСпаммер (2005-06-25 00:28:00) [2]FastNet только в D6
Используй TIdPOP3
(2005-06-16 15:50:00) [3]Удалено модератором
| |
