Call the system's default email program to send emails (Foxmail is supported with attachments, but there are some problems)

Because the customer requested to use the system to send mails by default and to support Foxmail, he tried it and the following code can be run. However, it is very problematic to use Foxmail to send attachments: 1. the file path name cannot contain spaces. the path must be correct. Otherwise, the email form cannot be opened. we recommend that you send the message in plain text format. Version 5.0 can only be sent in plain text format,

Operation: first use the sky ++ software to view Foxmail, and obtain the Class Name of the form and the class name such as the recipient CC, as well as the clear level (priority) used for if tricheditcount = 2 then. for more information, see the code.

Unit gmailfun;
Interface
Uses Windows, sysutils, graphics, messages, forms, classes, stdctrls, dialogs, shdocvw, mapi;

Type
Clipboardtype = (ctext, cbitmap, cother); // clipboard format

Function readfoxmailini (var key: string): Boolean; // reads the registry and returns the path of the Foxmail execution program.
Function foxmailisdefmail: Boolean; // whether the default value is Foxmail
Procedure shellexecandwait (dateiname: string; parameter: string); // open the Foxmail program and wait
Function sendbyemail (semail, semailcc, attachs, subjects, bodys: string): Boolean; // send an email

VaR foxsemail, foxsemailcc, foxsubjects, foxbodys: string; tzeditorcount, tricheditcount: integer;
Tempstr: string; tempbmp: tbitmap; ctype: clipboardtype; // temporarily store the clipboard content

Implementation
Uses shellapi, registry, mshtml, ActiveX, clipbrd, strutils;

Type
Tobjectfromlresult = function (lresult: lresult; const IID: tiid; wparam: wparam; out pobject): hresult; stdcall;

