Форум программистов [Powered by Invision Power Board]

Цитата(Snowy @ 28.5.2007, 19:31

)

Через MAPI.
Ищи поиском - пример я уже давал.

Код


function SendEMail(MailFrom: string; const MailTo: array of string;
  Subject, Body: string; const Attach: array of string):
  Cardinal;
var
  Mess: TMapiMessage;
  MRD:   array of TMapiRecipDesc;
  Files: array of TMapiFileDesc;
  i: integer;
  Session: THandle;
begin
  result := MapiLogon(0,nil,nil, MAPI_LOGON_UI or MAPI_NEW_SESSION,0,@Session);
  if (result = SUCCESS_SUCCESS) then
  begin
    FillChar(Mess, SizeOf(Mess), 0);
    if Subject <> '' then Mess.lpszSubject := PChar(Subject);
    if Body <> '' then Mess.lpszNoteText := PChar(Body);
    if Length(MailTo) > 0 then
    begin
      SetLength(MRD, Length(MailTo));
      for i:=0 to Length(MailTo)-1 do
      begin
        MRD[i].ulReserved := 0;
        MRD[i].ulRecipClass := MAPI_TO;
        MRD[i].lpszName := PChar(MailTo[i]);
        MRD[i].lpszAddress := PChar('SMTP:'+MailTo[i]);
        MRD[i].ulEIDSize := 0;
        MRD[i].lpEntryID := nil;
      end;
      Mess.nRecipCount := Length(MailTo);
      Mess.lpRecips := @MRD[0];
    end;
    if Length(Attach) > 0 then
    begin
      SetLength(Files, Length(Attach));
      for i := 0 to Length(Attach) - 1 do
      begin
        Files[i].ulReserved := 0;
        Files[i].flFlags := 0;
        Files[i].nPosition := ULONG($FFFFFFFF);
        Files[i].lpszPathName := PChar(Attach[i]);
        Files[i].lpszFileName := PChar(ExtractFileName(Attach[i]));
        Files[i].lpFileType := nil;
      end;
      Mess.nFileCount := Length(Attach);
      Mess.lpFiles := @Files[0];
    end;
    try
      result := MapiSendMail(Session, 0, Mess, MAPI_DIALOG, 0);
    except
      result := MAPI_E_FAILURE;
    end;
    MapiLogOff(Session, 0, 0, 0);
  end;
end;

Цитата(Snowy @ 29.5.2007, 14:26)

Попробуй этот код: http://forum.vingrad.ru/index.php?showtopic=72085&view=findpost&p=572116
Только так и юзай - отдельным модулем.
MAPI - штука загадочная...

Цитата(Snowy @ 29.5.2007, 16:29)

Ты сохранил код, как отдельный модуль, али вставил куда?
Эта ошибка лезет, если код вставлен.
Нужно его сохранить как отдельный pas файл и подключить к проекту.

Код


unit EMail;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MAPI;


function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;

implementation

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;

end.

Цитата(Rennigth @ 29.5.2007, 17:58)

http://forum.vingrad.ru/forum/topic-59901/anchor-entry478869/0.html
Компонент более-менее стабильно работает и с разными почтовиками.

Код


procedure TForm1.btn1Click(Sender: TObject);
var
  lMail: TMapiControl;
  lFiles: TStrings;
begin
  lMail := TMapiControl.Create(Self);
  try
    lMail.Reset;
    lMail.Recipients.Add('[email protected]');
    lMail.Recipients.Add('[email protected]');
    lMail.Subject := 'сабж';
    lMail.Body := 'Текст письма';
    lMail.ShowDialog := True; //Показывать перед отправкой диалог мейл-клиента по умолчанию или нет.

    lFiles := TStringList.Create;
    //Файлы должны существовать!
    lFiles.Add('c:\text1.txt');
    lFiles.Add('c:\text2.txt');
    try
      lMail.AttachedFiles := lFiles;
    finally
      lFiles.Free;
    end;

    lMail.Sendmail;
  finally
    lMail.Free;
  end;
end;

Цитата(Rennigth @ 29.5.2007, 18:31

)

Delphist,
Примерно так:

Код


lMail.Recipients.Add('[email protected]');
lMail.Recipients.Add('[email protected]');

Код


lMail.Recipients.Add('[email protected]');
lMail.Recipients.Add('[email protected]');
lMail.Recipients.Add('[email protected]');

Код


            lRegistry := nil;
          try
            lRegistry := TRegistry.Create(KEY_READ);
            lRegistry.RootKey := hkey_local_machine;
            lRegistry.OpenKey('SOFTWARE\Clients\Mail',true);
            lMailDefault := lRegistry.ReadString('');
            lRegistry.CloseKey;
          finally
            lRegistry.Free;
          end;

Код


{  Эта процедура составляет и отправляет Email }
procedure TMapiControl.Sendmail;
var
  MapiMessage: TMapiMessage;
  MError: Cardinal;
  Sender: TMapiRecipDesc;
  MRD: array of TMapiRecipDesc;
  Files: array of TMapiFileDesc;
  i: Integer;
  AppHandle: THandle;
  lMailDefault : string;
  lRegistry: TRegistry;
