E-Mail Client Üzerinden Mail Oluşturma(MAPI)

[3ddark]

Mevcutta kullandığım MAPI bir şekilde thunderbird mail programı kullanan bilgisayarlarda soruna neden oluyor ve çalışmıyor. Bu nedenle araştırma içine girip aşağıdaki gibi bir modül oluşturdum.
Kullanmak isteyen veya işine yarayan olursa burada kalsın.

Kullanımı

SendMailWithMailClient('C:\Program Files\Microsoft Office\Office16\OUTLOOK.EXE', ['ali@mail.com', 'veli@mail.com'], ['bilgi@mail.com'], ['gizli@mail.com'], 'Mail Başlık', 'Mesaj içeriği', ['C:\temp\dosya.txt']);
//veya
SendMailWithMailClient('C:\Program Files\Mozilla Thunderbird\thunderbird.exe', ['ali@mail.com', 'veli@mail.com'], ['bilgi@mail.com'], ['gizli@mail.com'], 'Mail Başlık', 'Mesaj içeriği', ['C:\temp\dosya.txt']);

Kodlar

type
  TMailApp = (Outlook, Thunderbird);

procedure SendMailWithMailClient(
   AMailClientAppPath: string;
   ATo: TArray<string>;
   ACC: TArray<string>;
   ABCC: TArray<string>;
   ASubject: string;
   ABodyText: string;
   AAttachedFiles: TArray<string>
);
var
 LParams: string;
 LTO, LCC, LBCC: string;
 LFiles: string;
 n1: Integer;
 LDelimeter: string;
 LMailApp: TMailApp;
begin
 if not FileExists(AMailClientAppPath) then
   raise Exception.Create('Uygulama dosya yolu hatalı.' + sLineBreak + AMailClientAppPath);

 for n1 := 0 to Length(AAttachedFiles)-1 do
   if not FileExists(AAttachedFiles[n1]) then
     raise Exception.Create('Dosya eki verilen "' + AAttachedFiles[n1] + '" konumda bulunamadı!');

 LDelimeter := '';
 LMailApp := TMailApp.Outlook;
 if LowerCase(ExtractFileName(AMailClientAppPath)) = LowerCase('outlook.exe') then
 begin
   LMailApp := TMailApp.Outlook;

   //outlook cli ile sadece tek ek eklenebiliyor
   if Length(AAttachedFiles) > 1 then
     raise Exception.Create('Outlook CLI ile sadece 1 tane ek dosya kabul ediyor. 20.12.2021');

   LDelimeter := ';'
 end
 else if LowerCase(ExtractFileName(AMailClientAppPath)) = LowerCase('thunderbird.exe') then
 begin
   LMailApp := TMailApp.Thunderbird;
   LDelimeter := ',';
 end;


 LTO := '';
 for n1 := 0 to Length(ATo)-1 do
   LTO := LTO + ATo[n1] + LDelimeter;
 if LTO <> '' then
   LTO := LeftStr(LTO, Length(LTO)-1);

 LCC := '';
 for n1 := 0 to Length(ACC)-1 do
   LCC := LCC + ACC[n1] + LDelimeter;
 if LCC <> '' then
   LCC := LeftStr(LCC, Length(LCC)-1);

 LBCC := '';
 for n1 := 0 to Length(ABCC)-1 do
   LBCC := LBCC + ABCC[n1] + LDelimeter;
 if LBCC <> '' then
   LBCC := LeftStr(LBCC, Length(LBCC)-1);


 if LMailApp = TMailApp.Outlook then
 begin
   LFiles := '';
   if Length(AAttachedFiles) > 0 then
     LFiles := AAttachedFiles[0];

   //OUTLOOK.EXE /m "john@doe.com;jane@doe.com&cc=baby@doe.com&&subject=Hi&body=Hello Body" /a "c:\temp\file.txx"
   LParams := Format(' /m "%s&cc=%s&bcc=%s&subject=%s&body=%s" /a "%s"', [LTO, LCC, LBCC, ASubject, ABodyText, LFiles]);
   ShellExecute(0, 'open', PWideChar(AMailClientAppPath), PWideChar(LParams), nil, SW_SHOWNORMAL)
 end
 else if LMailApp = TMailApp.Thunderbird then
 begin
   LFiles := '';
   for n1 := 0 to Length(AAttachedFiles)-1 do
     LFiles := LFiles + AAttachedFiles[n1] + LDelimeter;
   if LFiles <> '' then
     LFiles := LeftStr(LFiles, Length(LFiles)-1);

   //thunderbird.exe -compose "to='john@doe.com,jane@doe.com',cc='baby@doe.com',subject='Hi',body='Hello Body',attachment='C:\temp\1.doc,C:\temp\2.txt'"
   LParams := Format(' -compose "to=' + QuotedStr('%s') +
                               ',cc=' + QuotedStr('%s') +
                               ',bcc=' + QuotedStr('%s') +
                               ',subject=' + QuotedStr('%s') +
                               ',body=' + QuotedStr('%s') +
                               ',attachment=' + QuotedStr('%s') + '"', [LTO, LCC, LBCC, ASubject, ABodyText, LFiles]);
   ShellExecute(0, 'open', PWideChar(AMailClientAppPath), PWideChar(LParams), nil, SW_SHOWNORMAL)
 end;
end;

[emozgun]

Muhteşem @3ddark hocam teşekkürler