Function sendbyemail (semail, semailcc, attachs, subjects, bodys: string): Boolean;
VaR
Strkey: string;
Hfox: hwnd;
Begin
Result: = false;
If (not readfoxmailini (strkey) or (not foxmailisdefmail) Then // by default, if it is not Foxmail, it will be sent in Outlook
Begin
Sendtomapi (semail, semailcc, '', attachs, bodys, subjects,'', '', true );
End
Else
Begin
// If getfoxmailwindow> 0 then
// Sendmessage (getfoxmailwindow, wm_close,); // get Foxmail mail edit form handle send message close this form
Hfox: = findwindow ('tfoxmail _ main', nil); // obtain the handle of the Foxmail main form.
If (hfox = 0) then
Begin
Showmessage ('foxmail program is not enabled. Please start it before proceeding! ');
Exit;
End;
Tzeditorcount: = 0; // Initialization is used to find the topic
Tricheditcount: = 0; // Initialization is used to find recipients and CC
Shellexecandwait (pchar (strkey), attachs); // to send multiple files, add a space between the file paths. The file path or file name contains a space or the path is incorrect. The mail form is not displayed.
Foxsemail: = semail; // recipient // such as shellexecandwait (pchar (strkey), 'c:/aa.exe C:/bb.exe ');
Foxsemailcc: = semailcc; // CC
Foxsubjects: = subjects; // topic
Foxbodys: = bodys; // body content
Findfoxmailwindow;
End;

Result: = true;
End;

Function findfoxmailwindow: thandle;
VaR
Foxmail?whandle: thandle;

Function getfoxmailwindow: hwnd; // get the mail form handle
Begin
Result: = findwindow ('tf _ compose ', nil); // tf_compost indicates the Class Name of the email editing window.
End;

Function enumchildwindowsproc (H: hwnd; lparam: longint): Boolean; stdcall;
VaR
S {, clipboardtext}: string;
IE: iwebbrowser2;
Document: ihtmldocument2;
V: olevariant;
BMP: tbitmap;
Begin
Result: = true;
Setlength (seconds, 255 );
Getclassname (H, pchar (s), 255 );
If pos ('tzeditor', uppercase (s)> 0 then // find the Class Name of the Foxmail topic
Begin
Tzeditorcount: = tzeditorcount + 1;
If tzeditorcount = 1 then // body content
Begin
Clipboard. astext: = foxbodys; // body content (in plain text format) Note: In version 5.0, it is recommended that the content be sent in plain text format.
Sendmessage (H, wm_paste, 0, 0 );
End;
If tzeditorcount = 2 then // topic
Begin
Clipboard. astext: = foxsubjects;
Sendmessage (H, wm_paste, 0, 0); // topic: wm_settext cannot be used. You can only use this method.
End;
End;
If pos ('tzrichedit ', uppercase (s)> 0 then // used to find CC and recipient
Begin
Tricheditcount: = tricheditcount + 1;
If tricheditcount = 2 then
Sendmessage (H, wm_settext, 0, longint (pchar (foxsemailcc); // CC
If tricheditcount = 3 then
Sendmessage (H, wm_settext, 0, longint (pchar (foxsemail); // recipient
End;
If pos ('Internet assumer_server ', uppercase (s)> 0 then // body content (HTML format)
Begin
Getiefromhwnd (H, ie); // obtain the iwebbrowser2 Interface Based on the Internet assumer_server Class Name
Document: = ie. Document as ihtmldocument2;
Document. Body. innertext: = foxbodys;
Document. close;
End;
End;

Begin
Foxmailwindowhandle: = getfoxmailwindow; // get the handle
// While foxmail=whandle = 0 do
// Foxmail?whandle: = getfoxmailwindow;
// Enumchildwindows (foxmail?whandle, @ enumchildwindowsproc, 0 );
If foxmail?whandle <> 0 then
Begin
Try
Tempbmp: = tbitmap. Create;
Watchclipboard (true); // Save the clipboard content
Enumchildwindows (foxmail?whandle, @ enumchildwindowsproc, 0); // retrieve the tzrichedit type handle and save it
Watchclipboard (false); // write to the clipboard
Finally
Tempbmp. Free;
End;
End;
Result: = foxmail?whandle;
End;

 

Procedure watchclipboard (FLAG: Boolean); // clipboard flag: true: Save the clipboard content as temporary; false: Write the temporary content to the clipboard
Begin
If (FLAG) then
Begin
If (clipboard. hasformat (cf_text) or clipboard. hasformat (cf_oemtext) then
Begin
Tempstr: = clipboard. astext; // obtain the clipboard content.
Ctype: = ctext;
End
Else
If (clipboard. hasformat (cf_bitmap) then
Begin
Tempbmp. Assign (Clipboard );
Ctype: = cbitmap;
End
Else
Ctype: = cother;
End
Else
Begin
If ctype = ctext then
Clipboard. astext: = tempstr

Else
If ctype = cbitmap then
Begin
Clipboard. Assign (tempbmp );
End;
End;
End;

{*************************************** *********************
Function Name: getiefromhwnd
Parameter: hwnd, webbrowser control window handle
Function: Use wm_html_getobject to obtain the iwebbrowser2 interface of the control.
**************************************** ********************}
Function getiefromhwnd (whandle: hwnd; var ie: iwebbrowser2): hresult;
VaR
Hinst: hwnd;
Lres: Cardinal;
MSG: integer;
Pdoc: ihtmldocument2;
Objectfromlresult: tobjectfromlresult;
Begin
Hinst: = loadlibrary ('oleacc. dll ');
@ Objectfromlresult: = getprocaddress (hinst, 'objectfromlresult ');
If @ objectfromlresult <> nil then
Begin
Try
MSG: = registerwindowmessage ('wm _ html_getobject ');
Sendmessagetimeout (whandle, MSG, 0, 0, smto_abortifhung, 1000, lres );
Result: = objectfromlresult (lres, ihtmldocument2, 0, pdoc );
If result = s_ OK then
(Pdoc. parentwindow as iserviceprovider). queryservice (iwebbrowserapp, iwebbrowser2, ie );
Finally
Freelibrary (hinst );
End;
End;
End;

Function foxmailisdefmail: Boolean;

Function readinidefamail mail: string; // read whether the registry is Foxmail by default
VaR REG: Tregistry;
Begin
Result: = '';
Reg: = Tregistry. Create;
Reg. rootkey: = hkey_classes_root;
If Reg. openkey ('mailto/Shell/Open/command', false) then
Begin
Result: = reg. readstring ('');
End;
Reg. closekey;
Reg. Destroy;
End;

Begin
Result: = pos ('foxmail', uppercase (readinidefamail mail)> 0;
End;

// Read the registry and return the path of the Foxmail execution Program
Function readfoxmailini (var key: string): Boolean;
VaR REG: Tregistry;
Begin
Result: = false;
Reg: = Tregistry. Create;
Reg. rootkey: = HKEY_CURRENT_USER;
If Reg. openkey ('Software/aerofox/Foxmail/v3.1 ', false) then
Begin
Key: = reg. readstring ('foxmailpath ');
Result: = true;
End;
Reg. closekey;
Reg. Destroy;
End;

Procedure shellexecandwait (dateiname: string; parameter: string );
VaR executeinfo: tshellexecuteinfo;
Begin
Fillchar (executeinfo, sizeof (executeinfo), 0 );
With executeinfo do
Begin
Cbsize: = sizeof (executeinfo );
Fmask: = see_mask_nocloseprocess or see_mask_flag_ddewait;
WND: = getactivewindow ();
Executeinfo. lpverb: = 'open ';
Executeinfo. lpparameters: = pchar (parameter );
Lpfile: = pchar (dateiname );
Nshow: = sw_shownormal;
End;
Shellexecuteex (@ executeinfo );
While waitforsingleobject (executeinfo. hprocess, 50) <> wait_object_0 do
Application. processmessages;
End;

Function sendtomapi (STO, SCC, SBCC, satts: string;
Const body, subject, sendername, senderemail: string;
Showerror: Boolean = true): integer;
VaR
ATO, ACC, ABCC, aatts: tstringlist;
SM: tfnmapisendmail;
Mapimodule: hmodule;

MSG: mapimessage;
Lpsender: mapirecipdesc;
Recips: array of mapirecipdesc;
Att: array of mapifiledesc;
P1, P2, P3, Lento, lencc, lenbcc, lenatts: integer;
Serro: string;

Procedure strtoarray (SOR: string; var aarray: tstringlist );
Begin
If sor = ''then
Begin
Exit;
End;
If pos (';', SOR) <> 0 then
Begin
Sor: = stringreplace (SOR, ';', #13 #10, [rfreplaceall])
End;
Aarray. Text: = sor;
End;
Begin
Try
ATO: = tstringlist. Create; ACC: = tstringlist. Create; ABCC: = tstringlist. Create; aatts: = tstringlist. Create;
Strtoarray (STO, ATO );
Strtoarray (SCC, ACC );
Strtoarray (SBCC, ABCC );
Strtoarray (satts, aatts );

Fillchar (MSG, sizeof (MSG), 0 );
{Get the length of all array passed to this function}
Lento: = ATO. count;
Lencc: = acc. count;
Lenbcc: = ABCC. count;
Lenatts: = aatts. count;
{...}
Setlength (recips, lento + lencc + lenbcc );
Setlength (ATT, lenatts );
{}
For P1: = 0 to lento-1 do
Begin
Fillchar (recips [P1], sizeof (recips [P1]), 0 );
Recips [P1]. ulreserved: = 0;
Recips [P1]. ulrecipclass: = mapi_to;
Recips [P1]. lpszname: = pchar (ATO [P1]);
Recips [P1]. lpszaddress: = '';
End;
{CC}
For P2: = 0 to lencc-1 do
Begin
Fillchar (recips [P1 + p2], sizeof (recips [P1 + p2]), 0 );
Recips [P1 + p2]. ulreserved: = 0;
Recips [P1 + p2]. ulrecipclass: = mapi_cc;
Recips [P1 + p2]. lpszname: = pchar (ACC [P2]);
Recips [P1 + p2]. lpszaddress: = '';
End;
{BCC}
For P3: = 0 to lenbcc-1 do
Begin
Fillchar (recips [P1 + p2 + P3], sizeof (recips [P1 + p2 + P3]), 0 );
Recips [P1 + p2 + P3]. ulreserved: = 0;
Recips [P1 + p2 + P3]. ulrecipclass: = mapi_bcc;
Recips [P1 + p2 + P3]. lpszname: = pchar (ABCC [P3]);
Recips [P1 + p2 + P3]. lpszaddress: = '';
End;
{ATTS}
For P1: = 0 to lenatts-1 do
Begin
Fillchar (ATT [P1], sizeof (ATT [P1]), 0 );
ATT [P1]. ulreserved: = 0;
ATT [P1]. flflags: = 0;
ATT [P1]. nposition: = Cardinal ($ ffffffff); // ulong (-1 );
ATT [P1]. lpszpathname: = pchar (aatts [P1]);
ATT [P1]. lpszfilename: = '';
ATT [P1]. lpfiletype: = nil;
End;
{Fill the message}
With MSG do
Begin
Ulreserved: = 0;
If subject <> ''then
Lpszsubject: = pchar (subject );
If body <> ''then
Lpsznotetext: = pchar (body );
If senderemail <> ''then
Begin
Lpsender. ulrecipclass: = mapi_orig;
If sendername = ''then
Lpsender. lpszname: = pchar (senderemail)
Else
Lpsender. lpszname: = pchar (sendername );
Lpsender. lpszaddress: = pchar (senderemail );
Lpsender. uleidsize: = 0;
Lpsender. lpentryid: = nil;
Lporiginator: = @ lpsender;
End
Else
MSG. lporiginator: = nil;
MSG. lpszmessagetype: = nil;
MSG. lpszdatereceived: = nil;
MSG. lpszconversationid: = nil;
MSG. flflags: = 0;
MSG. nrecipcount: = lento + lencc + lenbcc;
MSG. lprecips: = @ recips [0];
MSG. nfilecount: = lenatts;
MSG. lpfiles: = @ ATT [0];
End;
Mapimodule: = loadlibrary (pchar (mapidll ));
If mapimodule = 0 then
Result: =-1
Else
Try
@ SM: = getprocaddress (mapimodule, 'mapisendmail ');
If @ SM <> nil then
Begin
Result: = Sm (0, application. Handle, MSG, mapi_dialog or mapi_logon_ui, 0 );
End
Else
Result: = 1;
Finally
Freelibrary (mapimodule );
End;
If result <> success_success then
Begin
// Here I know that exist better way to get error strings direct from API CILS
// If someone know how do this, please email me
Case result
Mapi_e_ambiguous_recipient: serro: =
'Recipient unknown ';
// '"Mapi_e_ambiguous_recipient "';
Mapi_e_attachment_not_found: serro: =
'File in attachment not found ';
// '"Mapi_e_attachment_not_found "';
Mapi_e_attachment_open_failure: serro: =
'Failed to open the attachment ';
// '"Mapi_e_attachment_open_failure "';
Mapi_e_bad_reciptype: serro: =
'Recipient does not exist ';
// '"Mapi_e_bad_reciptype "';
Mapi_e_failure: serro: =
'Sending failed ';
// '"Mapi_e_failure "';
Mapi_e_insufficient_memory: serro: =
'Memory insufficiency ';
// '"Mapi_e_insufficient_memory "';
Mapi_e_login_failure: serro: =
'Logon failed ';
// '"Mapi_e_login_failure "';
Mapi_e_text_too_large: serro: =
'Excessive content ';
// '"Mapi_e_text_too_large "';
Mapi_e_too_many_files: serro: =
'Too many files ';
// '"Mapi_e_too_many_files "';
Mapi_e_too_many_recipients: serro: =
'Too many recipients ';
// '"Mapi_e_too_many_recipients "';
Mapi_e_unknown_recipient: serro: =
'Unknown recipient ';
// '"Mapi_e_unknown_recipient "';
// Mapi_e_user_abort: serro: =
// '"Mapi_e_user_abort "';
// '"Mapi_e_user_abort "';
End;
If showerror then
Begin
If not result = mapi_e_user_abort then
Messagedlg ('error sending mail ('+ serro +'). ', mterror, [mbok],
0 );
End;
End;
Finally
ATO. Free;
ACC. Free;
ABCC. Free;
Aatts. Free;
End;
End;

End.