TStream as an object inside StringList - delphi

I am using Delphi 7 and playing with a StringList, with TStream as object.
My test project has a ListBox, a Memo and 2 buttons (Add and Remove).
Here is what I got so far:
var
List: TStringList;
procedure TForm1.FormCreate(Sender: TObject);
begin
List := TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
if (List.Count > 0) then
for I := 0 to Pred(List.Count) do
begin
List.Objects[I].Free;
List.Objects[I] := nil;
end;
FreeAndNil(List);
end;
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
List.AddObject(IntToStr(List.Count), TObject(Strm));
Memo.Clear;
ListBox.Items.Assign(List);
finally
// Strm.Free; (line removed)
end;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if (List.Count > 0) then
begin
List.Objects[0].Free;
List.Objects[0] := nil;
List.Delete(0);
ListBox.Items.Assign(List);
end;
end;
When I double-click the ListBox I would like to load the selected item Stream object to Memo. Here is what I tried to do:
procedure TForm1.ListBoxDblClick(Sender: TObject);
var
Idx: Integer;
begin
Memo.Clear;
Idx := ListBox.ItemIndex;
if (Idx >= 0) and (TStream(List.Objects[Idx]).Size > 0) then
Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]));
end;
My questions are:
Is correct the way I am adding and removing (freeing) the TStream object inside the StringList? Maybe I need to first free the Stream and then the Object??
Is correct the way I am freeing all objects on FormDestroy event?
When I try to load the stream back to Memo (Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]))), it doesn't load, despite Stream.Size is higher than zero. What I am doing wrong?

1.Is correct the way I am adding and removing (freeing) the TStream object inside the StringList?
Yes, because the TStrings.Objects[] property returns a TObject pointer and TStream derives from TObject, so you can call Free() on the object pointers.
Maybe I need to first free the Stream and then the Object??
You need to free the TStream objects before freeing the TStringList object. Just as you are already doing.
2.Is correct the way I am freeing all objects on FormDestroy event?
Yes. Though technically, you do not need to check the TStringList.Count property for > 0 before entering the loop, as the loop will handle that condition for you. And you do not need to nil the pointers before freeing the TStringList:
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
for I := 0 to Pred(List.Count) do
List.Objects[I].Free;
List.Free;
end;
One thing you are doing that is overkill, though, is Assign()ing the entire TStringList to the TListBox whenever you add/delete a single item from the TStringList. You should instead simply add/delete the associated item from the ListBox and preserve the remaining items as-is.
And add some extra error checking to btnAddClick() as well to avoid any memory leaks if something goes wrong.
Try this:
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
Strm.Position := 0;
Idx := List.AddObject(IntToStr(List.Count), Strm);
except
Strm.Free;
raise;
end;
try
ListBox.Items.Add(List.Strings[Idx]);
except
List.Objects[Idx].Free;
List.Delete(Idx);
raise;
end;
Memo.Clear;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if List.Count > 0 then
begin
List.Objects[0].Free;
List.Delete(0);
ListBox.Items.Delete(0);
end;
end;
3.When I try to load the stream back to Memo (Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]))), it doesn't load, despite Stream.Size is higher than zero. What I am doing wrong?
You are not seeking the stream back to Position 0 before loading it into the Memo. SaveToStream() always leaves the stream positioned at the end of the stream, and LoadFromStream() leave the stream positioned wherever the load stopped reading from (if not at the end, in case of failure).
Now, with all of this said, I personally would not use TListBox in this manner. I would instead set its Style property to lbVirtual and then use its OnData event to display the strings from the TStringList. No need to copy them into the TListBox directly, or try to keep the two lists in sync at all times. It would be safer, and use less memory, to let the TListBox ask you for what it needs, and then you can provide it from the TStringList (which I would then change to a TList since you are not really storing meaningful names that can't be produced dynamically in the OnData event handler):
var
List: TList;
procedure TForm1.FormCreate(Sender: TObject);
begin
List := TList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
ListBox.Count := 0;
for I := 0 to Pred(List.Count) do
TStream(List[I]).Free;
List.Free;
end;
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
Strm.Position := 0;
Idx := List.Add(Strm);
except
Strm.Free;
raise;
end;
try
ListBox.Count := List.Count;
except
TStream(List[Idx]).Free;
List.Delete(Idx);
raise;
end;
Memo.Clear;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if List.Count > 0 then
begin
TStream(List[0]).Free;
List.Delete(0);
ListBox.Count := List.Count;
end;
end;
procedure TForm1.ListBoxDblClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Memo.Clear;
Idx := ListBox.ItemIndex;
if Idx >= 0 then
begin
Strm := TStream(List[Idx]);
if Strm.Size > 0 then
begin
Strm.Position := 0;
Memo.Lines.LoadFromStream(Strm);
end;
end;
end;
procedure TForm1.ListBoxData(Control: TWinControl; Index: Integer; var Data: string);
begin
Data := IntToStr(Index);
end;

I don't understand what you suggest about freeing the stream and then the object. As I understand it, the object you're talking about freeing is the stream. You can't destroy one before the other because there's only one object, which is a stream.
Your methods of adding and removing stream objects in the string list are fine. They're not ideal, but I'll limit my comments here because Stack Overflow isn't Code Review.
After you call SaveToStream, the stream's position is at the end of the stream. If you want to read from the stream, then you'll have to set the position back to the start again. Set Position := 0 for the stream prior to calling LoadFromStream.

Related

Delphi delete FireMonkey element from Form on Android

I created an element on my Form with this code in the OnShow event:
procedure TForm4.FormShow(Sender: TObject);
var
VertScrollLink:TVertScrollBox;
begin
VertScrollLink := TVertScrollBox.Create(form4);
VertScrollLink.Align := TAlignLayout.Client;
VertScrollLink.Parent := form4;
end;
On some action, I need to delete the layout dynamically:
for LIndex := form4.ComponentCount-1 downto 0 do
begin
if (form4.Components[LIndex].ToString='TVertScrollBox') then
begin
//showmessage(form4.Components[LIndex].ToString);
form4.Components[LIndex].Free;
end;
end;
This code works good on Windows, but does not delete anything on Android.
The reason is because Delphi uses Automatic Reference Counting for Objects on mobile platforms (iOS and Android), but not on desktop platforms (Windows and OSX). Your Free() is effectively a no-op, because accessing the component from the Components[] property will increment its reference count, and then the Free() will decrement it (in fact, the compiler should have issued a warning about the code having no effect). The component still has active references to it (its Owner and Parent), so it is not actually freed.
If you want to force the component to be freed, you need to call DisposeOf() on it, eg:
for LIndex := form4.ComponentCount-1 downto 0 do
begin
if form4.Components[LIndex] is TVertScrollBox then
begin
form4.Components[LIndex].DisposeOf;
end;
end;
Alternatively, remove the active references and let ARC handle the destruction normally:
var
VertScrollLink: TVertScrollBox;
LIndex: Integer;
begin
...
for LIndex := form4.ComponentCount-1 downto 0 do
begin
if form4.Components[LIndex] is TVertScrollBox then
begin
VertScrollLink := TVertScrollBox(form4.Components[LIndex]);
VertScrollLink.Parent := nil;
VertScrollLink.Owner.RemoveComponent(VertScrollLink);
VertScrollLink := nil;
end;
end;
...
end;
That being said, you might consider keeping track of the component you create so you don't need to use a loop to find it later:
type
TForm4 = class(TForm)
procedure FormShow(Sender: TObject);
...
private
VertScrollLink: TVertScrollBox;
...
end;
procedure TForm4.FormShow(Sender: TObject);
begin
VertScrollLink := TVertScrollBox.Create(Self);
VertScrollLink.Align := TAlignLayout.Client;
VertScrollLink.Parent := Self;
end;
begin
...
if Assigned(VertScrollLink) then
begin
VertScrollLink.DisposeOf;
{ or:
VertScrollLink.Parent := nil;
VertScrollLink.Owner.RemoveComponent(VertScrollLink);
}
VertScrollLink := nil;
end;
...
end;

Delphi - Reading from a log file that changes every second

I need to read from a .log file that is constantly changing by another application. (more data being added frequently)
So I have this to begin with:
var
LogFile: TStrings;
Stream: TStream;
begin
LogFile := TStringList.Create;
try
Stream := TFileStream.Create(Log, fmOpenRead or fmShareDenyNone);
try
LogFile.LoadFromStream(Stream);
finally
Stream.Free;
end;
while LogFile.Count > Memo1.Lines.Count do
Memo1.Lines.Add(LogFile[Memo1.Lines.Count]);
finally
LogFile.Free;
end;
end;
This works perfectly fine. It updates the memo at real time with the data being added. However some of the data being added I don't want to see in the memo. I wish to not add these lines, but still have the memo updated at real time without the junk lines.
What is the best way to go about this?
You'd clearly need to check to see if the line has content you want to include, and only add it if it has that content (or not add it if you don't want to include it, whichever is the case). It would also be much more efficient to keep track of the last line in the LogFile you processed previously, so you could skip those lines each time - if you make the variable a private member of the form itself, it will automatically be initialized to 0 when your application starts:
type
TForm1 = class(TForm)
//... other stuff added by IDE
private
LastLine: Integer;
end;
// At the point you need to add the logfile to the memo
for i := LastLine to LogFile.Count - 1 do
begin
if ContentWanted(LogFile[i]) then
Memo1.Lines.Append(LogFile[i]);
Inc(LastLine);
end;
So to handle this completely based on your code:
type
TForm1 = class(TForm)
//... IDE stuff here
private
FLastLogLine: Integer;
procedure ProcessLogFile;
public
// Other stuff
end;
procedure TForm1.ProcessLogFile;
var
Log: TStringList;
LogStream: TFileStream;
i: Integer;
begin
Log := TStringList.Create;
try
LogStream := TFileStream.Create(...);
try
Log.LoadFromStream(LogStream);
finally
LogStream.Free;
end;
for i := FLastLogLine to Log.Count - 1 do
if Pos('[Globals] []', Log[i]) <>0 then
Memo1.Lines.Append(Log[i]);
// We've now processed all the lines in Log. Save
// the last line we processed as the starting point
// for the next pass.
FLastLogLine := Log.Count - 1;
finally
Log.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
try
ProcessLogFile;
finally
Timer1.Enabled := True;
end;
end;
end;
I know its been a couple of weeks since i last posted here, but i rewrote the entire application and came up with this piece of code, which is working perfectly!
Basically i do not call .free on the stream or stringlist and am able to set the initial stream size then check if its changed, hence getting the data i need and not the entire file!
Thanks everyone for helping!
procedure TForm1.GetEndLogFile;
begin
LogFile := TStringList.Create;
Stream := TFileStream.Create('C:\Users\John\Documents\chat.log', fmOpenRead or fmShareDenyNone);
LogFile.LoadFromStream(Stream);
i := Stream.Size;
end;
procedure TForm1.LogFileRefresh;
var
buf: string;
begin
if i <> Stream.Size then
begin
SetLength(buf, Stream.Size);
Stream.Seek(i, Stream.Size);
Stream.Read(buf[1], Stream.Size);
i := Stream.Size;
Memo1.Lines.Append(Buf);
//ShowMessage(buf);
end;
end;
procedure TForm1.GetEndLogFile;
var
LogFile: TStrings;
Stream: TStream;
begin
LogFile := TStringList.Create;
try
Stream := TFileStream.Create(LogFile, fmOpenRead or fmShareDenyNone);
try
LogFile.LoadFromStream(Stream);
EndOfFile := LogFile.Count;
finally
Stream.Free;
end;
finally
LogFile.Free;
end;
end;
procedure TForm1.LogFileRefresh;
var
LogFile2: TStrings;
Stream2: TStream;
i: Integer;
begin
LogFile2 := TStringList.Create;
try
Stream2 := TFileStream.Create(LogFile, fmOpenRead or fmShareDenyNone);
try
LogFile2.LoadFromStream(Stream2);
finally
Stream2.Free;
end;
for i := EndOfFile to LogFile2.Count -1 do
begin
if Pos('[Globals] []',LogFile2[i])<>0 then
Memo1.Lines.Append(LogFile2[i]);
Inc(EndOfFile);
end;
finally
LogFile2.Free
end;
end;
Basically came up with this, and its working perfectly fine. Should i run into any problems this way? Is there a neater way to do this?

