Search code examples
delphifiremonkeydelphi-10.4-sydney

How can i run a loop procedure in background?


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

Screenshot when I run the procedure

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;

Solution

  • 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;