Отправка сообщения с вложением через OE

Вопрос: пытаюсь отправить сообщение с вложением через Outlook Express при помощи процедуры, приведенной ниже, но при этом появившееся окно сообщения зависает и не реагирует ни на какие действия. В чем может быть причина?

 procedure SendMail(Subject, Body, RecvAddress : string; Attachs : array of string);
 var
   MM, MS : Variant;
   i : integer;
 begin
   MS := CreateOleObject('MSMAPI.MAPISession');
   try
     MM := CreateOleObject('MSMAPI.MAPIMessages');
     try
       MS.DownLoadMail := False;
       MS.NewSession := False;
       MS.LogonUI := True;
       MS.SignOn;
       MM.SessionID := MS.SessionID;
 
       MM.Compose;
 
       MM.RecipIndex := 0;
       MM.RecipAddress := RecvAddress;
       MM.MsgSubject := Subject;
       MM.MsgNoteText := Body;
 
       for i := Low(Attachs) to High(Attachs) do
       begin
         MM.AttachmentIndex := i;
         MM.AttachmentPathName := Attachs[i];
       end;
       MM.Send(True);
       MS.SignOff;
     finally
       VarClear(MS);
     end;
   finally
     VarClear(MM);
   end;
 end;

Сообщение отредактировано: Mischka - 21.01.05, 11:41

 uses ..., MAPI;
 
// отправка письма с вложением
// =============================================================================
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;
  i1: integer;
  FileName: string;
  dwRet: Cardinal;
  MAPI_Session: Cardinal;
  WndList: Pointer;
begin
  Result := 0;
  dwRet := MapiLogon(Application.Handle,
    nil,
    nil,
    MAPI_NEW_SESSION + MAPI_LOGON_UI,
    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;
    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 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);
    MapiLogOff(MAPI_Session, Handle, 0, 0);
  end;
end;

пример вызова:

procedure TForm1.Button1Click(Sender: TObject);
var
  Mail: TStringList;
begin
  Mail := TStringList.Create;
  try
    Mail.values['to'] := 'почтовый@адрес';
    Mail.values['subject'] := 'Тема письма';
    Mail.values['body'] := 'Любой текст письма';
    Mail.values['attachment0'] := 'Путь к файлу';
    sendEMail(Application.Handle, Mail);
  finally
    Mail.Free;
  end;
end;

А вот кстати, никто не пробовал отправлять таким образом сообщения , если клиент по умолчанию - The bat !
ver 2.10.01 а ОС WinXP prof SP2 русская. У меня дает ошибку с непонятным кодом. С Outlook все нормально.

Я пробовал, бат версии 2.04.7 - все без проблем...

если у кого-то не пойдет код предоставленный Rouse_ попробуйте отключить строку Аттачмента. должно заработать!

Сообщение отредактировано: Skynet - 08.08.05, 11:51

Просто нужно проверять, что файл аттача есть в наличии

У меня вопрос коллеги - пример Rouse_ прекрасно работает но мне надо чтобы он не только вызывал форму Outlook-а но и сразу отсылал письмо тоесть грубо говоря нажималась кн отправки в форме - как это сделать? Помогите гуру!

Цитата igr37 @ 27.02.14, 15:39

но и сразу отсылал письмо тоесть грубо говоря нажималась кн отправки в форме - как это сделать?

Этим способом - никак. Что собственно и правильно, ибо почтовик владеет данными об учетке с паролем, и так очень просто устроить спам рассылку, скомпроментировав ящик реципиента.
Если нужно отправлять полностью самостоятельно - нужно реализовывать SMTP в полном обьеме ручками.