Ver Mensaje Individual
  #10  
Antiguo 17-09-2007
Avatar de maxvera
maxvera maxvera is offline
Miembro
 
Registrado: jun 2006
Posts: 21
Reputación: 0
maxvera Va por buen camino
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.
__________________
El colmo del inmovilismo es el 0 absoluto.

Última edición por maxvera fecha: 17-09-2007 a las 20:59:13.
Responder Con Cita