avatar

直接用WinSockAPI发mail

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
//------------------------------------------
// 怎么使用定义好得相关单元
//---------------------------------------------
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.
Comments ( 2 ) Trackbacks ( 0 ) Leave a Reply
  1. avatar
  2. avatar
  3.                    
  1. No trackbacks yet.

    目前尚无任何 trackbacks 和 pingbacks.

    トラックバックはまだありません。

  • ☆*:.。. o(≧▽≦)o .。.:*☆
  • _(:з」∠)_
  • ♪(´ε` )
  • ψ(`∇´)ψ
  • (-_-#)
  • (=´∀`)人(´∀`=)
  • \(//∇//)\
  • ♪(*^^)o∀*∀o(^^*)♪
  • (((o(*゚▽゚*)o)))
  • (´・_・`)
  • σ(^_^;)
  • ( *`ω´)
  • (ノ`Д´)ノ
  • (( _ _ ))..zzzZZ
  • ( ̄▽ ̄)
  • ヽ(`Д´#)ノ
  • ((((;゚Д゚)))))))
  • (>_<)
  • (T_T)
  • ( T_T)\(^-^ )
  • ε=ε=ε=ε=ε=ε=┌(; ̄◇ ̄)┘