我如何运行在后台循环程序？

Question

我创建了一个过程来更新 SQLite 数据库。过程运行循环直到列表完成。问题是，当我运行程序时，程序停止响应

我怎样才能运行这个程序在后台运行而不会使程序崩溃？

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

将逻辑移动到一个单独的工作线程中，仅在绝对需要时才与主 UI 线程同步（即显示结果）。如果您计划在运行 Android 上编写此代码，则无论如何都需要执行此操作，因为您无法在 UI 主线程上执行网络操作。

此外，删除代码正在创建的 TMemo，它根本不需要。您使用它的全部目的是将 Whois 结果解析为 TStringList，您可以直接这样做。而且，您正在泄露 TMemo 并且永远不会向用户展示它。

试试像这样的东西：

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;

我如何运行在后台循环程序？

How can i run a loop procedure in background?

delphi

firemonkey

delphi-10.4-sydney

我如何 运行 在后台循环程序？

How can i run a loop procedure in background?

delphi

firemonkey

delphi-10.4-sydney

我如何运行在后台循环程序？