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ı
Kodlar
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;
PostgreSQL - Linux - Delphi, Poliüretan