1:
2:

uses 
  MAPI;                    

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:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
type
  TAttachAccessArray = array[0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  MapiMessage: TMapiMessage;
  Receip: TMapiRecipDesc;
  Origin: TMapiRecipDesc;
  Attachments: PAttachAccessArray;
  AttachCount: Integer;
  i1: integer;
  FileName: string;
  dwRet: Cardinal;
  MAPI_Session: Cardinal;
  WndList: Pointer;
begin
 // begin a Simple MAPI session
  dwRet := MapiLogon(Handle,
    PChar(''),
    PChar(''),
    MAPI_LOGON_UI or MAPI_NEW_SESSION,
    0, @MAPI_Session);

  if (dwRet <> SUCCESS_SUCCESS) then
  begin
    MessageBox(Handle,
      PChar('Error while trying to send email'),
      PChar('Error'),
      MB_ICONERROR or MB_OK);
  end
  else
  begin
    FillChar(MapiMessage, SizeOf(MapiMessage), #0);
    Attachments := nil;

    // Fill Receip property
    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;

    // Fill Origin(ator) property
    FillChar(Origin, SizeOf(Origin), #0);
    if Mail.Values['from'] <> '' then
    begin
      Origin.ulReserved := 0;
      Origin.ulRecipClass := MAPI_ORIG;
      Origin.lpszName := StrNew(PChar(Mail.Values['from']));
      Origin.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['from']));
      Origin.ulEIDSize := 0;
      Origin.lpEntryID := nil;
      MAPIMessage.lpOriginator := @Origin;
    end;

    AttachCount := 0;

    for i1 := 0 to MaxInt do
    begin
      if Mail.Values['attachment' + IntToStr(i1)] = '' then
        break;
      Inc(AttachCount);
    end;

    if AttachCount > 0 then
    begin
      GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

      for i1 := 0 to AttachCount - 1 do
      begin
        FileName := Mail.Values['attachment' + IntToStr(i1)];
        Attachments[i1].ulReserved := 0;
        Attachments[i1].flFlags := 0;
        Attachments[i1].nPosition := ULONG($FFFFFFFF);
        Attachments[i1].lpszPathName := StrNew(PChar(FileName));
        Attachments[i1].lpszFileName :=
          StrNew(PChar(ExtractFileName(FileName)));
        Attachments[i1].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']));

    WndList := DisableTaskWindows(0);
    try
      Result := MapiSendMail(MAPI_Session, Handle,
        MapiMessage, MAPI_DIALOG, 0);
    finally
      EnableTaskWindows(WndList);
    end;

    for i1 := 0 to AttachCount - 1 do
    begin
      StrDispose(Attachments[i1].lpszPathName);
      StrDispose(Attachments[i1].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);
    if Assigned(Origin.lpszAddress) then
      StrDispose(Origin.lpszAddress);
    if Assigned(Origin.lpszName) then
      StrDispose(Origin.lpszName);
    MapiLogOff(MAPI_Session, Handle, 0, 0);
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TfrmMain.btnSendClick(Sender: TObject);
var
  mail: TStringList;
  ssubject: string;
begin
  mail := TStringList.Create;
  try
    mail.values['from'] := 'from@xzy.net';
    mail.values['to'] := 'to@xzy.net';
    mail.values['subject'] := 'subject';
    mail.values['body'] := 'body';
    try
      sendEMail(Application.Handle, mail);
    except
    end;
  finally
    mail.Free;
  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:

procedure TMain.HelpMailClick(Sender: TObject);
var
  TOA:TOutlookApplication;
  MI: MailItem;
begin
    TOA:=  TOutlookApplication.Create(Self);
    TOA.ConnectKind := ckRunningOrNew;
    try
      TOA.Connect;
    except
      TOA.Free;
      MessageDlg('Outlook kann nicht geöffnet werden!',mtError,[mbok],0);
      exit;
    end;
    MI:= TOA.CreateItem(olMailItem) as MailItem;
    MI.Attachments.Add('Dateiname',emptyParam,EmptyParam,EmptyParam); // Attachment
    MI.HTMLBody:='HTML Body'; // ersetzen
    MI.Subject:='Subjekt';
    MI.Companies:= 'Your Company';
    MI.Categories:='HelpDesk';
    MI.Recipients.Add('Somewhere@never.go');
    MI.Display(1);
// Achtung hier wird die erzeugt Mail automatisch geöffnet, 
// da Outlook ab 2002 keinem externen Programm mehr gestattet, darüber
// eine Mail zu senden. Der User muß explizit das erlauben
// daher wird diese Mail erstmal angezeigt, der Outlook Warnhinweis entfällt
    TOA.Disconnect;
    TOA.Free;
end;