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
[1] [2] [3] 下一页 |
