Форум: "Сети";
Текущий архив: 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.
Для специфических целей этот и без того простой пример можно еще упростить !
А еще нужно добавить авторизацию...
← →
Shluz (2003-07-01 14:11) [41]> AL_! МегаСпасибо!!! Главное - счего-то начать учиться!! сокеты для меня - темный лес... сегодня сдал экзамен "Аналоговая и цифровая электроника" :)
← →
Polevi (2003-07-01 14:47) [42]2Ghost_ © (30.06.03 14:11)
не советую использовать данный код, работать будет только в тепличных условиях
код был написан мной для изучения работы с портами завершения, по уму надо создавать отдельный экз. структуры OVERLAPPED для каждой операции ввода-вывода, а не один экз. на клиента
← →
Ghost_ (2003-07-01 15:40) [43]Ну я и не собирался использовать...я хотел людям отдать..может чего додумают...меня вот компоненты вполне устраивают...(если хорошие конечно)
← →
Shluz (2003-07-01 20:33) [44]> Polevi все путем...как раз на OVERLAPPED и загоняюсь :) а то с ошибками работает...ээ..точнее сказать, не работает
← →
Shluz (2003-07-02 11:38) [45]>Al_ FAddr.sin_family:=AF_INET;
> ( Port) >Al_ FAddr.sin_family:=AF_INET;
> FAddr.sin_port:=htons(Port);
вроде автоматически заполняться должно(следуя HElpa).. ??
у меня ошибки на этих строках выскакивают...
//блин, есть статья , что-ли какая -нить по Инет-технологиям...основы..а то тяжело
← →
AL_! (2003-07-02 18:35) [46]To Shluz:
Какая именно ошибка ?
У меня все нормально компилируется и даже посылает (письмо)!
>вроде автоматически заполняться должно(следуя HElpa).. ??
Вроде что-то там и заполняется автоматически, но только не порт. это точно.
← →
Shluz (2003-07-03 20:24) [47]>AL_! (
..разобрался с авторизацией...хех.. :) >AL_!
"Can""t Resolve "+Server" вот эта искл ситуация светитися......
..TSockADr - у меня в хелпе написаноб что структура не документирова :(
..разобрался с авторизацией...хех.. :) вот только б подключиться нормально
← →
AL_! (2003-07-03 22:00) [48]>Can"t Resolve
Это искл. вылазит, если он не может определить IP-адрес хоста к которому нужно подключиться. Или имя хоста неправильное, или одно из двух :)
Попробуй определить IP-шник сервера сам. Потом измени код так:
закомментируй три строчки
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
ну и вызов соответсвенно (для mail.ru)
with TSMTP do
begin
Create;
try
( "194.67.57.51", "xakep@mail.ru", "lamer@microsoft.com",
"Subject: My Test Message"#13#10#13#10"And This is Body of Message!")>Can"t Resolve
Это искл. вылазит, если он не может определить IP-адрес хоста к которому нужно подключиться. Или имя хоста неправильное, или одно из двух :)
Попробуй определить IP-шник сервера сам. Потом измени код так:
закомментируй три строчки
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
ну и вызов соответсвенно (для mail.ru)
with TSMTP do
begin
Create;
try
SendMail("194.67.57.51", "xakep@mail.ru", "lamer@microsoft.com",
"Subject: My Test Message"#13#10#13#10"And This is Body of Message!");
finally
Free;
end;
end;
← →
Shluz (2003-07-04 12:30) [49]не могу понять, где объявления порта сокета...
вообщем все делал так
var smtp :Tsmtp;
begin
...
smtp.SendMail("194.67.57.51", "xakep@mail.ru", "lamer@microsoft.com",
"Subject: My Test Message"#13#10#13#10"And This is Body of Message!");
...
← →
AL_! (2003-07-04 22:53) [50]Порт не указывается, т.к. он по умолчанию 25
type
TSMTP = class(TObject)
protected
procedure connect(Server: string; Port: integer = IPPORT_SMTP);
end;
Если нужно другой, то измени процедуру SendMail:
procedure TSMTP.SendMail(Server, From, To_, Body: string; Port: integer);
begin
connect(Server, Port);
...
Ну и вызывай тогда так
smtp.SendMail("194.67.57.51", 25, "xakep@mail.ru", ...
← →
AL_! (2003-07-04 22:57) [51]P.S.
В модуле Winsock:
const
IPPORT_SMTP = 25;
← →
AL_! (2003-07-05 01:42) [52]Насчет адреса сервера я что-то попутал :(
Конечно же он должен быть smtp.mail.ru (194.67.23.10), а не pop3.mail.ru (хотя почему-то работало и так..?).
Вот новые сорцы. Фичи:
- поддержка SMTP авторизации (надо доделать чуть-чуть, хотя уже работает);
- возможность получить еще меньший EXE-шник... :)
← →
AL_! (2003-07-05 01:43) [53]
unit ESMTP;
interface
uses
windows, WinSock;
function SendMail(const Server: string; Port: integer;
const Login, Password, From, To_, Body: string): boolean;
implementation
{$B-} //Complete Boolean expression evaluation - off
function Base64Encode(const Text: string): string;
const
Base64Charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=";
var
i, TextLen: integer;
a1, a2, a3: byte;
b1, b2, b3, b4: byte;
begin
Result:="";
TextLen:=Length(Text);
i:=1;
while i<=TextLen do
begin
a1:=ord(Text[i]);
inc(i);
b1:=(a1 shr 2);
b2:=((a1 and $03) shl 4);
if i<=TextLen then
begin
a2:=ord(Text[i]);
inc(i);
b2:=b2 or (a2 shr 4);
b3:=((a2 and $0F) shl 2);
if i<=TextLen then
begin
a3:=ord(Text[i]);
inc(i);
b3:=b3 or (a3 shr 6);
b4:=(a3 and $3F);
end
else
begin
b4:=64;
end
end
else
begin
b3:=64;
b4:=64;
end;
Result:=Result+Base64Charset[b1+1]+Base64Charset[b2+1]+Base64Charset[b3+1]+Base64Charset[b4+1];
end;
end;
var
WSData: TWSAData;
Sock: TSocket;
Addr: TSockAddr;
function SendText(Text: string): boolean;
var
sent: integer;
begin
OutputDebugString(PChar(">>> "+Text));
Result:=false;
Text:=Text+#13#10;
while length(Text)>0 do
begin
sent:=send(Sock, pointer(Text)^, Length(Text), 0);
if sent=SOCKET_ERROR then Exit;
delete(Text, 1, sent);
end;
Result:=true;
end;
function ReceiveResponse(SuccessCode: integer): boolean;
var
ch: char;
line: string;
Code, Err: integer;
Response: string;
begin
Result:=false;
response:="";
repeat
line:="";
repeat
if recv(Sock, ch, 1, 0)>0 then
line:=line+ch
else
Exit;
until ch=#10;
response:=response+line;
until line[4]=" ";
OutputDebugString(pchar(response));
val(copy(line, 1, 3), Code, err);
if err<>0 then Exit;
Result:=Code=SuccessCode;
end;
function CreateSocket(const Server: string; Port: integer): boolean;
var
HostEnt: PHOSTENT;
begin
Result:=false;
Addr.sin_family:=AF_INET;
Addr.sin_port:=htons(Port);
HostEnt:=gethostbyname(PChar(Server));
if HostEnt=nil then Exit;
Addr.sin_addr:=PInAddr(HostEnt.h_addr^)^;
//FAddr.sin_addr.S_addr:=inet_addr(PChar(Server)); если ip-address, а не domain name
Sock:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
Result:=Sock<>INVALID_SOCKET;
end;
function Connect: boolean;
begin
Result:=
(winsock.connect(Sock, Addr, SizeOf(Addr))=0) and
ReceiveResponse(220);
end;
{
function HELO: boolean;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
Result:=
SendText("HELO "+string(HostName)) and
ReceiveResponse(250);
end;
}
function EHLO(const Login, Password: string): boolean;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
Result:=
SendText("EHLO "+string(HostName)) and
ReceiveResponse(250) and
SendText("AUTH LOGIN") and
ReceiveResponse(334) and //тут должна быть проверка, что нам передали строку "Username:" в Base64, но лень переделывать :)
SendText(Base64Encode(Login)) and
ReceiveResponse(334) and // а здесь - "Password:"
SendText(Base64Encode(Password)) and
ReceiveResponse(235);
end;
function MAIL(from: string): boolean;
begin
Result:=
SendText("MAIL FROM: "+from) and
ReceiveResponse(250);
end;
function RCPT(to_: string): boolean;
begin
Result:=
SendText("RCPT TO: "+to_) and
ReceiveResponse(250);
end;
function DATA(body: string): boolean;
begin
Result:=
SendText("DATA") and
ReceiveResponse(354) and
SendText(body) and
SendText(".") and
ReceiveResponse(250);
end;
function QUIT: boolean;
begin
Result:=
SendText("QUIT") and
ReceiveResponse(221);
end;
function SendMail(const Server: string; Port: integer;
const Login, Password, From, To_, Body: string): boolean;
begin
Result:=false;
if WSAStartup(MakeWord(1,1), WSData)=0 then
begin
if CreateSocket(Server, Port) then
begin
if connect then
begin
Result:=
EHLO(Login, Password) and
MAIL(from) and
RCPT(to_) and
DATA(body);
QUIT;
shutdown(sock, SD_BOTH);
end;
( Sock)
unit ESMTP;
interface
uses
windows, WinSock;
function SendMail(const Server: string; Port: integer;
const Login, Password, From, To_, Body: string): boolean;
implementation
{$B-} //Complete Boolean expression evaluation - off
function Base64Encode(const Text: string): string;
const
Base64Charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=";
var
i, TextLen: integer;
a1, a2, a3: byte;
b1, b2, b3, b4: byte;
begin
Result:="";
TextLen:=Length(Text);
i:=1;
while i<=TextLen do
begin
a1:=ord(Text[i]);
inc(i);
b1:=(a1 shr 2);
b2:=((a1 and $03) shl 4);
if i<=TextLen then
begin
a2:=ord(Text[i]);
inc(i);
b2:=b2 or (a2 shr 4);
b3:=((a2 and $0F) shl 2);
if i<=TextLen then
begin
a3:=ord(Text[i]);
inc(i);
b3:=b3 or (a3 shr 6);
b4:=(a3 and $3F);
end
else
begin
b4:=64;
end
end
else
begin
b3:=64;
b4:=64;
end;
Result:=Result+Base64Charset[b1+1]+Base64Charset[b2+1]+Base64Charset[b3+1]+Base64Charset[b4+1];
end;
end;
var
WSData: TWSAData;
Sock: TSocket;
Addr: TSockAddr;
function SendText(Text: string): boolean;
var
sent: integer;
begin
OutputDebugString(PChar(">>> "+Text));
Result:=false;
Text:=Text+#13#10;
while length(Text)>0 do
begin
sent:=send(Sock, pointer(Text)^, Length(Text), 0);
if sent=SOCKET_ERROR then Exit;
delete(Text, 1, sent);
end;
Result:=true;
end;
function ReceiveResponse(SuccessCode: integer): boolean;
var
ch: char;
line: string;
Code, Err: integer;
Response: string;
begin
Result:=false;
response:="";
repeat
line:="";
repeat
if recv(Sock, ch, 1, 0)>0 then
line:=line+ch
else
Exit;
until ch=#10;
response:=response+line;
until line[4]=" ";
OutputDebugString(pchar(response));
val(copy(line, 1, 3), Code, err);
if err<>0 then Exit;
Result:=Code=SuccessCode;
end;
function CreateSocket(const Server: string; Port: integer): boolean;
var
HostEnt: PHOSTENT;
begin
Result:=false;
Addr.sin_family:=AF_INET;
Addr.sin_port:=htons(Port);
HostEnt:=gethostbyname(PChar(Server));
if HostEnt=nil then Exit;
Addr.sin_addr:=PInAddr(HostEnt.h_addr^)^;
//FAddr.sin_addr.S_addr:=inet_addr(PChar(Server)); если ip-address, а не domain name
Sock:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
Result:=Sock<>INVALID_SOCKET;
end;
function Connect: boolean;
begin
Result:=
(winsock.connect(Sock, Addr, SizeOf(Addr))=0) and
ReceiveResponse(220);
end;
{
function HELO: boolean;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
Result:=
SendText("HELO "+string(HostName)) and
ReceiveResponse(250);
end;
}
function EHLO(const Login, Password: string): boolean;
var
HostName: array[0..255] of char;
begin
GetHostName(HostName, Length(HostName));
Result:=
SendText("EHLO "+string(HostName)) and
ReceiveResponse(250) and
SendText("AUTH LOGIN") and
ReceiveResponse(334) and //тут должна быть проверка, что нам передали строку "Username:" в Base64, но лень переделывать :)
SendText(Base64Encode(Login)) and
ReceiveResponse(334) and // а здесь - "Password:"
SendText(Base64Encode(Password)) and
ReceiveResponse(235);
end;
function MAIL(from: string): boolean;
begin
Result:=
SendText("MAIL FROM: "+from) and
ReceiveResponse(250);
end;
function RCPT(to_: string): boolean;
begin
Result:=
SendText("RCPT TO: "+to_) and
ReceiveResponse(250);
end;
function DATA(body: string): boolean;
begin
Result:=
SendText("DATA") and
ReceiveResponse(354) and
SendText(body) and
SendText(".") and
ReceiveResponse(250);
end;
function QUIT: boolean;
begin
Result:=
SendText("QUIT") and
ReceiveResponse(221);
end;
function SendMail(const Server: string; Port: integer;
const Login, Password, From, To_, Body: string): boolean;
begin
Result:=false;
if WSAStartup(MakeWord(1,1), WSData)=0 then
begin
if CreateSocket(Server, Port) then
begin
if connect then
begin
Result:=
EHLO(Login, Password) and
MAIL(from) and
RCPT(to_) and
DATA(body);
QUIT;
shutdown(sock, SD_BOTH);
end;
closesocket(Sock);
end;
WSACleanup;
end;
end;
end.
← →
Dwemer (2003-07-16 03:52) [54]2AL_!
Огромное спасибо за сорцы!!!
← →
AL_! (2003-07-17 02:48) [55]2Dwemer:
Да не за что. чё уж там.
просто когда-то я это уже делал. Решил выложить, думал может пригодится.
← →
Shluz (2003-07-26 19:50) [56]Всем огромное СПАСИБО!!!
I>Al_! РЕСПЕКТ за исходник, дружеский подход!! :))
Страницы: 1 2 вся ветка
Форум: "Сети";
Текущий архив: 2003.09.29;
Скачать: [xml.tar.bz2];
Память: 0.65 MB
Время: 0.011 c
