Why does scrolling through ADOTable get slower and slower? - delphi

I want to read the entire table from an MS Access file and I'm trying to do it as fast as possible. When testing a big sample I found that the loop counter increases faster when it's reading the top records comparing to last records of the table. Here's a sample code that demonstrates this:
procedure TForm1.Button1Click(Sender: TObject);
const
MaxRecords = 40000;
Step = 5000;
var
I, J: Integer;
Table: TADOTable;
T: Cardinal;
Ts: TCardinalDynArray;
begin
Table := TADOTable.Create(nil);
Table.ConnectionString :=
'Provider=Microsoft.ACE.OLEDB.12.0;'+
'Data Source=BigMDB.accdb;'+
'Mode=Read|Share Deny Read|Share Deny Write;'+
'Persist Security Info=False';
Table.TableName := 'Table1';
Table.Open;
J := 0;
SetLength(Ts, MaxRecords div Step);
T := GetTickCount;
for I := 1 to MaxRecords do
begin
Table.Next;
if ((I mod Step) = 0) then
begin
T := GetTickCount - T;
Ts[J] := T;
Inc(J);
T := GetTickCount;
end;
end;
Table.Free;
// Chart1.SeriesList[0].Clear;
// for I := 0 to Length(Ts) - 1 do
// begin
// Chart1.SeriesList[0].Add(Ts[I]/1000, Format(
// 'Records: %s %d-%d %s Duration:%f s',
// [#13, I * Step, (I + 1)*Step, #13, Ts[I]/1000]));
// end;
end;
And the result on my PC:
The table has two string fields, one double and one integer. It has no primary key nor index field. Why does it happen and how can I prevent it?

I can reproduce your results using an AdoQuery with an MS Sql Server dataset of similar size to yours.
However, after doing a bit of line-profiling, I think I've found the answer to this, and it's slightly counter-intuitive. I'm sure everyone who does
DB programming in Delphi is used to the idea that looping through a dataset tends to be much quicker if you surround the loop by calls to Disable/EnableControls. But who would bother to do that if there are no db-aware controls attached to the dataset?
Well, it turns out that in your situation, even though there are no DB-aware controls, the speed increases hugely if you use Disable/EnableControls regardless.
The reason is that TCustomADODataSet.InternalGetRecord in AdoDB.Pas contains this:
if ControlsDisabled then
RecordNumber := -2 else
RecordNumber := Recordset.AbsolutePosition;
and according to my line profiler, the while not AdoQuery1.Eof do AdoQuery1.Next loop spends 98.8% of its time executing the assignment
RecordNumber := Recordset.AbsolutePosition;
! The calculation of Recordset.AbsolutePosition is hidden, of course, on the "wrong side" of the Recordset interface, but the fact that the time to call it apparently increases the further you go into the recordset makes it reasonable imo to speculate that it's calculated by counting from the start of the recordset's data.
Of course, ControlsDisabled returns true if DisableControls has been called and not undone by a call to EnableControls. So, retest with the loop surrounded by Disable/EnableControls and hopefully you'll get a similar result to mine. It looks like you were right that the slowdown isn't related to memory allocations.
Using the following code:
procedure TForm1.btnLoopClick(Sender: TObject);
var
I: Integer;
T: Integer;
Step : Integer;
begin
Memo1.Lines.BeginUpdate;
I := 0;
Step := 4000;
if cbDisableControls.Checked then
AdoQuery1.DisableControls;
T := GetTickCount;
{.$define UseRecordSet}
{$ifdef UseRecordSet}
while not AdoQuery1.Recordset.Eof do begin
AdoQuery1.Recordset.MoveNext;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$else}
while not AdoQuery1.Eof do begin
AdoQuery1.Next;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$endif}
if cbDisableControls.Checked then
AdoQuery1.EnableControls;
Memo1.Lines.EndUpdate;
end;
I get the following results (with DisableControls not called except where noted):
Using CursorLocation = clUseClient
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:157 4000:16 4000:15
8000:453 8000:16 8000:15
12000:687 12000:0 12000:32
16000:969 16000:15 16000:31
20000:1250 20000:16 20000:31
24000:1500 24000:0 24000:16
28000:1703 28000:15 28000:31
32000:1891 32000:16 32000:31
36000:2187 36000:16 36000:16
40000:2438 40000:0 40000:15
44000:2703 44000:15 44000:31
48000:3203 48000:16 48000:32
=======================================
Using CursorLocation = clUseServer
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:1031 4000:454 4000:563
8000:1016 8000:468 8000:562
12000:1047 12000:469 12000:500
16000:1234 16000:484 16000:532
20000:1047 20000:454 20000:546
24000:1063 24000:484 24000:547
28000:984 28000:531 28000:563
32000:906 32000:485 32000:500
36000:1016 36000:531 36000:578
40000:1000 40000:547 40000:500
44000:968 44000:406 44000:562
48000:1016 48000:375 48000:547
Calling AdoQuery1.Recordset.MoveNext calls directly into the MDac/ADO layer, of
course, whereas AdoQuery1.Next involves all the overhead of the standard TDataSet
model. As Serge Kraikov said, changing the CursorLocation certainly makes a difference and doesn't exhibit the slowdown we noticed, though obviously it's significantly slower than using clUseClient and calling DisableControls. I suppose it depends on exactly what you're trying to do whether you can take advantage of the extra speed of using clUseClient with RecordSet.MoveNext.

