Bien. La función (que funciona) queda así:
(Añadir la unidad MAPI al uses del formulario);
Código Delphi
[-] function SendMail(Handle: THandle; Mail: TStrings): Cardinal;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
TDirecAccessArray = array [0..0] of TMapiRecipDesc;
PDirecAccessArray = ^TDirecAccessArray;
var
MapiMessage: TMapiMessage;
Receip: PDirecAccessArray;
Attachments: PAttachAccessArray;
AttachCount, DireccionesCount: 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;
Receip := nil;
DireccionesCount := 0;
for i1 := 0 to MaxInt do begin
if Mail.Values['bcc' + IntToStr(i1)] = ''
then Break;
Inc(DireccionesCount);
end;
if DireccionesCount > 0 then
begin
GetMem(Receip, SizeOf(TMapiRecipDesc) * DireccionesCount);
for i1 := 0 to DireccionesCount - 1 do begin
Receip[i1].ulReserved := 0;
Receip[i1].ulRecipClass := MAPI_BCC;
Receip[i1].lpszName := StrNew(PChar(Mail.Values['bcc' + IntToStr(i1)]));
Receip[i1].lpszAddress := StrNew(PChar('SMTP:' +
Mail.Values['bcc' + IntToStr(i1)]));
Receip[i1].ulEIDSize := 0;
end;
MapiMessage.nRecipCount := DireccionesCount;
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 DireccionesCount - 1 do
begin
if Assigned(Receip[i1].lpszAddress)
then StrDispose(Receip[i1].lpszAddress);
if Assigned(Receip[i1].lpszName)
then StrDispose(Receip[i1].lpszName);
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);
MapiLogOff(MAPI_Session, Handle, 0, 0);
end;
end;
Y el código para los archivos adjuntos y los destinatarios podría ser este:
Código Delphi
[-] maillist := TStringList.Create;
direcciones := TStringList.Create;
with DM.QrMailSelect do begin
First;
while not eof do begin
if Trim(DM.QrMailSelectFnE_mail.Value) <> ''
then direcciones.Append(DM.QrMailSelectFnE_mail.Value);
Next;
end;
end;
for i := 0 to direcciones.Count - 1
do maillist.values['bcc' + IntToStr(i)] := direcciones.Strings[i];
try
maillist.values['subject'] := _('Document sending.');
for i := 0 to documentos.Count - 1
do maillist.values['attachment' + IntToStr(i)] := documentos.Strings[i];
sendMail(Application.Handle, maillist);
finally
maillist.Free;
direcciones.Free;
end;
Donde documentos es un stringlist que le paso en otro procedimiento.
Funciona perfectamente con todos los destinatarios ocultos, aunque se podría completar incluyendo también destinatarios 'to' y 'cc'.
Los grupos '_(' en el código forman parte del gnugettext. En el caso de no estar usando tal soporte, basta con eliminarlos.
Gracias a dec por su apoyo.