unit sendmail;

{$mode objfpc}{$H+}

interface
{$IfNDef WINDOWS}
//damit man das nicht aus projekt dateien entfernen muß leere unit
implementation
end.
{$IfEnd}

uses
  Classes, {SysUtils,} LCLType, Mapi{, registry} //LCLType for Hwnd
  ,LazUTF8; //LazUTF8 UTF8ToWinCP

{
FromName: 	  Der Name des Absenders
FromAdress: 	  Die EMail-Adresse des Absenders
Subject: 	  Die Betreffzeile
Mailtext: 	  Der eigentliche Text der eMail
ToName: 	  Der Name des Empfängers
ToAdress: 	  Die EMail-Adresse des Empfängers
AttachedFileName: Der Dateiname der angehängten Datei
FileDisplayName:  Der in der Mail angezeigte Name der angehängten Datei
ShowDialog:	  true: Die Mail wird vor dem Absenden angezeigt
		  false: Die Mail wird "stumm" verschickt
}
function SendEMailByMAPI(WinHandle:HWND;
                   FromName,FromAdress,
                   Subject,Mailtext,
                   ToName,ToAdress,
                   AttachedFileName,
                   DisplayFileName:string;
                   ShowDialog:boolean):string;

function SendEMailByMAPI(WinHandle:HWND;
                   FromName,FromAdress,
                   Subject,Mailtext,
                   ToName,ToAdress: string;
                   AttachedFiles:TStringList;
                   ShowDialog:boolean):string;

//function SendEMailByMAPI(WinHandle:HWND; SenderName, SenderAddress, Subject, Body: string; Recipients, Attachments, AttachmentNames: TStrings; WithOpenMessage, ResolveNames, NeedReceipt: Boolean; intMAPISession: Integer): Integer;
implementation

function MapiErrMsg(AError: DWord): string;
begin
  case AError of
      MAPI_E_AMBIGUOUS_RECIPIENT:
        Result:='Empfänger nicht eindeutig. (Nur möglich, wenn Emailadresse nicht angegeben.)';

      MAPI_E_ATTACHMENT_NOT_FOUND:
        Result:='Datei zum Anhängen nicht gefunden';

      MAPI_E_ATTACHMENT_OPEN_FAILURE:
        Result:='Datei zum Anhängen konnte nicht geöffnet werden.';

      MAPI_E_BAD_RECIPTYPE:
        Result:='Empfängertyp nicht MAPI_TO, MAPI_CC oder MAPI_BCC.';

      MAPI_E_FAILURE:
        Result:='Unbekannter Fehler.';

      MAPI_E_INSUFFICIENT_MEMORY:
        Result:='Nicht genug Speicher.';

      MAPI_E_LOGIN_FAILURE:
        Result:='Benutzerlogin (z.B. bei Thunderbird, Outlook) fehlgeschlagen.';

      MAPI_E_TEXT_TOO_LARGE:
        Result:='Text zu groß.';

      MAPI_E_TOO_MANY_FILES:
        Result:='Zu viele Dateien zum Anhängen.';

      MAPI_E_TOO_MANY_RECIPIENTS:
        Result:='Zu viele Empfänger angegeben.';

      MAPI_E_UNKNOWN_RECIPIENT: Result:='Empfänger nicht in Adressbuch gefunden. '+LineEnding+'(Nur möglich, wenn Emailadresse nicht angegeben.)';

      MAPI_E_USER_ABORT:
        Result:='Benutzer hat Senden abgebrochen oder MAPI nicht installiert.';

      SUCCESS_SUCCESS:
        Result:=''; //MessageDlg('Erfolgreich !!! (Aber Absenden nicht garantiert.)';
      ELSE Result:='Unbekannter Fehler.';
  end;
end;

//aus: http://www.delphi-fundgrube.de/files/mapi.txt
function SendEMailByMAPI(WinHandle:HWND;
                   FromName,FromAdress,
                   Subject,Mailtext,
                   ToName,ToAdress,
                   AttachedFileName,
                   DisplayFileName:string;
                   ShowDialog:boolean):string;
