|
unit SMTP_Connections;
//------------------------------------------
//定义单元
//---------------------------------------------
interface
uses
Classes, StdCtrls;
const
WinSock = ’wsock32.dll’;
Internet = 2;
Stream = 1;
fIoNbRead = $4004667F;
WinSMTP = $0001;
LinuxSMTP = $0002;
type
TWSAData = packed record
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..256] of Char;
szSystemStatus: array[0..128] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
PHost = ^THost;
THost = packed record
Name: PChar;
aliases: ^PChar;
addrtype: Smallint;
Length: Smallint;
addr: ^Pointer;
end;
TSockAddr = packed record
Family: Word;
Port: Word;
Addr: Longint;
Zeros: array[0..7] of Byte;
end;
function WSAStartup Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock;
function socket Family,Kind,Protocol:integer):integer; stdcall; far; external winsock;
function shutdown Socket,How:Integer):integer; stdcall; far; external winsock;
function closesocket socket:Integer):integer; stdcall; far; external winsock;
function WSACleanup:integer; stdcall; far; external winsock;
function bind Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
function listen socket,flags:Integer):integer; stdcall; far; external winsock;
function connect socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
function accept socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock;
function WSAGetLastError:integer; stdcall; far; external winsock;
function recv socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock;
function send socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock;
function gethostbyname HostName:PChar):PHost; stdcall; far; external winsock;
function WSAIsBlocking:boolean; stdcall; far; external winsock;
function WSACancelBlockingCall:integer; stdcall; far; external winsock;
function ioctlsocket socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock;
function gethostname name:pchar; size:integer):integer; stdcall; far; external winsock;
procedure _authSendMail MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
function ConnectServer mhost:string;mport:integer):integer;
function ConnectServerwin mhost:string;mport:integer):integer;
function DisConnectServer:integer;
function Stat: string;
function SendCommand Command: String): string;
function SendData Command: String): string;
function SendCommandWin Command: String): string;
function ReadCommand: string;
function encryptB64 s:string):string;
var
mconnHandle: Integer;
mFin, mFOut: Textfile;
EofSock: Boolean;
mactive: Boolean;
mSMTPErrCode: Integer;
mSMTPErrText: string;
mMemo: TMemo;
implementation
uses
SysUtils, Sockets, IdBaseComponent,
IdCoder, IdCoder3to4, IdCoderMIME, IniFiles,Unit1;
var
mClient: TTcpClient;
procedure _authSendMail MailServer, uname, upass, mFrom, mFromName,
mToName, Subject: string; mto, mbody: TStringList);
var
tmpstr: string;
cnt: Integer;
mstrlist: TStrings;
RecipientCount: Integer;
begin
if ConnectServerWin Mailserver, 25) = 250 then
begin
Sendcommandwin ’AUTH LOGIN ’);
SendcommandWin encryptB64 uname));
SendcommandWin encryptB64 upass));
SendcommandWin ’MAIL FROM: ’ + mfrom);
for cnt := 0 to mto.Count - 1 do
SendcommandWin ’RCPT TO: ’ + mto[cnt]);
Sendcommandwin ’DATA’);
SendData ’Subject: ’ + Subject);
SendData ’From: "’ + mFromName + ’" <’ + mfrom + ’>’);
SendData ’To: ’ + mToName);
SendData ’Mime-Version: 1.0’);
SendData ’Content-Type: multipart/related; boundary="Esales-Order";’);
SendData ’ type="text/html"’);
SendData ’’);
SendData ’--Esales-Order’);
SendData ’Content-Type: text/html;’);
SendData ’ charset="iso-8859-9"’);
SendData ’Content-Transfer-Encoding: QUOTED-PRINTABLE’);
SendData ’’);
for cnt := 0 to mbody.Count - 1 do
SendData mbody[cnt]);
Senddata ’’);
SendData ’--Esales-Order--’);
Senddata ’ ’);
mSMTPErrText := SendCommand crlf + ’.’ + crlf);
try
mSMTPErrCode := StrToInt Copy mSMTPErrText, 1, 3));
except
end;
SendData ’QUIT’);
DisConnectServer;
end;
end;
function Stat: string;
var
s: string;
begin
s := ReadCommand;
Result := s;
end;
function EchoCommand Command: string): string;
begin
SendCommand Command);
Result := ReadCommand;
end;
function ReadCommand: string;
var
tmp: string;
begin
repeat
ReadLn mfin, tmp);
if Assigned mmemo) then
mmemo.Lines.Add tmp);
until Length tmp) < 4) or tmp[4] <> ’-’);
Result := tmp
end;
function SendData Command: string): string;
begin
Writeln mfout, Command);
end;
function SendCommand Command: string): string;
begin
Writeln mfout, Command);
Result := stat;
end;
function SendCommandWin Command: string): string;
begin
Writeln mfout, Command + #13);
Result := stat;
end;
function FillBlank Source: string; number: Integer): string;
var
a: Integer;
begin
Result := ’’;
for a := Length trim Source)) to number do
Result := Result + ’ ’;
end;
function IpToLong ip: string): Longint;
var
x, i: Byte;
ipx: array[0..3] of Byte;
v: Integer;
begin
Result := 0;
Longint ipx) := 0;
i := 0;
for x := 1 to Length ip) do
if ip[x] = ’.’ then
begin
Inc i);
if i = 4 then Exit;
end
else
begin
if not ip[x] in [’0’..’9’]) then Exit;
v := ipx[i] * 10 + Ord ip[x]) - Ord ’0’);
if v > 255 then Exit;
ipx[i] := v;
end;
Result := Longint ipx);
end;
function HostToLong AHost: string): Longint;
var
Host: PHost;
begin
Result := IpToLong AHost);
if Result = 0 then
begin
Host := GetHostByName PChar AHost));
if Host <> nil then Result := Longint Host^.Addr^^);
end;
end;
function LongToIp Long: Longint): string;
var
ipx: array[0..3] of Byte;
i: Byte;
begin
Longint ipx) := long;
Result := ’’;
for i := 0 to 3 do Result := Result + IntToStr ipx[i]) + ’.’;
SetLength Result, Length Result) - 1);
end;
procedure Disconnect Socket: Integer);
begin
ShutDown Socket, 1);
CloseSocket Socket);
end;
function CallServer Server: string; Port: Word): Integer;
var
SockAddr: TSockAddr;
begin
Result := socket Internet, Stream, 0);
if Result = -1 then Exit;
FillChar SockAddr, SizeOf SockAddr), 0);
SockAddr.Family := Internet;
SockAddr.Port := swap Port);
SockAddr.Addr := HostToLong Server);
if Connect Result, SockAddr, SizeOf SockAddr)) <> 0 then
begin
Disconnect Result);
Result := -1;
end;
end;
function OutputSock var F: TTextRec): Integer; far;
begin
if F.BufPos <> 0 then
begin
Send F.Handle, F.BufPtr^, F.BufPos, 0);
F.BufPos := 0;
end;
Result := 0;
end;
function InputSock var F: TTextRec): Integer; far;
var
Size: Longint;
begin
F.BufEnd := 0;
F.BufPos := 0;
Result := 0;
repeat
if IoctlSocket F.Handle, fIoNbRead, Size) < 0) then
begin
EofSock := True;
Exit;
end;
until Size >= 0);
F.BufEnd := Recv F.Handle, F.BufPtr, F.BufSize, 0);
EofSock := F.Bufend = 0);
end;
function CloseSock var F: TTextRec): Integer; far;
begin
Disconnect F.Handle);
F.Handle := -1;
Result := 0;
end;
function OpenSock var F: TTextRec): Integer; far;
begin
if F.Mode = fmInput then
begin
EofSock := False;
F.BufPos := 0;
F.BufEnd := 0;
F.InOutFunc := @InputSock;
F.FlushFunc := nil;
end
else
begin
F.Mode := fmOutput;
F.InOutFunc := @OutputSock;
F.FlushFunc := @OutputSock;
end;
F.CloseFunc := @CloseSock;
Result := 0;
end;
procedure AssignCrtSock Socket:integer; Var Input,Output:TextFile);
begin
with TTextRec Input) do
begin
Handle := Socket;
Mode := fmClosed;
BufSize := SizeOf Buffer);
BufPtr := @Buffer;
OpenFunc := @OpenSock;
end;
with TTextRec Output) do
begin
Handle := Socket;
Mode := fmClosed;
BufSize := SizeOf Buffer);
BufPtr := @Buffer;
OpenFunc := @OpenSock;
end;
Reset Input);
Rewrite Output);
end;
function ConnectServer mhost: string; mport: Integer): Integer;
var
tmp: string;
begin
mClient := TTcpClient.Create nil);
mClient.RemoteHost := mhost;
mClient.RemotePort := IntToStr mport);
mClient.Connect;
mconnhandle := callserver mhost, mport);
if mconnHandle<>-1) then
begin
AssignCrtSock mconnHandle, mFin, MFout);
tmp := stat;
tmp := SendCommand ’HELO bellona.com.tr’);
if Copy tmp, 1, 3) = ’250’ then
begin
Result := StrToInt Copy tmp, 1, 3));
end;
end;
end;
function ConnectServerWin mhost: string; mport: Integer): Integer;
var
tmp: string;
begin
mClient := TTcpClient.Create nil);
mClient.RemoteHost := mhost;
mClient.RemotePort := IntToStr mport);
mClient.Connect;
mconnhandle := callserver mhost, mport);
if mconnHandle<>-1) then
begin
AssignCrtSock mconnHandle, mFin, MFout);
tmp := stat;
tmp := SendCommandWin ’HELO bellona.com.tr’);
if Copy tmp, 1, 3) = ’250’ then
begin
Result := StrToInt Copy tmp, 1, 3));
end;
end;
end;
function DisConnectServer: Integer;
begin
closesocket mconnhandle);
mClient.Disconnect;
mclient.Free;
end;
function encryptB64 s: string): string;
var
hash1: TIdEncoderMIME;
p: string;
begin
if s <> ’’ then
begin
hash1 := TIdEncoderMIME.Create nil);
p := hash1.Encode s);
hash1.Free;
end;
Result := p;
end;
end.
//------------------------------------------
// 怎么使用定义好得相关单元
//---------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
SMTP_Connections;
procedure TForm1.Button1Click Sender: TObject);
var
mto, mbody: TStringList;
MailServer, uname, upass, mFrom, mFromName,
mToName, Subject: string;
begin
mMemo := Memo1; // 定义相关发送服务器
//..........................
MailServer := ’mail.163.com’;
uname := ’username’;
upass := ’password’;
mFrom := ’[email protected];
mFromName := ’forename surname’;
mToName := ’’;
Subject := ’Your Subject’;
//..........................
mto := TStringList.Create;
mbody := TStringList.Create;
try
mto.Add ’[email protected]’);
mbody.Add ’测试邮件’);
//发送.................
_authSendMail MailServer, uname, upass, mFrom, mFromName, mToName, Subject, mto, mbody);
//..........................
finally
mto.Free;
mbody.Free;
end;
end;
end.
| 
