Delphi 2009 - create a delay of over an hour? - delphi

My program needs to send about 600 emails out. As my ISP only allows 400 in each hour I need to send say 300 of them, wait for an hour and send another 300. I don't really want my program hung for an hour as the user might want to do something else with it while waiting. Better still, they might even want to shut it down.
Is there a way to delay for an hour whilst keeping the program responsive or even allowing it to be shut down and woken up to continue?
I found this which is helpful
[What is the best way to program a delay in Delphi?
but that declares a variable
var
SE: TSimpleEvent;
which Delphi 2009 does not understand
BTW if the answer involves threads please could you explain carefully or even give code as I have never used threads before (not knowingly anyway!)

A simple solution is often the best. You could use a standard TTimer with an interval of 1 second and the count down from 3600. When you counter is zero one hours has past.
This is a dummy implpementation showing my point :
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Tag := 1;
end;
procedure Send300EMails;
begin
// Dummy
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Tag := Timer1.Tag - 1;
if Timer1.Tag = 0 then
begin
Timer1.Enabled := false;
Timer1.Tag := SecsPerHour;
Send300EMails;
Timer1.Enabled := True;
end;
end;

Related

Delphi: is DBexpress faster than Firedac

I'm running a Mysql server on my network (Mariadb 10.3.24), and have made a performance test with dbexpress and firedac on the same data, same machine and with no other users on the database. I'm using Delphi 10.1 and made no changes to the connection or query components setup.
My findings were (total number of records is 261.000):
Reading 100.000 records without a "where-clause"
Firedac : 184 sec
DBexpress: 93 sec
Reading 100.000 records with a where clause (indexed)
Firedac: 160 sec
DBexpress: 86 sec
All my programs are programmed with Firedac, is there a simple way to speed up Firedac, or do i need to switch to dbexpress to get a decent performance ?
My test (identical for dxexpress and firedac):
var start, slut : tdatetime;
n : integer;
begin
start := now;
listbox1.Items.Clear;
sqlq.Close;
sqlq.SQLConnection:=sqlcon;
sqlq.SQL.Clear;
sqlq.SQL.Add('select * from forsendelser where kundenummer="test" limit '+spinedit1.Text);
sqlq.Open;
while not sqlq.Eof do begin
listbox1.Items.Add(sqlq.FieldByName('stregkode').AsString );
sqlq.Next;
end;
sqlq.Close;
n :=SecondsBetween(Now, start);
edit2.Text:=n.ToString;
end;
There are several things that can be done with your code to improve the performance.
Start with not updating the ListBox.Items during the loop, as each time an item is added or deleted the screen has to update. This isn't needed while the loop is running.
Second, stop using FieldByName inside the loop. It forces a search through the table's fields to find that field each time the loop is executed, which isn't needed. You can get the field one time before the loop runs, store it in a variable, and access it through that variable in the loop.
This should improve performance considerably for you.
var
start: TDateTime;
n: Integer;
Fld: TField;
begin
start := now;
ListBox1.Items.BeginUpdate;
try
listbox1.Items.Clear;
sqlq.Close;
sqlq.SQLConnection := sqlcon;
sqlq.SQL.Text := 'select * from forsendelser where kundenummer="test" limit ' + spinedit1.Text;
sqlq.Open;
Fld := sqlq.FieldByName('stregkode');
while not sqlq.Eof do
begin
listbox1.Items.Add(Fld.AsString);
sqlq.Next;
end;
sqlq.Close;
finally
ListBox1.Items.EndUpdate;
end;
n :=SecondsBetween(Now, start);
edit2.Text:=n.ToString;
end;

Unknown Runtime Error in delphi7, 'Invalid floating point operation.' No crash

Good day, I need advice on a piece of code I wrote. It is an activity from my delphi7 school textbook, so you can imagine I am still new to pascal.
My program works fine and gets the results I need, but I receive a strange:
" Invalid floating point operation" message in runtime without the program crashing. With my limited knowledge, I can't find the reason behind this error. It is confusing as I did not use any real numbers but please have a look.
Let me know if you need additional information
Thank you in advance, I am open to learning!
private
arrLearners : array of string;
arrMod : array of string;
procedure TfrmPortfolios.btnEnterClick(Sender: TObject);
var
numL,k,d,a : integer;
l :string;
begin
k:=0;
numL:=0;
repeat
numL := StrToInt(InputBox('Enter names','How many learners in Subject?
(Max 30):','30'));
until
numL<=30;
SetLength(arrLearners, numL);
for k:=0 to numL-1 do
begin
arrLearners[k]:='Student No'+IntToStr(k+1);
end;
k:=0;
d := numL div 5; //used to see for every which learner will go to moderation. I.e if d=3 then every third student.
if numL <=9 then // below 9, d=1 then it's every student anyways
begin
for k:=0 to NumL-1 do
begin
SetLength(arrMod,NumL);
arrMod[k]:=arrLearners[k];
end;
end
else
begin
a := numL div d;
SetLength(arrMod, a);
for k:=0 to a-1 do
begin
arrMod[k] := arrLearners[(k*d) +1];
end;
end;
k:=0;
redOutput.Lines.Add('Students sent for moderation:'+#13);
for k:=0 to numL-1 do
begin
l:= arrMod[k];
redOutput.Lines.Add(l);
end;
end;
Make sure you have enabled range checking and overflow checking options. You can enable them either globally or locally in the code using compiler directives {$R+,O+} Range check is a very useful thing - it can save you much time on debug weird issues.

Why does scrolling through ADOTable get slower and slower?

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)

Delphi: Problems with TList of Frames

I'm having a problem with an interface that consists of a number of frames (normally 25) within a TScrollBox.
There are 2 problems, and I am hoping that one is a consequence of the other...
Background:
When the application starts up, I create 25 frames, each containing approx. 20 controls, which are then populated with the default information. The user can then click on a control to limit the search to a subset of information at which point I free and recreate my frames (as the search may return < 25 records)
The problem:
If I quit the application after the initial search then it takes approx. 5 seconds to return to Delphi. After the 2nd search (and dispose / recreate of frames) it takes approx. 20 seconds)
Whilst I could rewrite the application to only create the frames once, I would like to understand what is going on.
Here is my create routine:
procedure TMF.CreateFrame(i: Integer; var FrameBottom: Integer);
var
NewFrame: TSF;
begin
NewFrame := TSF.Create(Self);
NewFrame.Name := 'SF' + IntToStr(i);
if i = 0 then
NewSF.Top := 8
else
NewSF.Top := FrameBottom + 8;
FrameBottom := NewFrame.Top + NewFrame.Height;
NewFrame.Parent := ScrollBox1;
FrameList.Add(NewFrame);
end;
And here is my delete routine:
procedure TMF.ClearFrames;
var
i: Integer;
SF: TSF;
begin
for i := 0 to MF.FrameList.Count -1 do
begin
SF := FrameList[i];
SF.Free;
end;
FrameList.Clear;
end;
What am I missing?
As you are taking control over the memory allocation of the Frames you are creating by Free'ing them, so there's no need to provide Self as the owner parameter in the create constructor. Pass nil instead to prevent the owner trying to free the frame.
Also, don't like the look of your ClearFrames routine. Try this instead:
while FrameList.count > 0 do
begin
TSF(Framelist[0]).free;
Framelist.delete(0);
end;
Framelist.clear;
If you want to know why your app is taking so long to do something, try profiling it. Try running Sampling Profiler against your program. The helpfile explains how to limit the profiling to only a specific section of your app, which you could use to only get sampling results on the clearing or creating parts. This should show you where you're actually spending most of your time and take a lot of the guesswork out of it.

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