Delphi多线程与ado冻结问题

Question

在下面的代码中，我在空表单上创建一些按钮。 每个按钮都会在单击时启动一个线程，该线程连接到 sql 并打开一些查询。效果很好.. 当线程正在工作时，单击同一按钮会将其暂停。再次点击即可恢复。这也很好用..

一旦我开始向随机按钮发送垃圾邮件，程序就会冻结并且既不会恢复正常也不会 给出错误..我只是不知道出了什么问题..

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Data.Win.ADODB, IdThread, Winapi.ADOInt, ActiveX,
  Vcl.StdCtrls, Vcl.ExtCtrls, System.SyncObjs, System.Threading, Vcl.Buttons,
  Vcl.AppEvnts, Vcl.ComCtrls;

const
  CnnStr = 'write your connection string here';
  OpenCmnd1 = 'write a query that returns some result. ie: "select * from xxx"';

type
  TMyButton = class(Vcl.StdCtrls.TButton)
    OwnedThread: TThread;
    ProgressBar: TProgressBar;
  end;

  TMyThread = class(TThread)
    private
      FCounter: Integer;
      FCountTo: Integer;
      FProgressBar: TProgressBar;
      FOwnerButton: TMyButton;
      FConnection: TADOConnection;
      FQuery: TADOQuery;
      procedure DoProgress;
      procedure SetCountTo(const Value: Integer);
      procedure SetProgressBar(const Value: TProgressBar);
      procedure SetOwnerButton(const Value: TMyButton);
    protected
      procedure Execute; override;
    public
      constructor Create(CreateSuspended: Boolean);
      destructor Done;
      property CountTo: Integer read FCountTo write SetCountTo;
      property ProgressBar: TProgressBar read FProgressBar write SetProgressBar;
      property OwnerButton: TMyButton read FOwnerButton write SetOwnerButton;
  end;

  TForm2 = class(TForm)
    procedure Button1Click(Sender: TObject) ;
    procedure FormCreate(Sender: TObject);
  end;
var
  Form2: TForm2;
  allThreads: array of TMyThread;

implementation
  {$R *.dfm}

constructor TMyThread.Create(CreateSuspended: Boolean) ;
begin
  inherited;
  FCounter := 0;
  FCountTo := 100;
end;

destructor TMyThread.Done;
begin
  inherited;
  FQuery.Close;
  FreeAndNil(FQuery);
  FConnection.Close;
  FreeAndNil(FConnection);
end;

procedure TMyThread.DoProgress;
var
  PctDone: Extended;
begin
  PctDone := (FCounter / FCountTo) ;
  FProgressBar.Position := Round(FProgressBar.Step * PctDone) ;
  FOwnerButton.Caption := FormatFloat('0.00 %', PctDone * 100) ;
end;

procedure TMyThread.Execute;
const
  Interval = 1;
var
  aThreadID:integer;
begin
  CoInitialize(nil);
  try
    FreeOnTerminate := True;
    FProgressBar.Max := FCountTo div Interval;
    FProgressBar.Step := FProgressBar.Max;
    FProgressBar.ShowHint := True;
    FProgressBar.Hint := 'Thread ID ='+IntToStr(GetCurrentThreadID);
    aThreadID := GetCurrentThreadID;
    if not Assigned(FConnection) then
    begin
      FConnection := TADOConnection.Create(nil);
      FConnection.LoginPrompt := False;
      FConnection.ConnectionString := FORMAT(CnnStr,[GetCurrentThreadID]);
      //FConnection.ConnectOptions := coAsyncConnect;
    end;
    if not FConnection.Connected then
      FConnection.Open;
    if not Assigned(FQuery) then
    begin
      FQuery := TADOQuery.Create(nil);
      FQuery.Connection := FConnection;
      FQuery.SQL.Text := OpenCmnd1;
      FQuery.ExecuteOptions := [];
      FQuery.ParamCheck;
    end;
    while FCounter < FCountTo do
    begin
      if FQuery.State = dsBrowse then
        FQuery.Close;
      FQuery.Open;
      if FCounter mod Interval = 0 then Synchronize(DoProgress) ;
        Inc(FCounter) ;
    end;
    FOwnerButton.Caption := 'Start';
    FOwnerButton.OwnedThread := nil;
    FProgressBar.Position := FProgressBar.Max;
  finally
    CoUnInitialize;
  end;
end;

procedure TMyThread.SetCountTo(const Value: Integer) ;
begin
  FCountTo := Value;
end;

procedure TMyThread.SetOwnerButton(const Value: TMyButton) ;
begin
  FOwnerButton := Value;
end;

procedure TMyThread.SetProgressBar(const Value: TProgressBar) ;
begin
  FProgressBar := Value;
end;

procedure TForm2.Button1Click(Sender: TObject) ;
var
  aButton: TMyButton;
  aProgressBar: TProgressBar;
begin
  aButton := TMyButton(Sender) ;
  if not Assigned(aButton.OwnedThread) then
  begin
    allThreads[aButton.Tag] := TMyThread.Create(True) ;
    aButton.OwnedThread := allThreads[aButton.Tag];
    aProgressBar := TProgressBar(FindComponent(StringReplace(aButton.Name, 'Button', 'ProgressBar', []))) ;
    allThreads[aButton.Tag].ProgressBar := aProgressBar;
    allThreads[aButton.Tag].OwnerButton := aButton;
    allThreads[aButton.Tag].Resume;
    aButton.Caption := 'Pause';
  end
  else
  begin
    if aButton.OwnedThread.Suspended then
      aButton.OwnedThread.Resume
    else
      aButton.OwnedThread.Suspend;
    aButton.Caption := 'Run';
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  i : integer;
begin
  for i := 1 to 5 do
  begin
    with TMyButton.Create(self) do
    begin
      Parent := Self;
      Tag := i;
      Left := 10;
      Top := 10 + 30*i;
      width := 100;
      Caption := 'Button'+IntToStr(i);
      Name := 'Button'+IntToStr(i);
      onClick := Button1Click;
    end;
    with TProgressBar.Create(self) do
    begin
      Parent := Self;
      Tag := i;
      Left := 120;
      Top := 12 + 30*i;
      width := 200;
      Name := 'ProgressBar'+IntToStr(i);
    end;
  end;
  SetLength(allThreads,6);
end;

end.

这只是一个演示来代表我的问题..抱歉编码。

Answer 1

首先，当从工作线程访问 UI 控件时（即更新进度条等时），您必须与 UI 线程同步。您已经有一个用于此目的的

DoProgress()

方法，但您没有使用它。

其次，

Suspend()

/

Resume()

被误用是危险的，这就是为什么它们被弃用。如果您想安全地挂起一个线程，您需要在安全的情况下要求线程自行挂起。你不能在任何你想要的时候盲目地从外部挂起一个线程，你不知道线程当时处于什么状态，如果它在锁或同步等内部，那么糟糕的事情就会发生（就像你一样）找出来）。 修复 UI 同步问题后，挂起问题最简单的解决方案是向线程类添加一个布尔值，并在要挂起线程时将其设置为 true，然后让线程的

Execute()

方法查看该布尔值定期并仅当它不做其他事情时才调用

Suspend()

。