Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Enviar Email con MAPI y los campos cc y bcc (o cco) (https://www.clubdelphi.com/foros/showthread.php?t=37640)

Durbed 18-11-2006 12:33:57

Enviar Email con MAPI y los campos cc y bcc (o cco)
 
Tengo una función que envia un email mediante el MAPI a un lista de direcciones, pero solo he conseguido meterlas en el campo "to" (para), y ahora me han pedido, que meta algunas direcciones en el campo bcc (cco), para que los destinatarios de los emails no vean a quien mas fue enviado.

La función es:
Código Delphi [-]
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 Al intentar mandar el 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);
    Result := MapiSendMail(Mapi_Session, Handle, MapiMessage, MAPI_LOGON_UI, 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;


Y la llamada la realizo asi:
Código Delphi [-]
  ...   
  mail := TStringList.Create;
  For i := 0 To LBPara.Items.Count -1 Do
    destinatarios := destinatarios + LBPara.Items.Strings[i] + ', ';
  destinatarios := copy(destinatarios,1 , length(destinatarios)-2);
  try
    mail.values['to'] := destinatarios;
    mail.values['subject'] := EdAsunto.Text;
    mail.values['body'] := MCuerpo.Text;
    For i := 0 to LBAdjuntos.Items.Count -1 Do
      mail.values['attachment' + IntToStr(i)] := LBAdjuntos.Items.Strings[i];
    sendEMail(Application.Handle, mail);
  finally
    mail.Free;
  end;


Me da que debe ser una chorrada que se me ha debido pasar, pero bueno ya saben lo que dicen, 1000 ojos ven mas que dos ;)

PD: La funcion no es mia, yo solo la he realizado pequeñisimos retoques, pero no me acuerdo de donde la saque, así que pido perdon al autor por no acordarme de el.

Un saludo y gracias

dec 18-11-2006 12:48:21

Hola,

No me hagas mucho caso, pero, luego de ver cómo has de utilizar la función de marras, parece que la cosa indica que la solución podría venir con la instrucción que resalto a continuación:

Código Delphi [-]
mail.values['to'] := destinatarios;
mail.values['bcc'] := copiascarbonocultas; // blind carbon copy
mail.values['subject'] := EdAsunto.Text;
mail.values['body'] := MCuerpo.Text;

Y todavía podrías ir más allá, o más acá, como veas, dejando las "copias carbon" visibles para los destinatarios, o sea, justo lo que creo que no quieres:

Código Delphi [-]
mail.values['to'] := destinatarios;
mail.values['cc'] := copiascarbonocultas; // carbon copy
mail.values['subject'] := EdAsunto.Text;
mail.values['body'] := MCuerpo.Text;

O sea, prueba con lo primero, porque creo que es lo que puede servirte. Ya dirás qué tal. ;)

Durbed 18-11-2006 13:09:09

Gracias Dec, pero esa no es la solución, lo que tu propones solo es la llamada a la funcion, pero lo que hay que modificar aparte de la llamada es la propia función.

Sospecho que el tema va mas por aqui, pero no he conseguido nada.
Código Delphi [-]
  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;

//Introducir las direcciones al BCC
  if Mail.Values['bcc'] <> '' then
    begin
      Receip.ulReserved := 0;
      Receip.ulRecipClass := MAPI_TO;
      Receip.lpszName := StrNew(PChar(Mail.Values['bcc']));
      Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['bcc']));
      Receip.ulEIDSize := 0;
      MapiMessage.nRecipCount := 1;
      MapiMessage.lpRecips := @Receip;
    end;



dec 18-11-2006 13:15:43

Hola,

Sí; llevas razón. Lo que ocurrió fue que ví tan claro (ah, qué errado estaba) que ni siquiera me paré en la implementación de la función...

De todos modos investigaremos un poco a ver qué tal... ;)

dec 18-11-2006 13:26:19

Hola,

Prueba añadiendo el siguiente código fuente luego del bloque:

Código Delphi [-]
if Mail.Values['bcc'] <> '' then
begin
  {...}
end;

Código Delphi [-]
    if Mail.Values['bcc'] <> '' then
    begin
      Receip.ulReserved := 0;
      Receip.ulRecipClass := MAPI_BCC;
      Receip.lpszName := StrNew(PChar(Mail.Values['bcc']));
      Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['bcc']));
      Receip.ulEIDSize := 0;
      MapiMessage.nRecipCount := 1;
      MapiMessage.lpRecips := @Receip;
    end;

Básicamente se trataría de cambiar la constante "MAPI_TO" por la constante "MAPI_BCC"... y recoger el "valor" adecuado en este caso. Prueba a ver qué tal. ;)

Y si funcionara... ya puestos podrías ampliar un tanto la función (si te interesara) de manera que incluyeras el remitente del correo... a lo menos es lo que entiendo yo por "Indicates the original sender of the message", que es la descripción de la constante "MAPI_ORIG" tal como se lee en esta página.

A lo mejor, en este último caso, bastaría con cambiar el "bcc" del "valor" por "orig"... ya dirás qué tal. ;)

Durbed 18-11-2006 13:29:27

La combinacion de los dos no me ha funcionado, pero como en realidad tengo que meter todas las direcciones en el bcc, he cambiado el to, por el bcc y funciona perfectamente.

Muchas gracias. Muy buena la pagina esa ;)

PD: Del poner el remitente del correo se encarga tu cliente de correo, pues la función lo que hace es mandar el email atraves del cliente que tienes por defecto. Esta probado con Outlook y Mozilla Thunderbird y funciona, te pone el remitente de la cuenta de SMTP que tengas puesta por defecto para el correo saliente.

dec 18-11-2006 13:32:57

Hola,

Un momento, que creo que nos hemos hecho un lío con los mensajes... y es que he publicado estos míos últimos un tanto rápido... mea culpa, pues. Digo si has probado con el código de más arriba, esto es, si probaste a utilizar la constante "MAPI_BCC", en lugar de "MAPI_TO",... ¿sabes a qué me refiero no? A incluir tanto el "bloque" "TO" como el bloque "BCC"... ¿porqué no iba a funcionar?

Tal vez el tema pase por usar sendas variables "Receip" (distintas) o algo así... ¡no te rindas! :D :D


La franja horaria es GMT +2. Ahora son las 22:53:28.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi