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;
Related
I have two StringList that are loaded (from a file) with users and users + password respectivally. I'm comparing these lists to determine what user (of first list) already have a password (in second list) and then insert on ListView who have and also who still not have.
But exists a problem here that from second ListItem.Caption (user) is repeting two times.
How i can solve this?
My files that are loaded on lists are:
users.dat
User01
User02
User03
logins.dat
User01|test01
User01|test01
And this was my last attempt of code:
type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
L1, L2, LSplit: TStringList;
L: TListItem;
I, J: Integer;
begin
L1 := TStringList.Create;
L2 := TStringList.Create;
LSplit := TStringList.Create;
L1.LoadFromFile('users.dat');
L2.LoadFromFile('logins.dat');
for I := 0 to L1.Count - 1 do
begin
for J := 0 to L2.Count - 1 do
begin
LSplit.Clear;
ExtractStrings(['|'], [], PChar(L2[J]), LSplit);
if L1[I] = LSplit[0] then
begin
L := ListView1.Items.Add;
L.Caption := LSplit[0];
L.SubItems.Add(LSplit[1]);
Break;
end;
L := ListView1.Items.Add;
L.Caption := L1[I];
end;
end;
L1.Free;
L2.Free;
LSplit.Free;
end;
end.
Your inner loop is broken. It is adding items to the ListView even when the 2 StringList items being compared don't match each other. For each user in the first list, you are adding it to the ListView as many times as there are entries in the second list.
Your code should look more like this instead:
procedure TForm1.Button1Click(Sender: TObject);
var
L1, L2, LSplit: TStringList;
L: TListItem;
I, J: Integer;
begin
L1 := TStringList.Create;
try
L2 := TStringList.Create;
try
LSplit := TStringList.Create;
try
L1.LoadFromFile('users.dat');
L2.LoadFromFile('logins.dat');
for I := 0 to L1.Count - 1 do
begin
L := ListView1.Items.Add;
L.Caption := L1[I];
for J := 0 to L2.Count - 1 do
begin
LSplit.Clear;
ExtractStrings(['|'], [], PChar(L2[J]), LSplit);
if L1[I] = LSplit[0] then
begin
L.SubItems.Add(LSplit[1]);
Break;
end;
end;
end;
finally
LSplit.Free;
end;
finally
L2.Free;
end;
finally
L1.Free;
end;
end;
That being said, you don't need 3 TStringList objects and 2 loops. 2 TStringList objects and 1 loop will suffice:
procedure TForm1.Button1Click(Sender: TObject);
var
L1, L2: TStringList;
L: TListItem;
I: Integer;
begin
L1 := TStringList.Create;
try
L2 := TStringList.Create;
try
L1.LoadFromFile('users.dat');
L2.LoadFromFile('logins.dat');
L2.NameValueSeparator := '|';
for I := 0 to L1.Count - 1 do
begin
L := ListView1.Items.Add;
L.Caption := L1[I];
L.SubItems.Add(L2.Values[L1[I]]);
end;
finally
L2.Free;
end;
finally
L1.Free;
end;
end;
for I := 0 to L1.Count - 1 do
begin
found := false;
L := ListView1.Items.Add;
for J := 0 to L2.Count - 1 do
begin
LSplit.Clear;
ExtractStrings(['|'], [], PChar(L2[J]), LSplit);
if L1[I] = LSplit[0] then
begin
L.Caption := LSplit[0];
L.SubItems.Add(LSplit[1]);
found := true;
Break;
end;
end;
if not found then
L.Caption := L1[I];
end;
Also note that dictionary approach is much faster for large lists
The problem with your code is that you are always adding the username from your first list to the result regardles of whether you aready added it from the second list with included password or not.
To avoid this you need to write your code in a way that adding username from first list happen only if it hasn't been added from the second one.
//If password exist in second list add username and password from second list
if L1[I] = LSplit[0] then
begin
L := ListView1.Items.Add;
L.Caption := LSplit[0];
L.SubItems.Add(LSplit[1]);
Break;
end
//Else add username from first list
else
begin
L := ListView1.Items.Add;
L.Caption := L1[I];
end;
Also note that your approqach Will fail in case if your second list contains username that is not present in the first list.
For instance let us check next scenario:
users.dat
User01
User02
User03
logins.dat
User01|test01
User02|test01
User04|test04
In the above scenario your final result won't include any data from User04 becouse it doesn't exist in your first list.
So I would recomend you to use different approach where you iterate the second list and for each entry search the first list to see if the username exists in it.
If it does you edit that entry on the first list to add the pasword infromation from the second list. And in case if you can't find username on the first list then you add both username and password to it.
This will guarantee you that final result will unclude all usernames from both lists no matter on which they were found.
Here its a VCL app and I have a link with my Ini file and I wanna keep adding lines in there with time and date stamps with press of a button.
private
FLog: TStringList;
FIni: TIniFile;
aTime: TDateTime;
procedure TForm2.btnBreakClick(Sender: TObject);
begin
FLog := TStringList.Create;
try
aTime := Now;
begin
FIni.WriteString('FileName', 'Break', FormatDateTime('dd/mm/yyyy hh:nn', aTime));
end;
finally
FLog.Free;
end
end;
With this piece of code I can only replace the previous time and date stamp I have tried to do it with a for loop but without succes.
This is the outcome with the current few lines of code.
[FileName]
Break=09-10-2018 13:35
And what I want is that everytime I hit the break button it needs to add on to the file with a other time.
An INI file contains key/value pairs. To do what you are asking for, you need to create a unique key name with every button press, otherwise you are just overwriting an existing value each time, as you have already discovered.
Try something more like this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
Keys: TStringList;
MaxBreak, I, Num: Integer;
begin
MaxBreak := 0;
Keys := TStringList.Create;
try
FIni.ReadSection('FileName', Keys);
for I := 0 to Keys.Count-1 do
begin
if StartsText('Break', Keys[I]) then
begin
if TryStrToInt(Copy(Keys, 6, MaxInt), Num) then
begin
if Num > MaxBreak then
MaxBreak := Num;
end;
end;
end;
finally
Keys.Free;
end;
FIni.WriteString('FileName', 'Break'+IntToStr(MaxBreak+1), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
I: Int64;
Key: string;
begin
for I := 1 to Int64(MaxInt) do
begin
Key := 'Break' + IntToStr(I);
if not FIni.ValueExists('FileName', Key) then
begin
FIni.WriteString('FileName', Key, FormatDateTime('dd/mm/yyyy hh:nn', Now));
Exit;
end;
end;
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
NumBreaks: Integer;
begin
NumBreaks := FIni.ReadInteger('FileName', 'NumBreaks', 0);
Inc(NumBreaks);
FIni.WriteInteger('FileName', 'NumBreaks', NumBreaks);
FIni.WriteString('FileName', 'Break' + IntToStr(NumBreaks), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Although you referred to TIniFile, your post and your comments tell me that that is not necessarily what you want. TIniFile is not really intended for the kind of usage you are describing, although it can be used (as the other answer shows).
For simple recording of events I suggest an ordinary text file, and for adding events to it, a TStringList as in the following example. The example is a simplified extract from code I used myself long time ago.
var
EventFile: TFileName;
procedure EventRecorder(EventTime: TDateTime; Description, Comment: string);
var
sl: TStringList;
es: string;
begin
sl: TStringList;
try
if FileExists(EventFile) then
sl.LoadFromFile(EventFile);
es := FormatDateTime('yyyy-mm-dd hh:nn:ss', EventTime)+' '+Description+' '+comment;
sl.Add(es);
sl.SaveToFile(EventFile);
finally
sl.free;
end;
end;
Typical usage
procedure TForm2.btnBreakClick(Sender: TObject);
begin
EventRecorder(now, 'Break', '');
end;
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.
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?
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;