如何在后台运行循环过程？

Question

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

​

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;