I have a procedure called domainupdate()
.
When I run the procedure directly in the buton click, I got the cursor waits with the SQL icon and the program stops responding until the procedure is finished.
However, when I run the procedure with TThread
, only the first record, or the first and second records, are updated.
How can I fix this issue?
procedure TForm1.domainupdate;
var
I, A, J, K, B: Integer;
domain, domain1, domain2, host, whois, expiry, status: string;
sl: TStringList;
fs, ds: TFormatSettings;
dt: TDatetime;
begin
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;
sl.NameValueSeparator := ':';
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
for B := 0 to sl.Count-1 do begin
sl[B] := TrimLeft(sl[B]);
if SameText(sl.Names[B], 'status') then
begin
status := Trim(sl.ValueFromIndex[B]);
status := Copy(status, 1);
end
else
if SameText(sl.Names[B], 'Domain Status') then
begin
status := Trim(sl.ValueFromIndex[B]);
status := Copy(status, -1);
notes.Lines.Add(status);
end;
end;
finally
sl.Free;
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.FieldByName('status').AsString := status;
DM.Qdomains.Post;
DM.Qdomains.next;
except
DM.Qdomains.Cancel;
raise;
end;
end;
end;
end;
end;
Button:
procedure TForm1.RefreshDomainsClick(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
domainupdate;
end
).Start;
end;
from Run procedure without crashing the application
No comments:
Post a Comment