idhttp post, can't read response text - indy10

I'm sending JSON to a restful service using TidHTTP.Post but having trouble reading the response from idHTTP when an HTTP error 400 occurs. When a 400 occurs, the server provides JSON which describes errors in the data being sent. I get readable JSON results sometimes but most of the time the response contains only a couple of unprintable characters.
procedure TForm1.SendData(const stlACSchedule: TStringList; BatchTimeIn: TDateTime);
var
TargetURL : String;
stsJson: TStringStream;
myResponse : String;
resp : TMemoryStream;
begin
TargetURL := 'http://sandbox.xxxxxxxxxxx.com/api/v1/feeds' ;
stsJson := TStringStream.Create;
stsJson.WriteString(stlACSchedule.Text);
resp := TMemoryStream.Create;
application.ProcessMessages;
try
myResponse := IdHTTP1.Post( TargetURL, stsJson );
WriteStatus( 'Response from Vendor Server: ' );
UpdateUploadStatus2( IdHTTP1.ResponseCode, IdHttp1.ResponseText, BatchTimeIn, 'usPending', 'usUploaded' );
except
on E: EIdHTTPProtocolException do begin
WriteStatus( 'HTTP Protocol Error from Vendor Server: ' + #13 + E.ErrorMessage + ' -*- ' + IdHTTP1.ResponseText );
UpdateUploadStatus2( IdHTTP1.ResponseCode, E.ErrorMessage + ' - ' + IdHTTP1.ResponseText, BatchTimeIn, 'usPending', 'usBatchFail' );
ShowMessage('Fubar_!: ' + myResponse);
end;
on E: Exception do begin
WriteStatus( 'Unknown Error from Vendor Server:' );
UpdateUploadStatus2( IdHTTP1.ResponseCode, E.Message + ' - ' + IdHTTP1.ResponseText, BatchTimeIn, 'usPending', 'usBatchFail' );
ShowMessage('Fubar!: ' + myResponse);
end;
end;
resp.free;
stsJson.free;
end; { SendData }
procedure TForm1.WriteStatus(strTextIn : String);
begin
Memo1.Lines.add('');
Memo1.Lines.add(strTextIn);
Memo1.Lines.add(IntToStr(IdHTTP1.ResponseCode));
Memo1.Lines.add(IdHTTP1.ResponseText);
end; { WriteStatus }
It appears that the EIdHTTPProtocolException exception handler is catching the error but most of the time I get responses like this (there are 3 unprintable characters below the "HTTP Protocol Error from Vendor Server" line):
HTTP Protocol Error from Vendor Server:
400
HTTP/1.1 400 Bad Request
but occasionally I get a good response, like this:
HTTP Protocol Error from ReturnJet Server:
{"errors":[{"code":7,"message":"Invalid departure or destination type for event: 1"}]} -*- HTTP/1.1 400 Bad Request
400
HTTP/1.1 400 Bad Request
It looks like it may have something to do w/ the length of the response but I'm not sure.
What do I need to do to consistently decode the ResponseText?
I'm using: Delphi XE8, Indy ver 10.6
PS - when I Post this data manually using Postman, I always get the full JSON response.
TIA

A 400 response is an error response. By default, TIdHTTP raises an EIdHTTPProtocolException exception when an HTTP error occurs (unless you ask it not to), where the HTTP response headers are available in the TIdHTTP.Response property, and the HTTP response content is available as a string in the exception's ErrorMessage property, so as not to corrupt whatever TStream is used for output (unless you ask for it).
If the exception's ErrorMessage does not contain the JSON you are expecting, then either the server is not sending JSON to begin with, or the JSON is not being transmitted in a format that Indy can decode to a string. But you didn't show what the actual HTTP responses look like, or what the "3 unprintable characters" actually are, so there is no way to know for sure why the ErrorMessage is not being populated as you are expecting.

You have to change some options on IdHTTP in order to get the same response as you get on the browser or programs like Postman.
Use:
IdHTTP1.HTTPOptions := idHTTP1.HTTPOptions + [hoNoProtocolErrorException, hoWantProtocolErrorContent];

Related

Indy 10 TIdUDPclient - detect wrong/no Answer

Using delphi 10.3 and JEDI VCL.
I have a communication with a device, which responds to UDP data.
Now I want to be able to check if I got an answer from the right device, or if if I even got any answer.
Currently I am using the following:
function TDIB.ReadData(ACommandCode: WORD; ASendLength : Cardinal; AReceiveLength : Cardinal; AAddress : Cardinal) : Integer;
var
cmdHeader : PDIBCommandHeader;
UDPSend, UDPRecv : TIdBytes;
client : TIdUDPClient;
begin
gRequestPending := TRUE;
// Reserviere Speicher
SetLength(UDPSend, SIzeOF(TDIBCommandHeader) + Cardinal(ASendLength));
SetLength(UDPRecv, SIzeOF(TDIBCommandHeader) + Cardinal(AReceiveLength));
cmdHeader := #UDPSend[0];
cmdHeader.Init(WORD(ACommandCode), AAddress, MAX(ASendLength, AReceiveLength));
client := TIdUDPClient.Create();
try
client.Host := ValToIPv4(gDIBAddress);
client.Port := TDIBPorts.mainPort;
client.Active := TRUE;
client.sendBuffer (UDPSend);
client.ReceiveBuffer(UDPRecv,TDIB.C_CMDTimeout);
except
on E: Exception do
begin
ShowMessage('Exception');
client.Free;
end;
end;
SetLength(lastUDPData, Length(UDPRecv));
move (UDPRecv[0],lastUDPData[0],Length(UDPRecv));
client.Free;
gRequestPending := FALSE;
end;
Which is fine when the client is responding, but I am not catching any misbehaviour, like when the host machine tries to reach the client and the client is not responding.
From the documentation of Indy10 I am missing something like TIdUDPClient.TimedOut or like that.
I want to be able to tell, if the client is not responding after Xms after I sent the UDP packet and I want to be able to check, if the sender address is the wanted client IP.
I want to be able to tell, if the client is not responding after Xms after I sent the UDP packet
ReceiveBuffer() returns the number of bytes actually received. If no packet is received within the specified timeout, ReceiveBuffer() will return 0.
I want to be able to check, if the sender address is the wanted client IP.
Use one of the ReceiveBuffer() overloads that has a VPeerIP output parameter. That will give you the sender IP if a packet is received, or it will give you an empty string if no packet is received.
Do be aware that UDP has a concept of a 0-byte datagram. ReceiveBuffer() will return 0 for that as well. In the case that 0 is returned, you can use this output string to differentiate between no packet received (VPeerIP = '') vs a 0-byte packet received (VPeerIP <> ''), if needed.

Indy HttpClient.Post gives range check error when built for release but not in debug - why?

I am using Delphi 2009, Indy ver 10.5498 together with libeay32.dll and ssleay32.dll from the zip file openssl-1.0.2r-i386-win32 at https://indy.fulgan.com/SSL/.
Range checking is turned on in project options and not turned off anywhere.
Using the code below, which I generated with Remy's help from this post, I can upload data to an API on a server via https when running in the IDE with debugging turned on or from a compiled exe generated with debugging tuned on.
However, if I build a release version then whether I run it through the IDE or as an exe I get a range check error on the line result := HttpClient.Post(THE_URL, FormData);
The params list simply contains the to, from, subject, body etc and there is no attachment in the filenames list ie filenames.Count = 0. U_GeneralRoutines.TheFileStoreFolder is simply a folder inside ProgramData where the SSL DLL's are stored.
As the debugger didn't catch this I put in the two showmessage lines before and after the call. When built as debug, both messages get shown and the post succeeds. When built as release the first one gets displayed and then I get the range check error.
I don't suppose there is a bug in the POST code, so what can be going wrong?
function UploadToAPI(params, filenames: TStrings): string;
var
HttpClient: TIdHttp;
IdSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
FormData : TIdMultiPartFormDataStream;
i : integer;
PathToSSLlibraries : string;
begin
FormData := TIdMultiPartFormDataStream.Create;
HttpClient:= TIdHttp.Create;
IdSSLIOHandler:= TIdSSLIOHandlerSocketOpenSSL.Create;
PathToSSLlibraries := IncludeTrailingPathDelimiter(U_GeneralRoutines.TheFileStoreFolder);
IdOpenSSLSetLibPath(PathToSSLlibraries); //set path to libeay32.dll and ssleay32.dll in the common ProgramData folder
HttpClient.IOHandler := IdSSLIOHandler;
HttpClient.Request.CustomHeaders.FoldLines := true ;
try
for i := 0 to params.Count - 1 do
FormData.AddFormField(params.Names[i], params.ValueFromIndex[i]);
for i := 0 to filenames.Count - 1 do
FormData.AddFile('attachment', filenames[i]); //works with ver 10.5498 but not with 10.2.5
//add authorisation header
HttpClient.Request.CustomHeaders.Add('Authorization:Basic ' + ATHORISATION_STR); //byte64 encoding of the api key
HttpClient.ProtocolVersion := pv1_1; //get the full server response which allows for just one try-except
HttpClient.HTTPOptions := HttpClient.HTTPOptions + [hoKeepOrigProtocol, hoNoProtocolErrorException, hoWantProtocolErrorContent];
try
showmessage('about to post');
result := HttpClient.Post(THE_URL, FormData); //post to the api
showmessage('posted');
except
on E: Exception do
begin
result := E.ClassName + ': ' + E.message;
raise;
end;
end; //try
finally
FormData.Free;
IdSSLIOHandler.free;
HttpClient.free;
end;
I appreciate that this type of scenario is often caused by unintialised variables in the release version that would get automatically initialised when in the IDE / debug. But all the variables in my procedure do seem to be getting initialised before the call to POST.

HTTPRIO connecting to webservice "error : HTTP/1.1 401 Unauthorized" on OS, while working in Win32

I have a simple project that uses the checkVatService.wsdl to chek the vality of european VAT numbers.
When running the project on MACOS I the following error : "error : HTTP/1.1 401 Unauthorized".
When running on Win32 the project returns "valid"
procedure TForm1.ControleVat;
var
cv : checkVatApprox;
cvs : checkVatApproxResponse;
HTTPRIO1: THTTPRIO;
begin
HTTPRIO1 := THTTPRIO.Create(nil);
HTTPRIO1.WSDLLocation := 'checkVatservice.WSDL';
HTTPRIO1.Service := 'checkVatService';
HTTPRIO1.Port := 'checkVatPort';
cvs:=nil;
cv:=checkVatApprox.Create;
try
cv.countryCode := 'BE';
cv.vatNumber := '0000000097';
try
cvs:= ( HTTPRIO1 as checkVatPortType ).checkVatApprox(cv);
if cvs.valid then begin
showmessage('valid');
end else begin
showmessage('invalid');
end;
except
on e:exception do begin
showmessage('error : ' + e.Message);
end;
end;
finally
cv.Free;
freeandnil(cvs);
end;
end;
The service does not require autohorisation and both in Win32 and OS the username/password are blank.
What is causing this error? What is the difference in connection?
i have same problem, in android. in windows it's all ok;
it seems related to some strange server issue, if client retrive ipv6 instead ipv4..
i suggest you to use : https://www.isvat.eu/

How can create https server using synapse in lazarus

I am trying to create https server in lazarus using synapse but I am failing. I want to mys server receive data from other https clients.
I am sending requests with my browser using https://localhost:1500 and mys server is receiving signals. But when I try to read sent data I receive nothing. When I tested simple http server all worked fine. But now in case of https it is not working. I am using ubuntu 15.04 as my OS
s := ASocket.RecvString(timeout); //returns noething
My sample code:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
blcksock, sockets, Synautil, ssl_openssl, ssl_openssl_lib;
procedure AttendConnection(ASocket: TTCPBlockSocket);
var
timeout: integer;
s: string;
method, uri, protocol: string;
OutputDataString: string;
ResultCode: integer;
begin
timeout := 1000;
WriteLn('Received headers+document from browser:');
//read request line
s := ASocket.RecvString(timeout);
WriteLn(s);
method := fetch(s, ' ');
uri := fetch(s, ' ');
protocol := fetch(s, ' ');
//read request headers
repeat
s := ASocket.RecvString(Timeout);
WriteLn(s);
until s = '';
// Now write the document to the output stream
if uri = '/' then
begin
// Write the output document to the stream
OutputDataString :=
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"'
+ ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF
+ '<html><h1>Teste</h1></html>' + CRLF;
// Write the headers back to the client
ASocket.SendString('HTTP/1.0 200' + CRLF);
ASocket.SendString('Content-type: Text/Html' + CRLF);
ASocket.SendString('Content-length: ' + IntTostr(Length(OutputDataString)) + CRLF);
ASocket.SendString('Connection: close' + CRLF);
ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);
ASocket.SendString('Server: Servidor do Felipe usando Synapse' + CRLF);
ASocket.SendString('' + CRLF);
// if ASocket.lasterror <> 0 then HandleError;
// Write the document back to the browser
ASocket.SendString(OutputDataString);
end
else
ASocket.SendString('HTTP/1.0 404' + CRLF);
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
ListenerSocket, ConnectionSocket: TTCPBlockSocket;
begin
ListenerSocket := TTCPBlockSocket.Create;
ConnectionSocket := TTCPBlockSocket.Create;
ListenerSocket.CreateSocket;
ListenerSocket.SSL.CertificateFile := '/home/imants/projects/apps/medieval/bin/40669199_localhost_8080.cert';
ListenerSocket.SSL.PrivateKeyFile := '/home/imants/projects/apps/medieval/bin/40669199_localhost_8080.key';
ListenerSocket.SSLDoConnect;
ListenerSocket.setLinger(true,10);
ListenerSocket.bind('localhost','1500');
ListenerSocket.listen;
repeat
if ListenerSocket.canread(1000) then
begin
ConnectionSocket.Socket := ListenerSocket.accept;
WriteLn('Attending Connection. Error code (0=Success): ', ConnectionSocket.lasterror);
AttendConnection(ConnectionSocket);
ConnectionSocket.CloseSocket;
end;
until false;
ListenerSocket.Free;
ConnectionSocket.Free;
end;
end.
There are two sources, that I know of, with an example for a HTTP(s) server in Synapse.
The first example is in the Synapse stable package (release 40). Although I would recommend you use the SVN version (you can use the Download Snapshot button on that page) you can still use the examples in the "release 40 package".
The example in synapse40\source\demo\httpsserv should be usable as HTTPS-server. If it's not you could take the httpserv (HTTP) example and change it as shown here. (But I think the httpsserv is just the same with those modifications)
If you're on Linux (Lazarus) you'll need to change every occurrence of winsock to synsock and remove any windows-clause.
Another example can be found here. (Direct download of SynHttp.zip) As far as I could see it also has HTTPS-server functionality.
I know that you want to use Synapse, but you may want to take a look at Indy. I have been developing server/client apps with indy for some years and I like it. It's working fine with windows and linux (32bit, 64bit, arm...) and has some nice features. You could use the TIdHTTPServer component. Moreover get an IOHandlerSSLOpenSSL. The event OnCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo) is the most important one. It allows access to the Request (like A ARequestInfo.Document) and to your HTTP response (AResponseInfo).

