unit SendMailUnit;

interface
uses Classes, Sysutils, Forms, Winapi.Windows, Winapi.MAPI;

function SendEmail(const RecipName, RecipAddress, RecipCopyAddress,
Subject, BodyText: String; Attachment: TStringList): Boolean;

type
  PWSTR = PWideChar;
  PMapiFileDescW = ^TMapiFileDescW;
  MapiFileDescW = record
    ulReserved: ULONG;        { Reserved for future use (must be 0)     }
    flFlags: ULONG;           { Flags                                   }
    nPosition: ULONG;         { character in text to be replaced by attachment }
    lpszPathName: PWSTR;      { Full path name of attachment file       }
    lpszFileName: PWSTR;      { Original file name (optional)           }
    lpFileType: LPVOID;       { Attachment file type (can be lpMapiFileTagExt) }
  end;
  TMapiFileDescW = MapiFileDescW;

  PMapiRecipDescW = ^TMapiRecipDescW;
  MapiRecipDescW = record
    ulReserved: ULONG;       { Reserved for future use                  }
    ulRecipClass: ULONG;     { Recipient class                          }
                             { MAPI_TO, MAPI_CC, MAPI_BCC, MAPI_ORIG    }
    lpszName: PWSTR;         { Recipient name                           }
    lpszAddress: PWSTR;      { Recipient address (optional)             }
    ulEIDSize: ULONG;        { Count in bytes of size of pEntryID       }
    lpEntryID: LPVOID;       { System-specific recipient reference      }
  end;
  TMapiRecipDescW = MapiRecipDescW;

  PMapiMessageW = ^TMapiMessageW;
  MapiMessageW = record
    ulReserved: ULONG;         { Reserved for future use (M.B. 0)       }
    lpszSubject: PWSTR;        { Message Subject                        }
    lpszNoteText: PWSTR;       { Message Text                           }
    lpszMessageType: PWSTR;    { Message Class                          }
    lpszDateReceived: PWSTR;   { in YYYY/MM/DD HH:MM format             }
    lpszConversationID: PWSTR; { conversation thread ID                 }
    flFlags: FLAGS;            { unread,return receipt                  }
    lpOriginator: PMapiRecipDescW; { Originator descriptor                  }
    nRecipCount: ULONG;        { Number of recipients                   }
    lpRecips: PMapiRecipDescW;  { Recipient descriptors                  }
    nFileCount: ULONG;         { # of file attachments                  }
    lpFiles: PMapiFileDescW;    { Attachment descriptors                 }
  end;
  TMapiMessageW = MapiMessageW;

  TFNMapiSendMailW = function(lhSession: LHANDLE; ulUIParam: ULONG_PTR;
    var lpMessage: TMapiMessageW; flFlags: FLAGS;
    ulReserved: ULONG): ULONG stdcall;

implementation

var
 sendMailW : TFNMapiSendMailW;
 MAPIModule: HModule = 0;
 MAPIDLL: string = 'MAPI32.DLL';

function MapiSendMailW(lhSession: LHANDLE; ulUIParam: ULONG_PTR;
  var lpMessage: TMapiMessageW; flFlags: FLAGS; ulReserved: ULONG): ULONG;
begin
  MAPIModule := LoadLibrary(PChar(MAPIDLL));
  @SendMailW := GetProcAddress(MAPIModule, 'MAPISendMailW');
  if @SendMailW <> nil then
    Result := SendMailW(lhSession, ulUIParam, lpMessage, flFlags, ulReserved)
  else Result := 2;
end;

function SendEmailAnsi(const RecipName, RecipAddress, RecipCopyAddress,
Subject, BodyText: String; Attachment: TStringList): Boolean;
var
  MapiMessage: TMapiMessage;
  MapiFileDesc: array of TMapiFileDesc;
  MapiRecipDesc: array of TMapiRecipDesc;
  i: integer;
begin

  if RecipCopyAddress<>'' then
  begin
  SetLength(MapiRecipDesc, 2);
  with MapiRecipDesc[0] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PAnsiChar(AnsiString(RecipName));
    lpszAddress := PAnsiChar(AnsiString(RecipAddress));
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  with MapiRecipDesc[1] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_CC;
    lpszName := PAnsiChar(AnsiString(RecipName));
    lpszAddress := PAnsiChar(AnsiString(RecipCopyAddress));
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  end else
  begin
  SetLength(MapiRecipDesc, 1);
  with MapiRecipDesc[0] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PAnsiChar(AnsiString(RecipName));
    lpszAddress := PAnsiChar(AnsiString(RecipAddress));
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  end;

   SetLength(MapiFileDesc, Attachment.Count);
   for i := 0 to Attachment.Count - 1 do
      with MapiFileDesc[i] do
      begin
         ulReserved:= 0;
         flFlags:= 0;
         nPosition:= i;
         lpszPathName:= PAnsiChar(AnsiString(Attachment.Strings[i]));
         lpszFileName:= nil;
         lpFileType:= nil;
      end;

  with MapiMessage do
  begin
    ulReserved := 0;
    lpszSubject := PAnsiChar(AnsiString(Subject));
    lpszNoteText := PAnsiChar(AnsiString(BodyText));
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    if RecipCopyAddress<>'' then
      nRecipCount := 2 else
      nRecipCount := 1;
    lpRecips := @MapiRecipDesc[0];
    if Attachment.Count > 0 then
    begin
      nFileCount:= Attachment.Count;
      lpFiles := @MapiFileDesc[0];
    end
    else
    begin
      nFileCount:= 0;
      lpFiles:= nil;
    end;
  end;

  i := MapiSendMail(0, Application.Handle, MapiMessage, MAPI_DIALOG
  or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
  Result:= i = SUCCESS_SUCCESS;
end;

function SendEmailW(const RecipName, RecipAddress, RecipCopyAddress,
Subject, BodyText: String; Attachment: TStringList): Boolean;
var
  MapiMessageW: TMapiMessageW;
  MapiFileDescW: array of TMapiFileDescW;
  MapiRecipDescW: array of TMapiRecipDescW;
  i: integer;
begin

  if RecipCopyAddress<>'' then
  begin
  SetLength(MapiRecipDescW, 2);
  with MapiRecipDescW[0] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PChar(RecipName);
    lpszAddress := PChar(RecipAddress);
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  with MapiRecipDescW[1] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_CC;
    lpszName := PChar(RecipName);
    lpszAddress := PChar(RecipCopyAddress);
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  end else
  begin
  SetLength(MapiRecipDescW, 1);
  with MapiRecipDescW[0] do
  begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PChar(RecipName);
    lpszAddress := PChar(RecipAddress);
    ulEIDSize := 0;
    lpEntryID := nil;
  end;
  end;

   SetLength(MapiFileDescW, Attachment.Count);
   for i := 0 to Attachment.Count - 1 do
      with MapiFileDescW[i] do
      begin
         ulReserved:= 0;
         flFlags:= 0;
         nPosition:= i;
         lpszPathName:= PChar(Attachment.Strings[i]);
         lpszFileName:= nil;
         lpFileType:= nil;
      end;

  with MapiMessageW do
  begin
    ulReserved := 0;
    lpszSubject := PChar(Subject);
    lpszNoteText := PChar(BodyText);
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    if RecipCopyAddress<>'' then
      nRecipCount := 2 else
      nRecipCount := 1;
    lpRecips := @MapiRecipDescW[0];
    if Attachment.Count > 0 then
    begin
      nFileCount:= Attachment.Count;
      lpFiles := @MapiFileDescW[0];
    end
    else
    begin
      nFileCount:= 0;
      lpFiles:= nil;
    end;
  end;

  i := MapiSendMailW(0, Application.Handle, MapiMessageW, MAPI_DIALOG
  or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
  MessageBox(Application.Handle, Pchar(IntToStr(i)), '', 0);
  Result:= i = SUCCESS_SUCCESS;
end;


function SendEmail(const RecipName, RecipAddress, RecipCopyAddress,
Subject, BodyText: String; Attachment: TStringList): Boolean;
begin
  Result := SendEmailW(RecipName, RecipAddress, RecipCopyAddress, Subject, BodyText, Attachment);
end;

end.