500分寻求发email的代码 ( 积分: 200 )

需要一段完整的发邮件的代码,高人可以采用下列任意一种.

1.通过调用outlook express发邮件,需要可携带附件.
2.通过SMTP协议发送邮件,需要可携带附件.

采用第三方控件实现也可以,但不能是收费控件,最好能告诉我控件的下载地址.

现在不怎么干编码,脑袋反应慢,希望有高人能帮个忙,500分酬谢.其它分数另开贴子结帐.

如果调用outlook express可以用ShellExecute;也可以直接用delphi中smtp组件

能否提供测试代码

非常感谢

调用默认邮件程序发送附件，支持outlook 或者foxmail
procedure TForm1.Email1Click(Sender: TObject);
VAR
ss,ss2 : STRING;
reg1: Tregistry;
begin
reg1:= Tregistry.Create;
reg1.RootKey:= HKEY_CLASSES_ROOT;
reg1.OpenKeyReadOnly('mailto/shell/open/command');
ss:= reg1.ReadString('');
reg1.Free;
if pos('Outlook',ss)= 0 then
begin
delete(ss,1,1);
ss:= copy(ss,1,pos('"',ss)-1);
shellexecute(handle,'open',pchar(ss),pchar(' "'+ss2+'"'),nil,sw_shownormal);
//winexec(pchar(ss+' "'+ss2+'"'),sw_shownormal);
end else begin
M_sendmail_byoutlook(ss2);
end;

end;

procedure TForm1.M_sendmail_byoutlook(M_filename: string);
TYPE
TAttachAccessArray = ARRAY [0..0] OF TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
VAR
MapiMessage : TMapiMessage;
Receip : TMapiRecipDesc;
Attachments : PAttachAccessArray;
AttachCount : INTEGER;
iCount : INTEGER;
FileName : STRING;
Mail : TStringlist;
BEGIN
Mail:= Tstringlist.Create;
mail.values['to'] := '';
mail.values['subject'] := '';
mail.values['body'] := '';
mail.values['attachment0'] := M_filename;//附件路径要存在

