Ver Mensaje Individual
  #22  
Antiguo 10-03-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
José Luis Garcí,

(Continuación del Msg #21)

Revisa este código:
Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SendMailMAPI(Subject, MsgText: String;
                      Filenames: TStrings;
                      SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
   TAttachAccessArray = array [0..0] of TMapiFileDesc;
   PAttachAccessArray = ^TAttachAccessArray;

var
   MailMessage: TMapiMessage;
   lpSender, lpRecepient: TMapiRecipDesc;
   FileName: string;
   Attachments: PAttachAccessArray;
   SM: TFNMapiSendMail;
   MAPIModule: HModule;
   Counter: Byte;

   AuxStr : String;
   pAuxStr : Array[0..255] of AnsiChar;

   pSubject : Array[0..255] of AnsiChar;
   pMsgText : Array[0..9999] of AnsiChar;
   pSenderName : Array[0..255] of AnsiChar;
   pSenderEMail : Array[0..255] of AnsiChar;
   pRecepientName : Array[0..255] of AnsiChar;
   pRecepientEMail : Array[0..255] of AnsiChar;
   pFileName : Array[0..255] of AnsiChar;
   pPathName : Array[0..255] of AnsiChar;

begin

   StrPCopy(pSubject,Subject);
   StrPCopy(pMsgText,MsgText);
   StrPCopy(pSenderName,SenderName);
   StrPCopy(pSenderEMail,SenderEMail);
   StrPCopy(pRecepientName,RecepientName);
   StrPCopy(pRecepientEMail,RecepientEMail);

   FillChar(MailMessage, SizeOf(MailMessage), 0);

   with MailMessage do
   begin

      if (Subject <> '') then
         MailMessage.lpszSubject := @pSubject;

      if (MsgText <> '') then
         MailMessage.lpszNoteText := @pMsgText;

      if (SenderEMail <> '') then
      begin

         lpSender.ulRecipClass := MAPI_ORIG;

         if (SenderName = '') then
            lpSender.lpszName := @pSenderEMail
         else
            lpSender.lpszName := @pSenderName;

         AuxStr := 'SMTP:' + SenderEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpSender.lpszAddress := @pAuxStr;
         lpSender.ulReserved := 0;
         lpSender.ulEIDSize := 0;
         lpSender.lpEntryID := nil;
         lpOriginator := @lpSender;

      end;

      if (RecepientEMail <> '') then
      begin
         lpRecepient.ulRecipClass := MAPI_TO;
         if (RecepientName = '') then
            lpRecepient.lpszName := @pRecepientEMail
         else
            lpRecepient.lpszName := @pRecepientName;

         AuxStr := 'SMTP:' + RecepientEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpRecepient.lpszAddress := @pAuxStr;
         lpRecepient.ulReserved := 0;
         lpRecepient.ulEIDSize := 0;
         lpRecepient.lpEntryID := nil;
         nRecipCount := 1;
         lpRecips := @lpRecepient;
      end
      else
         lpRecips := nil;

      if Filenames.Count > 0 then
      begin

         nFileCount := Filenames.Count;

         GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);

         for Counter := 0 to Filenames.Count - 1 do
         begin
            FileName := Filenames[counter];
            Attachments[counter].ulReserved := 0;
            Attachments[counter].flFlags := 0;
            Attachments[counter].nPosition := ULONG($FFFFFFFF);

            StrPCopy(pPathName, Filename);
            Attachments[counter].lpszPathName := StrNew(pPathName);

            StrPCopy(pFileName, ExtractFileName(Filename));
            Attachments[counter].lpszFileName := StrNew(pFileName);

            Attachments[counter].lpFileType := nil;
         end;

         lpFiles := @Attachments^;

      end
      else
      begin
         nFileCount := 0;
         lpFiles := nil;
      end;

   end;

   MAPIModule := LoadLibrary(PChar(MAPIDLL));
   if MAPIModule = 0 then
      Result := -1
   else
   begin
      try
         @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
         if @SM <> nil then
            Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
         else
            Result := 1
      finally
            FreeLibrary(MAPIModule);
      end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Subject : String;
   MsgText : TStringList;
   FileName : String;
   Filenames : TStringList;
   SenderName, SenderEMail, RecepientName, RecepientEMail : String;
   i : Integer;

begin

   Subject := 'Prueba de Email con MAPI';

   MsgText := TStringList.Create;

   for i := 1 to 10 do
      MsgText.Add('Línea de Texto-' + IntToStr(i));

   Filenames := TStringList.Create;

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile3.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   SenderName := 'UserName Surname';
   SenderEMail := 'userName@gmail.com';

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := 'anotheruserName@gmail.com';

   SendMailMAPI(Subject, MsgText.Text, Filenames,
                SenderName, SenderEMail, RecepientName, RecepientEMail);

   Filenames.Free;
   MsgText.Free;

end;

end.
El código anterior es la Versión 2 del código del Msg #21 la cual incluye una corrección y una mejora en el proceso de Attachment de archivos vía MAPI, ambas necesarias para el buen funcionamiento de la aplicación.

Espero sea útil

Nelson.
Responder Con Cita