var
  MapiMessage : TMapiMessage;
  MError      : DWord;
  Empfaenger  : Array[0..1] of TMapiRecipDesc;
  Absender    : TMapiRecipDesc;
  Datei       : Array[0..1] of TMapiFileDesc;
begin
  Result:='';
  with MapiMessage do begin
    ulReserved := 0;

    // Betreff
    lpszSubject := PChar(UTF8ToWinCP(Subject)); //soner

    // Body
    lpszNoteText := PChar(UTF8ToWinCP(Mailtext)); //soner

    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;

    // Absender festlegen
    Absender.ulReserved:=0;
    Absender.ulRecipClass:=MAPI_ORIG;
    Absender.lpszName:= PChar(FromName);
    Absender.lpszAddress:= PChar(FromAdress);
    Absender.ulEIDSize:=0;
    Absender.lpEntryID:=nil;
    lpOriginator := @Absender;

    // Empfänger festlegen (Hier: nur 1 Empfänger)
    nRecipCount := 1;

    Empfaenger[0].ulReserved:=0;
    Empfaenger[0].ulRecipClass:=MAPI_TO;
    Empfaenger[0].lpszName:= PChar(ToName);
    Empfaenger[0].lpszAddress:= PChar(ToAdress);
    Empfaenger[0].ulEIDSize:=0;
    Empfaenger[0].lpEntryID:=nil;
    lpRecips := @Empfaenger;

    // Dateien anhängen (Hier: nur 1 Datei)
    nFileCount := 1;

    // Name der Datei auf der Festplatte
    Datei[0].lpszPathName:= PChar(AttachedFilename);

    // Name, der in der Email angezeigt wird
    Datei[0].lpszFileName:= PChar(DisplayFilename);
    Datei[0].ulReserved:=0;
    Datei[0].flFlags:=0;
    Datei[0].nPosition:=Cardinal(-1);
    Datei[0].lpFileType:=nil;
    lpFiles := @Datei;

  end;

  // Senden
  if ShowDialog then
    MError := MapiSendMail(0, WinHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
  else
    // Wenn kein Dialogfeld angezeigt werden soll:
    MError := MapiSendMail(0, WinHandle, MapiMessage, 0, 0);

  Result:=MapiErrMsg(MError);

  {case MError of
    MAPI_E_AMBIGUOUS_RECIPIENT:
      Result:='Empfänger nicht eindeutig. (Nur möglich, wenn Emailadresse nicht angegeben.)';

    MAPI_E_ATTACHMENT_NOT_FOUND:
      Result:='Datei zum Anhängen nicht gefunden';

    MAPI_E_ATTACHMENT_OPEN_FAILURE:
      Result:='Datei zum Anhängen konnte nicht geöffnet werden.';

    MAPI_E_BAD_RECIPTYPE:
      Result:='Empfängertyp nicht MAPI_TO, MAPI_CC oder MAPI_BCC.';

    MAPI_E_FAILURE:
      Result:='Unbekannter Fehler.';

    MAPI_E_INSUFFICIENT_MEMORY:
      Result:='Nicht genug Speicher.';

    MAPI_E_LOGIN_FAILURE:
      Result:='Benutzerlogin (z.B. bei Thunderbird, Outlook) fehlgeschlagen.';

    MAPI_E_TEXT_TOO_LARGE:
      Result:='Text zu groß.';

    MAPI_E_TOO_MANY_FILES:
      Result:='Zu viele Dateien zum Anhängen.';

    MAPI_E_TOO_MANY_RECIPIENTS:
      Result:='Zu viele Empfänger angegeben.';

    MAPI_E_UNKNOWN_RECIPIENT: Result:='Empfänger nicht in Adressbuch gefunden. '+LineEnding+'(Nur möglich, wenn Emailadresse nicht angegeben.)';

    MAPI_E_USER_ABORT:
      Result:='Benutzer hat Senden abgebrochen oder MAPI nicht installiert.';

    SUCCESS_SUCCESS:
      Result:=''; //MessageDlg('Erfolgreich !!! (Aber Absenden nicht garantiert.)';
  end;}
end; {Christian "NineBerry" Schwarz}


//https://stackoverflow.com/questions/1962765/how-can-a-delphi-program-send-an-email-with-attachments-via-the-default-e-mail-cl/1962841#1962841

function SendEMailByMAPI(WinHandle:HWND;
                   FromName,FromAdress,
                   Subject,Mailtext,
                   ToName,ToAdress: string;
                   AttachedFiles:TStringList;
                   ShowDialog:boolean):string;
var
  MError      : DWord;
  MapiMessage: TMapiMessage;
  Originator, Recipient: TMapiRecipDesc;
  Files, FilesTmp: PMapiFileDesc;
  FilesCount: Integer;
  aFlags: Mapi.FLAGS;
begin
   FillChar(MapiMessage, Sizeof(TMapiMessage), 0);

   MapiMessage.lpszSubject := PAnsiChar(AnsiString(Subject));
   MapiMessage.lpszNoteText := PAnsiChar(AnsiString(Mailtext));

   FillChar(Originator, Sizeof(TMapiRecipDesc), 0);

   Originator.lpszName := PAnsiChar(AnsiString(FromName));
   Originator.lpszAddress := PAnsiChar(AnsiString(FromName));
   //   MapiMessage.lpOriginator := @Originator;
   MapiMessage.lpOriginator := nil;


   MapiMessage.nRecipCount := 1;
   FillChar(Recipient, Sizeof(TMapiRecipDesc), 0);
   Recipient.ulRecipClass := MAPI_TO;
   Recipient.lpszName := PAnsiChar(AnsiString(ToName));
   Recipient.lpszAddress := PAnsiChar(AnsiString(ToAdress));
   MapiMessage.lpRecips := @Recipient;

   MapiMessage.nFileCount :=  AttachedFiles.Count; //High(AttachmentFileNames) - Low(AttachmentFileNames) + 1;
   Files := AllocMem(SizeOf(TMapiFileDesc) * MapiMessage.nFileCount);
   MapiMessage.lpFiles := Files;
   FilesTmp := Files;
   for FilesCount := 0 to AttachedFiles.Count-1 do begin
     FilesTmp^.nPosition := $FFFFFFFF;
     FilesTmp^.lpszPathName := PAnsiChar(AnsiString(AttachedFiles[FilesCount]));
     Inc(FilesTmp)
   end;

  if ShowDialog then aFlags:=MAPI_DIALOG or MAPI_LOGON_UI
  else aFlags:=MAPI_LOGON_UI;

  try
    MError := MapiSendMail(0,WinHandle, MapiMessage, aFlags, 0);
  finally
    FreeMem(Files)
  end;
  Result:=MapiErrMsg(MError);
end;

{
Aufrufparameter:

Subject: 	  Die Betreffzeile
Mailtext: 	  Der eigentliche Text der eMail
FromName: 	  Der Name des Absenders
FromAdress: 	  Die EMail-Adresse des Absenders
ToName: 	  Der Name des Empfängers
ToAdress: 	  Die EMail-Adresse des Empfängers
AttachedFileName: Der Dateiname der angehängten Datei
FileDisplayName:  Der in der Mail angezeigte Name der angehängten Datei
ShowDialog:	  true: Die Mail wird vor dem Absenden angezeigt
		  false: Die Mail wird "stumm" verschickt
}

(*
//aus smcomponents.sendmail
{$DEFINE VER180}
{$IFDEF VER180}
  {$DEFINE SMForDelphi3}
  {$DEFINE SMForDelphi4}
  {$DEFINE SMForDelphi5}
  {$DEFINE SMForDelphi6}
  {$DEFINE SMForDelphi7}
  {$DEFINE SMForDelphi2005}
  {$DEFINE SMForDelphi2006}
  {hilftnicht bei üß.$DEFINE SMForDelphi2009} //soner
  {$IFDEF BCB}
    {$DEFINE SMForBCB2006}
  {$ENDIF}
{$ENDIF}

function MAPIErrorDescription(intErrorCode: Integer): string;
begin
   case intErrorCode of
     MAPI_E_USER_ABORT: Result := 'User cancelled request';
     MAPI_E_FAILURE: Result := 'General MAPI failure';
     MAPI_E_LOGON_FAILURE: Result := 'Logon failure';
     MAPI_E_DISK_FULL: Result := 'Disk full';
     MAPI_E_INSUFFICIENT_MEMORY: Result := 'Insufficient memory';
     MAPI_E_ACCESS_DENIED: Result := 'Access denied';
     MAPI_E_TOO_MANY_SESSIONS: Result := 'Too many sessions';
     MAPI_E_TOO_MANY_FILES: Result := 'Too many files open';
     MAPI_E_TOO_MANY_RECIPIENTS: Result := 'Too many recipients';
     MAPI_E_ATTACHMENT_NOT_FOUND: Result := 'Attachment not found';
     MAPI_E_ATTACHMENT_OPEN_FAILURE: Result := 'Failed to open attachment';
     MAPI_E_ATTACHMENT_WRITE_FAILURE: Result := 'Failed to write attachment';
     MAPI_E_UNKNOWN_RECIPIENT: Result := 'Unknown recipient';
     MAPI_E_BAD_RECIPTYPE: Result := 'Invalid recipient type';
     MAPI_E_NO_MESSAGES: Result := 'No messages';
     MAPI_E_INVALID_MESSAGE: Result := 'Invalid message';
     MAPI_E_TEXT_TOO_LARGE: Result := 'Text too large.';
     MAPI_E_INVALID_SESSION: Result := 'Invalid session';
     MAPI_E_TYPE_NOT_SUPPORTED: Result := 'Type not supported';
     MAPI_E_AMBIGUOUS_RECIPIENT: Result := 'Ambiguous recipient';
     MAPI_E_MESSAGE_IN_USE: Result := 'Message in use';
     MAPI_E_NETWORK_FAILURE: Result := 'Network failure';
     MAPI_E_INVALID_EDITFIELDS: Result := 'Invalid edit fields';
     MAPI_E_INVALID_RECIPS: Result := 'Invalid recipients';
     MAPI_E_NOT_SUPPORTED: Result := 'Not supported';
   else
     Result := 'Unknown Error Code: ' + IntToStr(intErrorCode);
   end;
end;

function GetDefaultLogon(var strDefaultLogon: string): Boolean;
const
  KEYNAME1 = 'Software\Microsoft\Windows Messaging Subsystem\Profiles';
  KEYNAME2 = 'Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles';
  VALUESTR = 'DefaultProfile';
begin
  Result := False;
  strDefaultLogon := '';
  with TRegistry.Create do begin
    try
      RootKey := HKEY_CURRENT_USER;

      {$IFDEF SMForDelphi5}
      if OpenKeyReadOnly(KEYNAME1) then
      {$ELSE}
      if OpenKey(KEYNAME1, False) then
      {$ENDIF}
      begin
        try
          strDefaultLogon := ReadString(VALUESTR);
          Result := True;
        except
        end;
        CloseKey;
      end
      else
      {$IFDEF SMForDelphi5}
      if OpenKeyReadOnly(KEYNAME2) then
      {$ELSE}
      if OpenKey(KEYNAME2, False) then
      {$ENDIF}
      begin
        try
          strDefaultLogon := ReadString(VALUESTR);
          Result := True;
        except
        end;
        CloseKey;
      end
      else;
    finally
      Free;
    end;
  end;
end;


function SendEMailByMAPI(WinHandle:HWND; SenderName, SenderAddress, Subject, Body: string; Recipients, Attachments, AttachmentNames: TStrings; WithOpenMessage, ResolveNames, NeedReceipt: Boolean; intMAPISession: Integer): Integer;
const
  RECIP_MAX  = MaxInt div SizeOf(TMapiRecipDesc);
  ATTACH_MAX = MaxInt div SizeOf(TMapiFileDesc);
type
  TRecipAccessArray = array [0..(RECIP_MAX - 1)] of TMapiRecipDesc;
  TlpRecipArray     = ^TRecipAccessArray;

  TAttachAccessArray = array [0..(ATTACH_MAX - 1)] of TMapiFileDesc;
  TlpAttachArray     = ^TAttachAccessArray;

  TszRecipName   = array[0..256] of Char;
  TlpszRecipName = ^TszRecipName;

  TszPathName   = array[0..256] of Char;
  TlpszPathname = ^TszPathname;

  TszFileName   = array[0..256] of Char;
  TlpszFileName = ^TszFileName;

var
  i: Integer;

  Message: TMapiMessage;
  lpRecipArray: TlpRecipArray;
  lpAttachArray: TlpAttachArray;


  function CheckRecipient(strRecipient: string): Integer;
  var
    lpRecip: PMapiRecipDesc;
  begin
    try
      Result := MapiResolveName(0, 0, PAnsiChar(AnsiString(strRecipient)), 0, 0, lpRecip);
      if (Result in [MAPI_E_AMBIGUOUS_RECIPIENT,
                     MAPI_E_UNKNOWN_RECIPIENT]) then
        Result := MapiResolveName(0, 0, PAnsiChar(AnsiString(strRecipient)), MAPI_DIALOG, 0, lpRecip);
      if Result = SUCCESS_SUCCESS then
      begin
        strRecipient := StrPas(lpRecip^.lpszName);
        with lpRecipArray^[i] do
        begin
          {$IFDEF SMForDelphi2009}
          lpszName := PAnsiChar(AnsiString(strRecipient));
          lpszAddress := PAnsiChar(AnsiString(strRecipient));
          {$ELSE}
          lpszName := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName);
          if lpRecip^.lpszAddress = nil then
            lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName)
          else
            lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszAddress);
          {$ENDIF}
          ulEIDSize := lpRecip^.ulEIDSize;
          lpEntryID := lpRecip^.lpEntryID;
          MapiFreeBuffer(lpRecip);
        end
      end;
    finally
    end;
  end;

  function SendMess: Integer;
  const
    arrMAPIFlag: array[Boolean] of Word = (0, MAPI_DIALOG);
    arrReceipt: array[Boolean] of Word = (0, MAPI_RECEIPT_REQUESTED);
    arrLogon: array[Boolean] of Word = (0, MAPI_LOGON_UI or MAPI_NEW_SESSION);
  begin
    try
      Result := MAPISendMail(0, WinHandle{Application.Handle}{0}, Message,
                    arrReceipt[NeedReceipt] or
                    arrMAPIFlag[WithOpenMessage] or
                    MAPI_LOGON_UI {or MAPI_NEW_SESSION} or
                    arrLogon[{True}intMAPISession = 0],
                    0);
    finally
    end;
  end;

