Mega Code Archive
Send email with using winsock
<![CDATA[
Title: Send email with using winsock
Question: How can I dend email with using winsock?
Answer:
Hello programmers , I found a way that u can send email with winsock :
procedure SMTPSend(Host: string; Port: Integer; FromName, FromAddress,
ToAddress, Subject, Body: string);
implementation
const
BUFSIZE = 256;
RECVSIZE = 4096;
SMTP_ERRORSTATUS = 400;
var
WinSockInitError: Boolean;
function SMTPRecv(Soc: Integer; Buf: PChar; Len: Integer): Boolean;
var
RecvLen: Integer;
P: PChar;
begin
FillChar(Buf^, Len, 0);
P := Buf;
while Pos(#13#10, StrPas(Buf)) = 0 do
begin
RecvLen := recv(Soc, P^, Len-1, 0);
Inc(P, RecvLen);
Dec(Len, RecvLen);
if Len begin
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure SMTPRes(soc: Integer);
var
RecvBuf: array[0..RECVSIZE-1] of Char; // Mobt@
Code: Integer;
begin
if not SMTPRecv(soc, @RecvBuf, RECVSIZE) then
raise Exception.Create('Error: T[o?Ms');
// Me?”KR[h?
Code := StrToIntDef(Copy(RecvBuf, 1, 3), -1);
if (Code = SMTP_ERRORSTATUS) then
raise Exception.Create('Error: ' + RecvBuf);
end;
procedure DoSend(Soc: Integer; S: string);
begin
S := S + #13#10;
if send(Soc, PChar(S)^, Length(S), 0) = SOCKET_ERROR then
raise Exception.Create('Error: T[o??Ms');
end;
procedure DoConnectServer(Soc: Integer; Host: string; Port: Integer);
var
Addr: DWORD; // T[oIPAhX
HostEnt: PHostEnt; // T[o?w|C^
sockaddr: TSockAddrIn; // T[o?AhX
begin
// svName?hbg??10iIPAhX??A
// addr32bitIPAhX??
Addr := inet_addr(PChar(Host));
if Addr = $FFFFFFFF then
begin
//Trace('zXg”_');
// T[o(Host)T[o?”_?
HostEnt := gethostbyname(PChar(Host));
if HostEnt = nil then
raise Exception.Create('Error: zXgAhX”_s');
// T[o???IPAhXaddr?Rs[?
Addr := DWORD(HostEnt^.h_addr_list);
end;
//Trace('T[o??');
// T[o?AhX?\??T[oIPAhX?|[g??
sockaddr.sin_family := AF_INET; // C^[lbg??
sockaddr.sin_addr.s_addr := Addr; // T[oIPAhX
sockaddr.sin_port := htons(WORD(Port)); // |[g?
FillChar(sockaddr.sin_zero, sizeof(sockaddr.sin_zero), 0);
// T[o???
if connect(Soc, sockaddr, sizeof(sockaddr)) = SOCKET_ERROR then
raise Exception.Create('Error: T[o???s');
end;
procedure SMTPSend(Host: string; Port: Integer; FromName, FromAddress,
ToAddress, Subject, Body: string);
var
Soc: Integer; // \PbgiSoket Descriptor
SList: TStringList;
Tos: TStringList;
Index: Integer;
begin
if WinSockInitError then
raise Exception.Create('WinSock?G[');
// soc?\Pbg??
Soc := socket(PF_INET, SOCK_STREAM, 0);
if Soc = INVALID_SOCKET then
raise Exception.Create('Error: Socket?s');
try
DoConnectServer(Soc, Host, Port);
try
SMTPRes(Soc);
DoSend(Soc, 'HELO '+Host);
SMTPRes(Soc);
DoSend(Soc, 'MAIL FROM:');
SMTPRes(Soc);
Tos := TStringList.Create;
try
Tos.CommaText := ToAddress;
for Index := 0 to Tos.Count-1 do
begin
DoSend(Soc, 'RCPT TO:');
SMTPRes(Soc);
end;
DoSend(Soc, 'DATA');
SMTPRes(Soc);
// {??
// ol?pXy[X???SpXy[X?u
FromName := StringReplace(FromName, ' ', '@',
[rfReplaceAll]);
DoSend(Soc, 'From: '+ (FromName) +
' ');
if Tos.Count = 1 then
DoSend(Soc, 'To: '+ToAddress)
else
DoSend(Soc, 'To: '+FromAddress);
DoSend(Soc, 'Subject: '+(Subject)+#13#10);
SList := TStringList.Create;
try
SList.Text := Body;
repeat
Index := SList.IndexOf('.');
if Index = 0 then
SList[Index] := '. ';
until Index = -1;
for Index := 0 to SList.Count-1 do
DoSend(Soc, SList[Index]);
finally
SList.Free;
end;
DoSend(Soc, '.');
SMTPRes(Soc);
finally
end;
DoSend(Soc, 'QUIT');
SMTPRes(Soc);
finally
// M???
shutdown(Soc,2);
end;
finally
// \Pbgj
closesocket(Soc);
end;
end;
procedure WinSockInit;
var
wVersionRequested: WORD;
wsaDat: WSAData;
nErrorStatus: Integer; // WinSock?
begin
// WinSock?s
wVersionRequested := MAKEWORD(1, 1); // o[W 1.1
v
nErrorStatus := WSAStartup(wVersionRequested, wsaDat);
WinSockInitError := (nErrorStatus 0);
end;
initialization
WinSockInit;
finalization
WSACleanup;
end.
I found it in http://www.nifty.ne.jp/forum/fdelphi/samples/01302.html
But it didn't work :-( , I think that it wants a suitable socket for smtp
If u found suitable socket plz tell me
tanx
Arad_hacker@delphi3000.com
]]>