| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

E-mail чисто на Api

Страницы:   < 1 2 3 >

Shluz ©   (2003-06-24 17:44:00) 

Уважаемые мастера!! Помогите плиз, а то пример который в фак не подходит... :( там Api OutLook"ом перехватывается и выползают настройки :(( Может есть выход??

---

Shluz   (2003-07-26 19:50:00) [1]

Всем огромное СПАСИБО!!!
I>Al_! РЕСПЕКТ за исходник, дружеский подход!! :))

---

AL_!   (2003-07-17 02:48:00) [2]

2Dwemer:
Да не за что. чё уж там.
просто когда-то я это уже делал. Решил выложить, думал может пригодится.

---

Dwemer   (2003-07-16 03:52:00) [3]

2AL_!
Огромное спасибо за сорцы!!!

---

AL_!   (2003-07-05 01:43:00) [4]


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.

---

AL_!   (2003-07-05 01:42:00) [5]

Насчет адреса сервера я что-то попутал :(
Конечно же он должен быть smtp.mail.ru (194.67.23.10), а не pop3.mail.ru (хотя почему-то работало и так..?).

Вот новые сорцы. Фичи:
- поддержка SMTP авторизации (надо доделать чуть-чуть, хотя уже работает);
- возможность получить еще меньший EXE-шник... :)

---

AL_!   (2003-07-04 22:57:00) [6]

P.S.
В модуле Winsock:

const
IPPORT_SMTP = 25;


---

AL_!   (2003-07-04 22:53:00) [7]

Порт не указывается, т.к. он по умолчанию 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", ...


---

Shluz   (2003-07-04 12:30:00) [8]

не могу понять, где объявления порта сокета...

вообщем все делал так
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-03 22:00:00) [9]

>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-03 20:24:00) [10]

>AL_! (
..разобрался с авторизацией...хех.. :)

>AL_!
"Can""t Resolve "+Server" вот эта искл ситуация светитися......
..TSockADr - у меня в хелпе написаноб что структура не документирова :(
..разобрался с авторизацией...хех.. :) вот только б подключиться нормально

---

AL_!   (2003-07-02 18:35:00) [11]

To Shluz:
Какая именно ошибка ?
У меня все нормально компилируется и даже посылает (письмо)!

>вроде автоматически заполняться должно(следуя HElpa).. ??
Вроде что-то там и заполняется автоматически, но только не порт. это точно.

---

Shluz   (2003-07-02 11:38:00) [12]

>Al_ FAddr.sin_family:=AF_INET;
> ( Port)

>Al_ FAddr.sin_family:=AF_INET;
> FAddr.sin_port:=htons(Port);

вроде автоматически заполняться должно(следуя HElpa).. ??
у меня ошибки на этих строках выскакивают...
//блин, есть статья , что-ли какая -нить по Инет-технологиям...основы..а то тяжело

---

Shluz   (2003-07-01 20:33:00) [13]

> Polevi все путем...как раз на OVERLAPPED и загоняюсь :) а то с ошибками работает...ээ..точнее сказать, не работает

---

Ghost_   (2003-07-01 15:40:00) [14]

Ну я и не собирался использовать...я хотел людям отдать..может чего додумают...меня вот компоненты вполне устраивают...(если хорошие конечно)

---

Polevi   (2003-07-01 14:47:00) [15]

2Ghost_ © (30.06.03 14:11)
не советую использовать данный код, работать будет только в тепличных условиях
код был написан мной для изучения работы с портами завершения, по уму надо создавать отдельный экз. структуры OVERLAPPED для каждой операции ввода-вывода, а не один экз. на клиента

---

Shluz   (2003-07-01 14:11:00) [16]

> AL_! МегаСпасибо!!! Главное - счего-то начать учиться!! сокеты для меня - темный лес... сегодня сдал экзамен "Аналоговая и цифровая электроника" :)

---

AL_!   (2003-07-01 02:45:00) [17]

У меня не 17КБ получилось конечно, а 41КБ, но это из-за SysUtils.
Для специфических целей этот и без того простой пример можно еще упростить !
А еще нужно добавить авторизацию...

---

AL_!   (2003-07-01 02:38:00) [18]

Использовать так:
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:33:00) [19]


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.


---

Shluz   (2003-06-30 23:57:00) [20]

уф.. а попроще чего-нить есть ? :) для ЛАМО!! :)

---

Страницы:   < 1 2 3 >

Наверх