Evaluate Email with Indy 10 and DELPHI - delphi

I use the following code to eval the msg. content (body / lines) of an E Mail msg received with the INDY 10 components
function LinesFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
begin
for i := 0 to aMsg.MessageParts.AttachmentCount-1 do
begin
if (amsg.MessageParts.Items[i].ContentType ='HTML') then
begin
if (amsg.MessageParts.Items[i] is Tidtext) then
Result := TidText(amsg.MessageParts.Items[i]).body;
end;
end;
end;
regarding this code I have 2 questions :
a) is this the correct way of finding the Tlines part in an arbitray mail message ?
( consider the advice shown at INDY 10 EMAIL MSG PARTS )
b) where can I find a tutorial of all the different Contenttype string values?

The correct ContentType value to look for is text/html. Use Indy's IsHeaderMediaType() function to check it, as the ContentType value may have additional attributes associated with it that your comparison needs to ignore.
You also need to take the TIdMessage.ContentType into account as well, as HTML emails may not be MIME encoded and thus not use the TIdMessage.MessageParts` collection at all.
And lastly, you loop needs to use the MessageParts.Count property instead of the MessageParts.AttachmentsCount property.
Try this:
function HTMLFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
Part: TIdMessagePart;
begin
Result := nil;
if IsHeaderMediaType(aMsg.ContentType, 'text/html') then
begin
Result := aMsg.Body;
Exit;
end;
for i := 0 to aMsg.MessageParts.Count-1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part is TIdText) and IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
Result := TIdText(Part).Body;
Exit;
end;
end;
end;
With that said, this is technically not the correct way to handle MIME. Officially, a conforming reader is supposed to loop backwards through the MIME parts, as they are ordered from the simpliest form downwards towards the most complex form. So you loop backwards, taking MIME nesting into account, looking for the most complex form you support. Something more like this (untested):
procedure DisplayPlainText(Body: TStrings);
begin
// display plain text as needed...
end;
procedure DisplayHTML(Body: TStrings);
begin
// display html as needed...
end;
procedure DisplayMultiPartAlternative(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer:
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
end;
end;
// nothing supported to display...
end;
procedure DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer;
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'multipart/alternative') then
begin
DisplayMultiPartAlternative(aMsg, ParentPart.Index, aLastIndex);
Exit;
end;
if IsHeaderMediaType(ParentPart.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
aLastIndex := i;
end;
end;
// nothing supported to display...
end;
procedure DisplayMsg(aMsg: TIdMessage);
var
ContentType: string;
begin
ContentType := ExtractHeaderMediaType(aMsg.ContentType);
case PosInStrArray(ContentType, ['multipart/mixed', 'multipart/alternative', 'text/html', 'text/plain'], False) of
0: begin
DisplayMultiPartAlternative(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
1: begin
DisplayMultiPartMixed(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
2: begin
DisplayHTML(aMsg.Body);
Exit;
end;
3: begin
DisplayPlainText(aMsg.Body);
Exit;
end;
else
// nothing supported to display...
end;
end;

Related

Retrieve Word server properties with Delphi

Thanks to the below functions, I am succesfully retrieving, from a Word document stored locally (synced with the Server through OneDrive), its Server properties (those which are stored as SharePoint columns), all this without Ole automation. The functions' structure is:
Since the Word document is a zipped file, unzip the file where such properties are stored.
Extract the contents of the file into a string.
Load the string into an XML document.
Feed the field names and their contents into a StringList.
``
function WordGetServerProperties (FName:string):TStringList;
var
s,ss:string;
i,ii:integer;
St:TStringList;
XML:IXMLDocument;
N,NN: IXMLNode;
begin
s:=ExtractZipToStr(FName,'customXml/item1.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item2.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
s:=ExtractZipToStr(FName,'customXml/item3.xml',ExtractFilePath(FName));
XML:=NewXMLDocument;
St:=TStringList.Create;
XML.Active := True;
XML.LoadFromXML(s);
N:=xml.DocumentElement;
try
for i := 0 to N.ChildNodes.Count -1 do
begin
if N.ChildNodes[i].NodeName = 'documentManagement' then
begin
NN:=N.ChildNodes[i];
for ii := 0 to NN.ChildNodes.Count -1 do
begin
ss:=AnsiReplaceStr(NN.ChildNodes[ii].NodeName,'_x0020_',' ');
if ss='SharedWithUsers' then continue;
ss:=ss+'='+NN.ChildNodes[ii].Text;
st.Add(ss)
end;
end;
end;
finally
XML.Active := False;
end;
Result:=st;
end;
function ExtractZipToStr(const ZipFileName: string; const ZippedFileName, ExtractedFileName: string): widestring;
var
ZipFile: TZipFile;
F,s:string;
i:integer;
Exists:Boolean;
LStream: TStream;
FStream:TFileStream;
LocalHeader: TZipHeader;
begin
Exists:=False;
ZipFile := TZipFile.Create;
LStream := TStream.Create;
try
try
ZipFile.Open(ZipFileName,zmRead);
except on EZipException do begin Result:='noprops'; ZipFile.Close; ZipFile.Free; LStream.Free; exit; end; end;
for i := 0 to ZipFile.FileCount - 1 do
begin
F:= ZipFile.FileNames[i];
if F='docProps/custom.xml' then begin Exists:=True; system.Break; end;
end;
if exists=True then
begin
ZipFile.Read(ZippedFileName, LStream, LocalHeader);
LStream.Position:=0;
Result:=StreamToString(LStream);
end
else Result:='noprops';
finally
ZipFile.Close;
ZipFile.Free;
LStream.Free;
end;
end;
function StreamToString(aStream: TStream): widestring;
var
SS: TStringStream;
begin
if aStream <> nil then
begin
SS := TStringStream.Create('');
try
SS.CopyFrom(aStream, 0);
Result := SS.DataString;
finally
SS.Free;
end;
end else
begin
Result := '';
end;
end;
This is relatively fast but as not as much as I would like. Hopefully I have shown that (being amateur at this) I am at the end of my wits. Would you see any way to either improve or utterly replace these routines by something more efficient?

Delphi Inconsistent data coming from a hardware using Cport

I am having trouble getting the serial port data from an equipment.
Below is the image of the expected result:
Desire result:
Unwanted result:
I use Ttimer so I can automatically get the data and put it to the Memo.
I need the data to be placed line by line in the memo.
This is the source code:
procedure TForm3.Timer1Timer(Sender: TObject);
var
k: Integer;
InBuffer: array[1..500] of char;
begin
for k:=1 to 500 do
InBuffer[k]:=' ';
Trim(InBuffer);
if cport.Connected = true then
begin
ComLed1.Kind := lkGreenLight;
cport.ReadStr(str,k);
Trim(str);
S:=str;
if str = '' then
begin
end
else
begin
memo1.lines.Add(str);
end;
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Connected';
end;
end;
My question is what is the problem? And what is the solution for this.
TMemo.Lines.Add() adds a line. The text you add will have a line break inserted at the end of it. It is clear that you are receiving the hardware data in pieces, and you are adding each piece separately as its own line in the Memo.
To do what you are attempting, you need to either:
Read the pieces from the hardware and cache them until you detect the end of a complete message, and then Add() only complete messages to the Memo. How you do this depends on the particular protocol the hardware is using to send data to you. Does it wrap the data in STX/ETX markers? Does it delimit messages? We don't know, you have not provided any information about that. And your code is trying (unsuccessfully) to trim a lot of data away that it probably shouldn't be throwing away at all.
Don't use Add() at all. You can use the SelText property instead to avoid inserting any line breaks you don't want.
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
That being said, your timer code is doing some odd things. InBuffer is filled with spaces, then (unsuccessfully) trimmed, and then completely ignored. You are passing an uninitialized k value to ReadStr(). The str value you do read is unsuccessfully trimmed before added to the Memo. You are assigning str to S and then ignoring S.
Try this instead:
procedure TForm3.Timer1Timer(Sender: TObject);
var
str: AnsiString;
begin
if cport.Connected then
begin
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
cport.ReadStr(str, 256);
str := Trim(str);
if str <> '' then
begin
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
end;
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
Alternatively (assuming you are using TComPort that has an OnRxChar event):
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if cport.Connected then
begin
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
procedure TForm3.cportRxChar(Sender: TObject; Count: Integer);
var
str: AnsiString;
begin
cport.ReadStr(str, Count);
str := Trim(str);
if str <> '' then
begin
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
end;
end;
Edit based on new information provided in comments, try something like this:
private
buffer: AnsiString;
portConnected: boolean;
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if cport.Connected then
begin
if not portConnected then
begin
portConnected := true;
buffer := '';
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
end;
end
else
begin
if portConnected then
begin
portConnected := false;
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
end;
procedure TForm3.cportRxChar(Sender: TObject; Count: Integer);
var
str: AnsiString;
i: integer;
begin
cport.ReadStr(str, Count);
buffer := buffer + str;
repeat
i := Pos(#10, buffer);
if i = 0 then Exit;
str := Copy(buffer, 1, i-1);
Delete(buffer, 1, i);
memo1.Lines.Add(str);
until buffer = '';
end;

Delphi TCPClient Issue

I am new to Delphi and trying to convert vb.net apps to learn. The issue I am having is reading from a TCP/IP host. Currently I can connect via telnet to the device, send a command, and the device will send data non-stop until all data is sent. This could be simply two characters followed by CR/LF, or it could be several rows of varing length data. Each row is end is CR/LF. Prior to writing code, we were able to telnet via Hyperterminal to the device. Send a command, and, with the capture text enabled save to a text file.
Below is the code I have so far. I have not coded for saving to text file (one step at a time). The data is pipe delimited. I have no control on the format or operatation of the device aside from sending commands and receiving data. It works most of the time however there are times when not all of the data (65 records for testing) are received. I will greatly appreciate guidence and feel free to comment on my code, good or bad.
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm2.btnEXITClick(Sender: TObject);
begin
if idTcpClient1.connected then
begin
idTcpClient1.IOHandler.InputBuffer.clear;
idTcpClient1.Disconnect;
end;
Close;
end;
procedure TForm2.btnSendDataClick(Sender: TObject);
var
mTXDataString : String;
RXString : String;
begin
IdTCPClient1.Host := IPAddress.Text;
IdTCPClient1.Port := StrToInt(IPPort.Text);
mTXDataString := mTXData.Text + #13#10;
IdTCPClient1.Connect;
If IdTCPClient1.Connected then
begin
IdTCPClient1.IOHandler.Write(mTXDataString);
mTXDataString := mTXData.Lines.Text;
if MTXDataString.Contains('SCHEMA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
//Add received data to RXmemo
mRXData.Lines.Add(RXString);
//Determine number of records to received based on schema data
lblRecords.Caption := Parse(',', RXString, 2);
end;
end; //while not
end // if
else
if mTXDataString.Contains('DATA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
mRXData.Lines.Add(RXString);
end; // if
end; //while not
end; // if Schema or not
end; // if Connected
IdTCPClient1.Disconnect;
end; //Procedure
HyperTerminal and Telnet apps display whatever data they receive, in real-time. TIdTCPClient is not a real-time component. You control when and how it reads. If you are expecting data to arrive asynchronously, especially if you don't know how many rows are going to be received, then you need to perform the reading in a timer or worker thread, eg:
procedure TForm2.TimerElapsed(Sender: TObject);
var
S: String;
begin
if IdTCPClient1.IOHandler = nil then Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
end;
S := IdTCPClient1.IOHandler.ReadLn;
// use S as needed ...
end;
Or:
type
TMyThread = class(TThread)
protected
fClient: TIdTCPClient;
procedure Execute; override;
public
constructor Create(aClient: TIdTCPClient);
end;
constructor TMyThread.Create(aClient: TIdTCPClient);
begin
inherited Create(False);
fClient := aClient;
end;
procedure TMyThread.Execute;
var
S: String;
begin
while not Terminated do
begin
S := fClient.IOHandler.ReadLn;
// use S as needed ...
end;
end;
Or, if the server supports the actual Telnet protocol, have a look at using Indy's TIdTelnet component instead.

Find body property inside a message part

Trying to evaluate the mail message content I#m using this code which is derived from
a RELEATED QUESTION ON EMAIL WITH INDY
DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer;
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'multipart/alternative') then
begin
DisplayMultiPartAlternative(aMsg, Part.Index, aLastIndex);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
DisplayHTML(Part.Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(Part.Body);
Exit;
end;
aLastIndex := i;
end;
// nothing supported to display...
end;
end;
I could not find the body (TStrings) property inside a INDY 10 TidMessage , Part subclass
You need to type-cast the TIdMessagePart to a TIdText, like the DisplayMultiPartAlternative() procedure does. That omission was just a typo on my part, I fixed it in my answer to the other question.

Chromium: How to get all form of a loaded page

I try to get the name of all forms of the loaded page. I have done this:
procedure TForm2.Button2Click(Sender: TObject);
var
L: TStringList;
begin
L := TStringList.Create;
try
Chromium1.Browser.MainFrame.VisitDomProc(
procedure (const doc: ICefDomDocument)
procedure IterateNodes(Node: ICefDomNode);
begin
if not Assigned(Node) then Exit;
repeat
if Node.ElementTagName = 'FORM' then
L.Add(Node.GetElementAttribute('name'));
if Node.HasChildren then IterateNodes(Node.FirstChild);
Node := Node.NextSibling;
until not Assigned(Node);
end;
begin
IterateNodes(doc.Body);
end
);
ShowMessage(L.Text);
finally
FreeAndNil(L);
end;
end;
But I don't have any result. Any idea?
Thanks
With XE2 Update 4
I have realized that the program flow continues when running the procedure parameter so that upon reaching the ShowMessage still has not run this procedure and therefore the TStringList is empty.
I have put a boolean variable control and it worked right, but this is not a elegant solution.
Here the new code:
procedure TForm2.Button2Click(Sender: TObject);
var
L: TStringList;
Finish: Boolean;
begin
L := TStringList.Create;
Finish := False;
try
Chromium1.Browser.MainFrame.VisitDomProc(
procedure (const doc: ICefDomDocument)
procedure IterateNodes(Node: ICefDomNode);
begin
if not Assigned(Node) then Exit;
repeat
if SameText(Node.ElementTagName, 'FORM') then
begin
L.Add(Node.GetElementAttribute('name'));
end;
if Node.HasChildren then
IterateNodes(Node.FirstChild);
Node := Node.NextSibling;
until not Assigned(Node);
end;
begin
IterateNodes(doc.Body);
Finish := True;
end
);
repeat Application.ProcessMessages until (Finish);
ShowMessage(L.Text);
finally
FreeAndNil(L);
end;
end;
I managed to get the whole page like this:
Inject a DOM element - text.
ChromiumWB.Browser.MainFrame.ExecuteJavaScript('$("body").prepend(''<input type="text" id="msoftval" value=""/>'')', '', 0);
Use jquery or js to get body html into injected element.
mResult := '';
ChromiumWB.Browser.MainFrame.ExecuteJavaScript('$("#msoftval").val($("body").html());', '', 0);
ChromiumWB.Browser.MainFrame.VisitDomProc(getResult);
while mResult = '' do Application.ProcessMessages;
Memo1.Text := mResult;
wait untill 'VisitDomProc' finish- make it sync.
procedure TForm44.getResult(const doc: ICefDomDocument);
var
q: ICefDomNode;
begin
q := doc.GetElementById('msoftval');
if Assigned(q) then
mResult := q.GetValue
else
mResult := '-';
end;

Resources