How can i run a loop procedure in background? - delphi

Question

I created a procedure to update an SQLite DB. The procedure runs in a loop until the list is finished. The problem is, when I run the procedure, the program stops responding
How can I run this procedure in the background, without crashing the program?
procedure TForm1.domainupdate;
var
I, J, K, svr: integer ;
domain1, domain2: string ;
expiry: string;
sl: TStringList;
fs: TFormatSettings;
s: string;
dt: TDatetime;
ds : TFormatSettings;
memo : tmemo;
begin
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
for J := Length (DM.Qdomains.FieldByName('domain').AsString) downto 2 do begin
if DM.Qdomains.FieldByName('domain').AsString [J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace
// found uk
else begin
domain2 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace ;
// found co.uk
Break ;
end;
end;
end;
FWhoisServers := TStringList.Create;
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.add(WhoisNames[I]);
FHost := 'whois.ripe.net' ;
K := -1 ;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos (domain1, FWhoisServers [I]) = 1) then K := I ;
if (Pos (domain2, FWhoisServers [I]) = 1) then
begin
K := I ;
break ;
end ;
end;
if K >= 0 then begin
J := Pos (IcsSpace, FWhoisServers [K]) ;
end;
end;
if K < 0 then begin
end;
IdWhois1.host := Copy (FWhoisServers [K], J + 1, 99) ;
Memo:=TMemo.Create(nil);
Memo.Visible:=false;
memo.Lines.text := IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
begin
sl := TStringList.Create;
try
sl.Assign(Memo.Lines);
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry = '' then
exit
else
s := expiry;
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.shortdateformat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDatetime(s, fs);
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.longtimeFormat := 'hh:mm:ss';
end;
end;
//********************************************************
//********************************************************
//if edit1.text <> '' then DM.Qdomains.Open;
DM.Qdomains.Edit;
DM.Qdomains.FieldByName('domain').AsString :=
DM.Qdomains.FieldByName('domain').AsString;
DM.Qdomains.FieldByName('expiry').AsString := datetimetostr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString :=
IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
DM.Qdomains.FieldByName('update').AsString := DatetimeToStr(now);
DM.Qdomains.Post;
DM.Qdomains.Next;
end;

Answer 1

Move the logic into a separate worker thread, synchronizing with the main UI thread only when absolutely needed (ie, to show the results). You need to do this anyway if you ever plan on running this code on Android, since you can't perform network operations on the main UI thread.
Also, get rid of the TMemo that the code is creating, it is not needed at all. All you are using it for is to parse the Whois result into a TStringList, which you can do directly. And, you are leaking the TMemo and never showing it to the user anyway.
Try something more like this:
procedure TForm1.DomainUpdate;
var
I, J, K: Integer;
domain, domain1, domain2, host, whois, expiry: string;
sl: TStringList;
fs, ds: TFormatSettings;
dt: TDatetime;
begin
// TODO: perform the DB query here instead of in the main thread...
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
domain := DM.Qdomains.FieldByName('domain').AsString;
domain1 := '';
domain2 := '';
for J := Length(domain) downto 2 do begin
if domain[J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy(domain, J + 1, MaxInt) + IcsSpace
// found uk
else begin
domain2 := Copy(domain, J + 1, MaxInt) + IcsSpace;
// found co.uk
Break;
end;
end;
end;
FWhoisServers := TStringList.Create;
try
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.Add(WhoisNames[I]);
host := 'whois.ripe.net';
K := -1;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos(domain1, FWhoisServers[I]) = 1) then K := I;
if (Pos(domain2, FWhoisServers[I]) = 1) then
begin
K := I;
Break;
end;
end;
if K >= 0 then begin
J := Pos(IcsSpace, FWhoisServers[K]);
host := Copy(FWhoisServers[K], J + 1, MaxInt);
end;
end;
IdWhois1.Host := host;
finally
FWhoisServers.Free;
end;
expiry := '';
sl := TStringList.Create;
try
whois := IdWhois1.WhoIs(domain);
sl.Text := whois;
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry <> '' then begin
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.ShortDateFormat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDateTime(expiry, fs);
ds := TFormatSettings.Create;
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.LongTimeFormat := 'hh:mm:ss';
DM.Qdomains.Edit;
try
DM.Qdomains.FieldByName('domain').AsString := domain;
DM.Qdomains.FieldByName('expiry').AsString := DateTimeToStr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString := whois;
DM.Qdomains.FieldByName('update').AsString := DateTimeToStr(Now);
DM.Qdomains.Post;
except
DM.Qdomains.Cancel;
raise;
end;
end;
DM.Qdomains.Next;
end;
end;
...
TThread.CreateAnonymousThread(DomainUpdate).Start;