做一个邮件程序。控件为TNMSMTP/TNMPOP3.在SMTP认证这一块不会搞了。(100分)

  • 主题发起人 主题发起人 1111
  • 开始时间 开始时间
1

1111

Unregistered / Unconfirmed
GUEST, unregistred user!
做一个邮件程序。控件为TNMSMTP/TNMPOP3.程序快做完了,在SMTP认证这一块不会搞了。不能发SOHU.SINA等需SMTP认证的邮件。请高手指教。
 
这是认证那部分
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Psock, NMsmtp, ExtCtrls;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Edit1: TEdit;
NMSMTP1: TNMSMTP;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
TabSheet4: TTabSheet;
StatusBar1: TStatusBar;
Edit3: TEdit;
Label3: TLabel;
Button3: TButton;
Edit4: TEdit;
Label4: TLabel;
Memo1: TMemo;
Panel1: TPanel;
GroupBox1: TGroupBox;
Edit5: TEdit;
Edit6: TEdit;
Label5: TLabel;
Label6: TLabel;
Edit7: TEdit;
Label7: TLabel;
Edit8: TEdit;
Label8: TLabel;
Edit9: TEdit;
Label9: TLabel;
ListBox1: TListBox;
Label10: TLabel;
Button4: TButton;
Button5: TButton;
Memo2: TMemo;
Panel2: TPanel;
Button6: TButton;
Label11: TLabel;
Panel3: TPanel;
Label14: TLabel;
Button7: TButton;
Label12: TLabel;
OpenDialog1: TOpenDialog;
Edit10: TEdit;
Edit11: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure NMSMTP1Connect(Sender: TObject);
procedure NMSMTP1Disconnect(Sender: TObject);
procedure NMSMTP1Status(Sender: TComponent; Status: String);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure NMSMTP1EncodeStart(Filename: String);
procedure NMSMTP1EncodeEnd(Filename: String);
procedure Button7Click(Sender: TObject);
procedure NMSMTP1MailListReturn(MailAddress: String);
procedure NMSMTP1ConnectionFailed(Sender: TObject);
procedure NMSMTP1ConnectionRequired(var handled: Boolean);
procedure NMSMTP1Failure(Sender: TObject);
procedure NMSMTP1HostResolved(Sender: TComponent);
procedure NMSMTP1InvalidHost(var handled: Boolean);
procedure NMSMTP1PacketSent(Sender: TObject);
procedure NMSMTP1RecipientNotFound(Recipient: String);
procedure NMSMTP1SendStart(Sender: TObject);
procedure NMSMTP1Success(Sender: TObject);
procedure NMSMTP1HeaderIncomplete(var handled: Boolean;
hiType: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
//BaseTable为BASE64码表
const BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

var
Form1: TForm1;
function DecodeBase64(Source:string):string; //解码函数
function FindInTable(CSource:char):integer; //
function EncodeBase64(Source:string):string; //编码函数
implementation

{$R *.DFM}
//
function FindInTable(CSource:char):integer;
begin
result:=Pos(string(CSource),BaseTable)-1;
end;
////
function DecodeBase64(Source:string):string;
var
SrcLen,Times,i:integer;
x1,x2,x3,x4,xt:byte;
begin
result:='';
SrcLen:=Length(Source);
Times:=SrcLen div 4;
for i:=0 to Times-1 do
begin
x1:=FindInTable(Source[1+i*4]);
x2:=FindInTable(Source[2+i*4]);
x3:=FindInTable(Source[3+i*4]);
x4:=FindInTable(Source[4+i*4]);
x1:=x1 shl 2;
xt:=x2 shr 4;
x1:=x1 or xt;
x2:=x2 shl 4;
result:=result+chr(x1);
if x3= 64 then break;
xt:=x3 shr 2;
x2:=x2 or xt;
x3:=x3 shl 6;
result:=result+chr(x2);
if x4=64 then break;
x3:=x3 or x4;
result:=result+chr(x3);
end;
end;
/////
function EncodeBase64(Source:string):string;
var
Times,LenSrc,i:integer;
x1,x2,x3,x4:char;
xt:byte;
begin
result:='';
LenSrc:=length(Source);
if LenSrc mod 3 =0 then Times:=LenSrc div 3
else Times:=LenSrc div 3 + 1;
for i:=0 to times-1 do
begin
if LenSrc >= (3+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(Ord(Source[2+i*3]) shl 2) and 60;
xt:=xt or (ord(Source[3+i*3]) shr 6);
x3:=BaseTable[xt+1];
xt:=(ord(Source[3+i*3]) and 63);
x4:=BaseTable[xt+1];
end
else if LenSrc>=(2+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(ord(Source[2+i*3]) shl 2) and 60;
x3:=BaseTable[xt+1];
x4:='=';
end else
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
x2:=BaseTable[xt+1];
x3:='=';
x4:='=';
end;
result:=result+x1+x2+x3+x4;
end;
end;
//////////
procedure TForm1.Button1Click(Sender: TObject);
begin
NMSMTP1.Host := Edit1.Text;
NMSMTP1.Port := StrToInt(Edit2.Text);
NMSMTP1.UserID := Edit4.Text;
NMSMTP1.Connect;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
TmpStr: String;
begin
TmpStr := Edit3.Text; // Do this so the user can't change the edit box.
If NMSMTP1.Verify(TmpStr) then
ShowMessage(TmpStr+' verified')
else
ShowMessage(TmpStr+' not verified');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
NMSMTP1.Disconnect;
end;

procedure TForm1.NMSMTP1Connect(Sender: TObject);
begin
StatusBar1.SimpleText := 'Connected';
end;

procedure TForm1.NMSMTP1Disconnect(Sender: TObject);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := 'Disconnected';
end;

procedure TForm1.NMSMTP1Status(Sender: TComponent; Status: String);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := status;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
If OpenDialog1.Execute then
ListBox1.Items.Add(OpenDialog1.FileName);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
NMSMTP1.PostMessage.FromAddress := Edit6.Text;
NMSMTP1.PostMessage.FromName := Edit5.Text;
NMSMTP1.PostMessage.Subject := Edit10.Text;
NMSMTP1.PostMessage.ToAddress.Add(Edit7.Text);
NMSMTP1.PostMessage.ToBlindCarbonCopy.Add(Edit9.Text);
NMSMTP1.PostMessage.ToCarbonCopy.Add(Edit8.Text);
NMSMTP1.PostMessage.Attachments.AddStrings(Listbox1.Items);
NMSMTP1.PostMessage.Body.Assign(Memo1.Lines);
NMSMTP1.SendMail;
end;

procedure TForm1.NMSMTP1EncodeStart(Filename: String);
begin
StatusBar1.SimpleText := 'Encoding '+Filename;
end;

procedure TForm1.NMSMTP1EncodeEnd(Filename: String);
begin
StatusBar1.SimpleText := 'Finished encoding '+Filename;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
NMSMTP1.ExpandList(Edit11.Text);
end;

procedure TForm1.NMSMTP1MailListReturn(MailAddress: String);
begin
Memo2.Lines.Add(MailAddress);
end;

procedure TForm1.NMSMTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('Connection Failed');
end;

procedure TForm1.NMSMTP1ConnectionRequired(var handled: Boolean);
begin
If MessageDlg('Connection Required. Connect?', mtConfirmation, mbOkCancel, 0) = mrOk then
Begin
Handled := TRUE;
NMSMTP1.Connect;
End;
end;

procedure TForm1.NMSMTP1Failure(Sender: TObject);
begin
StatusBar1.SimpleText := 'Failure';
end;

procedure TForm1.NMSMTP1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'Host Resolved';
end;

procedure TForm1.NMSMTP1InvalidHost(var handled: Boolean);
var
TmpStr: String;
begin
If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
Begin
NMSMTP1.Host := TmpStr;
Handled := TRUE;
End;
end;

procedure TForm1.NMSMTP1PacketSent(Sender: TObject);
begin
StatusBar1.SimpleText := IntToStr(NMSMTP1.BytesSent)+' bytes of '+IntToStr(NMSMTP1.BytesTotal)+' sent';
end;

procedure TForm1.NMSMTP1RecipientNotFound(Recipient: String);
begin
ShowMessage('Recipient "'+Recipient+'" not found');
end;

procedure TForm1.NMSMTP1SendStart(Sender: TObject);
begin
StatusBar1.simpleText := 'Sending message';
end;

procedure TForm1.NMSMTP1Success(Sender: TObject);
begin
StatusBar1.SimpleText := 'Success';
end;

procedure TForm1.NMSMTP1HeaderIncomplete(var handled: Boolean;
hiType: Integer);
begin
ShowMessage('Header Incomplete.');
end;





procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
NMSMTP1.Abort;
end;

end.
 
一个利用TNMSmtp控件通过需要口令认证的SMTP服务器发送Email的的程序
http://www.aidelphi.com/6to23/docu/sendmail.zip
 
好长啊,谢谢先。读一下。
 
谢谢两位,程序很好用。
 
后退
顶部