Авторизация

Логин: Пароль:
Регистрация Забыли свой пароль?

Как отправить почту из приложений, написанных на Delphi

Страницы: 1 2 След.
Как отправить почту из приложений, написанных на Delphi
#1
22.12.2009 21:29:56
Здравствуйте, подскажите, как можно отправить почту из приложений, написанных на Delphi. Знаю, что для этого нужно отправлять какие-то 4 команды, но я так и не смог в этом разобраться.
 
 
#2
22.12.2009 22:28:50
Если под отправкой четырех команд Вы подразумеваете отправку почты через telnet, то для этого нужно, если я ничего не путаю, послать приветствие, адрес отправителя, получателя и сам текст письма. Этого достаточно.
 
 
#3
22.12.2009 22:32:43
Может Вам лучше через веб-интерсфейс это все организовать. Сначала авторизуетесь на сайте, а затем отправляете данные скрипту, он уже письмо сам отправит smile:)
 
 
#4
22.12.2009 22:34:49
Зачем так делать? Есть более простые способы отправки.
Код
procedure TForm1.Button1Click(Sender: TObject);  
begin  
   NMSMTP1.Host := 'smtp.mailserver.com';   
   NMSMTP1.UserID := 'h.abdullah';   
   NMSMTP1.Connect;   
   NMSMTP1.PostMessage.FromAddress := 'hasan@excite.com';   
   NMSMTP1.PostMessage.ToAddress.Text := 'someone@xmail.com';   
   NMSMTP1.PostMessage.Body.Text := 'Текст письма';  
   NMSMTP1.PostMessage.Subject := 'Тема письма';  
   NMSMTP1.SendMail;   
   
end;
 
 
#5
22.12.2009 22:42:28
А вот есть еще несколько функций. Они позволяют отправлять почту через MAPI
Код
unit Email; 

interface 

uses Windows, SusUtils, Classes; 

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean; 
function IsOnline: Boolean; 

implementation 

uses Mapi; 

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean; 
var 
   MapiMessage: TMapiMessage;  
   MapiFileDesc: TMapiFileDesc;  
   MapiRecipDesc: TMapiRecipDesc;  
   i: integer;  
   s: string;  
   
begin 
   with MapiRecipDesc do   
   begin  
   
   ulRecerved:= 0;  
   ulRecipClass:= MAPI_TO;  
   lpszName:= PChar(RecipName);  
   lpszAddress:= PChar(RecipAddress);  
   ulEIDSize:= 0;  
   lpEntryID:= nil;  
   
  end; 
   with MapiFileDesc do   
   begin  
   
   ulReserved:= 0;  
   flFlags:= 0;  
   nPosition:= 0;  
   lpszPathName:= PChar(Attachment);  
   lpszFileName:= nil;  
   lpFileType:= nil;  
   
   end;  
   with MapiMessage do   
   begin  
   
   ulReserved := 0;  
   lpszSubject := nil;  
   lpszNoteText := PChar(Subject);  
   lpszMessageType := nil;  
   lpszDateReceived := nil;  
   lpszConversationID := nil;  
   flFlags := 0;  
   lpOriginator := nil;  
   nRecipCount := 1;  
   lpRecips := @MapiRecipDesc;  
   
     if length(Attachment) > 0 then   
       begin  
         nFileCount:= 1;  
         lpFiles := @MapiFileDesc;  
       end   
     else   
       begin  
         nFileCount:= 0;  
         lpFiles:= nil;  
       end;  
   end;  
   Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;  
   
end; 

function IsOnline: Boolean; 
var 
   RASConn: TRASConn;  
   dwSize,dwCount: DWORD;  
   
begin 
   RASConns.dwSize:= SizeOf(TRASConn);  
   dwSize:= SizeOf(RASConns);  
   Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);  
   Result:= (Res = 0) and (dwCount > 0);  
   
end; 

end.
 
 
#6
22.12.2009 22:46:41
Хорошие функции, но лично мне больше нравиться использовать компоненты. Во вложении код одного из них.
MAPI.pas (10.85 КБ) [ Скачать ]
 
 
#7
23.12.2009 00:12:04
Спасибо всем за советы сделал так
Код
procedure TForm1.Button1Click(Sender: TObject);
begin
NMSMTP1.Host := 'mail.ru';{Сервер отправки}
NMSMTP1.UserID := 'zma23@mail.ru';{Учётная запись на сервере}
NMSMTP1.Connect;{Соединение}
NMSMTP1.PostMessage.FromAddress:= 'zma23@mail.ru';{От кого}
NMSMTP1.PostMessage.ToAddress.Text:= 'zma@uuh0.bank.gov.ua';{Кому}
NMSMTP1.PostMessage.Body.Text:= memo1.Text;{Текст сообщения}
NMSMTP1.PostMessage.Subject:='Проверка!';{Тема}
NMSMTP1.PostMessage.Date:='27.01.04' ;{Дата}
NMSMTP1.PostMessage.localprogram:='Microsoft Outlook';{Прога отправки} { Эта строка вообще нужна? }
NMSMTP1.SendMail;{Отправка}
NMSMTP1.Disconnect;{Отсоединение}
end;