When you open a table, ADO dataset internally creates special data structures to navigate dataset forward/backward - "dataset CURSOR". During navigation, ADO stores the list of already visited records to provide bidirectional navigation.
Seems ADO cursor code uses quadratic-time O(n2) algorithm to store this list.
But there are workaround - use server-side cursor:
Table.CursorLocation := clUseServer;
I tested your code using this fix and get linear fetch time - fetching every next chunk of records takes the same time as previous.
PS Some other data access libraries provides special "unidirectional" datasets - this datasets can traverse only forward and don't even store already traversed records - you get constant memory consumption and linear fetch time.

DAO is native to Access and (IMHO) is typically faster.
Whether or not you switch, use the GetRows method. Both DAO and ADO support it.
There is no looping. You can dump the entire recordset into an array with a couple of lines of code. Air code:
yourrecordset.MoveLast
yourrecordset.MoveFirst
yourarray = yourrecordset.GetRows(yourrecordset.RecordCount)

Related

For-loop variable violates loop bound

Today I have met very strange bug.
I have the next code:
var i: integer;
...
for i := 0 to FileNames.Count - 1 do
begin
ShowMessage(IntToStr(i) + ' from ' + IntToStr(FileNames.Count - 1));
FileName := FileNames[i];
...
end;
ShowMessage('all');
FileNames list has one element. So, I consider then loop will be executed once and I see
0 from 0
all
It is a thing I did thousands times :).
But in this case I see the second loop iteration when code optimization is switched on.
0 from 0
1 from 0
all
Without code optimization loop iterates right.
For the moment I don't know even the direction to move with this issue (and upper loop bound stays unchanged, yes).
So any suggestion will be very helpful. Thanks.
I use Delphi 2005 (Upd2) compiler.
Considering the QC report referred to by LU RD, and my own experience with D2005, here is a few workarounds. I recall using the while loop solution myself.
1.Rewrite the for loop as a while loop
var
i: integer;
begin
i := 0;
while i < FileNames.Count do
begin
...
inc(i);
end;
end;
2.Leave the for loop control variable alone from any other processing and use a separate variable, that you increment in the loop, for string manipulation and FileNames indexing.
var
ctrl, indx: integer;
begin
indx := 0;
for ctrl := 0 to FileNames.Count-1 do
begin
// use indx for string manipulation and FileNames indx
inc(indx);
end;
end;
3.You hinted at a workaround in saying Without code optimization loop iterates right.
Assuming you have optimization on turn it off ( {$O-} ) before the procedure/function and on ( {$O+} ) again after. Note! The Optimization directive can only be used around at least whole procedures/functions.
Ok, it seems to me I solved the problem and can explain it.
Unfortunately, I cannot make test to reproduce the bug, and I cannot show the real code, which under NDA. So I must use simplified example again.
Problem is in dll, which used in my code. Consider the next data structure:
type
TData = packed record
Count: integer;
end;
TPData = ^TData;
and function, which defined in dll:
Calc: function(Data: TPData): integer; stdcall;
In my code I try to proceed data records which are taken from list (TList):
var
i: integer;
Data: TData;
begin
for i := 0 to List.Count - 1 do
begin
Data := TPData(List[i])^;
Calc(#Data);
end;
and in case when optimization is on I see second iteration in loop from 0 to 0.
If rewrite code as
var
i: integer;
Data, Data2: TData;
begin
for i := 0 to List.Count - 1 do
begin
Data := TPData(List[i])^;
Data2 := TPData(List[i])^;
Calc(#Data2);
end;
all works as expected.
Dll itself was developed by another programmer, so I asked him to take care about it.
What was unexpected for me - that local procedure's stack can be corruped in so unusual way without access violations or other similar errors. BTW, Data and Data2 variables contains correct values.
Maybe, my experience will be useful to someone. Thanks all who helps me and please sorry my unconscious mistakes.

How to reduce CPU usage when scanning for folders/sub-folders/files?

I have developed an application that scans basically everywhere for a file or list of files.
When I scan small folders like 10 000 files and sub files there is no problem. But when I scan for instance my entire users folder with more than 100 000 items, it is very heavy on my processor. It takes about 40% of my processor's power.
Is there a way to optimize this code so that it uses less CPU?
procedure GetAllSubFolders(sPath: String);
var
Path: String;
Rec: TSearchRec;
begin
try
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then
try
repeat
Application.ProcessMessages;
if (Rec.Name <> '.') and (Rec.Name <> '..') then
begin
if (ExtractFileExt(Path + Rec.Name) <> '') And
(ExtractFileExt(Path + Rec.Name).ToLower <> '.lnk') And
(Directoryexists(Path + Rec.Name + '\') = False) then
begin
if (Pos(Path + Rec.Name, main.Memo1.Lines.Text) = 0) then
begin
main.ListBox1.Items.Add(Path + Rec.Name);
main.Memo1.Lines.Add(Path + Rec.Name)
end;
end;
GetAllSubFolders(Path + Rec.Name);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
except
on e: Exception do
ShowMessage(e.Message);
end;
end;
My app searches for all the files in a selected folder and sub-folder, zip's them and copies them to another location you specify.
The Application.ProcessMessages command is there to make sure the application doesn't look like it is hanging and the user closes it. Because finding 100 000 files for instance can take an hour or so...
I am concerned about the processor usage, The memory is not really affected.
Note: The memo is to make sure the same files are not selected twice.
I see the following performance problems:
The call to Application.ProcessMessages is somewhat expensive. You are polling for messages rather than using a blocking wait, i.e. GetMessage. As well as the performance issue, the use of Application.ProcessMessages is generally an indication of poor design for various reasons and one should, in general, avoid the need to call it.
A non-virtual list box performs badly with a lot of files.
Using a memo control (a GUI control) to store a list of strings is exceptionally expensive.
Every time you add to the GUI controls they update and refresh which is very expensive.
The evaluation of Memo1.Lines.Text is extraordinarily expensive.
The use of Pos is likewise massively expensive.
The use of DirectoryExists is expensive and spurious. The attributes returned in the search record contain that information.
I would make the following changes:
Move the search code into a thread to avoid the need for ProcessMessages. You'll need to devise some way to transport the information back to the main thread for display in the GUI.
Use a virtual list view to display the files.
Store the list of files that you wish to search for duplicates in a dictionary which gives you O(1) lookup. Take care with case-insensitivity of file names, an issue that you have perhaps neglected so far. This replaces the memo.
Check whether an item is a directory by using Rec.Attr. That is check that Rec.Attr and faDirectory <> 0.
I agree with the answer which says you would do best to do what you're doing in a background thread and I don't want to encourage you to persist in doing it in your main thread.
However, if you go to a command prompt and do this:
dir c:\*.* /s > dump.txt & notepad dump.txt
you may be surprised quite how quickly Notepad pops into view.
So there are few things you could do to speed up your GetAllSubFolders, even if you keep it in your main thread, e.g. to bracket the code by calls to main.Memo1.Lines.BeginUpdate and main.Memo1.Lines.EndUpdate, likewise main.Listbox1.Items.BeginUpdate and EndUpdate. This will stop these controls being updated while it executes (which is actually what your code is spending most of its time doing, that and the "if Pos( ...)" business I've commented on below). And, if you haven't gathered already, Application.ProcessMessages is evil (mostly).
I did some timings on my D: drive, which is a 500Gb SSD with 263562 files in 35949 directories.
The code in your q: 6777 secs
Doing a dir to Notepad as per the above: 15 secs
The code below, in main thread: 9.7 secs
The reason I've included the code below in this answer is that you'll find it much easier to execute in a thread because it gathers the results into a TStringlist, whose contents you can then assign to your memo and listbox once the thread has completed.
A few comments on the code in your q, which I imagine you might have got from somewhere.
It pointlessly recurses even when the current entry in Rec is a plain file. The code below only recurses if the current Rec entry is a directory.
It apparently tries to avoid duplicates by the "if Pos( ...)" business, which shouldn't be necessary (except maybe if there's a symbolic link (e.g created with the MkLink command) somewhere that points elsewhere on the drive) and does it in a highly inefficient manner, i.e. by searching for the filename in the memo contents - those will get longer and longer as it finds more files). In the code below, the stringlist is set up to discard duplicates and has its Sorted property set to True, which makes its checking for duplicates much quicker, becauseit can then do a binary search through its contents rather than a serial one.
It calculates Path + Rec.Name 6 times for each thing it finds, which is avoidably inefficient at r/t and inflates the source code. This is only a minor point, though, compared to the first two.
Code:
function GetAllSubFolders(sPath: String) : TStringList;
procedure GetAllSubFoldersInner(sPath : String);
var
Path,
AFileName,
Ext: String;
Rec: TSearchRec;
Done: Boolean;
begin
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then begin
Done := False;
while not Done do begin
if (Rec.Name <> '.') and (Rec.Name <> '..') then begin
AFileName := Path + Rec.Name;
Ext := ExtractFileExt(AFileName).ToLower;
if not ((Rec.Attr and faDirectory) = faDirectory) then begin
Result.Add(AFileName)
end
else begin
GetAllSubFoldersInner(AFileName);
end;
end;
Done := FindNext(Rec) <> 0;
end;
FindClose(Rec);
end;
end;
begin
Result := TStringList.Create;
Result.BeginUpdate;
Result.Sorted := True;
Result.Duplicates := dupIgnore; // don't add duplicate filenames to the list
GetAllSubFoldersInner(sPath);
Result.EndUpdate;
end;
procedure TMain.Button1Click(Sender: TObject);
var
T1,
T2 : Integer;
TL : TStringList;
begin
T1 := GetTickCount;
TL := GetAllSubfolders('D:\');
try
Memo1.Lines.BeginUpdate;
try
Memo1.Lines.Text := TL.Text;
finally
Memo1.Lines.EndUpdate;
end;
T2 := GetTickCount;
Caption := Format('GetAll: %d, Load: %d, Files: %d', [T2 - T1, GetTickCount - T2, TL.Count]);
finally
TL.Free;
end;
end;

Showing accumulated messages to the user

I want to show the user a summary of all the relevant messages that have occurred during a code execution (e.g. parsing, algorithm, conversion, validation etc). The messages should be showed together when the process is done.
A similar incident might occur none, one or several times. The user should be notified if the incident occurred. There might be several types of incidents.
I'm not sure if the scenario is clear, but maybe some code will help:
PSEUDO-CODE:
begin
//Execute computing process//
repeat
Set a flag if an incident occurs
Set another flag if another incident occurs
until done
//Show message to user//
if AnyFlagIsSet then
ShowPrettyMessageToUser
end;
EXECUTABLE DELPHI CODE:
program Test;
{$APPTYPE CONSOLE}
uses
SysUtils, StrUtils;
var
i: Integer;
tmpFlags: Array[1..4] of Boolean;
tmpMessage: String;
tmpChar: Char;
begin
Randomize;
repeat
//Initialization//
for i := 1 to 4 do
tmpFlags[i] := False;
//Will insident occur?//
for i := 0 to 5 do
begin
if (Random(10) = 0) then tmpFlags[1] := True;
if (Random(10) = 0) then tmpFlags[2] := True;
if (Random(10) = 0) then tmpFlags[3] := True;
if (Random(10) = 0) then tmpFlags[4] := True;
end;
//Show message//
tmpMessage := '';
if tmpFlags[1] then tmpMessage := tmpMessage + IfThen(tmpMessage <> '', #13#10+#13#10) + 'Incident 1';
if tmpFlags[2] then tmpMessage := tmpMessage + IfThen(tmpMessage <> '', #13#10+#13#10) + 'Incident 2';
if tmpFlags[3] then tmpMessage := tmpMessage + IfThen(tmpMessage <> '', #13#10+#13#10) + 'Incident 3';
if tmpFlags[4] then tmpMessage := tmpMessage + IfThen(tmpMessage <> '', #13#10+#13#10) + 'Incident 4';
Writeln('----------');
Writeln(tmpMessage);
Writeln('----------');
Writeln;
Write('Again? (Y/N) ');
Readln(tmpChar);
until tmpChar <> 'y';
end.
The code in the iteration is quiet complex in real life, of course.
And the messages are also more informative, and may even be formatted and multi-lined.
So...
Is there a best practice or pattern that can be used for this?
Any Delphi-component that handles this?
An easy solution would be to use a TStringList to collect all messages. You can then either display the strings in a listbox or concatenate the strings (in this case all messages should be valid sentences).
Pseudocode:
procedure DoSomething(Log : TStrings);
begin
//...
Log.Add ('Some hint.');
//...
Log.Add ('Some error happened.');
//...
end;
DoSomething (Log);
if (Log.Count > 0) then
LogListBox.Items.AddStrings (Log);
For formatted or multi-lined messages you could store HTML strings in the stringlist and use a component that can display HTML formatted text to display the messages.
Edit: If you want no duplicate messages, just do
Log.Duplicates := dupIgnore;
I would (where the memory requirements are not a factor) create a class which uses a hashed stringlist as a catalog, where X number of "logitems" could be inserted as objects. This allows some control over how the items are grouped. By accessing the stringlist using a normal index - you get a linear timeline. But accessing the items through it's hash-keys, you get the items grouped by content. Using a hashed stringlist is much faster to work with since it employes a lookup-table.
For an overall, application-wide solution, I have used the midas library's TClientDataset which has been with Delphi for ages. Just remember to declare "midaslib" as the first unit in your project and it's linked directly into your binary (no need to ship midaslib.dll). This gives you the benefit of fields and sorting by message/error types. As long as the record count dont get above 10k it's both fast and stable to work with.

Why is my code so slow?

Top-posted (sorry) answer, for those who don't have time to get into it but may have similar problems.
Rule #1, as always, move as much as you can out of loops.
2, moving TField var := ADODataSet.FieldByname() out of the loop
3, ADODataSet.DisableControls(); and ADODataSet.EnableControls(); around the loop
4, stringGrid.Rows[r].BeginUpdate() and EndUpdate() on each row (cannot do on teh whle control)
each of these shaved off a few seconds, but I got it down to "faster than the eye can see" by changing
loop
stringGrid.RowCount := stringGrid.RowCount + 1;
end loop
to putting stringGrid.RowCount := ADODataSet.RecordCount; before the loop
+1 and heartfelt thanks to all who helped.
(now I will go and see what I can do to optimize drawing a TChart, which is also slow ;-)
with about 3,600 rows in the table this takes 45 seconds to populate the string grid. What am I doing wrong?
ADODataSet := TADODataSet.Create(Nil);
ADODataSet.Connection := AdoConnection;
ADODataSet.CommandText := 'SELECT * FROM measurements';
ADODataSet.CommandType := cmdText;
ADODataSet.Open();
while not ADODataSet.eof do
begin
TestRunDataStringGrid.RowCount := TestRunDataStringGrid.RowCount + 1;
measurementDateTime := UnixToDateTime(ADODataSet.FieldByname('time_stamp').AsInteger);
DoSQlCommandWithResultSet('SELECT * FROM start_time_stamp', AdoConnection, resultSet);
startDateTime := UnixToDateTime(StrToInt64(resultSet.Strings[0]));
elapsedTime := measurementDateTime - startDateTime;
TestRunDataStringGrid.Cells[0, Pred(TestRunDataStringGrid.RowCount)] := FormatDateTime('hh:mm:ss', elapsedTime);
TestRunDataStringGrid.Cells[1, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('inputTemperature').AsFloat);
TestRunDataStringGrid.Cells[2, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('outputTemperature').AsFloat);
TestRunDataStringGrid.Cells[3, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('flowRate').AsFloat);
TestRunDataStringGrid.Cells[4, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('waterPressure').AsFloat * convert);
TestRunDataStringGrid.Cells[5, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('waterLevel').AsFloat);
TestRunDataStringGrid.Cells[6, Pred(TestRunDataStringGrid.RowCount)] := FloatToStrWithPrecision(ADODataSet.FieldByname('cod').AsFloat);
ADODataSet.Next;
end;
ADODataSet.Close();
ADODataSet.Free();
update:
Function DoSQlCommandWithResultSet(const command : String; AdoConnection : TADOConnection; resultSet : TStringList): Boolean;
var
i : Integer;
AdoQuery : TADOQuery;
begin
Result := True;
resultSet.Clear();
AdoQuery := TADOQuery.Create(nil);
try
AdoQuery.Connection := AdoConnection;
AdoQuery.SQL.Add(command);
AdoQuery.Open();
i := 0;
while not AdoQuery.eof do
begin
resultSet.Add(ADOQuery.Fields[i].Value);
i := i + 1;
AdoQuery.Next;
end;
finally
AdoQuery.Close();
AdoQuery.Free();
end;
end;
You are executing the command SELECT * FROM start_time_stamp 3,600 times, but it does not appear to me that it is correlated with your outer loop in any way. Why not execute it once before the loop?
That SELECT command appears to return only a single column of a single record, yet you use "*" to load all columns, and no WHERE clause to limit the results to a single row (if there's more than one row in the table).
You use only a limited number of columns from Measurements, but you retrieve all columns with "*".
You don't show the contents of DoSQlCommandWithResultSet, so it's not clear if there's a problem in that routine.
It's not clear whether the problem is in your database access or the string grid. Comment out all the lines pertaining to the string grid and run the program. How long does the database access alone take?
Additionally to Larry Lustig points:
In general, FieldByName is comparably slow method. You are calling it in loop for the same fields. Move the getting of field references out of the loop and store references in the variables. Like: InputTempField := ADODataSet.FieldByname('inputTemperature');
You are resizing the grid in the loop TestRunDataStringGrid.RowCount := TestRunDataStringGrid.RowCount + 1. That is the case, when you should use ADODataSet.RecordCount before the loop: TestRunDataStringGrid.RowCount := ADODataSet.RecordCount.
That is a good practice to call ADODataSet.DisableControls before loop and ADODataSet.EnableControls after loop. Even more actual that is for ADO dataset, which has not optimal implementation and those calls help.
Depending on a DBMS you are using, you can improve the fetching performance by setting a larger "rowset size". Not sure, how it control in ADO, probably setting ADODataSet.CacheSize to a greater value will help. Also, there are cursor settings :)
instead of calling ADODataSet.FieldByname('Fieldname') inside the loop you should declare local variables of type TField for each field, assign ADODataset.FindField('Fieldname') to the variables and use the variables inside the loop. FindFieldByName searches a list with every call.
Update:
procedure TForm1.Button1Click(Sender: TObject);
var
InputTemp, OutputTemp: TField;
begin
ADODataSet := TADODataSet.Create(Nil);
try
ADODataSet.Connection := ADOConnection;
ADODataSet.CommandText := 'SELECT * FROM measurements';
ADODataSet.Open;
InputTemp := ADODataSet.FindField('inputTemperature');
OutputTemp := ADODataSet.FindField('outputTemperature');
// assign more fields here
while not ADODataSet.Eof do begin
// do something with the fields, for example:
// GridCell := Format ('%3.2f', [InputTemp.AsFloat]);
// GridCell := InputTemp.AsString;
ADODataSet.Next;
end;
finally
ADODataSet.Free;
end;
end;
Another option would be to drop the TADODataset Componont on the form (or use a TDataModule) and define the fields at designtime.
Additional to the Larry Lustig answer, consider using data-aware controls instead, like the TDbGrid component.
If you aren't using data-aware controls you should use TestRunDataStringGrid.BeginUpdate before and TestRunDataStringGrid.EndUpdate after loop. Without this is your grid constantly redrawing after each modification (adding new row, cell update).
Another tip is set AdoQuery.LockType := ltReadOnly before opening query.
You could also try an instrumenting profiler instead of a sampling profiler to get better results (sampling profilers miss lot of detail info, and most time they have less then 1000 samples per second, and 1000 is already low: only good to get a quick overview).
Instrumenting profilers:
AQTime (commercial)
AsmProfiler (open source)
http://code.google.com/p/asmprofiler/wiki/AsmProfilerInstrumentingMode

Delphi loop speed question

Is there a faster way? I basically need to add AA-ZZ to thousands of records at a time.
Just a list of 35 items takes quite a while to complete muchless a list of a thousand.
procedure Tmainform.btnSeederClick(Sender: TObject);
var
ch,ch2:char;
i:integer;
slist1, slist2:TStrings;
begin
slist1:= TStringList.Create;
slist2:= TStringList.Create;
slist1.Text :=queuebox.Items.Text;
for ch := 'a' to 'z' do
begin
for ch2 := 'a' to 'z' do
begin
//
for I := 0 to slist1.Count - 1 do
begin
application.ProcessMessages; // so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
sleep(1); //Without this it doesn't process the cancel button.
if cancel then Break;
slist2.Add(slist1.Strings[i]+ch+ch2);
end;
end;
end;
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);
end;
Thanks for any help
There are a couple obvious problems with your code.
First off, you're wasting a lot of CPU cycles computing the same values over and over again. The AA..ZZ values aren't going to change, so there's no need to build them over and over. Try something like this: Create a third TStringList. Go through and fill it with all possible AA..ZZ permutations with your double loop. Once that's over with, loop through and merge this list of precomputed strings with the values in slist1. You should see a pretty big boost from that.
(Or, if time is absolutely at a premium, write a minor little program that will compute the permutation list and save it to a textfile, then compile that into your app as a string resource which you can load at runtime.)
Second, and this is probably what's killing you, you shouldn't have the ProcessMessages and the Sleep calls in the innermost loop. Sleep(1); sounds like it means "sleep for 1 milisecond", but Windows doesn't offer that sort of precision. What you end up getting is "sleep for at least 1 milisecond". It releases the CPU until Windows gets back around to it, which is usually somewhere on the order of 16 miliseconds. So you're adding a delay of 16 msec (plus as long as ProcessMessages takes) into a very tight loop that probably takes only a few microseconds to execute the rest of its code.
If you need something like that to keep the UI responsive, it should be in the outermost loop, not an inner one, and you probably don't even need to run it every iteration. Try something like if ch mod 100 = 0 then //sleep and process messages here. Craig's suggestion to move this task to a worker thread would also help, but only if you know enough about threads to get it right. They can be tricky.
You should surround your code with slist2.BeginUpdate() and slist2.EndUpdate(), to stop TStringList from doing extra processing.
From my experience, you would get a very large improvement by using fewer ProcessMessages(); Sleep(1); statements, as suggested in other answers.
Try moving it to just below the first for loop, and see what improvement you get.
An example of how you might use a secundary thread to do the heavy work.
Note that for the 35 items you mention, it is really not worth it to start another thread. For a few thousand items the game changes. Processing 10.000 items takes 10 seconds on my desktop computer.
Some benefits of multithreading:
the main thread stays responsive.
the calculation can be stopped at will.
and offcourse some pitfalls:
care must be taken (in its current implementation) to not mess with the passed stringlists while the seeding is running.
multithreading adds complexity and are source for hard to find bugs.
paste below code in our favorite editor and you should be good to go.
procedure TForm1.btnStartClick(Sender: TObject);
var
I: Integer;
begin
//***** Fill the sourcelist
FSource := TStringList.Create;
FDestination := TStringList.Create;
for I := 0 to 9999 do
FSource.Add(Format('Test%0:d', [I]));
//***** Create and fire Thread
FSeeder := TSeeder.Create(FSource, FDestination);
FSeeder.OnTerminate := DoSeederDone;
FSeeder.Resume;
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
if Assigned(FSeeder) then
FSeeder.Terminate;
end;
procedure TForm1.DoSeederDone(Sender: TObject);
var
I, step: Integer;
begin
I := 0;
step := 0;
while I < FDestination.Count do
begin
//***** Don't show every item. OutputDebugString is pretty slow.
OutputDebugString(PChar(FDestination[I]));
Inc(step);
Inc(I, step);
end;
FSource.Free;
FDestination.Free;
end;
{ TSeeder }
constructor TSeeder.Create(const source, destination: TStringList);
begin
//***** Create a suspended, automatically freed Thread object.
Assert(Assigned(source));
Assert(Assigned(destination));
Assert(destination.Count = 0);
inherited Create(True);
FreeOnTerminate := True; //***** Triggers the OnTerminate event
FSource := source;
FDestination := destination;
end;
procedure TSeeder.Execute;
var
I, J: Integer;
AString: string;
begin
FDestination.BeginUpdate;
try
FDestination.Capacity := FSource.Count * 26 * 26;
for I := 0 to Pred(FSource.Count) do
begin
AString := FSource[I];
for J := 0 to Pred(26 * 26) do
begin
FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
if Terminated then Exit;
end;
end;
finally
FDestination.EndUpdate;
end;
end;
OK. I have tried to optimize your code. For final tests, some test-data is needed.
What I have done (it include most of the ideas from Mason):
comment out the code about "cancel" and "
gave types and variables a more meaningfull name
used the names that Delphi uses ("Application" in stead of "application", etc) to make it readable
moved some logic into "KeepUIGoing"
move the calculation of the suffixes out of the main loop into an initialization loop
made it optionally use a TStringBuilder (which can be way faster than a TStringList, and is available since Delphi 2009)
Below is the modified code, let me know if it works for you.
procedure TForm2.Button1Click(Sender: TObject);
{$define UseStringBuilder}
procedure KeepUIGoing(SourceListIndex: Integer);
begin
if SourceListIndex mod 100 = 0 then
begin
Application.ProcessMessages;
// so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
Sleep(1);
end;
end;
const
First = 'a';
Last = 'z';
type
TRange = First .. Last;
TSuffixes = array [TRange, TRange] of string;
var
OuterIndex, InnerIndex: Char;
SourceListIndex: Integer;
SourceList, TargetList: TStrings;
Suffixes: TSuffixes;
NewLine: string;
{$ifdef UseStringBuilder}
TargetStringBuilder: TStringBuilder; // could be way faster than TStringList
{$endif UseStringBuilder}
begin
for OuterIndex := First to Last do
for InnerIndex := First to Last do
Suffixes[OuterIndex, InnerIndex] := OuterIndex + InnerIndex;
SourceList := TStringList.Create;
TargetList := TStringList.Create;
{$ifdef UseStringBuilder}
TargetStringBuilder := TStringBuilder.Create();
{$endif UseStringBuilder}
try
SourceList.Text := queuebox.Items.Text;
for OuterIndex := First to Last do
begin
for InnerIndex := First to Last do
begin
for SourceListIndex := 0 to SourceList.Count - 1 do
begin
KeepUIGoing(SourceListIndex);
// if cancel then
// Break;
NewLine := SourceList.Strings[SourceListIndex] + Suffixes[OuterIndex, InnerIndex];
{$ifdef UseStringBuilder}
TargetStringBuilder.AppendLine(NewLine);
{$else}
TargetList.Add(NewLine);
{$endif UseStringBuilder}
end;
end;
end;
{$ifdef UseStringBuilder}
TargetList.Text := TargetStringBuilder.ToString();
{$endif UseStringBuilder}
// insertsingle(TargetList, queuebox);
finally
{$ifdef UseStringBuilder}
FreeAndNil(TargetStringBuilder);
{$endif UseStringBuilder}
FreeAndNil(SourceList);
FreeAndNil(TargetList);
end;
end;
--jeroen
I would see if you can do it in one loop as per comment. Also try doing it in a thread so you can eliminate the Application.ProcessMessages and Sleep calls without blocking the UI.
I know this doesn't specifically answer your question, but if you are interested in Delphi algorithm's, Julian Bucknall (CTO of DevExpress) wrote the definitive Delphi algorithms book
Tomes of Delphi: Algorithms and Data Structures:
Chapter 1: What is an algorithm?
Chapter 2: Arrays
Chapter 3: Linked Lists, Stacks, and Queues
Chapter 4: Searching
Chapter 5: Sorting
Chapter 6: Randomized Algorithms
Chapter 7: Hashing and Hash Tables
Chapter 8: Binary Trees
Chapter 9: Priority Queues and Heapsort
Chapter 10: State Machines and Regular Expressions
Chapter 11: Data Compression
Chapter 12: Advanced Topics
You can also get his EZDSL (Easy Data Structures Library) for Delphi 2009 and Delphi 6-2007.
try this sample code - hope this will help a little (Delphi 5 Ent./WinXP)
procedure TForm1.Button1Click(Sender: TObject);
var
i,k: Integer;
sourceList, destList: TStringList;
ch1, ch2: char;
begin
destList := TStringList.Create;
sourceList := TStringList.Create;
//some sample data but I guess your list will have 1000+
//entries?
sourceList.Add('Element1');
sourceList.Add('Element2');
sourceList.Add('Element3');
try
i := 0;
while i < (26*26) do
begin
if (i mod 100) = 0 then
Application.ProcessMessages;
ch1 := char(65 + (i div 26));
ch2 := char(65 + (i mod 26));
for k := 0 to sourceList.Count -1 do
destList.Add(Format('%s-%s%s', [sourceList.Strings[k], ch1, ch2]));
Inc(i);
end;
Memo1.Lines.AddStrings(destList);
finally
FreeAndNil(destList);
FreeAndNil(sourceList);
end;
end;
--Reinhard
If you want events to be processed during your loop, such as the Cancel button being clicked, calling Application.ProcessMessages is sufficient. If you call that regularly but not too regularly, e.g. 50 times per second, then your application will remain responsive to the Cancel button without slowing down too much. Application.ProcessMessages returns pretty quickly if there aren't any messages to be processed.
This technique is appropriate for relatively short computations (a few seconds) that you would expect the user to wait on. For long computations a background thread is more appropriate. Then your application can remain fully responsive, particularly if the user has a multi-core CPU.
Calling Sleep in the main thread does not allow your application to process events. It allows other applications to do something. Calling Sleep really puts your application (the calling thread, actually) to sleep for the requested amount of time or the remainder of the thread's time slice, whichever is larger.
Use Delphi backgroundworker Component for this purpose can be better than thread.it is a easy and event based.features of backgroundworker(additional use Thread) :
Use Event based code. no need create class
Add Progress to process
Sample Code:
procedure TForm2.FormCreate(Sender: TObject);
var
I: Integer;
begin
FSource := TStringList.Create;
FDestination := TStringList.Create;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
I: Integer;
begin
try
FSource.BeginUpdate;
FSource.Clear;
for I := 0 to 9999 do
FSource.Add(Format('Test%0:d', [I]));
BackgroundWorker1.Execute;
finally
FSource.EndUpdate;
end;
end;
procedure TForm2.StopButtonClick(Sender: TObject);
begin
BackgroundWorker1.Cancel;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FreeAndNil(FSource);
FreeAndNil(FDestination);
end;
procedure TForm2.BackgroundWorker1Work(Worker: TBackgroundWorker);
var
I, J: Integer;
AString: string;
begin
FDestination.BeginUpdate;
try
FDestination.Capacity := FSource.Count * 26 * 26;
for I := 0 to Pred(FSource.Count) do
begin
AString := FSource[I];
for J := 0 to Pred(26 * 26) do
begin
FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
if Worker.CancellationPending then
Exit;
end;
if I mod 10 = 0 then
TThread.Sleep(1);
Worker.ReportProgress((I * 100) div FSource.Count);
end;
Worker.ReportProgress(100); // completed
finally
FDestination.EndUpdate;
end;
end;
procedure TForm2.BackgroundWorker1WorkProgress(Worker: TBackgroundWorker;
PercentDone: Integer);
begin
ProgressBar1.Position := PercentDone;
end;
if you are looking for pure speed just unroll the code into a single loop and write each line as a separate assignment. You could write a program to write the lines for you automatically then copy and past them into your code. This would essentially be about the fastest method possible. Also turn off all updates as mentioned above.
procedure Tmainform.btnSeederClick(Sender: TObject);
var
ch,ch2:char;
i:integer;
slist1, slist2:TStrings;
begin
slist1:= TStringList.Create;
slist2:= TStringList.Create;
slist1.Text :=queuebox.Items.Text;
slist2.BeginUpdate()
for I := 0 to slist1.Count - 1 do
begin
application.ProcessMessages; // so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
if cancel then Break;
slist2.Add(slist1.Strings[i]+'AA');
slist2.Add(slist1.Strings[i]+'AB');
slist2.Add(slist1.Strings[i]+'AC');
...
slist2.Add(slist1.Strings[i]+'ZZ');
end;
slist2.EndUpdate()
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);
end;

Resources