Форум: "Сети";
Текущий архив: 2003.09.29;
Скачать: [xml.tar.bz2];
Вниз
E-mail чисто на Api Найти похожие ветки
← →
Shluz (2003-06-24 17:44) [0]Уважаемые мастера!! Помогите плиз, а то пример который в фак не подходит... :( там Api OutLook"ом перехватывается и выползают настройки :(( Может есть выход??
← →
Song (2003-06-25 08:38) [1]Легально - нет.
← →
Shluz (2003-06-25 10:14) [2]>Song а не легально??
и вообще, спасибо вам, вы часто помогаете! респект! :)
← →
Shluz (2003-06-25 10:39) [3]неужели эта задача никого не интересовала??
← →
Ghost_ (2003-06-25 13:14) [4]>неужели эта задача никого не интересовала??
Кроме троянописателей...врядли кого-то...:0)
← →
nikkie (2003-06-25 15:15) [5]честно говоря, вообще вопрос не понял. e-mail получать или отправлять? какое апи перехватывается, ShellExecute что ли? или MAPI?
← →
delphimun (2003-06-25 16:11) [6]>Ghost_ Думаете, что только вирусописатели занимаются этим, вы глубоко заблуждаетесь! Почему нужно отослать письмо на АПИ? Да потамучто программа с VCL занимает очень много места, и если бы я увидел в нете прогу занимающую 1 мб я бы низа-что не стал пириписывать ее, т.к 1) При помегобайтном трафике платить за это 40 центов 2) При почасовом отдавать за это пол часа времени, при этом и так затормаживая еле билущие байты от провайдера! Ну а если она занимает 20 кб, кликнул бы на скачивание даже незадусываясь, ведь 20 кб это 20 кб. А ведь все программисты хотят, чтобы их прога была популярна в основном канале сбыта - сети Интернет.
Почему-же он хочет скрыть от глаз пользователя процес отправки письма? Да потаму-что каждый программист хочет, чтобы его программа выглядела прилежно, не засаряя забитые мозги пользователя всякими лишними собщениями, ведь как хочется, чтобы в окне About своей программы юзер ввел свои добрые пожелания о программе и нажал, кнопку ок, окошко About закрылось и письмо отослалось, неутруждая пользователя в подтверждении ненужных согласий и чтения мозгозасоряющих предупреждений.
Shluz>
Я пробовал в это окно на кнопку "Отправить" послать собщение о ее нажатии, но Винда там что-то намутила, вобщем, кнопка почему-то не нажалась!. Однако получилось! Если после вызова ф-ии отправки подождать с секунду, пока окно откроется, и послать своему приложению сигнал закрытия(close), тогда почта отлично отсылается. Еще сами понимаете, это нужно делать в отдельном потоке, т.к окно от аутлука вылетает модальное и прога останавливается в ожидании результата если непонял то то вот я тебе примерчик скинул на сайт:
http://delphin.rbcmail.ru/MAPISendMail.zip
← →
delphimun (2003-06-25 16:41) [7]Странно в этом форуме 6 ответов, а выше в winapi форуме у меня пишет что 0
← →
Shluz (2003-06-25 17:31) [8]nikkie > посылка сообщения; перехватывается MapiSendMail
delphimun> спасибо за правильную оценку! :)
← →
Shluz (2003-06-25 17:35) [9]delphimun> как бы это окно предупреждения обойти?? оно из vxd перехватывается, не знаешь?? блин :(( может снести outlook.. типа terminate process
← →
nikkie (2003-06-25 17:40) [10]а если у меня TheBat стоит, MAPI сработает?
>оно из vxd перехватывается, не знаешь??
ага. в виндоуз для этого прерывание 47 зарезервировано.
IdSMTP и не мучайся.
← →
Ghost_ (2003-06-26 09:11) [11]>delphimun вопрос на самом деле спорный и видимо не для этого топика..но по вашей версии если прога вообще без VCL (таких наверное не очень много) то такой вариано для Эбаут...может быть но опять же подавляющее большинство прог всетаки запускают программу почты...а любая прога отсылающая чего-то незаметно будет подозрительна и правильно настроенным файрволом будет поймана..а значит расчитана на лохов... это тоже взгляд(хороший файрвол недаст незарегистрированной проге ничего отправить, а регистрировать ее для отправки одного сообщения по меньшей мере глупо..хотябы потому незная, что она отправит потом еще в интернет)..это как мысль..затем на счет размера..и размещения в интернте...есть такие программы как архиваторы (если кто-то не знает - хотя я думаю это глупая сноска) я писал полностью готовый почтовый сервер с VCL который занимал 600 кб и в зжатом виде соответственно прмерно 200 это совсем небольшой размер зля распространения в интеренте, а написать программу для отправки почты которая в архиве будет занимать мегабайт...ну это уже покуситься на такие столпы как бат или аутлук...что нелегко..
А по существу ..на этом сайте раньше в кладовке был исходник прокси сервера написанного на API очень маленький (незнаю сейчас есть или нет) так в нем доступно написаны функции создания сокет как клиентского так и серверного..можно посмотреть и зная протокол отправки почты все реализовать...(если на сайте нет могу поискать у себя) вполне должно получиться
← →
Shluz (2003-06-27 12:42) [12]с сокетами, если я правильно понимаю, сервер должен постоянно работать для получения писем?
... а такая схема корректна: ловлю окно аутлука, передаю sw_hide , программно жму на "отправить"... delphimun, что там вы говорите с этой кнопкой винда мутит ?
...может vxd снести :)
← →
Delphin (2003-06-28 15:30) [13]Не мучийся напиши с помощью VCL, а потом сожми UPX"ом, Лежит тут: http://delphi5.times.lv/download/upxshell.zip
← →
Shluz (2003-06-28 15:59) [14]UPx это конечно замечательно, но просто интересна технология...
← →
Delphin (2003-06-28 16:14) [15]Ну вот чо про эту прогу пишут:
Программа-упаковщик является удобной оболочкой для лучшего консольного упаковщика ЕХЕ-файлов UPX. Программа UPX полностью упакована в compressor.exe. Программа сжимает программные файлы с расширением *.exe, *.com, *.dll и *.sys. Имеет 9 степеней сжатия, возможность сжатия иконок, оверлеев. Отлично сжимает файлы DOS и Windows. Возможна проверка работоспособности и обратной распоковки уже сжатого файлы.
В версии 1.2 полностью изменен алгоритм доступа к файлу, внешний вид, добавлены ключи и опции сжатия. В результате резко возросла скорость сжатия ЕХЕ-файлов. (700 Кб при максимальной степени сжатия в первой версии сжимались за 80 сек, в версии 1.2 - за 19 сек!!!).
← →
Shluz (2003-06-28 19:12) [16]если сжимать , то некоторые функции работают некорректно...я уж не знаю как этот объяснить, но это факт, например хуки...
← →
Bayer_Linse (2003-06-29 04:09) [17]SMTP RFC не подойдет?
← →
Shluz (2003-06-29 13:49) [18]прошу прощение за незнание... что это такое??
← →
Palladin (2003-06-29 16:57) [19]http://www.yandex.ru/yandsearch?rpt=rad&text=rfc821
← →
Shluz (2003-06-29 18:48) [20]не понял... а что-нить более приближенное к SDK если можно, а то яндекс выдал спам типа "наша фирма строго придерживается технологии rfc " и т.п. Спасибо
← →
Shluz (2003-06-29 19:02) [21]виноват!! глупость написал про SDK. :)Вообщем вы хотите сказать, что нужно с нуля разруливать SMTP?
← →
Palladin (2003-06-29 19:07) [22]ну это и есть ёмаил чиста на API
← →
int64 (2003-06-29 19:14) [23]http://www.delphi3000.com/articles/article_3274.asp
Только надо будет зарегистрироваться.
← →
Shluz (2003-06-29 19:28) [24]> Palladin © просто для масштаба моей программы это слишком круто протокол разруливать...не знаю, может так кажется..никогда не работал над этим.
← →
Palladin (2003-06-29 20:53) [25]ну у тебя в палитре есть целых два компонента, один тебе уже подсказали, и другой на вкладке FastNet - NMSMPT
выбирай...
← →
int64 (2003-06-29 22:36) [26]Palladin © (29.06.03 20:53)
Ну так это будет VCL
Shluz © (29.06.03 19:28)
Зайди по сылке - не парься.
← →
AL_! (2003-06-29 22:51) [27]Не понимаю, чё все так парятся насчет SMTP. :(
Посмотрите перевод RFC на русский, там все расписано по шагам, что нужно делать, наверняка есть пример работы.
Сложности возникнут, если сервер потребует авторизацию (и такое бывает например на mail.ru)...
← →
AL_! (2003-06-29 22:53) [28]Полезно почитать http://www.sources.ru/protocols/smtp_learning.shtml и потренироваться вручную для начала...
← →
Shluz (2003-06-29 23:51) [29]>int64 зашел по ссылке, все хорошо..но откуда все это берется, половина функций не системных библиотек..т.е. уже компонентно-зависимо, как мне показалось...наприме DoSend ---что это???..но ссылочка все равно полезная, кое-что принял на заметку, спасибо
← →
app (2003-06-29 23:54) [30]int64 © (29.06.03 22:36)
Это будет AxtiveX + VCL, от второго звена естественно можно избавиться, если напрямую работать с этим AxtiveX
← →
Вася путин (2003-06-30 10:10) [31]конетктишся к серверу, и обмениваешься командами... какими?(RFC)
обычная работа с сокетами...
StrCopy(buff, "MAIL FROM: vasya_putin@fsb.ru"+#13#10);
StrCut()
send(Sk, Buf, sizeof(buff), 0);
recv(Sk, Buf, Count, 0);
получаешь ответ сервера и далее if... then...
в свое время весила такая програмка у меня 17к (98г)
← →
Shluz (2003-06-30 12:29) [32]Вася, send, StrCopy, StrCut,recv уж больно на VCL похоже :)
я думаю надо свой модуль для SMTP (минимальный) сокетами разрулить чтоли...как такая версия, ребят? реально VCL_free организовать
← →
Ghost_ (2003-06-30 14:11) [33]Вот исходник прокси на "чистом API"
program proxy;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Winsock, Classes;
type
TCompletionPort=class
public
FHandle:THandle;
constructor Create(dwNumberOfConcurentThreads:DWORD);
destructor Destroy;override;
function AssociateDevice(hDevice:THandle;dwCompKey:DWORD):boolean;
end;
TAcceptThread=class(TThread)
private
FListenSocket:TSocket;
FListenPort:Word;
FClientList:TList;
procedure GarbageCollect;
protected
procedure Execute;override;
public
constructor Create(AListenPort:Word);reintroduce;
destructor Destroy;override;
end;
type
TClientThread=class(TThread)
public
procedure Execute;override;
end;
type
TClient=class
private
FSocket:TSocket;
FEvent:THandle;
ov:POVERLAPPED;
Buffer:Pointer;
BufSize:Cardinal;
procedure Write(Buf:Pointer;Size:Cardinal);
public
FOppositeClient:TClient;
FLastActivity:double;
constructor Create;
destructor Destroy;override;
procedure Connect(ARequest:string);
procedure Disconnect;
procedure Complete(dwNumBytes:Cardinal);virtual;abstract;
end;
TInternalClient=class(TClient)
public
procedure Complete(dwNumBytes:Cardinal);override;
end;
TExternalClient=class(TClient)
public
procedure Complete(dwNumBytes:Cardinal);override;
end;
← →
Ghost_ (2003-06-30 14:11) [34]
//-------------------------------implementation-------------------------------
var
FCompPort:TCompletionPort;
{ TCompletionPort }
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
function TCompletionPort.AssociateDevice(hDevice: THandle;
dwCompKey: DWORD): boolean;
begin
result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
destructor TCompletionPort.Destroy;
begin
CloseHandle(FHandle);
inherited;
end;
{ TAcceptThread }
constructor TAcceptThread.Create(AListenPort: Word);
begin
inherited Create(false);
FListenPort:=AListenPort;
FClientList:=TList.Create;
end;
destructor TAcceptThread.Destroy;
begin
FClientList.Free;
inherited;
end;
procedure TAcceptThread.GarbageCollect;
var
AClient:TClient;
i:integer;
begin
for i:=0 to FClientList.Count-1 do
begin
AClient:=TClient(FClientList[i]);
if Assigned(AClient) then
if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
begin
FClientList[i]:=nil;
if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
AClient.Free;
end;
end;
FClientList.Pack;
FClientList.Capacity:=FClientList.Count;
end;
procedure TAcceptThread.Execute;
var
FAddr: TSockAddrIn;
Len: Integer;
ClientSocket:TSocket;
InternalClient:TClient;
begin
FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := htons(FListenPort);
bind(FListenSocket, FAddr, SizeOf(FAddr));
listen(FListenSocket, SOMAXCONN);
try
while not Terminated do
begin
Len:=sizeof(FAddr);
ClientSocket:=accept(FListenSocket, @FAddr, @Len);
try
GarbageCollect;
if ClientSocket<>INVALID_SOCKET then
begin
InternalClient:=TInternalClient.Create;
InternalClient.FSocket:=ClientSocket;
FClientList.Add(InternalClient);
FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
InternalClient.Complete(0);
end;
except
( FListenSocket,2)//-------------------------------implementation-------------------------------
var
FCompPort:TCompletionPort;
{ TCompletionPort }
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
function TCompletionPort.AssociateDevice(hDevice: THandle;
dwCompKey: DWORD): boolean;
begin
result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
destructor TCompletionPort.Destroy;
begin
CloseHandle(FHandle);
inherited;
end;
{ TAcceptThread }
constructor TAcceptThread.Create(AListenPort: Word);
begin
inherited Create(false);
FListenPort:=AListenPort;
FClientList:=TList.Create;
end;
destructor TAcceptThread.Destroy;
begin
FClientList.Free;
inherited;
end;
procedure TAcceptThread.GarbageCollect;
var
AClient:TClient;
i:integer;
begin
for i:=0 to FClientList.Count-1 do
begin
AClient:=TClient(FClientList[i]);
if Assigned(AClient) then
if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
begin
FClientList[i]:=nil;
if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
AClient.Free;
end;
end;
FClientList.Pack;
FClientList.Capacity:=FClientList.Count;
end;
procedure TAcceptThread.Execute;
var
FAddr: TSockAddrIn;
Len: Integer;
ClientSocket:TSocket;
InternalClient:TClient;
begin
FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := htons(FListenPort);
bind(FListenSocket, FAddr, SizeOf(FAddr));
listen(FListenSocket, SOMAXCONN);
try
while not Terminated do
begin
Len:=sizeof(FAddr);
ClientSocket:=accept(FListenSocket, @FAddr, @Len);
try
GarbageCollect;
if ClientSocket<>INVALID_SOCKET then
begin
InternalClient:=TInternalClient.Create;
InternalClient.FSocket:=ClientSocket;
FClientList.Add(InternalClient);
FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
InternalClient.Complete(0);
end;
except
end;
end;
finally
shutdown(FListenSocket,2);
closesocket(FListenSocket);
end;
end;
{ TClientThread }
procedure TClientThread.Execute;
var
CompKey,dwNumBytes:Cardinal;
ov:POVERLAPPED;
begin
try
while not Terminated do
begin
if GetQueuedCompletionStatus(FCompPort.FHandle,dwNumBytes,CompKey,ov,INFINITE) and (dwNumBytes>0) then
begin
if TClient(CompKey).FSocket<>INVALID_SOCKET then
begin
TClient(CompKey).Complete(dwNumBytes);
TClient(CompKey).FLastActivity:=now;
end;
end
else
TClient(CompKey).Disconnect;
end;
except
TClientThread.Create(false);
end;
end;
{ TClient }
constructor TClient.Create;
begin
FSocket:=INVALID_SOCKET;
BufSize:=8192;
GetMem(Buffer,BufSize);
new(ov);
ov.Internal:=0;
ov.InternalHigh:=0;
ov.Offset:=0;
ov.OffsetHigh:=0;
ov.hEvent:=0;
FEvent:=CreateEvent(nil,true,false,nil);
FLastActivity:=now;
end;
destructor TClient.Destroy;
begin
Disconnect;
CloseHandle(FEvent);
FreeMem(Buffer);
Dispose(ov);
inherited;
end;
procedure TClient.Connect(ARequest: string);
var
f,t:integer;
ARemoteAddress:string;
ARemotePort:string;
he:PHostEnt;
FAddr:TSockAddrIn;
begin
f:=Pos("/",ARequest)+2;
t:=Pos("HTTP",ARequest)-1;
ARemoteAddress:=Copy(ARequest,f,t-f);
t:=Pos("/",ARemoteAddress);
if t<>0 then ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
t:=Pos(":",ARemoteAddress);
if t<>0 then
begin
ARemotePort:=Copy(ARemoteAddress,t+1,Length(ARemoteAddress)-t);
ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
end
else
ARemotePort:="80";
he:=GetHostByName(PChar(ARemoteAddress));
if not Assigned(he) then exit;
ARemoteAddress:=inet_ntoa(PInAddr(he.h_addr_list^)^);
FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
FAddr.sin_family:=PF_INET;
FAddr.sin_addr.s_addr :=inet_addr(PChar(ARemoteAddress));
try
FAddr.sin_port := htons(StrToInt(ARemotePort));
if WinSock.connect(FSocket, FAddr, SizeOf(FAddr))=SOCKET_ERROR then FSocket:=INVALID_SOCKET;
except
end;
end;
procedure TClient.Disconnect;
begin
if FSocket<>INVALID_SOCKET then
begin
shutdown(FSocket,2);
closesocket(FSocket);
FSocket:=INVALID_SOCKET;
if Assigned(FOppositeClient) then FOppositeClient.Disconnect;
end;
end;
procedure TClient.Write(Buf: Pointer; Size: Cardinal);
var
BytesWrite:Cardinal;
begin
ov.hEvent:=FEvent or 1;
WriteFile(FSocket,Buf^,Size,BytesWrite,ov);
ov.hEvent:=0;
end;
← →
Ghost_ (2003-06-30 14:12) [35]
{ TInternalClient }
procedure TInternalClient.Complete(dwNumBytes: Cardinal);
var
BytesRead:Cardinal;
begin
if dwNumBytes>0 then
begin
if not Assigned(FOppositeClient) then
begin
FOppositeClient:=TExternalClient.Create;
FOppositeClient.FOppositeClient:=self;
FOppositeClient.Connect(PChar(Buffer));
if FOppositeClient.FSocket=INVALID_SOCKET then
begin
Disconnect;
exit;
end;
FCompPort.AssociateDevice(FOppositeClient.FSocket,Cardinal(FOppositeClient));
FOppositeClient.Complete(0);
end;
FOppositeClient.Write(Buffer,dwNumBytes);
end;
ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
{ TExternalClient }
procedure TExternalClient.Complete(dwNumBytes: Cardinal);
var
BytesRead:Cardinal;
begin
if dwNumBytes>0 then FOppositeClient.Write(Buffer,dwNumBytes);
ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
const
ClientThreadCount:integer=8;
ListenPort:Dword=8080;
var
WSAData:TWSAData;
Cnt:Cardinal;
i:integer;
begin
FCompPort:=TCompletionPort.Create(ClientThreadCount);
if FCompPort.FHandle<>0 then
begin
WSAStartup($0101, WSAData);
for i:=0 to ClientThreadCount-1 do TClientThread.Create(false);
TAcceptThread.Create(ListenPort);
ReadConsole(GetStdHandle(STD_INPUT_HANDLE),nil,0,Cnt,nil);
WSACleanup;
end;
end.
Прочитай найдешь для себя полезное...создание сокета передача данных ...
← →
Shluz (2003-06-30 14:48) [36]>Ghost_ Дело, дело!! Спасибо!! Буду учиться
← →
Shluz (2003-06-30 23:57) [37]уф.. а попроще чего-нить есть ? :) для ЛАМО!! :)
← →
AL_! (2003-07-01 02:33) [38]
unit SMTP;
interface
uses
windows, WinSock, SysUtils;
type
TSMTP = class(TObject)
private
FSock: TSocket;
FAddr: TSockAddr;
procedure SendText(Text: string);
procedure ReceiveResponse(SuccessCode: integer);
protected
procedure connect(Server: string; Port: integer = IPPORT_SMTP);
procedure HELO;
procedure MAIL(from: string);
procedure RCPT(to_: string);
procedure DATA(body: string);
procedure QUIT;
procedure closesocket;
public
constructor Create;
destructor Destroy; override;
procedure SendMail(Server, From, To_, Body: string);
end;
E_SMTPSession = class (Exception);
implementation
{ TSMTP }
constructor TSMTP.Create;
var
WSData: TWSAData;
begin
WSAStartup(MakeWord(1,1), WSData);
end;
destructor TSMTP.Destroy;
begin
WSACleanup;
end;
procedure TSMTP.SendText(Text: string);
begin
OutputDebugString(PChar(">>"+Text));
Text:=Text+#13#10;
if send(FSock, pointer(Text)^, Length(Text), 0)<Length(Text) then
raise E_SMTPSession.Create("Error while sending");
end;
procedure TSMTP.ReceiveResponse(SuccessCode: integer);
var
ch: char;
response, line: string;
begin
response:="";
repeat
line:="";
repeat
recv(FSock, ch, 1, 0);
line:=line+ch;
until ch=#10;
response:=response+line;
until line[4]=" "; //Обрабатываем многострочный ответ
OutputDebugString(PChar("<<"+response));
if strtoint(copy(line, 1, 3))<>SuccessCode then
raise E_SMTPSession.Create("Response: "+#13#10+response);
end;
procedure TSMTP.connect(Server: string; Port: integer);
var
HostEnt: PHOSTENT;
begin
FAddr.sin_family:=AF_INET;
FAddr.sin_port:=htons(Port);
HostEnt:=gethostbyname(PChar(Server));
if HostEnt=nil then raise E_SMTPSession.Create("Can""t Resolve "+Server);
FAddr.sin_addr:=PInAddr(HostEnt.h_addr^)^;
//FAddr.sin_addr.S_addr:=inet_addr(PChar(Server)); если ip-address, а не hostname
FSock:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if FSock<>INVALID_SOCKET then
if winsock.connect(FSock, FAddr, SizeOf(FAddr))<>SOCKET_ERROR then
ReceiveResponse(220)
else
begin
raise E_SMTPSession.Create("Can""t connect: "+syserrormessage(WSAGetLastError))
end
else
raise E_SMTPSession.Create("Can""t create socket");
end;
procedure TSMTP.HELO;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
SendText("HELO "+string(HostName));
ReceiveResponse(250);
end;
procedure TSMTP.MAIL(from: string);
begin
SendText("MAIL FROM: "+from);
ReceiveResponse(250);
end;
procedure TSMTP.RCPT(to_: string);
begin
SendText("RCPT TO: "+to_);
ReceiveResponse(250);
end;
procedure TSMTP.DATA(body: string);
begin
SendText("DATA");
ReceiveResponse(354);
SendText(body);
SendText(".");
ReceiveResponse(250);
end;
procedure TSMTP.QUIT;
begin
SendText("QUIT");
ReceiveResponse(221);
end;
procedure TSMTP.closesocket;
begin
winsock.closesocket(FSock);
end;
procedure TSMTP.SendMail(Server, From, To_, Body: string);
begin
connect(Server);
try
HELO;
MAIL(from);
RCPT(to_);
( body)
unit SMTP;
interface
uses
windows, WinSock, SysUtils;
type
TSMTP = class(TObject)
private
FSock: TSocket;
FAddr: TSockAddr;
procedure SendText(Text: string);
procedure ReceiveResponse(SuccessCode: integer);
protected
procedure connect(Server: string; Port: integer = IPPORT_SMTP);
procedure HELO;
procedure MAIL(from: string);
procedure RCPT(to_: string);
procedure DATA(body: string);
procedure QUIT;
procedure closesocket;
public
constructor Create;
destructor Destroy; override;
procedure SendMail(Server, From, To_, Body: string);
end;
E_SMTPSession = class (Exception);
implementation
{ TSMTP }
constructor TSMTP.Create;
var
WSData: TWSAData;
begin
WSAStartup(MakeWord(1,1), WSData);
end;
destructor TSMTP.Destroy;
begin
WSACleanup;
end;
procedure TSMTP.SendText(Text: string);
begin
OutputDebugString(PChar(">>"+Text));
Text:=Text+#13#10;
if send(FSock, pointer(Text)^, Length(Text), 0)<Length(Text) then
raise E_SMTPSession.Create("Error while sending");
end;
procedure TSMTP.ReceiveResponse(SuccessCode: integer);
var
ch: char;
response, line: string;
begin
response:="";
repeat
line:="";
repeat
recv(FSock, ch, 1, 0);
line:=line+ch;
until ch=#10;
response:=response+line;
until line[4]=" "; //Обрабатываем многострочный ответ
OutputDebugString(PChar("<<"+response));
if strtoint(copy(line, 1, 3))<>SuccessCode then
raise E_SMTPSession.Create("Response: "+#13#10+response);
end;
procedure TSMTP.connect(Server: string; Port: integer);
var
HostEnt: PHOSTENT;
begin
FAddr.sin_family:=AF_INET;
FAddr.sin_port:=htons(Port);
HostEnt:=gethostbyname(PChar(Server));
if HostEnt=nil then raise E_SMTPSession.Create("Can""t Resolve "+Server);
FAddr.sin_addr:=PInAddr(HostEnt.h_addr^)^;
//FAddr.sin_addr.S_addr:=inet_addr(PChar(Server)); если ip-address, а не hostname
FSock:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if FSock<>INVALID_SOCKET then
if winsock.connect(FSock, FAddr, SizeOf(FAddr))<>SOCKET_ERROR then
ReceiveResponse(220)
else
begin
raise E_SMTPSession.Create("Can""t connect: "+syserrormessage(WSAGetLastError))
end
else
raise E_SMTPSession.Create("Can""t create socket");
end;
procedure TSMTP.HELO;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
SendText("HELO "+string(HostName));
ReceiveResponse(250);
end;
procedure TSMTP.MAIL(from: string);
begin
SendText("MAIL FROM: "+from);
ReceiveResponse(250);
end;
procedure TSMTP.RCPT(to_: string);
begin
SendText("RCPT TO: "+to_);
ReceiveResponse(250);
end;
procedure TSMTP.DATA(body: string);
begin
SendText("DATA");
ReceiveResponse(354);
SendText(body);
SendText(".");
ReceiveResponse(250);
end;
procedure TSMTP.QUIT;
begin
SendText("QUIT");
ReceiveResponse(221);
end;
procedure TSMTP.closesocket;
begin
winsock.closesocket(FSock);
end;
procedure TSMTP.SendMail(Server, From, To_, Body: string);
begin
connect(Server);
try
HELO;
MAIL(from);
RCPT(to_);
DATA(body);
finally
QUIT;
closesocket;
end;
end;
end.
← →
AL_! (2003-07-01 02:38) [39]Использовать так:
SendMail("pop3.mail.ru", "xakep@mail.ru", "lamer@microsoft.com",
"Subject: My Test Message"#13#10#13#10"And This is Body of Message!");
Если сервер требует авторизации (ответ 530), то с того сервера сначала необходимо забрать почту каким-нибудь другим агентом
← →
AL_! (2003-07-01 02:45) [40]У меня не 17КБ получилось конечно, а 41КБ, но это из-за SysUtils.
Для специфических целей этот и без того простой пример можно еще упростить !
А еще нужно добавить авторизацию...
Страницы: 1 2 вся ветка
Форум: "Сети";
Текущий архив: 2003.09.29;
Скачать: [xml.tar.bz2];
Память: 0.59 MB
Время: 0.01 c