begin
  { Перво-наперво сохраняем Handle приложения, if not
    the Component might fail to send the Email or
    your calling Program gets locked up. }
  AppHandle := Application.Handle;
  {Если Вы используете этот компонент совместно с Outlook97 или 2000
   не Express версии, то нам прийдётся добавить 'SMTP:' в начало
   каждого (email-) адреса}

  lRegistry := TRegistry.Create(KEY_READ);
  try
    lRegistry.RootKey := hkey_local_machine;
    lRegistry.OpenKey('SOFTWARE\Clients\Mail',true);
    lMailDefault := lRegistry.ReadString('');
    lRegistry.CloseKey;
  finally
    lRegistry.Free;
  end;

  FillChar(MapiMessage, SizeOf(MapiMessage), 0);
  if FSubject <> '' then MapiMessage.lpszSubject := PChar(FSubject);
  if FMailtext <> '' then MapiMessage.lpszNoteText := PChar(FMailText);

  { отправитель: (MAPI_ORIG) }
  Sender.ulReserved := 0;
  Sender.ulRecipClass := MAPI_ORIG;
  Sender.lpszName := PChar(FromName);
  Sender.lpszAddress := PChar(FromAdress);
  Sender.ulEIDSize := 0;
  Sender.lpEntryID := nil;
  MapiMessage.lpOriginator := @Sender;

  SetLength(MRD, 0);
  { У нас много получателей письма: (MAPI_TO) установим для каждого: }
  if FTOAdr.Count + FCCAdr.Count + FBCCAdr.Count > 0 then
  begin
    for i := 0 to FTOAdr.Count - 1 do
    begin
      SetLength(MRD, Length(MRD) + 1);
      MRD[High(MRD)].ulReserved := 0;
      MRD[High(MRD)].ulRecipClass := MAPI_TO;
      MRD[High(MRD)].lpszName := PChar(FTOAdr.Strings[i]);
      if AnsiUpperCase(lMailDefault) = 'MOZILLA THUNDERBIRD' then
        MRD[High(MRD)].lpszAddress := PChar(FTOAdr.Strings[i])
      else
        MRD[High(MRD)].lpszAddress := PChar('SMTP:' + FTOAdr.Strings[i]);
      MRD[High(MRD)].ulEIDSize := 0;
      MRD[High(MRD)].lpEntryID := nil;
    end;

    { То же самое проделываем с получателями копии письма: (CC, MAPI_CC) }
    for i := 0 to FCCAdr.Count - 1 do
    begin
      SetLength(MRD, Length(MRD) + 1);
      MRD[High(MRD)].ulReserved := 0;
      MRD[High(MRD)].ulRecipClass := MAPI_CC;
      MRD[High(MRD)].lpszName := PChar(FCCAdr.Strings[i]);
      MRD[High(MRD)].lpszAddress := PChar('SMTP:' + FCCAdr.Strings[i]);
      MRD[High(MRD)].ulEIDSize := 0;
      MRD[High(MRD)].lpEntryID := nil;
    end;

    { ... тоже самое для Bcc: (BCC, MAPI_BCC) }
    for i := 0 to FBCCAdr.Count - 1 do
    begin
      SetLength(MRD, Length(MRD) + 1);
      MRD[High(MRD)].ulReserved := 0;
      MRD[High(MRD)].ulRecipClass := MAPI_BCC;
      MRD[High(MRD)].lpszName := PChar(FBCCAdr.Strings[i]);
      MRD[High(MRD)].lpszAddress := PChar('SMTP:' + FBCCAdr.Strings[i]);
      MRD[High(MRD)].ulEIDSize := 0;
      MRD[High(MRD)].lpEntryID := nil;
    end;
  end;
  MapiMessage.nRecipCount := Length(MRD);
  if MapiMessage.nRecipCount <> 0 then
    MapiMessage.lpRecips := @MRD[0]
  else
    MapiMessage.lpRecips := nil;

  { Теперь обработаем прикреплённые к письму файлы: }
  SetLength(Files, 0);
  if FAttachedFileName.Count > 0 then
  begin
    { Теперь составим структурку для прикреплённого файла: }
    for i := 0 to FAttachedFileName.Count  - 1 do
    begin
      SetLength(Files, Length(Files) + 1);
      Files[High(Files)].ulReserved := 0;
      Files[High(Files)].flFlags := 0;
      Files[High(Files)].nPosition := DWORD(-1);
      Files[High(Files)].lpszPathName := PChar(FAttachedFileName.Strings[i]);
      Files[High(Files)].lpszFileName := PChar(ExtractFileName(FAttachedFileName[i]));
      Files[High(Files)].lpFileType := nil;
    end;
  end;
  MapiMessage.nFileCount := Length(Files);
  if MapiMessage.nFileCount <> 0 then
    MapiMessage.lpFiles := @Files[0]
  else
    MapiMessage.lpFiles := nil;

  if FShowDialog then
    MError := MapiSendMail(0, AppHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
  else
    MError := MapiSendMail(0, AppHandle, MapiMessage, 0, 0);

  case MError of
    MAPI_E_USER_ABORT:
      begin
        if Assigned(FOnUserAbort) then
          FOnUserAbort(Self);
      end;
    SUCCESS_SUCCESS:
      begin
        if Assigned(FOnSuccess) then
          FOnSuccess(Self);
      end
  else if Assigned(FOnMapiError) then
    FOnMapiError(Self, MError);
  end;
end;

Цитата(Delphist @ 30.5.2007, 12:45

)

Вообще я немного переделал твой исходник т.к. там было еще больше такого рода нюансов.

Цитата(Rennigth @ 30.5.2007, 14:16

)

Ты по экспериментирой с приставкой SMTP:, F8-же еще никто не отменял