fillChar(MapiMessage, SizeOf(MapiMessage), #0);
//Attachments := NIL;
fillChar(Receip,SizeOf(Receip), #0);
IF Mail.Values['to'] <> ''
THEN
BEGIN
Receip.ulReserved := 0;
Receip.ulRecipClass := MAPI_TO;
Receip.lpszName := StrNew(PChar(Mail.Values['to']));
Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
Receip.ulEIDSize := 0;
MapiMessage.nRecipCount := 1;
MapiMessage.lpRecips := @Receip;
END;
AttachCount := 0;
FOR iCount := 0 TO MaxInt
DO
BEGIN
IF Mail.Values['attachment' + IntToStr(iCount)] = ''
THEN
BREAK;
AttachCount := AttachCount + 1;
END;
IF AttachCount > 0
THEN
BEGIN
GetMem(Attachments,SizeOf(TMapiFileDesc) * AttachCount);
FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
FileName := Mail.Values['attachment' + IntToStr(iCount)];
Attachments[iCount].ulReserved := 0;
Attachments[iCount].flFlags := 0;
Attachments[iCount].nPosition := ULONG($FFFFFFFF);
Attachments[iCount].lpszPathName := StrNew(PChar(FileName));
Attachments[iCount].lpszFileName := StrNew(PChar(ExtractFileName(FileName)));
Attachments[iCount].lpFileType := NIL;
END;
MapiMessage.nFileCount := AttachCount;
MapiMessage.lpFiles := @Attachments^;
END;

IF Mail.Values['subject'] <> ''
THEN
MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
IF Mail.Values['body'] <> ''
THEN
MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

//MapiSendMail(0, Handle, MapiMessage,MAPI_DIALOG*Ord(Handle <> 0) OR MAPI_LOGON_UI OR MAPI_NEW_SESSION, 0);
MapiSendMail(0, Application.Handle, MapiMessage,
MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
(* FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
strDispose(Attachments[iCount].lpszPathName);
strDispose(Attachments[iCount].lpszFileName);
END;

IF assigned(MapiMessage.lpszSubject)
THEN
strDispose(MapiMessage.lpszSubject);
IF assigned(MapiMessage.lpszNoteText)
THEN
strDispose(MapiMessage.lpszNoteText);
IF assigned(Receip.lpszAddress)
THEN
strDispose(Receip.lpszAddress);
IF assigned(Receip.lpszName)
THEN
strDispose(Receip.lpszName); *)

//MapiSendMail(0, Handle, MapiMessage,MAPI_DIALOG*Ord(Handle <> 0) OR MAPI_LOGON_UI OR MAPI_NEW_SESSION, 0);
mail.Free;
end;

to ufo
你的代码怎么这么长呀?我用ShellExecute调用outlook就一句哟,有区别吗?
ShellExecute(Handle,'open',pchar(csemail), nil,nil,SW_Show);

下面贴上我测试通过的代码,outlook express会弹出提示框,这种情况需要对outlook express的一些设置项目进行修改,谢谢上面的两位朋友.

FUNCTION SendEMail(Handle : THandle; Mail : TStrings):Cardinal;
TYPE
TAttachAccessArray = ARRAY [0..0] OF TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
VAR
MapiMessage : TMapiMessage;
Receip : TMapiRecipDesc;
Attachments : PAttachAccessArray;
AttachCount : INTEGER;
iCount : INTEGER;
FileName : STRING;
BEGIN
fillChar(MapiMessage, SizeOf(MapiMessage), #0);
Attachments := NIL;
fillChar(Receip,SizeOf(Receip), #0);
IF Mail.Values['to'] <> ''
THEN
BEGIN
Receip.ulReserved := 0;
Receip.ulRecipClass := MAPI_TO;
Receip.lpszName := StrNew(PChar(Mail.Values['to']));
Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
Receip.ulEIDSize := 0;
MapiMessage.nRecipCount := 1;
MapiMessage.lpRecips := @Receip;
END;
AttachCount := 0;
FOR iCount := 0 TO MaxInt
DO
BEGIN
IF Mail.Values['attachment' + IntToStr(iCount)] = ''
THEN
BREAK;
AttachCount := AttachCount + 1;
END;
IF AttachCount > 0
THEN
BEGIN
GetMem(Attachments,SizeOf(TMapiFileDesc) * AttachCount);
FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
FileName := Mail.Values['attachment' + IntToStr(iCount)];
Attachments[iCount].ulReserved := 0;
Attachments[iCount].flFlags := 0;
Attachments[iCount].nPosition := ULONG($FFFFFFFF);
Attachments[iCount].lpszPathName := StrNew(PChar(FileName));
Attachments[iCount].lpszFileName := StrNew(PChar(ExtractFileName(FileName)));
Attachments[iCount].lpFileType := NIL;
END;
MapiMessage.nFileCount := AttachCount;
MapiMessage.lpFiles := @Attachments^;
END;

IF Mail.Values['subject'] <> ''
THEN
MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
IF Mail.Values['body'] <> ''
THEN
MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

Result := MapiSendMail(0, Handle, MapiMessage,MAPI_NEW_SESSION, 0);

FOR iCount := 0 TO (AttachCount - 1)
DO
BEGIN
strDispose(Attachments[iCount].lpszPathName);
strDispose(Attachments[iCount].lpszFileName);
END;

IF assigned(MapiMessage.lpszSubject)
THEN
strDispose(MapiMessage.lpszSubject);
IF assigned(MapiMessage.lpszNoteText)
THEN
strDispose(MapiMessage.lpszNoteText);
IF assigned(Receip.lpszAddress)
THEN
strDispose(Receip.lpszAddress);
IF assigned(Receip.lpszName)
THEN
strDispose(Receip.lpszName);
END;