How to drop files onto .MAPIMail

Given some files (or shell file objects) how do i invoke the .MAPIMail registered shell extension handler with them?
The Question
i have some files on the computer:
C:\Users\ian\AppData\Local\Temp\Contoso_Invoice_141174.pdf
C:\Users\ian\AppData\Local\Temp\Contoso_Invoice_141173.pdf
C:\Users\ian\AppData\Local\Temp\Contoso_Invoice_141171.pdf
That i want to do the programmatic equivalent of dropping them on the .MAPIMail registered handler:
The Sent to folder's Mail recipient option is actually a special registered .MAPIMail extension:
Which is a file type that is registered on the system:
HKEY_CLASSES_ROOT\.mapimail
How do i invoke a drop onto a ephermeral .mapimail file?
Can't you just look in the registry?
Now, i could be a bad developer, and spellunk the registry, the .mapimail entry's default value:
CLSID\{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}
Extract the clsid {9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}, and confirm that class is registered:
HKEY_CLASSES_ROOT\CLSID\{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}
(default) = Desktop Shortcut
\InProcServer32
(default) = %SystemRoot%\System32\sendmail.dll
And use CoCreateInstance to create that COM object:
IUnknown unk = CreateComObject("{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}");
And then i'm in an undocumented, unsupported world, where i don't know what interface i have to QueryInterface for, and what methods to call in what order.
So we're left with shell programming
What i'd like is to likely something involving the shell (pseudo-code):
IShellFolder desktop;
OleCheck(SHGetDesktopFolder(out desktop));
List<pidl> pidls = new List<pidl>();
ULONG chEaten = 0;
ULONG dwAttributes = 0;
PIDL pidl;
foreach (String filename in Files) do
{
OleCheck(desktop.ParseDisplayName(0, nil, filename, out chEaten, out pidl, ref dwAttributes));
pidls.Add(pidl);
}
//Get the shell folder of the temp folder
IShellFolder tempShellFolder;
desktop.ParseDisplayName(0, nil, GetTemporaryPath, out chEaten, out pidl, ref dwAttributes));
desktop.BindToObject(pidl, nil, IShellFolder, tempShellFolder);
//i have no idea what i've been doing; just throwing reasonable looking code together
//nobody will actually ever read this
IDontCare context;
tempShellFolder.GetUIObjectOf(0, pidls.Count, pidls, IDontCareAnymore, nil, ref context);
Except all that code relies on the extistance of a context menu, which i don't have. Nobody says that .MAPIMail has to be in any context Send to menu.
i was asking how to drop files on a .mapimail file.
And my god.
Why not just use MAPI?
Because no MAPI client is installed when you're a 32-bit application running on Windows 64-bit with Office 64-bit installed. So i need to be able to accomplish what the user already can.
Although it doesn't answer my question, Raymond pointed out that it's a stupid question. Nobody in their right mind should be trying to send mail to recipients. But i was desperate!
Turns out i'm not completely stuck. While there is a bitness nightmare when dealing with 64-bit Outlook (MAPI provider) from 32-bit applications (or vice versa), there is one out.
If i use just MapiSendMail, and no other MAPI functions, it is safe to cross the 32-bit/64-bit barrier. From Building MAPI Applications on 32-Bit and 64-Bit Platforms:
32-bit MAPI Application and 64-Bit Outlook
32-bit MAPI applications are not supported to run on a computer installed with 64-bit Outlook and 64-bit Windows. The application developer must update and rebuild the application as a 64-bit application for the 64-bit platform. This is because a 32-bit application cannot load a 64-bit Msmapi32.dll file. There are a small number of API changes that application developers must incorporate to build their code successfully for a 64-bit environment. MAPI header files have been updated with these changes to support the 64-bit platform. You can download these header files at Outlook 2010: MAPI Header Files. Developers can use this same set of MAPI header files to build both 32-bit and 64-bit MAPI applications
That makes it sound like all hope is lost. But, there is, on Windows 7:
Exception: MAPISendMail
However, one function call among all Simple MAPI and MAPI elements, MAPISendMail, would succeed in a Windows-32-bit-on-Windows-64-bit (WOW64) or Windows-64-bit-on-Windows-32-bit (WOW32) scenario and would not result in the above alert. This WOW64 scenario only applies to Windows 7. Figure 2 shows a WOW64 scenario in which a 32-bit MAPI application calls MAPISendMail on a computer installed with 64-bit Windows 7. In this scenario, the MAPI library makes a COM call to launch a 64-bit Fixmapi application. The Fixmapi application implicitly links to the MAPI library, which routes the function call to the Windows MAPI stub, which in turn forwards the call to the Outlook MAPI stub, enabling the MAPISendMail function call to succeed.
So, as a Delphi Jedi user, their Simple Send E-mail functions will fail (as they use too much of MAPI). So i had to create my own:
procedure MapiSimpleSendMail(slFiles: TStrings; ToEmailAddress: string=''; ToName: string='');
var
mapiMessage: TMapiMessage;
flags: LongWord;
// senderName: AnsiString;
// senderEmailAddress: AnsiString;
emailSubject: AnsiString;
emailBody: AnsiString;
// sender: TMapiRecipDesc;
recipients: packed array of TMapiRecipDesc;
attachments: packed array of TMapiFileDesc;
i: Integer;
hr: Cardinal;
es: string;
const
MAPI_E_UNICODE_NOT_SUPPORTED = 27; //Windows 8. The MAPI_FORCE_UNICODE flag is specified and Unicode is not supported.
begin
ZeroMemory(#mapiMessage, SizeOf(mapiMessage));
{ senderName := '';
senderEmailAddress := '';
ZeroMemory(#sender, sizeof(sender));
sender.ulRecipClass := MAPI_ORIG; //MAPI_TO, MAPI_CC, MAPI_BCC, MAPI_ORIG
sender.lpszName := PAnsiChar(senderName);
sender.lpszAddress := PAnsiChar(senderEmailAddress);}
mapiMessage.lpOriginator := nil; //PMapiRecipDesc; { Originator descriptor }
if ToEmailAddress <> '' then
begin
SetLength(recipients, 1);
recipients[0].ulRecipClass := MAPI_TO;
recipients[0].lpszName := LPSTR(ToName);
recipients[0].lpszAddress := LPSTR(ToEmailAddress);
mapiMessage.lpRecips := #recipients[0]; //A value of NULL means that there are no recipients. Additionally, when this member is NULL, the nRecipCount member must be zero.
mapiMessage.nRecipCount := 1;
end
else
begin
mapiMessage.lpRecips := nil; //A value of NULL means that there are no recipients. Additionally, when this member is NULL, the nRecipCount member must be zero.
mapiMessage.nRecipCount := 0;
end;
mapiMessage.lpszMessageType := nil;
if slFiles.Count > 0 then
begin
emailSubject := 'Emailing: ';
emailBody :=
' '+#13#10+ //Yes, the shell really does create a blank mail with a leading line of ten spaces
'Your message is ready to be sent with the following file or link attachments:'+#13#10;
SetLength(attachments, slFiles.Count);
for i := 0 to slFiles.Count-1 do
begin
attachments[i].ulReserved := 0; // Cardinal; { Reserved for future use (must be 0) }
attachments[i].flFlags := 0; // Cardinal; { Flags }
attachments[i].nPosition := $FFFFFFFF; //Cardinal; { character in text to be replaced by attachment }
attachments[i].lpszPathName := PAnsiChar(slFiles[i]); { Full path name of attachment file }
attachments[i].lpszFileName := nil; // LPSTR; { Original file name (optional) }
attachments[i].lpFileType := nil; // Pointer; { Attachment file type (can be lpMapiFileTagExt) }
if i > 0 then
emailSubject := emailSubject+', ';
emailSubject := emailSubject+ExtractFileName(slFiles[i]);
emailBody := emailBody+#13#10+
ExtractFileName(slFiles[i]);
end;
emailBody := emailBody+#13#10+
#13#10+
#13#10+
'Note: To protect against computer viruses, e-mail programs may prevent sending or receiving certain types of file attachments. Check your e-mail security settings to determine how attachments are handled.';
mapiMessage.lpFiles := #attachments[0];
mapiMessage.nFileCount := slFiles.Count;
end
else
begin
emailSubject := '';
emailBody := '';
mapiMessage.lpFiles := nil;
mapiMessage.nFileCount := 0;
end;
{
Subject
Emailing: 4388_888871544_MVM_10.tmp, amt3.log, swtag.log, wct845C.tmp, ~vs1830.sql
Body
<-- ten spaces
Your message is ready to be sent with the following file or link attachments:
4388_888871544_MVM_10.tmp
amt3.log
swtag.log
wct845C.tmp
~vs1830.sql
Note: To protect against computer viruses, e-mail programs may prevent sending or receiving certain types of file attachments. Check your e-mail security settings to determine how attachments are handled.
}
mapiMessage.lpszSubject := PAnsiChar(emailSubject);
mapiMessage.lpszNoteText := PAnsiChar(emailBody);
flags := MAPI_DIALOG;
hr := Mapi.MapiSendMail(0, 0, mapiMessage, flags, 0);
case hr of
SUCCESS_SUCCESS: {nop}; //The call succeeded and the message was sent.
MAPI_E_AMBIGUOUS_RECIPIENT:
begin
//es := 'A recipient matched more than one of the recipient descriptor structures and MAPI_DIALOG was not set. No message was sent.';
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_AMBIGUOUS_RECIPIENT', SysErrorMessage(hr)]);
end;
MAPI_E_ATTACHMENT_NOT_FOUND:
begin
//The specified attachment was not found. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_ATTACHMENT_NOT_FOUND', SysErrorMessage(hr)]);
end;
MAPI_E_ATTACHMENT_OPEN_FAILURE:
begin
//The specified attachment could not be opened. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_ATTACHMENT_OPEN_FAILURE', SysErrorMessage(hr)]);
end;
MAPI_E_BAD_RECIPTYPE:
begin
//The type of a recipient was not MAPI_TO, MAPI_CC, or MAPI_BCC. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_BAD_RECIPTYPE', SysErrorMessage(hr)]);
end;
MAPI_E_FAILURE:
begin
//One or more unspecified errors occurred. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_FAILURE', SysErrorMessage(hr)]);
end;
MAPI_E_INSUFFICIENT_MEMORY:
begin
//There was insufficient memory to proceed. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_INSUFFICIENT_MEMORY', SysErrorMessage(hr)]);
end;
MAPI_E_INVALID_RECIPS:
begin
//One or more recipients were invalid or did not resolve to any address.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_INVALID_RECIPS', SysErrorMessage(hr)]);
end;
MAPI_E_LOGIN_FAILURE:
begin
//There was no default logon, and the user failed to log on successfully when the logon dialog box was displayed. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_LOGIN_FAILURE', SysErrorMessage(hr)]);
end;
MAPI_E_TEXT_TOO_LARGE:
begin
//The text in the message was too large. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_TEXT_TOO_LARGE', SysErrorMessage(hr)]);
end;
MAPI_E_TOO_MANY_FILES:
begin
//There were too many file attachments. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_TOO_MANY_FILES', SysErrorMessage(hr)]);
end;
MAPI_E_TOO_MANY_RECIPIENTS:
begin
//There were too many recipients. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_TOO_MANY_RECIPIENTS', SysErrorMessage(hr)]);
end;
MAPI_E_UNICODE_NOT_SUPPORTED:
begin
//The MAPI_FORCE_UNICODE flag is specified and Unicode is not supported.
//Note This value can be returned by MAPISendMailW only.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_UNICODE_NOT_SUPPORTED', SysErrorMessage(hr)]);
end;
MAPI_E_UNKNOWN_RECIPIENT:
begin
//A recipient did not appear in the address list. No message was sent.
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_UNKNOWN_RECIPIENT', SysErrorMessage(hr)]);
end;
MAPI_E_USER_ABORT:
begin
es := 'The user canceled one of the dialog boxes. No message was sent.';
raise Exception.CreateFmt('Error %s sending e-mail message: %s', ['MAPI_E_USER_ABORT', es]);
end;
else
raise Exception.CreateFmt('Error %d sending e-mail message: %s', [hr, SysErrorMessage(hr)]);
end;
end;
Note: Any code is released into the public domain. No attribution required.

Resources