运行程序而不会使应用程序崩溃

问题描述 投票:0回答:0

我有一个程序叫做

'域更新'.

当我通过单击直接运行该过程时,我得到了带有 SQL 图标的光标等待并且程序停止响应,直到该过程完成。但是,当我使用 TThread 运行该过程时,只有第一条记录或第一条和第二条记录被更新。我该如何解决这个问题?

    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;

按钮:

procedure TForm1.RefreshDomainsClick(Sender: TObject);
begin
 TThread.CreateAnonymousThread(
    procedure
    begin
     domainupdate;
    end
  ).Start;
end;
android delphi firemonkey delphi-11-alexandria
© www.soinside.com 2019 - 2024. All rights reserved.