Но иногда у меня происходит проблема. Выдается ошибка
project project1.exe raised exeption class ESockError with message "Connection Failed".
Кто знает, что это такое и как от нее избавиться.
 
 
#8
23.12.2009 00:16:00
Это не проблема Вашей программы, а проблема сервера. От Вас это уже не зависит.
 
 
#9
23.12.2009 00:16:42
Была у меня однажды такая же проблема. Тогда я её решил, переписав код. Если нужно сделала отправку так
Код
 
const 
  // OlItemType constants 
  olMailItem = 0; 
  olAppointmentItem = 1;
  olContactItem = 2; 
  olTaskItem  = 3; 
  olJournalItem = 4; 
  olNoteItem = 5; 
  olPostItem = 6; 
  // OlAttachmentType constants 
  olByValue = 1; 
  olByReference = 4; 
  olEmbeddedItem = 5; 
  olOLE = 6; 

var 
  myOlApp, myItem, myRecipient, myAttachments: OleVariant; 
begin 
  myOlApp := CreateOLEObject('Outlook.Application'); 
  myItem := myOlApp.CreateItem(olMailItem); 
  myItem.Subject := 'Das Ist Test';
  myRecipient := myItem.Recipients.Add('адрес получателя');
  // Прикрепляем к письму файлы
  myAttachments := myItem.Attachments;
  myAttachments.Add('C:\1.txt', olByValue, 1, '1.txt');
  myItem.Send;
  myOlApp := VarNull;
  myItem := VarNull; 
  myRecipient := VarNull; 
  myAttachments := VarNull; 
end;
 
 
#10
23.12.2009 00:19:27
"Хорошо" вы решили проблему, только в таком случаи Outlook может выдать сообщение, что к нему пытается получить доступ другая программа.
 
 
#11
23.12.2009 00:36:12
Кстати, я раньше отправлял почту, использую com объекта outlook
Код
uses Outlook_TLB; 

var outlook : _application; 

Procedure Init; 
begin 
  outlook := Coapplication_.Create; 
end; 

procedure SendEmail; 
begin 
  with Outlook.CreateItem(olMailItem) as mailitem do 
    begin 
      To_ := 'email@email.com'; 
      cc:='email2@email.com'; 
      Subject := 'This is subject line'; 
      Body :='This is email body'; 
      Send; 
    end; 
end;
 
 
#12
23.12.2009 00:37:27
А у меня еще один вопрос. Как можно отправить файл, вложив его в письмо?
 
 
#13
23.12.2009 00:41:52
Я делаю так.
Код
uses ComObj; 

procedure TForm1.Button1Click(Sender: TObject);  
Const  
  // константы OlItemType  
  olMailItem = 0;  
  olAppointmentItem = 1;  
  olContactItem = 2;  
  olTaskItem  = 3;  
  olJournalItem = 4;  
  olNoteItem = 5;  
  olPostItem = 6;  
  // константы OlAttachmentType  
  olByValue = 1;  
  olByReference = 4;  
  olEmbeddedItem = 5;  
  olOLE = 6;  

var  
  myOlApp, myItem, myRecipient, myAttachments: OleVariant;  
begin  
  // файл VBScript для создания почтового сообщения и прикрепления к нему файла  
  myOlApp := CreateOLEObject('Outlook.Application');  
  myItem := myOlApp.CreateItem(olMailItem);  
  myItem.Subject := 'This is the Subject';  
  myRecipient := myItem.Recipients.Add('recipientaddress@recipienthost.com');  
  myItem.Body := #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + 'Hello,' + #13;  
  myItem.Body := myItem.Body + 'This code created this message and '+  
                               ' sent it and I didn''t even have' + #13;  
  myItem.Body := myItem.Body + 'to click the send button!!!' + #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + 'If you have any more problems, let me know' +  
