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;

CodePudding user response：

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;