Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2006.01.29;
Скачать: [xml.tar.bz2];

Вниз

Отправить почту   Найти похожие ветки 

 
АртемК   (2005-11-15 22:15) [0]

Привет всем!
Ребята, как через АПи отправить/принять почту.
Подскажите простенький пример, пожалуйста!
Зараннее благодарен!


 
WondeRu ©   (2005-11-16 10:21) [1]

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
 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"] := "Receiver-Email@test.xyz";
   mail.values["subject"] := "Hello";
   mail.values["body"] := "blah";
   mail.values["body"] := "blah";
   mail.values["attachment0"] := "C:\Test.txt";
   // mail.values["attachment1"]:="C:\Test2.txt";
   sendEMail(Application.Handle, mail);
 finally
   mail.Free;
 end;
end;



 
АртемК   (2005-11-16 21:15) [2]

Друг, спасибо.
Но выскакивает ошибка-error while trying to send email



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2006.01.29;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.04 c
4-1132253502
reskator
2005-11-17 21:51
2006.01.29
несколько USB мышей в качестве датчиков перемещений


4-1132555715
Deka
2005-11-21 09:48
2006.01.29
Как подменить некоторые функции DLL?


2-1137059398
Bratskiy
2006-01-12 12:49
2006.01.29
Запись значения ячейки таблицы в переменную


2-1136392163
asd
2006-01-04 19:29
2006.01.29
Кнопка


2-1137321045
Tonich
2006-01-15 13:30
2006.01.29
Число знаков





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский