This is the followup of my previous post . I now have a few ADOQueries in the Procedure and one ADOConnection . All of these are Dynamically Created and Freed .
QUESTION : I was hoping that this entire Compare Procedure would be a lot faster if I use 4 Threads , but instead I have the same speed as without Threads, only it is a lot more complicated now . Or maybe I am doing something completely wrong here ?
The Code is here , sorry I know it is a bit to much , but without the code my Question makes no sense and the answer would only be guessing . MSSQL is not wrapped in a Try Finally I know , I just wanted first to check if there is any speed gain here .
Entire Procedure pasted as asked . I also altered it I do the CREATE of Objects outside the Loop and the Free After the Loop .
procedure TMain.SYNC(AProgressBar: TProgressBar; AData : array of RemoteDATA);
var i : integer;
isFound : boolean;
LStatus, LSU_Stueck, LHistLines , LPosLines, LSTLLines, LTXTLines, LKTXTLines : integer;
ABQuery , HistQuery, PosQuery, STLQuery, TXTQuery, KTXTQuery : TADOQuery;
MSSQL : TADOConnection;
begin
MSSQL := TADOConnection.Create(nil);
MSSQL.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\xlr_main.udl';
MSSQL.Provider:='SQLOLEDB.1';
MSSQL.KeepConnection:=true;
MSSQL.LoginPrompt:=false;
ABQuery := TADOQuery.Create(nil);
ABQuery.Connection:=MSSQL;
HistQuery := TADOQuery.Create(nil);
HistQuery.Connection:=MSSQL;
PosQuery := TADOQuery.Create(nil);
PosQuery.Connection:=MSSQL;
STLQuery := TADOQuery.Create(nil);
STLQuery.Connection:=MSSQL;
TXTQuery := TADOQuery.Create(nil);
TXTQuery.Connection:=MSSQL;
KTXTQuery := TADOQuery.Create(nil);
KTXTQuery.Connection:=MSSQL;
for i := Low(AData) to High(AData) do
begin
isFound:=false;
LStatus:=0;
LSU_Stueck:=0;
LHistLines:=0;
LPosLines:=0;
LSTLLines:=0;
LTXTLines:=0;
LTXTLines:=0;
ABQuery.SQL.Clear;
ABQuery.SQL.Add('select AB,STATUS,SU_STUECK,DB_YEAR from BW_AUFTR_KOPF where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
ABQuery.Open;
if ABQuery.RecordCount <> 0 then
begin
isFound:=true;
LStatus:=ABQuery.FieldByName('Status').AsInteger;
LSU_Stueck:=ABQuery.FieldByName('SU_STUECK').AsInteger;
end;
HistQuery.SQL.Clear;
HistQuery.SQL.Add('select COUNT(Datum) as HistLines from BW_AUFTR_HIST where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
HistQuery.Open;
LHistLines:=HistQuery.FieldByName('HistLines').AsInteger;
PosQuery.SQL.Clear;
PosQuery.SQL.Add('select COUNT(POS_NR) as PosLines from BW_AUFTR_POS where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
PosQuery.Open;
LPosLines:=PosQuery.FieldByName('PosLines').AsInteger;
STLQuery.SQL.Clear;
STLQuery.SQL.Add('select COUNT(POS_NR) as STLLines from BW_AUFTR_STL where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
STLQuery.Open;
LSTLLines:=STLQuery.FieldByName('STLLines').AsInteger;
TXTQuery.SQL.Clear;
TXTQuery.SQL.Add('select COUNT(POS_NR) as TXTLines from BW_AUFTR_TXT where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
TXTQuery.Open;
LTXTLines:=TXTQuery.FieldByName('TXTLines').AsInteger;
KTXTQuery.SQL.Clear;
KTXTQuery.SQL.Add('select COUNT(LFD_NR) as KTXTLines from BW_AUFTR_KTXT where AB='+inttostr(AData[i].AB)+' and DB_YEAR='+inttostr(AData[i].DB_YEAR));
KTXTQuery.Open;
LKTXTLines:=KTXTQuery.FieldByName('KTXTLines').AsInteger;
if isFound = true then
begin
if (AData[i].STATUS <> LStatus) or (AData[i].SU_STUECK <> LSU_Stueck)
or (AData[i].HISTLINES <> LHistLines) or (AData[i].POSLINES <> LPosLines) or (AData[i].STLLINES <> LSTLLines)
or (AData[i].TXTLINES <> LTxtLines) or (AData[i].KTXTLINES <> LKTXTLines) then
if (AData[i].STATUS < 100) and (AData[i].STATUS <> 98) then
begin
setlength(CHANGED_ARRAY,length(CHANGED_ARRAY)+1);
CHANGED_ARRAY[High(CHANGED_ARRAY)].AB:=AData[i].AB;
CHANGED_ARRAY[High(CHANGED_ARRAY)].DB_YEAR:=AData[i].DB_YEAR;
end;
if (AData[i].STATUS = 98) or (AData[i].STATUS = 117) or (AData[i].STATUS = 900)
or (AData[i].STATUS = 999) then
begin
setlength(DELETE_ARRAY,length(DELETE_ARRAY)+1);
DELETE_ARRAY[High(DELETE_ARRAY)].AB:=AData[i].AB;
DELETE_ARRAY[High(DELETE_ARRAY)].DB_YEAR:=AData[i].DB_YEAR;
end;
end
else
begin
if (AData[i].STATUS <> 98) and (AData[i].STATUS <> 117) and (AData[i].STATUS <> 900)
and (AData[i].STATUS <> 999) and (AData[i].STATUS <> 120) then
begin
setlength(NEW_ARRAY,length(NEW_ARRAY)+1);
NEW_ARRAY[High(NEW_ARRAY)].AB:=AData[i].AB;
NEW_ARRAY[High(NEW_ARRAY)].DB_YEAR:=AData[i].DB_YEAR;
end;
end;
TThread.Queue(TThread.CurrentThread,
procedure
begin
AProgressBar.Position:=i;
end);
end;
ABQuery.Free;
HistQuery.Free;
PosQuery.Free;
STLQuery.Free;
TXTQuery.Free;
KTXTQuery.Free;
MSSQL.Free;
end;
And I start the Threads here , then I wait for it to complete , but I also must show the progress .
if length(RAB_ARRAY) > 10 then
begin
Edit1.Text:='Items '+inttostr(length(RAB_ARRAY))+' 1/4 '+inttostr(length(RAB_ARRAY) div 4)+' LeftOver '+inttostr(length(RAB_ARRAY) mod 4);
Part:=length(RAB_ARRAY) div 4;
LeftOver:=length(RAB_ARRAY) mod 4;
setlength(Tasks,4);
Tasks[0] := TTask.Create(
procedure
begin
SYNC(progressThread1,copy(RAB_ARRAY,0,Part))
end);
Tasks[1] := TTask.Create(
procedure
begin
SYNC(progressThread2,copy(RAB_ARRAY,Part-1,Part))
end);
Tasks[2] := TTask.Create(
procedure
begin
SYNC(progressThread3,copy(RAB_ARRAY,(2*Part)-2,Part))
end);
Tasks[3] := TTask.Create(
procedure
begin
SYNC(progressThread4,copy(RAB_ARRAY,(3*Part)-3,Part+LeftOver))
end);
progressThread1.Max:=Part;
progressThread2.Max:=Part;
progressThread3.Max:=Part;
progressThread4.Max:=Part+LeftOver;
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
while true do
begin
if (Tasks[0].Status = TTaskStatus.Completed) and (Tasks[1].Status = TTaskStatus.Completed)
and (Tasks[2].Status = TTaskStatus.Completed) and (Tasks[3].Status = TTaskStatus.Completed) then
break;
Application.ProcessMessages;
end;
The answer here is that you need to profile your code and your queries to determine what your real bottleneck is here. Most likely it is that your numerous SELECT COUNT... queries do not have suitable indexes and the SQL server is being forced to scan the table, hitting the disk and providing the major serial bottleneck.
Related
I have this code working ...
procedure ValidatePage;
begin
WizardForm.NextButton.Enabled :=
(CompareText(InputPage6.Values[EditIndex2], 'Admin') <> 0);
end;
procedure EditChange(Sender: TObject);
begin
ValidatePage;
end;
procedure PageActivate(Sender: TWizardPage);
begin
ValidatePage;
end;
But I want to add more validations.
Example: If you have not allowed EX12345 or EX54321.
WizardForm.NextButton.Enabled :=
(CompareText(InputPage6.Values[EditIndex2], 'EX12345') <> 0);
and
WizardForm.NextButton.Enabled :=
(CompareText(InputPage6.Values[EditIndex2], 'EX54321') <> 0);
If I understand you correctly, you are asking how to combine multiple logical expressions into one. Use boolean operators, particularly and operator.
procedure ValidatePage;
begin
WizardForm.NextButton.Enabled :=
(CompareText(InputPage6.Values[EditIndex2], 'EX12345') <> 0) and
(CompareText(InputPage6.Values[EditIndex2], 'EX54321') <> 0);
end;
Particularly if you are going to add even more options, you can optimize the code by storing the value into a local variable first:
procedure ValidatePage;
var
Value: string;
begin
Value := InputPage6.Values[EditIndex2];
WizardForm.NextButton.Enabled :=
(CompareText(Value, 'EX12345') <> 0) and
(CompareText(Value, 'EX54321') <> 0);
end;
I do not know how to Create a TTask where I have a Procedure with parameters, without parameters it works but with parameters it does not .
Example
procedure TMain.SYNC(AProgressBar: TProgressBar; ASleep: Integer);
var i : integer;
begin
for i := 0 to 100 do
begin
sleep(ASleep);
TThread.Queue(TThread.CurrentThread,
procedure
begin
AProgressBar.Position:=i;
end);
end;
end;
Then I would like to create 4 Tasks like this :
setlength(Tasks,4);
Tasks[0] := TTask.Create(SYNC(progressThread1,100));
Tasks[1] := TTask.Create(SYNC(progressThread2,150));
Tasks[2] := TTask.Create(SYNC(progressThread3,300));
Tasks[3] := TTask.Create(SYNC(progressThread4,200));
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
TTask operates with anonymous procedures. You can capture the values that you want to pass to your method, eg:
SetLength(Tasks, 4);
Tasks[0] := TTask.Create(
procedure
begin
SYNC(progressThread1, 100);
end
);
Tasks[1] := TTask.Create(
procedure
begin
SYNC(progressThread2, 150);
end
);
Tasks[2] := TTask.Create(
procedure
begin
SYNC(progressThread3, 300);
end
);
Tasks[3] := TTask.Create(
procedure
begin
SYNC(progressThread4, 200);
end
);
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
Extending the Remy's answer, you can also write a function which returns an anonymous function that you pass to the task.
function MakeSync(AProgressBar: TProgressBar; ASleep: integer): TProc;
begin
Result :=
procedure
begin
SYNC(AProgressBar, ASleep);
end;
end;
SetLength(Tasks, 4);
Tasks[0] := TTask.Create(MakeSYNC(progressThread1, 100));
Tasks[1] := TTask.Create(MakeSYNC(progressThread2, 150));
Tasks[2] := TTask.Create(MakeSYNC(progressThread3, 300));
Tasks[3] := TTask.Create(MakeSYNC(progressThread4, 200));
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
Extending Remy's answer.
The loop 0..100 calling TThread.Queue with index i suffers from updating the progressbar with the i reference value, rather than the passed value.
To better view the consequence of this, remove the sleep call and add the i value to a memo. This will reveal a sequence similar to this:
42
101
101
101
...
101
Here is an example of how to capture the value of i when calling TThread.Queue:
procedure TMain.SYNC(AProgressBar: TProgressBar; ASleep: Integer);
function CaptureValue( ix : Integer) : TThreadProcedure;
begin
Result :=
procedure
begin
AProgressBar.Position := ix;
end;
end;
var i : integer;
begin
for i := 0 to 100 do
begin
sleep(ASleep);
TThread.Queue(TThread.CurrentThread, CaptureValue(i) );
end;
end;
i have a text file and 10 StringLists, i want to open the txt files in the 10 StringLists, for example the text file has 1000 line, i want the first 100 line in StringList1 and the second 100 in StringLists2 and so on, my idea is to get text file lines count and divide it by 10 then copy each 100 in the 10 StringLists
var
i, x :integer;
U : TStrings;
DatFile ,ExePath:string;
begin
U := TStringList.Create;
ExePath := ExtractFilePath(Application.ExeName);
DatFile := ExePath + 'Test.txt';
U.LoadFromFile(DatFile);
x := U.Count Div 10;
Edit1.Text := IntToStr(x);
/// Stoped here
end;
how to continue this?
You can use an array to hold the Memo pointers, and then loop through the lines of the file, calculating which array index to add each line to, eg:
var
i, LinesPerMemo, LinesAdded: integer;
U : TStrings;
DatFile: string;
Memos: array[0..9] of TMemo;
CurMemo: TMemo;
begin
Memos[0] := Memo1;
Memos[1] := Memo2;
Memos[2] := Memo3;
Memos[3] := Memo4;
Memos[4] := Memo5;
Memos[5] := Memo6;
Memos[6] := Memo7;
Memos[7] := Memo8;
Memos[8] := Memo9;
Memos[9] := Memo10;
DatFile := ExtractFilePath(Application.ExeName) + 'Test.txt';
U := TStringList.Create;
try
U.LoadFromFile(DatFile);
LinesPerMemo := U.Count div 10;
if (U.Count mod 10) <> 0 then
Inc(LinesPerMemo);
Edit1.Text := IntToStr(LinesPerMemo);
J := 0;
CurMemo := Memos[J];
try
LinesAdded := 0;
for I := 0 to U.Count-1 do
begin
CurMemo.Lines.Add(U[I]);
Inc(LinesAdded);
if (LinesAdded = LinesPerMemo) and (J < 9) then
begin
CurMemo.Lines.EndUpdate;
Inc(J);
CurMemo := Memos[J];
CurMemo.Lines.BeginUpdate;
LinesAdded := 0;
end;
finally
CurMemo.Lines.EndUpdate;
end;
end;
finally
U.Free;
end;
end;
Alternatively, use a temp TStringList to collect the lines for each Memo:
var
i, LinesPerMemo: integer;
U, Lines : TStrings;
DatFile: string;
Memos: array[0..9] of TMemo;
begin
Memos[0] := Memo1;
Memos[1] := Memo2;
Memos[2] := Memo3;
Memos[3] := Memo4;
Memos[4] := Memo5;
Memos[5] := Memo6;
Memos[6] := Memo7;
Memos[7] := Memo8;
Memos[8] := Memo9;
Memos[9] := Memo10;
DatFile := ExtractFilePath(Application.ExeName) + 'Test.txt';
U := TStringList.Create;
try
U.LoadFromFile(DatFile);
LinesPerMemo := U.Count div 10;
if (U.Count mod 10) <> 0 then
Inc(LinesPerMemo);
Edit1.Text := IntToStr(LinesPerMemo);
Lines := TStringList.Create;
try
J := 0;
for I := 0 to U.Count-1 do
begin
Lines.Add(U[I]);
if (Lines.Count = LinesPerMemo) and (J < 9) then
begin
Memos[J].Lines.Assign(Lines);
Inc(J);
Lines.Clear;
end;
end;
Memos[J].Lines.Assign(Lines);
finally
Lines.Free;
end;
finally
U.Free;
end;
end;
To speed up, you can use Texfile and Tstringstream with creating Tmemo if needed.
type
TForm1 = class(TForm)
Button1: TButton;
ScrollBox1: TScrollBox;
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
function getNewMemo(const aStream : Tstream) : TMemo;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const nblines : Integer = 100;
var F : TextFile;
sLine, sfile : string;
cpt : Integer;
Memo : TMemo;
tmp : TStringStream;
begin
sfile := 'C:\TEMP\Test.txt';
tmp := TStringStream.Create;
AssignFile(F, sFile);
Reset(F);
try
LockWindowUpdate(ScrollBox1.Handle);
cpt := 0;
while not Eof(F) do begin
Readln(F, sLine);
Inc(cpt);
tmp.WriteString(sLine + #13);
if (cpt mod nbLines = 0) then begin
Memo := getNewMemo(tmp);
tmp.Clear;
end;
end;
if tmp.Size > 0 then begin
Memo := getNewMemo(tmp);
tmp.Clear;
end;
finally
CloseFile(F);
tmp.Free;
LockWindowUpdate(0);
end;
end;
function TForm1.getNewMemo(const aStream : Tstream): TMemo;
begin
Result := TMemo.Create(ScrollBox1);
Result.Parent := ScrollBox1;
Result.Top := High(integer);
Result.Align := alTop;
Result.Height := 150;
Result.ScrollBars := ssBoth;
if aStream <> nil then begin
aStream.Seek(0, soFromBeginning);
Result.Lines.LoadFromStream(aStream);
end;
end;
end.
I want to use a TParallel.&For loop to calculate, for example, the prime numbers between 1 and 100000 and save all these prime numbers in AList: TList<Integer>:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TList<Integer>;
LoopResult: Tparallel.TLoopResult;
begin
AList:=TList<Integer>.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
//add the prime number to AList
end;
end);
//show the list
for i := 0 to AList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(AList[i]));
end;
end;
The calculations can be performed in parallel without issue but the TList is a shared resource. How can I add confirmed primes to the list in a threadsafe way?
You would simply call AList.Add(AIndex), and then Sort() the list after the loop is finished. But TList is not thread-safe, so you need a lock around the Add(), like a TCriticalSection or TMutex:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TList<Integer>;
ALock: TCriticalSection;
LoopResult: TParallel.TLoopResult;
begin
AList := TList<Integer>.Create;
ALock := TCriticalSection.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
ALock.Enter;
try
AList.Add(AIndex);
finally
ALock.Leave;
end;
end;
end);
AList.Sort;
for i := 0 to AList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(AList[i]));
end;
ALock.Free;
AList.Free;
end;
Or use TThreadList<T> instead:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TThreadList<Integer>;
LList: TList<Integer>;
LoopResult: TParallel.TLoopResult;
begin
AList := TThreadList<Integer>.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
AList.Add(AIndex);
end;
end);
LList := AList.LockList;
try
LList.Sort;
for i := 0 to LList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(LList[i]));
end;
finally
AList.UnlockList;
end;
AList.Free;
end;
Is there a way to exclude blank strings from the dynamic array resulting of the SplitString function (Delphi XE, StrUtils), without having to iterate through the array?
If not, can anyone suggest the most efficient way to do it? Right now I'm doing it like this:
function SplitStringNoEmpty(myString : string; myDelimiters : string):TStringDynArray;
var
words_array_pre : TStringDynArray;
words_array_pos : TStringDynArray;
array_length : Integer;
actual_length : Integer;
current_word : string;
procedure AddElement(const Str: string);
begin
words_array_pos[actual_length]:= Str;
inc(actual_length);
end;
begin
words_array_pre:= SplitString(myString, whitespaceNewLineCharacterSet + punctuationCharacterSet);
array_length:= Length(words_array_pre);
if (array_length >0) then
begin
actual_length:= 0;
SetLength(words_array_pos, array_length);
for current_word in words_array_pre do
begin
if (current_word <> '') then
AddElement(current_word);
end;
SetLength(words_array_pos, actual_length);
result:= words_array_pos;
end
else
result:= words_array_pre;
end;
You can write your own implementation of the SplitString function ignoring the empty strings.
Check this sample
function SplitString2(const S, Delimiters: string): TStringDynArray;
var
LIndex, SIndex, FIndex, LMax, LPos: Integer;
foo : string;
begin
Result := nil;
if S <> '' then
begin
LPos := 0;
LMax := 0;
SIndex := 1;
for LIndex := 1 to Length(S) do
if IsDelimiter(Delimiters, S, LIndex) then Inc(LMax);
SetLength(Result, LMax + 1);
repeat
FIndex := FindDelimiter(Delimiters, S, SIndex);
if FIndex <> 0 then
begin
foo:= Copy(S, SIndex, FIndex - SIndex);
if foo<>'' then
begin
Result[LPos] := foo;
Inc(LPos);
end;
SIndex := FIndex + 1;
end;
until (LPos = LMax) or (FIndex=0);
if LPos<LMax then
SetLength(Result, LPos + 1);
foo:=Copy(S, SIndex, Length(S) - SIndex + 1);
if foo<>'' then
Result[LMax] := foo
else
SetLength(Result, LPos);
end;
end;
It's impossible to remove certain elements of an array without iterating over the array — how else would you know which elements to remove? The improvements to make to your code are to remove the need to allocate an extra array. You can cull the original array in-place:
function SplitStringNoEmpty(const s, delimiters: string): TStringDynArray;
var
Src, Dest: Integer;
begin
Result := SplitString(s, delimiters);
if Length(Result) <> 0 then begin
// Push all non-empty values to front of array
Dest := 0;
for Src := 0 to High(Result) do
if Result[Src] <> '' then begin
if Src <> Dest then
Result[Dest] := Result[Src];
Inc(Dest);
end;
// Remove excess from end of array
SetLength(Result, Dest);
end;
end;