var
  lpSender: TMapiRecipDesc;
  strDefaultProfile, s: string;
begin
  lpAttachArray := nil;
  Result := 0;

  strDefaultProfile := '';
  if GetDefaultLogon(strDefaultProfile) then
  begin
    try
      { try to logon with default profile }
      Result := MapiLogOn(0, PAnsiChar(AnsiString(strDefaultProfile)), nil, MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @intMAPISession);
    finally
      if (Result <> SUCCESS_SUCCESS) then
      begin
        intMAPISession := 0;

//        raise Exception.CreateFmt('MAPI Error %d: %s', [Result, MAPIErrorDescription(Result)]);
      end;
    end
  end;

  FillChar(Message, SizeOf(Message), 0);
  with Message do
  begin
    if (SenderAddress <> '') then
    begin
      lpSender.ulRecipClass := MAPI_ORIG;
      if (SenderName <> '') then
        lpSender.lpszName := PAnsiChar(AnsiString(SenderAddress))
      else
        lpSender.lpszName := PAnsiChar(AnsiString(SenderName));
      lpSender.lpszAddress := PAnsiChar(AnsiString(SenderAddress));
      lpSender.ulReserved := 0;
      lpSender.ulEIDSize := 0;
      lpSender.lpEntryID := nil;
      lpOriginator := @lpSender;
    end;

    if (Subject <> '') then
      lpszSubject := PAnsiChar(AnsiString(Subject));
    if (Body <> '') then
      lpszNoteText := PAnsiChar(AnsiString(Body));

    if Assigned(Attachments) and (Attachments.Count > 0) then
    begin
      nFileCount := Attachments.Count;

      lpAttachArray := TlpAttachArray(StrAlloc(nFileCount*SizeOf(TMapiFileDesc)));
      FillChar(lpAttachArray^, StrBufSize(PAnsiChar(lpAttachArray)), 0);
      for i := 0 to nFileCount-1 do
      begin
        lpAttachArray^[i].nPosition := Cardinal(-1); //Cardinal($FFFFFFFF); //ULONG(-1);
        {$IFDEF SMForDelphi2009}
        lpAttachArray^[i].lpszPathName := PAnsiChar(AnsiString(Attachments[i]));
        if i < AttachmentNames.Count then
          lpAttachArray^[i].lpszFileName := PAnsiChar(AnsiString(AttachmentNames[i]))
        else
          lpAttachArray^[i].lpszFileName := PAnsiChar(AnsiString(ExtractFileName(Attachments[i])));
        {$ELSE}
        lpAttachArray^[i].lpszPathName := StrPCopy(new(TlpszPathname)^, Attachments[i]);
        if i < AttachmentNames.Count then
          lpAttachArray^[i].lpszFileName := StrPCopy(new(TlpszFileName)^, AttachmentNames[i])
        else
          lpAttachArray^[i].lpszFileName := StrPCopy(new(TlpszFileName)^, ExtractFileName(Attachments[i]));
        {$ENDIF}
      end;
      lpFiles := @lpAttachArray^
    end
    else
      nFileCount := 0;
  end;


  if Assigned(Recipients) and (Recipients.Count > 0) then
  begin
    lpRecipArray := TlpRecipArray(StrAlloc(Recipients.Count*SizeOf(TMapiRecipDesc)));
    FillChar(lpRecipArray^, StrBufSize(PAnsiChar(lpRecipArray)), 0);
    for i := 0 to Recipients.Count-1 do
    begin
      s := Recipients[i];
      if (UpperCase(Copy(s, 1, 3)) = 'CC:') then
      begin
        lpRecipArray^[i].ulRecipClass := MAPI_CC;
        Delete(s, 1, 3);
      end
      else
      if (UpperCase(Copy(s, 1, 4)) = 'BCC:') then
      begin
        lpRecipArray^[i].ulRecipClass := MAPI_BCC;
        Delete(s, 1, 4);
      end
      else
        lpRecipArray^[i].ulRecipClass := MAPI_TO;

      if ResolveNames then
        CheckRecipient(s)
      else
      begin
        {$IFDEF SMForDelphi2009}
        lpRecipArray^[i].lpszName := PAnsiChar(AnsiString(s));
        lpRecipArray^[i].lpszAddress := PAnsiChar(AnsiString(s));
        {$ELSE}
        lpRecipArray^[i].lpszName := StrCopy(new(TlpszRecipName)^, PChar(s));
        lpRecipArray^[i].lpszAddress := StrCopy(new(TlpszRecipName)^, PChar(s));
        {$ENDIF}
      end;
    end;
    Message.nRecipCount := Recipients.Count;
    Message.lpRecips := @lpRecipArray^;
  end
  else
    Message.nRecipCount := 0;

  Result := SendMess;

  if Assigned(Attachments) and (Message.nFileCount > 0) then
  begin
    {$IFNDEF SMForDelphi2009}
    for i := 0 to Message.nFileCount-1 do
    begin
      Dispose(lpAttachArray^[i].lpszPathname);
      Dispose(lpAttachArray^[i].lpszFileName);
    end;
    {$ENDIF}
    StrDispose(PChar(lpAttachArray));
  end;

  if Assigned(Recipients) and (Recipients.Count > 0) then
  begin
    {$IFNDEF SMForDelphi2009}
    for i := 0 to Message.nRecipCount-1 do
    begin
      if Assigned(lpRecipArray^[i].lpszName) then
        Dispose(lpRecipArray^[i].lpszName);

      if Assigned(lpRecipArray^[i].lpszAddress) then
        Dispose(lpRecipArray^[i].lpszAddress);
    end;
    {$ENDIF}
    StrDispose(PChar(lpRecipArray));
  end;

  if intMAPISession <> 0 then
    try
      MapiLogOff(intMAPISession, 0, 0, 0);
    except
    end;
end;*)
end.