TADOConnection with SQL Server Thread with Delphi

Question

I am working on a project and I need to think about emergency situations.

The main issue is, how to check if the database is connected (circle object = red or green)?

BeforeConnect, AfterDisconnect, they have no good answer.

Inside type:

Create Connection:

procedure TForm1.Button1Click(Sender: TObject);
var
  s : String;
begin
  ADOConnectionSQL := TADOConnection.Create(nil);
  ADOConnectionSQL.LoginPrompt := false;
  with ADOSQL do
  begin
    s := 'Provider=SQLNCLI11.1;'+
    'Persist Security Info=False;'+
    'User ID='+Edit1.Text+';'+
    'Initial Catalog='+Edit2.Text+';'+
    'Data Source='+Edit3.Text+';'+
    'Initial File Name="";'+
    'Server SPN="";'+
    'password="'+Edit4.Text+'"';
    ADOConnectionSQL.ConnectionString := s;
  end;
  ADOConnectionSQL.BeforeConnect := SQLConnected;
  ADOConnectionSQL.AfterDisconnect := SQLDisconnected;
end;

Try to connect:

procedure TForm1.Button2Click(Sender: TObject);
var
  Thread : TThread;
begin
  Thread := TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize(TThread.CurrentThread,
      procedure
        begin
        try
          ADOConnectionSQL.Connected := True;
          ADOConnectionSQL.Open;
        except
          on E: Exception do
          begin
            ShowMessage('Exception message = '+E.Message);
          end;
        end;
        ADOQuerySQL := TADOQuery.Create(nil);
      end);
    end);
  Thread.OnTerminate := FinishConnected;
  Thread.Start;
end;

Green or Red:

procedure TForm1.SQLConnected(Sender: TObject);
begin
  Circle1.Fill.Color := $FF00FF00;
end;

procedure TForm1.SQLDisconnected(Sender: TObject);
begin
  Circle1.Fill.Color := $FFFF0000;
end;

FinishConnected:

procedure TForm1.FinishConnected(Sender: TObject);
begin
  if TThread(Sender).FatalException <> nil then
  begin
    // something went wrong
    ShowMessage ('Failure to connection');
    //Exit;
  end;
end;

When the SQL Server is online, I would like to see a green circle. When the connection with server goes downs, the circle should be red.

Answer 1

You are creating and opening the ADO connection in the context of the main UI thread, not in the context of the worker thread. So your worker thread is basically useless. You could have just used TThread.ForceQueue() instead to get the same effect.

ADO uses COM technology internally, so you can't really use it across thread boundaries anyway. If you want to use ADO in a thread, give the thread its own ADO Connection and Query objects. Do all your SQL work in the context of the thread, and synchronize status updates with the main UI thread as needed.

Also, you need to initialize the COM library in the worker thread before it can work with ADO.

Try something more like this instead:

procedure TForm1.Button1Click(Sender: TObject);
var
  Thread : TThread;
  ConnStr: string;
begin
  ConnStr := 'Provider=SQLNCLI11.1;'+
    'Persist Security Info=False;'+
    'User ID='+Edit1.Text+';'+
    'Initial Catalog='+Edit2.Text+';'+
    'Data Source='+Edit3.Text+';'+
    'Initial File Name="";'+
    'Server SPN="";'+
    'password="'+Edit4.Text+'"';

  Thread := TThread.CreateAnonymousThread(
    procedure
    var
      ADOConnectionSQL: TADOConnection;
      ADOQuerySQL: TADOQuery;
    begin
      CoInitialize(nil);
      try
        ADOConnectionSQL := TADOConnection.Create(nil);
        try
          ADOConnectionSQL.LoginPrompt := False;
          ADOConnectionSQL.ConnectionString := ConnStr;

          ADOConnectionSQL.Open;

          TThread.Queue(nil,
            procedure
            begin
              Circle1.Fill.Color := TAlphaColorRec.Green;
            end
          );

          ADOQuerySQL := TADOQuery.Create(nil);
          try
            ADOQuerySQL.Connection := ADOConnectionSQL;
            // use ADOQuerySQL as needed...
          finally
            ADOQuerySQL.Free;
          end;
        finally
          ADOConnectionSQL.Free;
        end;
      finally
        CoUninitialize;
      end;
    end);
  Thread.OnTerminate := SQLFinished;
  Thread.Start;
end;

procedure TForm1.SQLFinished(Sender: TObject);
begin
  Circle1.Fill.Color := TAlphaColorRec.Red;
  if TThread(Sender).FatalException <> nil then
  begin
    // something went wrong
    ShowMessage('Failure! ' + Exception(TThread(Sender).FatalException).Message);
  end;
end;