#13;  
  myItem.Body := myItem.Body + 'rename to blah.vbs and run like this:' + #13;  
  myItem.Body := myItem.Body + 'wscript c:\blah.vbs' + #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + 'Eddie' + #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + 'const'+ #13;  
  myItem.Body := myItem.Body + '  // константы OlItemType'+ #13;  
  myItem.Body := myItem.Body + '  olMailItem = 0;'+ #13;  
  myItem.Body := myItem.Body + '  olAppointmentItem = 1;'+ #13;  
  myItem.Body := myItem.Body + '  olContactItem = 2;'+ #13;  
  myItem.Body := myItem.Body + '  olTaskItem  = 3;'+ #13;  
  myItem.Body := myItem.Body + '  olJournalItem = 4;'+ #13;  
  myItem.Body := myItem.Body + '  olNoteItem = 5;'+ #13;  
  myItem.Body := myItem.Body + '  olPostItem = 6;'+ #13;  
  myItem.Body := myItem.Body + '  // OlAttachmentType constants'+ #13;  
  myItem.Body := myItem.Body + '  olByValue = 1;'+ #13;  
  myItem.Body := myItem.Body + '  olByReference = 4;'+ #13;  
  myItem.Body := myItem.Body + '  olEmbeddedItem = 5;'+ #13;  
  myItem.Body := myItem.Body + '  olOLE = 6;'+ #13;  
  myItem.Body := myItem.Body + #13;  
  myItem.Body := myItem.Body + 'var'+ #13;  
  myItem.Body := myItem.Body + '  myOlApp, myItem, myRecipient, myAttachments:  
OleVariant;'+ #13;  
  myItem.Body := myItem.Body + 'begin'+ #13;  
  myItem.Body := myItem.Body + '  myOlApp :=  
CreateObject(''Outlook.Application'')' + #13;  
  myItem.Body := myItem.Body + '  myItem := myOlApp.CreateItem(olMailItem)' +  
#13;  
  myItem.Body := myItem.Body + '  myItem.Subject := ''This is the Subject''' +  
#13;  
  myItem.Body := myItem.Body + '  myItem.Body := ''This is the body''' + #13;  
  myItem.Body := myItem.Body + '  myRecipient := myItem.Recipients.Add  
('recipientaddress@recipienthost.com')' + #13;  
  myItem.Body := myItem.Body + '  myAttachments := myItem.Attachments' + #13;  
  myItem.Body := myItem.Body + '  // Теперь прикрепим файлы...' + #13;  
  myItem.Body := myItem.Body + '  myAttachments.Add ''C:\blah.txt'', olByValue,  
