Enviar Email con MAPI y los campos cc y bcc (o cco)

[Durbed]

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:

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:

...
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]

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:


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:


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]

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.

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]

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 (http://msdn2.microsoft.com/en-us/library/ms529097.aspx)... ;)

[dec]

Hola,

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


if Mail.Values['bcc'] <> '' then
begin
{...}
end;



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 (http://msdn2.microsoft.com/en-us/library/ms529097.aspx).

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

[Durbed]

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]

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