请问谁有用Delphi开发的邮件发送与接收程序.能够发送如163,sina,sohu邮件,用户验证(在线等待) (50分)

阿艺

Unregistered / Unconfirmed
GUEST, unregistred user!
请问谁有用Delphi开发的邮件发送与接收程序.能够发送如163,sina,sohu邮件的源代码.
 
呵呵,起始是很简单的东西
1.如果用控件是最简单的了,但是有的控件往往有限制或者毛病,我不是很喜欢
procedure TForm1.Button1Click(Sender: TObject);
begin
NMSMTP1.Host :=edit3.text;
NMSMTP1.Port :=strtoint(edit4.text);
NMSMTP1.UserID :=edit5.text;
NMSMTP1.connect;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if opendialog1.Execute then
listbox1.items.add(opendialog1.FileName);
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
listbox1.items.delete(listbox1.itemindex);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
NMSMTP1.PostMessage.FromAddress :=edit6.text;
NMSMTP1.PostMessage.Subject :=edit2.text;
NMSMTP1.PostMessage.ToAddress.Add (edit1.text);
NMSMTP1.PostMessage.Attachments.AddStrings(listbox1.items);
NMSMTP1.PostMessage.Body.Assign(memo1.lines);
NMSMTP1.SendMail ;
end;

procedure TForm1.NMSMTP1Connect(Sender: TObject);
begin
statusbar1.SimpleText :='正在连接SMTP服务器';
end;

procedure TForm1.NMSMTP1PacketSent(Sender: TObject);
begin
statusbar1.SimpleText :=inttostr(NMSMTP1.BytesSent)+'字节/'+inttostr(NMSMTP1.BytesTotal)+'字节';
end;

procedure TForm1.NMSMTP1EncodeEnd(Filename: String);
begin
statusbar1.SimpleText :='完成编码'+filename;
end;

procedure TForm1.NMSMTP1EncodeStart(Filename: String);
begin
statusbar1.SimpleText :='正在编码'+filename+'...';
end;

procedure TForm1.NMSMTP1ConnectionFailed(Sender: TObject);
begin
statusbar1.SimpleText :='连接失败';
end;

procedure TForm1.NMSMTP1HostResolved(Sender: TComponent);
begin
statusbar1.SimpleText :='找到服务器';
end;

procedure TForm1.NMSMTP1InvalidHost(var Handled: Boolean);
begin
statusbar1.SimpleText :='主机名非法';
end;

2.用socket api,说白了,也不难
下面的代码是获取http页面的,你只要看看smtp协议轻松就可以改成发邮件的
都是问答形式的
客户:服务器你好
服务器:用户名
客户:XXX
服务器:密码
客户:XXX
.......
类似这样的东西,一个字:很简单
const
//自定义windows消息
WM_CLIENT_READ = WM_USER + 103;
WM_CLIENT_READCLOSE = WM_USER + 105;
port = 80;
CRLF = #$0D#$0A;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
url: TEdit;
Button2: TButton;
Memo2: TMemo;
Panel2: TPanel;
Splitter1: TSplitter;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
dl: TCheckBox;
ip: TEdit;
port: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Splitter2: TSplitter;
Button1: TButton;
TabSet1: TTabSet;
WebBrowser1: TWebBrowser;
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure TabSet1Change(Sender: TObject;
NewTab: Integer;
var AllowChange: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn: TSockAddrIn;
procedure ReadData(var Message: TMessage);
message WM_CLIENT_READ;
procedure ClientReadClose(var Message: TMessage);
message WM_CLIENT_READCLOSE;
procedure ShowHtml(Browser: TWebBrowser;
content: string);
public
{ Public declarations }
procedure SendData(Content: string);
end;

var
Form1: TForm1;
firstrciv: integer;
implementation
{$R *.DFM}
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CloseSocket(s);
end;

procedure TForm1.SendData(Content: string);
var
value {,hostname}: string;
len: integer;
begin
value := Content;
len := sendto(s, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail')
else
if len <> Length(value) then
showmessage('Not Send all');
end;

procedure TForm1.ReadData(var Message: TMessage);
var
//buffer: array of char;
buffer: array[1..1000000] of char;
len: integer;
flen: integer;
Event: word;
value: string;
i: integer;
begin
flen := sizeof(FSockAddrIn);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
if firstrciv = 0 then
//如果是第一个包,分析http head
begin
i := 0;
while i <= len - 4do
begin
if (buffer = #13) and (buffer[i + 1] = #10) and (buffer[i + 2] = #13) and (buffer[i + 3] = #10) then
break;
inc(i);
end;
value := copy(buffer, 1, i);
Memo1.Lines.add(value);
value := copy(buffer, i, len - i);
Memo2.Lines.add(value);
end
else
begin
value := copy(buffer, 1, len);
Memo2.Lines.add(value);
end;
inc(firstrciv);
end;
end;

procedure TForm1.ClientReadClose(var Message: TMessage);
begin
case Message.LParam of
FD_READ: ReadData(Message);
FD_CLOSE: memo1.Lines.add('已关闭连接.');
end;
end;

function GetHostAddress(const hostname: string): u_long;
var
pHostAddr: PHostEnt;
type
T = ^u_long;
begin
pHostAddr := gethostbyname(PCHAR(hostname));
if (pHostAddr = nil) then
begin
result := 0;
end
else
begin
result := T(pHostAddr^.h_addr^)^;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
TempWSAData: TWSAData;
//dwIPAddr: integer;
ulHostAddress: u_long;
in_: TInAddr;
ToSend: string;
begin
firstrciv := 0;
// 初始化SOCKET dll
if WSAStartup($101, TempWSAData) = 1 then
showmessage('WSAStartup Error!');
s := Socket(AF_INET, SOCK_STREAM, 0);
//tcp通讯
//Socket创建失败
if (s = INVALID_SOCKET) then
begin
showmessage(inttostr(WSAGetLastError()) + ' Socket创建失败');
CloseSocket(s);
exit;
end;
if dl.Checked then
begin
memo1.Lines.Add('正在连接代理服务器 ' + ip.text + ':' + port.text);
ulHostAddress := inet_addr(pchar(ip.text));
end
else
begin
memo1.Lines.Add('正在连接 ' + ip.text + ':80');
//判断ip地址的格式
ulHostAddress := GetHostAddress(url.text);
//ulHostAddress := GetHostAddress(hostname);
in_.S_addr := ulHostAddress;
//edit2.Text := inet_ntoa(in_);
memo1.Lines.Add('正在连接 ' + url.text + ' [IP=' + inet_ntoa(in_) + ':80' + ']');
end;
if (ulHostAddress < 0) then
begin
showmessage('IPAddress is error!Please input again!');
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := ulHostAddress;
addr.sin_port := htons(80);
if connect(s, addr, sizeof(addr)) <> 0 then
begin
//showmessage('connect fail');
end;
memo1.Lines.Add('已连接.');
WSAAsyncSelect(s, Form1.Handle, WM_CLIENT_READCLOSE, FD_CLOSE xor FD_READ);
if dl.Checked then
ToSend := 'get http://' + url.text + ' HTTP/1.1' + CRLF
else
ToSend := 'GET / HTTP/1.1' + CRLF;
ToSend := ToSend + 'Accept: */*' + CRLF;
ToSend := ToSend + 'Accept-Language: en' + CRLF;
ToSend := ToSend + 'Accept-Encoding: gzip' + CRLF;
ToSend := ToSend + 'User-Agent: Mozilla/4.7 [fr] (AmstradOS;
I)' + CRLF;
if pos('/', url.text) <> 0 then
ToSend := ToSend + 'Host: ' + copy(url.text, 1, pos('/', url.text) - 1) + CRLF
else
ToSend := ToSend + 'Host: ' + url.text + CRLF;
if dl.Checked then
ToSend := ToSend + 'Proxy-Connection: Close' + CRLF
else
ToSend := ToSend + 'Connection: Close' + CRLF;
memo1.Lines.Add(ToSend);
ToSend := ToSend + CRLF + CRLF;
senddata(ToSend);
end;
 
主要是服务器上用户验证的问题怎么办.
 
服务器:用户名
客户:XXX
服务器:密码
客户:XXX
这不就是验证吗?建议在网上找smtp的协议看看,有中文的
 
我正好有,,,把信箱给我。我给你把代码和demo都发过去
 
to sohuandsina:
也给我发一份:hanjiabo@yahoo.com.cn
 
我也要一份,sgp_kq@msn.com
 
我也要一份,wangydm@163.net
 
to sohuandsina:
我也想要一份luwang0004@163.cm
 
to sohuandsina或其他高手!:
能发一份愿码(使用有控件要连带控件)和dem0,好吗!
不知你用的是delphi几开发的,5,6和7区别很大!
如好用,修改后一定再给你一份!另给分100分::zhang_yz@163.com
 
也給我一份好嗎
holyknight@acocell.com
 
我也要学习。
xieyong@whjs.com
 
to sohuandsina:
麻烦了,我也要一份
soft102@eyou.com
 
我曾经做过,用sakemail控件,很简单的.
但有的邮箱服务器通不过验证,163我试过可以.
 
我也要一份,希望是Delphi 6.0的
Sov@mickyland.com
如果能收到,测试正确,送你100分
 

Similar threads

S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
975
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
顶部