delphi中调用OUTLOOK发送邮件（带附件）(200分)

查看过以前的贴子，但没有找到确切可行的答案，再次提问。

你可能得要研究MIME的编码了，这个问题我也研究了好久，最后只能接受小于1K的用户
信息的返回。

uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
Outlook : variant;
Item : variant;
xlsFileName:String;
begin
Try
Outlook := CreateOLEObject('Outlook.Application');
try
Item:=Outlook.CreateItem(0);
xlsFileName:=ExtractFilePath(Application.EXEName)+'project1.exe';
Item.Attachments.Add(xlsFileName,1,1,'project1.exe');
Item.Display(1);
Finally
Update;
Screen.Cursor:=crHourGlass;
Outlook.Quit;
Screen.Cursor:=crDefault;
end;
Except
Showmessage('错误：本机未安装OutLook,或OutLook打开错误！');
End;

end;
//调试通过

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses mapi;
{$R *.DFM}
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_DIALOG*Ord(Handle <> 0) 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);
END;


procedure TForm1.Button1Click(Sender: TObject);
VAR
mail : TStringList ;
BEGIN
mail := TStringList.Create;
mail.values['to'] := 'delphi2000@8848.net';
mail.values['subject'] := 'A subject';
mail.values['body'] := 'Some body text (line 1)';
mail.values['body'] := 'Some more body text (line 2)';
mail.values['attachment0'] := 'f:/a.txt';//附件路径要存在
sendEMail(Application.Handle, mail);
mail.Free;
end;

end.

这是我查询以前帖子所得到的，发送邮件时没有提示出错，但却没有收邮件，不知何解？

gz

gz

刚发现一个问题，如果直接打开OUTLOOK，再运行这个程序发送，就成功，为什么？
如何解决？

gz

用函数 SHFileExecute() 不可以吗？
注意用 mailto:xxx@123.com 的文件名，它可以自动调出 outlook express 窗口

如果仅仅是启动Outlook这样：
ShellExecute(Handle,nil,PChar('MailTo:YourEMailAdress'),nil,nil,SW_SHOWNORMAL);

源码空间去看看

用NMSMTP解决问题了，感谢各位的参与。

如果各位也用NMSMTP的话，有问题大家可以一齐研究。QQ：386665