1, ''Blah.txt Attachment''' + #13;  
  myItem.Body := myItem.Body + '  myItem.Send' + #13;  
  myItem.Body := myItem.Body + '  myOlApp := VarNull;' + #13;  
  myItem.Body := myItem.Body + '  myItem := VarNull;' + #13;  
  myItem.Body := myItem.Body + '  myRecipient := VarNull;' + #13;  
  myItem.Body := myItem.Body + '  myAttachments := VarNull;' + #13;  
  myItem.Body := myItem.Body + 'end;' + #13;  
  // Теперь прикрепим файлы...  
  myAttachments := myItem.Attachments;  
  myAttachments.Add('C:\blah.txt', olByValue, 1, 'Blah.txt Attachment');  
  myItem.Send  
  myOlApp := VarNull;  
  myItem := VarNull;  
  myRecipient := VarNull;  
  myAttachments := VarNull;  
End;
 
 
#14
23.12.2009 00:47:30
Все прекрасно, только ваш код не будет работать с OutlookExpress. Нужно, чтобы обязательно был установлен MsOutlook, а его использует не каждый.
 
 
#15
23.12.2009 00:48:31
А я делаю так
Код
uses Outlook_TLB; 

var outlook : _application; 

Procedure Init; 
begin 
  outlook := Coapplication_.Create; 
end; 

procedure SendEmail; 
begin 
  with Outlook.CreateItem(olMailItem) as mailitem do 
    begin 
      To_ := 'email@email.com'; 
      cc:='email2@email.com'; 
      Subject := 'This is subject line'; 
      Attachments.Add('FileName',1,1,'This is attachment'); 
      Body :='This is email body'; 
      Send; 
    end; 
end;
 
 
#16
23.12.2009 00:49:39
У меня есть такая функция
Код
function SendMail(const From, Dest, Subject, Text, FileName: PChar;
Outlook: boolean):Integer;
var
 Message: TMapiMessage;
 Recipient, Sender: TMapiRecipDesc;
 File_Attachment: TMapiFileDesc;

 function MakeMessage: TMapiMessage;
 begin
   FillChar(Sender, SizeOf(Sender), 0);
   Sender.ulRecipClass := MAPI_ORIG;
   Sender.lpszAddress := From;

   FillChar(Recipient, SizeOf(Recipient), 0);
   Recipient.ulRecipClass := MAPI_TO;
   Recipient.lpszAddress := Dest;

   FillChar(File_Attachment, SizeOf(File_Attachment), 0);
   File_Attachment.nPosition := Cardinal(-1);
   File_Attachment.lpszPathName := FileName;

   FillChar(Result, SizeOf(Result), 0);
   with Message do begin
     lpszSubject := Subject;
     lpszNoteText := Text;
     lpOriginator := @Sender;
     nRecipCount := 1;
     lpRecips := @Recipient;
     nFileCount := 1;
     lpFiles := @File_Attachment;
   end;
 end;

var
 SM: TFNMapiSendMail;
 MAPIModule: HModule;
 MAPI_FLAG: Cardinal;
begin
 if Outlook then
  MAPI_FLAG:=MAPI_DIALOG
 else
  MAPI_FLAG:=0;
 MAPIModule := LoadLibrary(PChar(MAPIDLL));
 if MAPIModule = 0 then
   Result := -1
 else
   try
     @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
     if @SM <> nil then begin
       MakeMessage;
       Result := SM(0, Application.Handle, Message, MAPI_FLAG, 0);
     end else Result := 1;
   finally
     FreeLibrary(MAPIModule);
   end;
end;

Но, к сожалению, она отправляет только один файл, во вложении. Если кто-нибудь сможет доработать её так, чтобы она могла отправлять несколько файлов буду очень благодарен.
 
 
#17
23.12.2009 00:59:37
Как один из вариантов можно упаковать все файлы в один архив и отправлять его
 
 
#18
23.12.2009 01:03:00
Я сейчас так и делаю, но мне этот вариант не нравиться, поэтому и спрашивал совета.
 
 
#19
23.12.2009 01:14:08
Спасибо всем за такую полезную тему. А никто случайно не знает, как можно отправить письмо, если сервер требует авторизации. Отправку через web-интерфейс не предлагать.
 
 
#20
23.12.2009 01:17:30
Можно использовать компоненты Indy вот здесь есть хороший урок видеоурок http://delphiexpert.ru/view_lesson.php?id=46
 
 
#21
23.12.2009 01:21:50
Если на видео жалко трафика то, вот кусочек кода из моей программы. В нем все просто и понятно.
Код
IdMessage1->Body->Text= "Текст письма";
IdMessage1->From->Text= "адрес отправителя";
IdMessage1->Recipients->EMailAddresses= "адрес получателя";
IdMessage1->Subject="Тема письма";
IdSMTP1->UserId="адрес отправителя";
IdSMTP1->Password="пароль ящика отправителя";
IdSMTP1->Host="smtp.bk.ru"; //Может быть другой
IdSMTP1->Port= 25;
IdSMTP1->Connect();
IdSMTP1->Send(IdMessage1);
IdSMTP1->Disconnect();
 
 
#22
23.12.2009 01:26:13
Чтобы отправлять письма с вложениями можно использовать indy
Код
AnsiString sFile;
TIdAttachment *pAttachment;
sFile = "c:\\a.txt";

pAttachment = new TIdAttachment(IdMessage1->MessageParts,sFile);
IdMessage1->ContentType = "multipart/mixed";
IdMessage1->MessageParts->Add();
IdMessage1->MessageParts->Items[0] = pAttachment;

IdMessage1->Body->Text= "Письмо от рассылателя писем";
IdMessage1->From->Text= "";
IdMessage1->Recipients->EMailAddresses= "";
IdMessage1->Subject="Прайс лист от ";

IdSMTP1->UserId="";
IdSMTP1->Password="";
IdSMTP1->Host="smtp.bk.ru";
IdSMTP1->Port= 25;
IdSMTP1->Connect();
IdSMTP1->Send(IdMessage1);
IdSMTP1->Disconnect();
 
 
#23
23.12.2009 01:29:13
Вот нашел хороший исходник программы для отправки почты
SendMail.pas (5.23 КБ) [ Скачать ]
 
 
#24
23.12.2009 01:30:25
Чтобы не создавать новую тему спрошу здесь, думаю, многие с такой ситуацией уже сталкивались и смогут мне помочь. Я сейчас пишу программу отправки сообщений на почту. Вот что у меня получилось
Код
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 
  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; 
    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'] := 'REmail@test.ru'; 
    mail.values['subject'] := 'Hello'; 
    mail.values['body'] := ''; 
    mail.values['attachment0'] := 'C:\Test.txt'; 
    sendEMail(Application.Handle, mail); 
  finally 
    mail.Free; 
  end; 
end;

Проблема в том, что этот код прекрасно работает, когда нужно отправить сообщение на один e-mail, Но если адресов больше, то ничего не получается. Подскажите, как это исправить.
 
 
#25
23.12.2009 01:40:18
Создайте массив адресов и отправлять почту по этим адресам в цикле.
Изменено: Алексей Смирнов - 23.12.2009 01:41:50
 
 
 
Страницы: 1 2 След.
Читают тему (гостей: 1, пользователей: 0, из них скрытых: 0)