über Outlook E-Mail senden

[toms]

Hallo

Moechte eine E-Mail ueber Outlook (2002, XP) senden.
Alles funktioniert ausser dass der Absender leer bleibt, obwowhl
dem MAPIMessage.lpOriginator der Absender zugewiesen wird.
Hat jemand was am Code nicht stimmt (oder liegt's am Outlook)?

Delphi-Quellcode:

uses 
  MAPI;

Delphi-Quellcode:

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;

Delphi-Quellcode:

procedure TfrmMain.btnSendClick(Sender: TObject);
var
  mail: TStringList;
  ssubject: string;
begin
  mail := TStringList.Create;
  try
    mail.values['from'] := '[e-mail]';
    mail.values['to'] := '[e-mail]';
    mail.values['subject'] := 'subject';
    mail.values['body'] := 'body';
    try
      sendEMail(Application.Handle, mail);
    except
    end;
  finally
    mail.Free;
  end;
end;