Evaluate Email with Indy 10 and 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;

IndyTCP delphi array of objects exchanging

I'm sorry I know that I ask too many questions, but tomorrow (actually today cause in my coutry it's 2:00 am right now) I need to show to my teacher what I started to make e.t.c. So as I asked in previous questions I need to send from server to client some data.
But it nothing appers in server's memo field after thatt memo1.Lines.Add(IntToStr(arrOf[1]));
I was trying to send it like that on client
procedure TForm1.btnTestClick(Sender: TObject);
var
msRecInfo: TMemoryStream;
arrOf: array of integer; i:integer;
begin
setLength(arrOf, 11);
for i := 0 to 10 do
arrOf[i]:=random(100);
msRecInfo:= TMemoryStream.Create;
try
msRecInfo.Write(arrOf, SizeOf(arrOf));
idTCPClient1.IOHandler.Write(msRecInfo);
finally
msRecInfo.Free;
end;
end;
on server
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
msRecInfo: TMemoryStream;
arrOf: array of Integer; i:integer;
begin
msRecInfo:= TMemoryStream.Create;
try
AContext.Connection.IOHandler.ReadStream(msRecInfo, -1, False);
SetLength(arrOf,11);
msRecInfo.Position := 0;
msRecInfo.Read(arrOf, SizeOf(arrof));
finally
memo1.Lines.Add(IntToStr(arrOf[1]));
msRecInfo.Free;
end;
end;
Please could you help me to solve this problem and to find some examples of how to send arrays of different types/classes?
As Rufo already explained, you are not writing the array into, and reading the array out of, the TMemoryStream correctly.
Worse, you are not sending the TMemoryStream over the socket correctly, either. The default parameters of TIdIOHandler.Write(TStream) and TIdIOHandler.ReadStream() are not compatible with each other. By default, Write(TStream) does not send the TStream.Size value. However, the default parameters of ReadStream() (which are the same values that you are passing in explicitally) tell it to read the first few bytes and interpret them as the Size, which would be very wrong in this example.
Try this instead:
procedure TForm1.btnTestClick(Sender: TObject);
var
msRecInfo: TMemoryStream;
arrOf: Array of Integer;
i: Integer;
begin
SetLength(arrOf, 11);
for i := Low(arrOf) to High(arrOf) do
arrOf[i] := random(100);
msRecInfo := TMemoryStream.Create;
try
msRecInfo.WriteBuffer(arrOf[0], Length(arrOf) * SizeOf(Integer));
IdTCPClient1.IOHandler.Write(msRecInfo, 0, True);
finally
msRecInfo.Free;
end;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
msRecInfo: TMemoryStream;
arrOf: Array of Integer;
i: Integer;
begin
msRecInfo := TMemoryStream.Create;
try
AContext.Connection.IOHandler.ReadStream(msRecInfo, -1, False);
SetLength(arrOf, msRecInfo.Size div SizeOf(Integer));
if Lenth(arrOf) > 0 then
begin
msRecInfo.Position := 0;
msRecInfo.ReadBuffer(arrOf[0], Length(arrOf) * SizeOf(Integer));
end;
finally
msRecInfo.Free;
end;
...
end;
Alternatively, get rid of the TMemoryStream and send the individual Integer values by themselves:
procedure TForm1.btnTestClick(Sender: TObject);
var
arrOf: Array of Integer;
i: Integer;
begin
SetLength(arrOf, 11);
for i := Low(arrOf) to High(arrOf) do
arrOf[i] := random(100);
IdTCPClient1.IOHandler.Write(Length(arrOf));
for I := Low(arrOf) to High(arrOf) do
IdTCPClient1.IOHandler.Write(arrOf[i]);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
arrOf: Array of Integer;
i: Integer;
begin
i := AContext.Connection.IOHandler.ReadLongInt;
SetLength(arrOf, i);
for i := Low(arrOf) to High(arrOf) do
arrOf[i] := AContext.Connection.IOHandler.ReadLongInt;
...
end;
Now, with that said, accessing the TMemo directly in the OnExecute event handler is not thread-safe. TIdTCPServer is a multi-threaded component. The OnExecute event is triggered in the context of a worker thread, not the main thread. UI components, like TMemo, cannot be safely accessed from outside of the main thread. You can use Indy's TIdNotify or TIdSync class to synchronize with the main thread, eg:
type
TMemoSync = class(TIdSync)
protected
FLine: String;
procedure DoSynchronize; override;
end;
procedure TMemoSync.DoSynchronize;
begin
Form1.Memo1.Lines.Add(FLine);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
...
begin
...
with TMemoSync.Create do try
FLine := IntToStr(arrOf[1]);
Synchronize;
finally
Free;
end;
...
end;
If you do not synchronize with the main thread, bad things can happen.
This is your Main Problem here
msRecInfo.Write( arrOf, SizeOf( arrOf ) );
You write the pointer-address of the array into the stream ... i dont't think thats your goal.
If you want to put the content of the array into the stream you should use
msRecInfo.Write( arrOf[ Low( arrOf ) ], SizeOf( Integer ) * Length( arrOf ) );
Why? You have to point to the first position of the data (first element of the array), and you have to calculate the length of the data.
On the receiving part it is just the same
msRecInfo.Read( arrOf[ Low( arrOf ) ], SizeOf( Integer ) * Length( arrOf ) );
PS: This may work well in this special case, but to be safe, you should send at first, the length of all data, so the receiver knows, when message is complete

How can I quickly remove duplicates from a list box?

I wish to remove duplicate items from a large TListBox. To do that I use a classic simple method. It works, but it takes 19 minutes. I read a lot and apparently I should use a TFileStream (?). But I don't know how.
My classic method is this:
procedure NoDup(AListBox : TListBox);
var
i : integer;
begin
with AListBox do
for i := Items.Count - 1 downto 0 do
begin
if Items.IndexOf(Items[i]) < i then
Items.Delete(i);
Application.ProcessMessages;
end;
end;
How can I improve the speed?
procedure NoDup(AListBox: TListBox);
var
lStringList: TStringList;
begin
lStringList := TStringList.Create;
try
lStringList.Duplicates := dupIgnore;
lStringList.Sorted := true;
lStringList.Assign(AListBox.Items);
AListBox.Items.Assign(lStringList);
finally
lStringList.free
end;
end;

Resources