SQL Server 2008 - Connection error (EOleException)

good ?
close connection when you have been idle a while

when running a query, check the connection, reopen if necessary and then run the query
preferable check the connection in a thread

Hi Geert:
Your answer brings up more questions:

> close connection when you have been idle a while
What needs to be idle (application, database, computer)? And how can the application check for this idle-status?

> check the connection
What would check the connection? Maybe something like this?
If NOT ADOConnection1.Active then
  ADOConnection1.Active := True;    

How would I check for an open connection in a thread?
What is the use of closing the connection (when idle), if it is checked and re-opened in a thread anyway?

Also I found this to change the database property:
ADOConnection1.Execute('ALTER DATABASE ' + MyDatabaseName + ' SET AUTO_CLOSE OFF;');

Instead of pingning the server, I use a sytem where by I have a stored procedure that calls the function CURRENT_TIMESTAMP from sql sever periodically. This is handled by a thread in my connection manager object. If a result is not returned, there is a problem with the connection and I try to handle it gracefully

The auto_close property isn't preventing the client to lose connection, it's about whether or not the database should be closed when no users are logged in that database, so that won't solve your problem.


AUTO_CLOSE { ON | OFF }

The database is shut down cleanly and its resources are freed after the last user exits.

The database automatically reopens when a user tries to use the database again. For example, by issuing a USE database_name statement. If the database is shut down cleanly while AUTO_CLOSE is set to ON, the database is not reopened until a user tries to use the database the next time the Database Engine is restarted.

auke t:
Thank you for the clarification, but what would be very interesting is to get a solution that will solve handling connectionerrors. :-)

So at this point my answer is:
How can I create a thread that will periodically check if the connection to the database server is still available. And if the connection is lost; handling it gracefully (as ewangoya pointed out so nicely).

ewangoya:
I would appreciate some example of how you do this. Especially handling connection-problems.

idle connection
> keep resources busy on the server >> to do nothing
> keep network resources busy >> reducing bandwidth for others
> keep local network/memory busy > reducing cpu for other apps

sometimes people see a program in the task manager with cpu at 2% or 10%
and they know they aren't doing anything with it, so they wonder, what in gods name is that app doing ?
basically ... nothing

i used to do this too, keeping a connection open in my program
then i started working in a large company ... my app got deployed to hundreds of pc's
all with a idle connection, bringing down the network to snail speed, the database server to snail speed ....
everything to snail speed...

this is costing your company (or the clients company) a lot of unecessary resource consumption
if this is across a WAN it is costing money too ... because you pay per byte sent

with all this in mind, there are 2 options
1: create client server apps with managed connections
2: create a layer which manages the db connections (closing and reopening as necessary)

don't take this litely, it took me 2 years to program option 2

i'll give you a sample of my code.

the basic idea:
store all the info about a connection in the registry > connectionstring
give each connection string a name
when a query/stp starts, catch a connection error, check the connection in a thread, keep trying till it opens, close it again,
in the same scope as the query, reopen the connection for the query
monitor the connection for use and close after idle timeout

this is for oracle using Odac from DevArt

this will not compile (it's not the whole unit )

TCanAutoDisconnectEvent = procedure (Sender: TObject; ConnectionName: string; var CanAutoDisconnect: boolean) of object;

  TDacConnectionState = (dcsCreating, dcsUsing, dcsDestroying);
  TDacConnection = class(TCollectionItem)
  private
    FDacType: TDacType;
    FConnectionName: string;
    FPassword: string;
    FEnabled: boolean;
    FConnection: TCustomDAConnection;
    FConnectionString: string;
    FReconnectThread: TReconnectThread;
    FSignalEvent: TEvent;
    FDacConnectionState: TDacConnectionState;
    FConnectStep: TConnectStep;
    FAutoReconnect: boolean;
    FCanTimeOut: Boolean;
    FTimedOut: Boolean;
    fLogonType: TLogonType;
    fLogonPassword: string;
    FAskPassword: Boolean;
    FIsHidden: Boolean;
    fDisConnectTimer: TTimer;
    fAutoDisconnect: boolean;
    fOnCanAutoDisconnect: TCanAutoDisconnectEvent;
    procedure OnDisconnectTimer(Sender: TObject); 
    function GetPassword(user: string): string;
    function GetDataSource: string;
    procedure MakeConnection;
    procedure SetConnectStep(const Value: TConnectStep);
    procedure SetAutoReconnect(const Value: boolean);
    function GetConnected: boolean;
    procedure SetConnected(const Value: boolean);
    function GetConnectionString: string;
    procedure SetTimedOut(const Value: Boolean);
    function GetSchema: string;
    procedure SetAutoDisconnect(const Value: boolean);
  protected
    procedure ConnectionErrorOra(Sender: TObject; E: EDAError; var Fail: boolean);
    procedure ConnectionErrorMS(Sender: TObject; E: EDAError; var Fail: boolean);
    procedure DoReconnectCallback; dynamic;
    function FirstConnection: Boolean;
  public
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(Collection: TCollection; aConnectionName, aConnectionString: string; aConnectPrompt: boolean = False); reintroduce; overload;
    destructor Destroy; override;
    function GetOracleHomeParameters: string;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure ResetDisconnectTimer;
    function CanAutoDisconnect: boolean;
    function IsDefault: Boolean;

    procedure DoConnect(aConnectionName, aConnectionString: string; aConnectPrompt: boolean = False);

    procedure Reconnect;

    property AutoDisconnect: boolean read fAutoDisconnect write SetAutoDisconnect;
    property ConnectStep: TConnectStep read FConnectStep write SetConnectStep;
    property AutoReconnect: boolean read FAutoReconnect write SetAutoReconnect;
    property Connection: TCustomDAConnection read FConnection;
    property DacType: TDacType read FDacType;
    property Connected: boolean read GetConnected write SetConnected;
    property DataSource: string read GetDataSource;
    property Schema: string read GetSchema;
    property Enabled: boolean read FEnabled;
    property ConnectionName: string read FConnectionName;
    property ConnectionString: string read GetConnectionString;
    property TimedOut: Boolean read fTimedOut write SetTimedOut;
    property IsHidden: Boolean read fIsHidden;
    property OnCanAutoDisconnect: TCanAutoDisconnectEvent read fOnCanAutoDisconnect write fOnCanAutoDisconnect;
  end;

  TDacConnections = class(TCollection)
  private
    fcsConnection: TCriticalSection;
    FOnReconnectCallback: TReconnectCallbackEvent;
    FTimeOutTimer: TTimer;
    fFirstConnection: Boolean;
    function GetItems(Index: Integer): TDacConnection;
    procedure PreventNetworkTimeOut(Sender: TObject);
  protected
    property FirstConnection: boolean read fFirstConnection;
  public
    constructor Create(ItemClass: TCollectionItemClass);
    destructor Destroy; override;
    function Describe(aConnectionName: string; condesc: TConDesc): string;
    function DescribeAll(aMax: integer = 0): string;
    function CopyFrom(aConnectionFrom, aNewConnectionName: string; NoRegistry: boolean = False): TDacConnection;
    function Add(aConnectionName, aConnectionString: string; aConnectPrompt: boolean): TDacConnection;
    function FindConnection(aConnectionName: string): TDacConnection;
    procedure Disable(aConnectionName: string);
    procedure Enable(aConnectionName: string);
    function NewConnectionName: string;

    property Items[Index: Integer]: TDacConnection read GetItems;
    property OnReconnectCallback: TReconnectCallbackEvent read FOnReconnectCallback write FOnReconnectCallback;
  end;

  TDacQuery = class(TDacRoot)
  private
    function GetParams: TDAParams;
  public
    constructor Create(AOwner: TComponent); override;
    constructor Create(AOwner: TComponent; aConnectionName: string); override;
    constructor Create(AOwner: TComponent; aConnectionName, aConnectionString: string); override;
    procedure ExecSQL;
    property Params: TDAParams read GetParams;
    property ReturnParams;
    property SQL;
  end;

const 
  ConnectionErrors: string = '03113,03114,03135,12519,12545,12152,12154,12156,12571,12560';

function ConnectionError(ErrorMessage: string): boolean;
var
  OraError, Temp: string;
begin
  AddLog(DacError, ErrorMessage);
  OraError := '';
  Result := False;
  if AnsiContainsStr(ErrorMessage, 'ORA-') then
  begin
    Temp := Copy(ErrorMessage, Pos('ORA-', ErrorMessage) + 4, Length(ErrorMessage));
    while (Temp <> '') and (Temp[1] in ['0'..'9']) do
    begin
      OraError := OraError + Temp[1];
      Delete(Temp, 1, 1);
    end;
    if (OraError <> '') and (Pos(OraError, ConnectionErrors) > 0) then
      Result := True;
  end;
end;

{ TDacConnection }

procedure TDacConnection.ConnectionErrorOra(Sender: TObject; E: EDAError; var Fail: boolean);
begin
  if FAutoReconnect and ConnectionError(E.Message + #13#10'ORA-' + IntToStr(E.ErrorCode)) then
  begin
    Reconnect;
    //Fail := True;
  end;
end;

procedure TDacConnection.ConnectionErrorMs(Sender: TObject; E: EDAError; var Fail: boolean);
begin
  if FAutoReconnect and ConnectionError(E.Message + #13#10'MSSQL-' + IntToStr(E.ErrorCode)) then
    Reconnect;
end;

constructor TDacConnection.Create(Collection: TCollection);
begin
  Create(Collection, DefaultConnection, '');
end;

constructor TDacConnection.Create(Collection: TCollection; aConnectionName, aConnectionString: string; aConnectPrompt: boolean = False);
begin
  inherited Create(Collection);
  FConnectStep := csNoConnection;
  FAutoDisconnect := False;
  FAutoReconnect := AutoReconnectConnections;
  FDacConnectionState := dcsCreating;
  FEnabled := False;
  FConnectionName := '';
  FConnection := nil;
  FDacType := dacUnknown;
  FConnectionString := '';
  FSignalEvent := TEvent.Create(nil, False, False, 'SignalEventThread_' + aConnectionName);
  FReconnectThread := nil;
  FPassword := '';
  fLogonPassword := '';
  FCanTimeOut := False;
  FTimedOut := False;
  DoConnect(aConnectionName, aConnectionString, aConnectPrompt);
end;

procedure TDacConnection.DoConnect(aConnectionName, aConnectionString: string; aConnectPrompt: boolean);
var
  I: Integer;
  Reg: TRegistry;
  List: TStrings;
  AppName, ConnectionString, LogonUser: string;
  AutoConnectDB, ConnectionFound: boolean;
begin
  FConnectionName := aConnectionName;
  AutoConnectDB := False;

  AppName := ChangeFileExt(ExtractFileName(ParamStr(0)), '');

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(Format('%s\%s\parameters',[CompanyKey, AppName]), True) then
    try
      if not Reg.ValueExists('auto_connect_db') then
        Reg.WriteBool('auto_connect_db', True);
      if Reg.ValueExists('auto_connect_db') and Reg.ReadBool('auto_connect_db') then
        AutoConnectDB := True;
    finally
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;

  if aConnectionString <> '' then
  begin
    List := TStringList.Create;
    try
      List.CommaText := aConnectionString;
      List.Values['ConnectionName'] := FConnectionName;
      aConnectionString := List.CommaText;
    finally
      FreeAndNil(List);
    end;
  end;
  ConnectionString := aConnectionString;
  if aConnectionString = '' then
  begin
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey(Format('%s\%s\parameters',[CompanyKey, AppName]), False) then
      try
        List := TStringList.Create;
        try
          Reg.GetValueNames(List);
          ConnectionFound := False;
          for I := 0 to List.Count -1 do
            if SameText(List[I], 'CDB_' + FConnectionName) and
              (Reg.GetDataType(List[I]) = rdString) then
            begin
              ConnectionString := '"' + StringReplace(Reg.ReadString(List[I]), ',', '","', [rfReplaceAll]) + '"';
              ConnectionFound := True;
              Break;
            end;
          if not ConnectionFound and SameText(FConnectionName, DB_Company) then
          begin
            if SameText(FConnectionName, DB_Company) then
              ConnectionString := Format('Driver=ORACLE,UserId=%s,DataSource=%s,ConnectionName=%s,Type=ODAC,Enabled=TRUE',
                ['SHOP', 'OracleDB', DB_Company]);
            if ConnectionString <> '' then
              Reg.WriteString('cdb_' + LowerCase(FConnectionName), ConnectionString);
            ConnectionString := '"' + StringReplace(ConnectionString, ',', '","', [rfReplaceAll]) + '"';
          end;
        finally
          List.Free;
        end;
      finally
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end;
  FConnectionString := ConnectionString;

  if ConnectionString <> '' then
  begin
    List := TStringList.Create;
    try
      List.CommaText := ConnectionString;
      FIsHidden := List.Values['NOREGISTRY'] = '1';
      FCanTimeOut := List.Values['CANTIMEOUT'] = '1';
      FAskPassword := List.Values['ASKPASSWORD'] = '1';
      if FAskPassword then
        FCanTimeOut := True;
      fLogonType := ltNone;
      if (List.Values['USEWINLOGON'] = '1') or SameText(List.Values['LOGONTYPE'], 'WINDOWS') then
        fLogonType := ltWindows;
      if SameText(List.Values['LOGONTYPE'], 'CUSTOM') then
        fLogonType := ltCustom;
      if fLogonType in [ltWindows, ltCustom] then
      begin
        FCanTimeOut := True;
        FAskPassword := True;
      end;
      if FCanTimeOut then FTimedOut := True;
      case fLogonType of
        ltWindows: LogonUser := MyUserName;
        ltCustom: LogonUser := Dictionary.Read('logon_user', '');
      else
        LogonUser := List.Values['UserId'];
      end;
      if List.Values['TYPE'] = 'BDE' then
        List.Values['TYPE'] := 'ODAC';
      if List.Values['TYPE'] = 'ODAC' then
        fDacType := dacOracle;
      // Remove SDAC
      //else if List.Values['TYPE'] = 'SDAC' then
      //  fDacType := dacMSSQL;
      if (List.Values['NOREGISTRY'] = '') and (
        not SameText(List.Values['NOREGISTRY'], '1') or SameText(List.Values['NOREGISTRY'], 'TRUE')) then
        Dictionary.Write('cdb_' + ConnectionName, List.CommaText);
      case fDacType of
        dacOracle:
        begin
          if (FConnection <> nil) and not (FConnection is TOraSession) then
            FreeAndNil(FConnection);
          if FConnection = nil then
            FConnection := TOraSession.Create(nil)
          else if FConnection.Connected then
            FConnection.Disconnect;
          FConnection.Username := LogonUser;
          if List.IndexOfName('Password') = -1 then
            FPassword := GetPassword(FConnection.UserName + '@' + List.Values['DataSource'])
          else
            FPassword := List.Values['Password'];
          FConnection.Password := FPassword;
          FConnection.Server := List.Values['DataSource'];
          FConnection.OnError := ConnectionErrorOra;
          TOraSession(FConnection).ThreadSafety := True;
          TOraSession(FConnection).AutoCommit := True;
          FConnection.LoginPrompt := aConnectPrompt;
          FEnabled := SameText(List.Values['Enabled'], 'TRUE');
        end;
        // Removed SDAC
        {
        dacMSSQL:
        begin
          OLEDBAccess.ParamsInfoOldBehavior := True;
          if (FConnection <> nil) and not (FConnection is TMSConnection) then
            FreeAndNil(FConnection);
          if FConnection = nil then
            FConnection := TMSConnection.Create(nil);
          FConnection.Username := LogonUser;
          if List.IndexOfName('Password') = -1 then
            FPassword := GetPassword(FConnection.UserName + '@' + List.Values['DataSource'])
          else
            FPassword := List.Values['Password'];
          FConnection.Password := FPassword;
          FConnection.Server := List.Values['DataSource'];
          FConnection.OnError := ConnectionErrorMS;
          TMSConnection(FConnection).Authentication := auServer;
          TMSConnection(FConnection).Database := List.Values['DatabaseName'];
          FConnection.LoginPrompt := aConnectPrompt;
          FEnabled := SameText(List.Values['Enabled'], 'TRUE');
        end;
        }
      else
        if FConnection <> nil then
          FreeAndNil(FConnection);
      end;
    finally
      List.Free;
    end;
  end;
  ConnectStep := csInitConnect;
  if AutoConnectDB then
    MakeConnection;
  if (FConnection <> nil) and FConnection.Connected then
    ConnectStep := csConnected;
end;

procedure ShowNotePadMessage(aMessage: string);
var List: TStrings;
  aFileName: string;
begin
  AfileName := ChangeFileExt(Application.ExeName, '.ixt');
  List := TStringList.Create;
  try
    List.Text := aMessage;
    List.SaveToFile(aFileName);
  finally
    List.Free;
  end;
end;

procedure TDacConnection.MakeConnection;
var
  aUserName, aPassword: string;
  WrongError: boolean;
  LoggedIn, DoLogin: Boolean;
begin
  if FDacConnectionState <> dcsDestroying then
  begin
    if (FConnection <> nil) and not FConnection.Connected then
    begin
      FLogonPassword := FPassword;
      if (FCanTimeOut and fTimedOut) or FConnection.LoginPrompt then
      begin
        case fLogonType of
          ltWindows:
          begin
            aUserName := MyUserName;
            aPassword := '';
          end;
          ltCustom:
          begin
            aUserName := Dictionary.Read('logon_user', '');
            aPassword := '';
          end;
        else
          begin
            aUserName := FConnection.UserName;
            if FAskPassword then
              aPassword := ''
            else
              aPassword := FConnection.Password;
          end;
        end;
        repeat
          LoggedIn := False;
          DoLogin := LoginDialogEx(FConnection.Server, aUserName, aPassword, fLogonType <> ltCustom);
          if DoLogin then
          begin
            if fLogonType = ltCustom then
            begin
              Dictionary.Write('logon_user', aUserName);
              FConnection.Username := aUserName;
            end;
            fLogonPassword := aPassword;
            FConnection.Password := aPassword;
            try
              FConnection.PerformConnect;
              LoggedIn := True;
            except
              on E: Exception do
              begin
                if Pos('ORA-28000', E.Message) > 0 then // Account locked
                  MessageDlg(E.Message, mtError, [mbOk], 0);
              end;
            end;
          end else
            Raise Exception.Create('Error login database!'#13#10' Closing Application');
        until LoggedIn or not (FCanTimeOut and fTimedOut);
      end else
      begin
        if Application.MainForm = nil then
        begin
          try
            FConnection.PerformConnect;
          except
            // Don't catch error at startup ... application should shut down
            on E: Exception do
            begin
              ShowNotePadMessage('Error in application "' + Application.ExeName + '"'#13#10+ E.Message);
              Application.Terminate;
            end;
          end;
        end else
        begin
          FConnection.OnError := nil;
          try
            {  Gebruikt in frontend geeft problemen met feedback en response app
            while not FConnection.Connected and not Application.Terminated do
            begin
              try
                FConnection.PerformConnect;
              except
                on E: exception do
                  if not ConnectionError(E.Message) then
                    Break;
              end;
            end;
            //}

            //
            WrongError := False;
            FSignalEvent.ResetEvent;
            ConnectStep := csStartReconnect;
            if FConnection is TOraSession then
            begin
              FReconnectThread := TReconnectThread.Create(FConnection, FLogonPassword, FSignalEvent, FAutoReconnect);
              FReconnectThread.Resume;
              while not FConnection.Connected and not WrongError and not FShuttingDown do
              begin
                try
                  case FSignalEvent.WaitFor(ThreadWaitReconnectTimeOut) of
                    wrSignaled:
                    begin
                      while FConnection.Connected do
                      begin
                        FConnection.DisConnect;
                        Sleep(100);
                      end;
                      FConnection.Connect;
                      ConnectStep := csEndReconnect;
                    end;
                    wrTimeOut: // try again and allow for update
                      ConnectStep := csReconnecting;
                    wrAbandoned: // cancel button pressed !
                      ConnectStep := csNoConnection;
                    wrError:
                      ConnectStep := csError;
                  end;
                except
                  on E: Exception do
                  begin
                    if not ConnectionError(E.Message) or not FAutoReconnect then
                      WrongError := True;
                  end;
                end;
                FReconnectThread := nil;
              end;
            end else
            begin
              try
                FConnection.Connect;
              except
                // Foutje
              end;
            end;
            if ConnectStep = csEndReconnect then
              ConnectStep := csConnected;
            //}
          finally
            FConnection.OnError := ConnectionErrorOra;
          end;
        end;
      end;
    end;
  end;
end;

function TDacConnection.GetConnectionString: string;
begin
  Result := FConnectionString;
end;

function TDacConnection.GetDataSource: string;
begin
  Result := '';
  if FConnection <> nil then
    Result := FConnection.Server;
end;

function TDacConnection.GetOracleHomeParameters: string;
  function ValidateNetworkPath(Path: string): string;
  var PathOk: boolean;
  begin
    Result := Path;
    PathOk := False;
    try
      if DirectoryExists(Path) then
        PathOk := True
    except
      // path is not ok
    end;
    if not PathOk and not SameText(Path, LocalOraclePath) then
      Result := LocalOraclePath;
  end;
var
  reg: TRegistry;
  LastHome: string;
begin
  Result := '';
  reg := TRegistry.Create(KEY_ALL_ACCESS);
  try
    with reg do
    begin
      LastHome := '0';
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('\Software\ORACLE\ALL_HOMES') then
      begin
        try
          LastHome := ReadString('Last_Home');
          if LastHome = '' then
            LastHome := '0';
        finally
          CloseKey;
        end;
        if OpenKeyReadOnly('\Software\ORACLE\HOME'+LastHome) then
        try
          if ValueExists('TNS_ADMIN') then
            Result := ReadString('TNS_ADMIN')
          else
            Result := ReadString('ORACLE_HOME')+'\NETWORK\ADMIN';
        finally
          CloseKey;
        end;
        Result := ValidateNetworkPath(Result);
      end else // No Oracle  client
        Raise EOracleNotInstalled.Create('Find oracle home');
    end;
  finally
    reg.Free;
  end;
end;

function TDacConnection.GetPassword(user: string): string;
var IniFile: TIniFile;
begin
  Result := '';
  IniFile := TIniFile.Create(GetOracleHomeParameters + '\databases.ini');
  try
    if IniFile.ValueExists(UpperCase(user), 'PASSWORD') then
      Result := EnDeCrypt(IniFile.ReadString(UpperCase(user), 'PASSWORD', ''))
    else
    begin
      if SameText('UPG', RightStr(user, 3)) or SameText('TST', RightStr(user, 3)) then
        Result := 'ora920';
    end;
  finally
    IniFile.Free;
  end;
  //if (Result = '') and (DebugHook <> 0) then
  //  Result := DefaultOraPassword;
end;

procedure TDacConnection.Reconnect;
begin
  if not ((FConnection <> nil) and (csDestroying in  FConnection.ComponentState)) then
    MakeConnection;
end;

procedure TDacConnection.AfterConstruction;
begin
  inherited AfterConstruction;
  FDacConnectionState := dcsUsing;
end;

procedure TDacConnection.BeforeDestruction;
begin
  FConnection.OnError := nil;
  FDacConnectionState := dcsDestroying;
  inherited BeforeDestruction;
end;

destructor TDacConnection.Destroy;
begin
  try
    FConnection.Disconnect;
  except
    // Allready disconnected
  end;
  FreeAndNil(FConnection);
  FreeAndNil(FSignalEvent);
  FreeAndNil(fDisConnectTimer);
  inherited Destroy;
end;

procedure TDacConnection.DoReconnectCallback;
begin
  if Assigned(TDacConnections(Collection).FOnReconnectCallback) then
    TDacConnections(Collection).FOnReconnectCallback(Self, FConnectStep);
end;

procedure TDacConnection.SetConnectStep(const Value: TConnectStep);
begin
  FConnectStep := Value;
  DoReconnectCallback;
end;

procedure TDacConnection.SetAutoReconnect(const Value: boolean);
begin
  FAutoReconnect := Value;
  if Value and not FConnection.Connected then
    DoConnect(FConnectionName, FConnectionString);
end;

function TDacConnection.GetConnected: boolean;
begin
  Result := False;
  if FConnection <> nil then
    Result := FConnection.Connected;
end;

procedure TDacConnection.SetConnected(const Value: boolean);
begin
  if FConnection <> nil then
    FConnection.Connected := Value;
end;

function TDacConnection.FirstConnection: Boolean;
begin
  Result := TDacConnections(Collection).FirstConnection;
end;

function GetDatabasePassword(UserAndServer: string): string;
  function GetOracleHome: string;
  var
    reg: TRegistry;
    LastHome: string;
  begin
    Result := '';
    reg := TRegistry.Create(KEY_ALL_ACCESS);
    try
      with reg do
      begin
        LastHome := '0';
        RootKey := HKEY_LOCAL_MACHINE;
        if OpenKeyReadOnly('\Software\ORACLE\ALL_HOMES') then
        begin
          try
            LastHome := ReadString('Last_Home');
            if LastHome = '' then
              LastHome := '0';
          finally
            CloseKey;
          end;
          if OpenKeyReadOnly('\Software\ORACLE\HOME'+LastHome) then
          try
            if ValueExists('TNS_ADMIN') then
            begin
              Result := ReadString('TNS_ADMIN');
            end
            else
              Result := ReadString('ORACLE_HOME')+'\NETWOK\ADMIN';
          finally
            CloseKey;
          end;
        end else // No Oracle  client
        begin
          Raise EOracleNotInstalled.Create('Find oracle home');
        end;
      end;
    finally
      reg.Free;
    end;
  end;
var IniFile: TIniFile;
begin
  Result := '';
  IniFile := TIniFile.Create(GetOracleHome + '\databases.ini');
  try
    if IniFile.ValueExists(UpperCase(UserAndServer), 'PASSWORD') then
      Result := EnDeCrypt(IniFile.ReadString(UpperCase(UserAndServer), 'PASSWORD', ''));
  finally
    IniFile.Free;
  end;
  if (Result = '') and (DebugHook <> 0) then
    Result := DefaultOraPassword;
end;

procedure TDacConnection.SetTimedOut(const Value: Boolean);
begin
  if fCanTimeOut then
  begin
    fTimedOut := Value;
    if fTimedOut then
    begin
      FConnection.Disconnect;
      FConnectStep := csInitConnect;
      MakeConnection;
    end;
  end;
end;


function TDacConnection.IsDefault: Boolean;
begin
  Result := ConnectionName = DefaultConnection;
end;

function TDacConnection.GetSchema: string;
var List: TStrings;
begin
  Result := '';
  if Assigned(FConnection) then
  begin
    List := TStringList.Create;
    try
      List.CommaText := FConnectionString;
      Result := List.Values['SCHEMA'];
    finally
      FreeAndNil(List);
    end;
    if Result = '' then
    begin
      if FDacType = dacOracle then
        Result := TOraSession(FConnection).Username;
      // Removed SDAC
      {
      else if FDacType = dacMSSQL then
        Result := TMSConnection(FConnection).Database;
      }
    end;
  end;
end;

procedure TDacConnection.ResetDisconnectTimer;
begin
  if fAutoDisconnect then
  begin
    fDisConnectTimer.Enabled := False;
    fDisConnectTimer.Enabled := True;
  end;
end;

procedure TDacConnection.OnDisconnectTimer(Sender: TObject);
begin
  try
    if CanAutoDisconnect and FConnection.Connected then
      FConnection.Disconnect;
  except
    // Catch exceptions
    // mainly cause by DBControls !!!
  end;
end;

procedure TDacConnection.SetAutoDisconnect(const Value: boolean);
begin
  fAutoDisconnect := Value;
  if fAutoDisconnect and (fDisConnectTimer = nil) then
  begin
    FreeAndNil(fDisconnectTimer);
    fDisconnectTimer := TTimer.Create(nil);
    fDisconnectTimer.Name := FConnectionName + '_disconnecttimer';
    fDisconnectTimer.Interval := Dictionary.Read('autodisconnect_interval', 60) * 1000;
    fDisconnectTimer.OnTimer := OnDisconnectTimer;
  end else if not fAutoDisconnect and Assigned(fDisconnectTimer) then
    FreeAndNil(fDisconnectTimer);
end;

function TDacConnection.CanAutoDisconnect: boolean;
begin
  Result := False;
  if Assigned(fOnCanAutoDisconnect) then
    fOnCanAutoDisconnect(Self, FConnectionName, Result);
end;

{ TDacConnections }

function TDacConnections.Add(aConnectionName, aConnectionString: string; aConnectPrompt: boolean): TDacConnection;
var aItem: TDacConnection;
begin
  Result := nil;
  fcsConnection.Enter;
  try
    FTimeOutTimer.Enabled := True;
    if aConnectionName = '' then
      aConnectionName := DefaultConnection;
    aItem := FindConnection(aConnectionName);
    if aItem = nil then
    begin
      if Count < MaxConnections then
        aItem := TDacConnection.Create(Self, aConnectionName, aConnectionString, aConnectPrompt)
      else
        Raise ETooManyConnections.Create('Too many open connections');
    end;
    Result := aItem;
    if (Result <> nil) and fFirstConnection then
      fFirstConnection := False;
  finally
    fcsConnection.Leave;
  end;
end;

function TDacConnections.CopyFrom(aConnectionFrom, aNewConnectionName: string; NoRegistry: boolean = False): TDacConnection;
var
  Temp: TDacConnection;
  List: TStrings;
begin
  fcsConnection.Enter;
  try
    Result := FindConnection(aNewConnectionName);
    if Result = nil then
    begin
      if aConnectionFrom = '' then
        aConnectionFrom := DefaultConnection;
      Temp := FindConnection(aConnectionFrom);
      if Temp = nil then
      begin
        Add(aConnectionFrom, '', False);
        Temp := FindConnection(aConnectionFrom);
      end;
      if Temp <> nil then
      begin
        List := TStringList.Create;
        try
          List.CommaText := Temp.FConnectionString;
          if NoRegistry then
            List.Values['NOREGISTRY'] := '1'
          else
            List.Values['NOREGISTRY'] := '';
          Result := Add(aNewConnectionName, List.CommaText, Temp.Connection.LoginPrompt);
        finally
          List.Free;
        end;
      end;
    end;
  finally
    fcsConnection.Leave;
  end;
end;

constructor TDacConnections.Create(ItemClass: TCollectionItemClass);
begin
  inherited Create(ItemClass);
  fcsConnection := TCriticalSection.Create;
  fFirstconnection := True;
  FTimeOutTimer := TTimer.Create(nil);
  FTimeOutTimer.Name := 'DacConnections_timeoutTimer';
  FTimeOutTimer.Enabled := False;
  FTimeOutTimer.Interval := NetWorkTimeOutInterval * 1000;
  FTimeOutTimer.OnTimer := PreventNetworkTimeOut;
end;

function TDacConnections.Describe(aConnectionName: string; condesc: TConDesc): string;
var c: TDacConnection;
  s: string;
begin
  fcsConnection.Enter;
  try
    Result := '';
    c := FindConnection(aConnectionName);
    if c <> nil then
    begin
      case condesc of
        cdShort: s := '%0:s@%1:s';
        cdLong: s := 'Connected to %1:s, Username %0:s';
      else
        s := '';
      end;
      if s <> '' then
        Result := Format(s, [c.Connection.Username, c.Connection.Server]);
    end;
  finally
    fcsConnection.Leave;
  end;
end;

destructor TDacConnections.Destroy;
begin
  Clear;
  FTimeOutTimer.Enabled := False;
  FreeAndNil(FTimeOutTimer);
  FreeAndNil(fcsConnection);
  inherited Destroy;
end;

procedure TDacConnections.Enable(aConnectionName: string);
var aPassword: string;
  aConn: TDacConnection;
begin
  fcsConnection.Enter;
  try
    aConn := Add(aConnectionName, '', False);
    if aConn <> nil then
      with aConn do
      begin
        aConn.FEnabled := True;
        try
          try
            FConnection.PerformConnect;
          except
            aPassword := '';
            if InputQuery(aConnectionName, 'Password : ', aPassword) then
            begin
              FLogonPassword := aPassword;
              FConnection.Password := aPassword;
              try
                FConnection.PerformConnect;
              except
                MessageDlg('Wrong password for ' + aConnectionName, mtError, [mbOk], 0);
                Abort;
              end;
            end;
          end;
        finally
          FConnection.LoginPrompt := False;
        end;
      end;
  finally
    fcsConnection.Leave;
  end;
end;

procedure TDacConnections.Disable(aConnectionName: string);
begin
  fcsConnection.Enter;
  try
    if FindConnection(aConnectionName) <> nil then
      FindConnection(aConnectionName).Free;
  finally
    fcsConnection.Leave;
  end;
end;

function TDacConnections.FindConnection(aConnectionName: string): TDacConnection;
var I: Integer;
begin
  fcsConnection.Enter;
  try
    Result := nil;
    try
      for I := 0 to Count -1 do
        if SameText(Items[I].ConnectionName, aConnectionName) then
        begin
          Result := Items[I];
          Break;
        end;
    except
      // Error when freeing connection
    end;
  finally
    fcsConnection.Leave;
  end;
end;

function TDacConnections.GetItems(Index: Integer): TDacConnection;
begin
  fcsConnection.Enter;
  try
    Result := TDacConnection(inherited Items[Index]);
  finally
    fcsConnection.Leave;
  end;
end;

procedure TDacConnections.PreventNetworkTimeOut(Sender: TObject);
var
  FQry: TDacQuery;
  I: Integer;
begin
  fcsConnection.Enter;
  try
    FTimeOutTimer.Enabled := False;
    try
      for I := 0 to Count - 1 do
      begin
        if not (Items[I].ConnectStep in [csStartReconnect, csReconnecting, csEndReconnect]) then
        begin
          FQry := TDacQuery.Create(nil, Items[I].ConnectionName);
          try
            if FQry.DacType <> dacUnknown then
            begin
              FQry.SQL.Text := 'SELECT &SYSDATE FROM &DUAL';
              try
                FQry.Open;
                FQry.Close;
              except
                on E: Exception do
                  AddLog(DacError, E.Message);
              end;
            end;
          finally
            FQry.Free;
          end;
        end;
      end;
    except
      // error on connection free
    end;
    FTimeOutTimer.Interval := NetWorkTimeOutInterval * 1000;
    FTimeOutTimer.Enabled := True;
  finally
    fcsConnection.Leave;
  end;
end;

function TDacConnections.DescribeAll(aMax: integer = 0): string;
var I: Integer;
begin
  fcsConnection.Enter;
  try
    if aMax = 0 then
      aMax := Count;
    Result := '';
    try
      I := 0;
      if Count > 0 then
      repeat
        if I < aMax then
        begin
          if Items[I].Enabled then
          begin
            if Result <> '' then
              Result := Result + ' - ';
            if not Items[I].Connected then
              Result := Result + '!';
            Result := Result + Items[I].FConnection.Username +  '@' + Items[I].DataSource;
            if Items[I].Schema <> '' then
              Result := Result + ',' + Items[I].Schema;
          end;
        end;
        Inc(I);
      until (I > aMax-1) or (I > Count -1);
      if Count > aMax then
        Result := Result + ' ...';
    except
      // error on connection free
    end;
  finally
    fcsConnection.Leave;
  end;
end;

function TDacConnections.NewConnectionName: string;
begin
  fcsConnection.Enter;
  try
    repeat
      Inc(impConnectionNum);
      Result := 'dbconn_' + IntToStr(impConnectionNum);
    until FindConnection(Result) = nil;
  finally
    fcsConnection.Leave;
  end;
end;

Select allOpen in new window

The connection is lost after 30 minutes of idle time.

I told all my users that if the problem occurred often they should probably tell their superiors. For some reason the problem has almost completely disappeared since then. ;-)

geert:
Having read your post I fully agree with you, so in my opinion there are two options.

1. You could share your layer which manages the db connections, so I have a quick start and can adjust it to my own needs (if possible).
   
2. Create some short-term solution that solves the problem for now, by keeping the connection open and handling any errors.
   This might be an acceptable solution as my current customers don't have to many FTE (1 to 15 max).

Either way I need a solution for this. Any other suggestions / approaches?

>auke_t
30 minutes ?
check the firewall ... this can also autoclose the connections/ports

it's possible the network admin says he/she isn't doing that because
1: they want (and have) to save resources by closing idle connections (so they ignore your request)
2: they don't know it is an option on the firewall (unlikely)

>DelphiWizard
you can see my way of doing that in the code piece (copied from above)

procedure TDacConnections.PreventNetworkTimeOut(Sender: TObject);
var
  FQry: TDacQuery;
  I: Integer;
begin
  fcsConnection.Enter;
  try
    FTimeOutTimer.Enabled := False;
    try
      for I := 0 to Count - 1 do
      begin
        if not (Items[I].ConnectStep in [csStartReconnect, csReconnecting, csEndReconnect]) then
        begin
          FQry := TDacQuery.Create(nil, Items[I].ConnectionName);
          try
            if FQry.DacType <> dacUnknown then
            begin
              FQry.SQL.Text := 'SELECT &SYSDATE FROM &DUAL';
              try
                FQry.Open;
                FQry.Close;
              except
                on E: Exception do
                  AddLog(DacError, E.Message);
              end;
            end;
          finally
            FQry.Free;
          end;
        end;
      end;
    except
      // error on connection free
    end;
    FTimeOutTimer.Interval := NetWorkTimeOutInterval * 1000;
    FTimeOutTimer.Enabled := True;
  finally
    fcsConnection.Leave;
  end;
end;

Select allOpen in new window

Hm,

I'm interested in this question too because we recently migrated to SQL Server 2008 on new servers.
We use mirroring between the 2 Db-Servers.
But when a failover is needed (cas of disaster), the client-app loses connection for about 10 seconds.
And then our apps give errors (because connection was lost).

That's why this question raised my attention.
I hope nobody hate me for 'intruding' this question.

Best regards,

Wim.

this all depends on the components you use
that's a other issue : what happens if the component you use (TADOQuery) has a bug
or you find one which performs 1000x better and you want to switch to that new component

you need a layer for that too :)

DevArt have components which are state of the art
I believe failover is built in to them.
I haven't tested them for SQL Server, only doing oracle atm

mirroring > this is at disk level > does not cause your problem
clustering is probably what you have which is causing the problem

in a os cluster, the database runs on server A
when it fails, it switches to server B (the database on B has to start up > 10 seconds)

in a db cluster, there are several instances running, you connect to A
if instance A fails, the connection is transferred to B
i don't know if MSSQL has a db cluster, in oracle it's RAC
there is only 1 database, but different instances
a client connects to the instance, the instance connects to the database

only Oracle has a DB cluster
SQL Server does not

since the interest is so high and some people may find bugs ... and mail them back to me:

http://delphi.veerle-en-geert.be/uRoot.pas

No problem Wim, were are all in the EE-community :-)

Just visited the site if DevArt
http://www.devart.com/sdac/
They have SDAC-components specially for SQL Server (all editions) and they also provide Failover.
Also they claim to be 5 - 10 times faster then
What would be important to know is how easy it is to migrate from ADO to SDAC.
f.e. Will current SQL still be valid or has it a slitely different format?
They say on the website:
"Project migration can be automated with the BDE/ADO Migration Wizard."

I migrated from BDE to ODAC.
There wasn't a migration wizard yet ... so don't know how long with that

lol, thanx for pointing that out... seems that wizard is available in the IDE from the menu

28-09-2010-10-11-47.png

You might have an older version, as Core Lab (see your picture)  is now DevArt.

or they forgot to change that picture ... :)


28-09-2010-10-22-33.png

Geert, how is support from DevArt?

Fantastic,
I think we had 3 issues.
They fixed the worst one after a day and mailed us the new version the next day.
We didn't even have to wait for the new release.

I once mailed my unit for a problem. It had both SDAC and ODAC inside it.  They fixed that too.
6 months later they came up with that UNIDAC.
Damn, why didn't I patent that ?

So where does that leave us with my initial question?
If I buy DevArt, the connection-problem probably will be solved (at least the once I know of :-). Need to see how to set that up correctly with SDAC.
I already send a question to DevArt, so let's wait and so how quickly they respond...

actually it doesn't leave you anywhere
SDAC will try to fix the connection lost certain number of times (probably 10)

the ultimate test: a program for running on a truck using a wireless network with network connection not always available
currently a check is done every second,
we have found that connection checking would be better if slowed down after a number of attempts
first 10 seconds: check each second
next 20 seconds: check each 2 seoncds
next 30 seconds: check each 3 seoncds
next minute: check every 10 seconds
later: check every 30 seconds
> not programmed yet ...
SDAC will not solve this either

the uRoot.pas provided can solve this
it needs some work if SDAC is used, ... SDAC component code is commented ... worked with 6.70 version
you would need to analyse each error generated by the connection to see if it's a connection error
or a syntax, like 'SELECTCOLUMN FROM TABLE';
>syntax check = no space between SELECT and COLUMN

I downloaded a trial of SDAC.
It took me quite some time to adjust all the code.
Some properties have a slitely different name.

Also I have some properties that are not supported at all, so I have to check if they have some other solution for it.
Got no answer till yet (probably they are in USA?)

Some problems I still have:

ADOConnection.Execute;
ERROR: "Undeclared identifier: Execute"

If (IFoto.Picture.Width > 0) AND (IFoto.Picture.Height > 0) then
  ADOQuery1.Params.ParamByName('Foto').LoadFromFile('Test.jpg', ftBytes);
ERROR: "Constant expression violates subrange bounds"

ADOQuery1.SaveToFile(NieuwSjabloon);
ERROR: "Undeclared identifier: SaveToFile"

ADOQuery1.RecordSet.Resync(adAffectCurrent, adResyncAllValues); // uses AdoDB2000
Uses unit ADODB2000, which doesn't support SDAC.

Select allOpen in new window

For now I prefer to check the connection within a thread, as I have no idea what else comes up and I would have to test my application competely all over again.
Who can supply me with some example which will start-up a thread in the main form which will check for an active database connection and correct this when an error occurs?

this is the piece of code you need to change for your own needs for the connection checking within a thread

if FConnection is TOraSession then
            begin
              FReconnectThread := TReconnectThread.Create(FConnection, FLogonPassword, FSignalEvent, FAutoReconnect);
              FReconnectThread.Resume;
              while not FConnection.Connected and not WrongError and not FShuttingDown do
              begin
                try
                  case FSignalEvent.WaitFor(ThreadWaitReconnectTimeOut) of
                    wrSignaled:
                    begin
                      while FConnection.Connected do
                      begin
                        FConnection.DisConnect;
                        Sleep(100);
                      end;
                      FConnection.Connect;
                      ConnectStep := csEndReconnect;
                    end;
                    wrTimeOut: // try again and allow for update
                      ConnectStep := csReconnecting;
                    wrAbandoned: // cancel button pressed !
                      ConnectStep := csNoConnection;
                    wrError:
                      ConnectStep := csError;
                  end;
                except
                  on E: Exception do
                  begin
                    if not ConnectionError(E.Message) or not FAutoReconnect then
                      WrongError := True;
                  end;
                end;
                FReconnectThread := nil;
              end;

Select allOpen in new window

This is what I created now.
It's called from the mainform in a thread by a timer every minute (can be adjusted of course).
I still use standard Delphi ADO-components.
Please let me know if anything else should be coverred?
Also if the interval of the timer must be adjusted.

unit CheckConnectionThread;

interface

uses Classes, cxClasses, ADODB, DB, SysUtils, Dialogs;

type
  TCheckConnectionThread = class(TThread)
  private
  protected
    procedure Execute; override;
  public
  end;

implementation

uses DataModule, Form1;

procedure TCheckConnectionThread.Execute;
var CheckQuery : TADOQuery;
begin
  Form1.CheckConnectionThreadTimer.Enabled := False;
  NoConnectionWithDatabase := False;
  CheckQuery := TADOQuery.Create(CheckQuery);
  try
    with CheckQuery do
    begin
      Connection := DM.ADOConnectionSQL;
      SQL.Add('SELECT Null ');
      try
        Open;
        Close;
      except
        on E: Exception do
        try
          DM.ADOConnectionSQL.Connected := True;
          try
            Open;
            Close;
          except
            NoConnectionWithDatabase := True;
          end;
        except
          NoConnectionWithDatabase := True;
        end;
      end;
    end;
  finally
    CheckQuery.Free;
    Form1.CheckConnectionThreadTimer.Enabled := True;
  end;
end;

end.

Select allOpen in new window

This is what I have now.
Please give me some feedback on timer inval (currently set to 1 minute).
And maybe something else needs to be covered?

unit CheckConnectionThread;

interface

uses Classes, cxClasses, ADODB, DB, SysUtils, Dialogs;

type
  TCheckConnectionThread = class(TThread)
  private
  protected
    procedure Execute; override;
  public
  end;

implementation

uses DataModule, Form1;

procedure TCheckConnectionThread.Execute;
var CheckQuery : TADOQuery;
begin
  Form1.CheckConnectionThreadTimer.Enabled := False;
  NoConnectionWithDatabase := False;
  CheckQuery := TADOQuery.Create(CheckQuery);
  try
    with CheckQuery do
    begin
      Connection := DM.ADOConnectionSQL;
      SQL.Add('SELECT Null ');
      try
        Open;
        Close;
      except
        on E: Exception do
        try
          DM.ADOConnectionSQL.Connected := True;
          try
            Open;
            Close;
          except
            NoConnectionWithDatabase := True;
          end;
        except
          NoConnectionWithDatabase := True;
        end;
      end;
    end;
  finally
    CheckQuery.Free;
    Form1.CheckConnectionThreadTimer.Enabled := True;
  end;
end;

end.

Select allOpen in new window

This is what I have now.
Please give me some feedback on timer inval (currently set to 1 minute).
And maybe something else needs to be covered?

unit CheckConnectionThread;

interface

uses Classes, cxClasses, ADODB, DB, SysUtils, Dialogs;

type
  TCheckConnectionThread = class(TThread)
  private
  protected
    procedure Execute; override;
  public
  end;

implementation

uses DataModule, Hoofdscherm;

procedure TCheckConnectionThread.Execute;
var CheckQuery : TADOQuery;
begin
  FHoofdscherm.CheckConnectionThreadTimer.Enabled := False;
  GeenVerbindingMetDatabase := False;
  CheckQuery := TADOQuery.Create(CheckQuery);
  try
    with CheckQuery do
    begin
      Connection := DM.ADOConnectionSQL;
      SQL.Add('SELECT Null ');
      try
        Open;
        Close;
      except
        on E: Exception do
        try
          DM.ADOConnectionSQL.Connected := True;
          try
            Open;
            Close;
          except
            GeenVerbindingMetDatabase := True;
          end;
        except
          GeenVerbindingMetDatabase := True;
        end;
      end;
    end;
  finally
    CheckQuery.Free;
    FHoofdscherm.CheckConnectionThreadTimer.Enabled := True;
  end;
end;

end.

Select allOpen in new window

Sorry for the three posts.
IE gave some connection errors (how apropiate) and the post didn't seem to be saved.

you are creating some problems with this

first: you are mixing vcl objects within the thread > don't do that
second: you need to create a second connection to use in the thread
third: every 14 minutes is more than adequate

i didn't compile the code, but this is how i would do it

call from mainform like this:

procedure TMainForm.TimerCheck(Sender: TObject);
begin
  CheckConnection('Provider=SQLOLEDB.1;Persist Security Info=False;User ID=Test;Data Source=SQLSERVER;Password=Test', ConnectionLost);
end;

procedure TMainForm.ConnectionLost(Sender: TObject; ConnectionString: string; ConnectionLost: Boolean);
const CLType: Array[Boolean] of ('restored', 'lost');
var  s: TStrings;
begin
  s := TStringList.Create;
  try
    s.Delimiter := ';';
    s.StrictDelimiter := True;
    s.DelimitedText := ConnectionString;
    panelDBConnection.Caption := 'Connection ' + CLType[ConnectionLost] + ' to database ' + s.Values['Data Source']';
  finally
    s.Free;
  end;
end;

unit CheckConnectionThread;

interface

uses Classes;

type
  TFeedbackEvent = procedure (Sender: TObject; ConnectionString: string; ConnectionLost: Boolean);

procedure CheckConnection(ConnectionString: string; Feedback: TFeedbackEvent);

implementation

uses ADODB, DB, SysUtils;

type
  TCheckConnectionThread = class(TThread)
  private
    fConnectionString: string;
    fConnectionLost: Boolean;
  protected
    procedure Execute; override;
  public
  end;

procedure CheckConnection(ConnectionString: string; Feedback: TFeedbackEvent);
begin
  with TCheckConnectionThread.Create(True) do
  begin
    fConnectionString := ConnectionString;
    fFeedback := Feedback;
    Resume;
  end;
end;

procedure TCheckConnectionThread.Execute;
var 
  CheckQuery : TADOQuery;
  CheckConn : TAdoConnection;
  MsgSent: boolean;
begin
  MsgSent := False;
  CheckQuery := TADOQuery.Create(nil);
  try
    CheckQuery.ConnectionString := fConnectionString;
    CheckQuery.SQL.Add('SELECT Null ');
    repeat 
      fConnectLost := False;
      try
        CheckQuery.Open;
      except
        on E: Exception do
          fConnectLost := True;
      end;
      CheckQuery.Close;
      if fConnectLost then 
      begin
        if not MsgSent then 
        begin 
          if Assigned(fFeedback) then 
            fFeedback(Self, fConnectionString, fConnectLost);
          MsgSent := True;  
        end;
        Sleep(1000); // Wait a while to reconnect
      end;
    until not fConnectLost;
  finally
    CheckQuery.Free; 
  end;
  if MsgSent then 
  begin 
    if Assigned(fFeedback) then 
      fFeedback(Self, fConnectionString, fConnectLost);
  end;
end;

end.

Select allOpen in new window

Hi Geert,
You were right...it doesn't compile.

fConnectLost and fFeedback are unknown in unit:  CheckConnectionThread

I changed the private section:
    fConnectionLost: Boolean;
    fFeedback: TFeedbackEvent

Also I updated fConnectLost to fConnectionLost

But even then the code doesn't compile:

CheckConnection(Format('File Name=%s;', [UDLBestandnaam]), ConnectionLost);
[DCC Error] Hoofdscherm.pas(5813): E2009 Incompatible types: 'regular procedure and method pointer'
const CLType: Array[Boolean] of ('restored', 'lost');
[DCC Error] Hoofdscherm.pas(5817): E2029 Identifier expected but string constant found
Also I don't see the use of a timer, nore quiting the application when the connection can't be restored.
 

sorry, dont have delphi here atm :)

type
  TFeedbackEvent = procedure (Sender: TObject; ConnectionString: string; ConnectionLost: Boolean) of object;

const CLType: Array[Boolean] of string = ('restored', 'lost');

attach the event procedure TMainForm.TimerCheck(Sender: TObject); to the timer
i assumed you already had one

Besides the unit CheckConnectionThread I had in my main unit the following code:

procedure TFHoofdscherm.StartCheckConnectionThread;
begin
  FHoofdscherm.ToevoegenAanLogbestand('StartCheckConnectionThread - Start');
  with TCheckConnectionThread.Create(True) do
  begin
    OnTerminate     := CheckConnectionThreadOnTerminate;
    FreeOnTerminate := True;
    Resume;
  end;
end;

procedure TFHoofdscherm.CheckConnectionThreadOnTerminate(ASender: TObject);
begin
  if GeenVerbindingMetDatabase then
  begin
    CheckConnectionThreadTimer.Enabled := False;
    ShowMessage('No connection found or lost');
    ApplicatieWordtAfgesloten;
    Application.Terminate;
    ExitProcess(0);
  end;
end;

Select allOpen in new window

Won't the following code loop when the connection can't be restored?

repeat
      fConnectionLost := False;
      try
        CheckQuery.Open;
      except
        on E: Exception do
          fConnectionLost := True;
      end;
      CheckQuery.Close;
      if fConnectionLost then
      begin
        if not MsgSent then
        begin
          if Assigned(fFeedback) then
            fFeedback(Self, fConnectionString, fConnectionLost);
          MsgSent := True;
        end;
        Sleep(1000); // Wait a while to reconnect
      end;
    until not fConnectionLost;

Select allOpen in new window

yes, isn't that the point of this whole exercise ?
it loops until restored and it tries every second

And here is my code in the mainform.

procedure TFHoofdscherm.CheckConnectionThreadTimerTimer(Sender: TObject);
begin
  StartCheckConnectionThread;
end;

procedure TFHoofdscherm.ConnectionLost(Sender: TObject; ConnectionString: string; ConnectionLost: Boolean);
const CLType: Array[Boolean] of string = ('restored', 'lost');
begin
  if CLType[ConnectionLost] = 'lost' then
    GeenVerbindingMetDatabase := True;
end;

procedure TFHoofdscherm.StartCheckConnectionThread;
begin
  FHoofdscherm.ToevoegenAanLogbestand('StartCheckConnectionThread - Start');
  with TCheckConnectionThread.Create(True) do
  begin
    CheckConnection(Format('File Name=%s;', [UDLBestandnaam]), ConnectionLost);
    OnTerminate     := CheckConnectionThreadOnTerminate;
    FreeOnTerminate := True;
    Resume;
  end;
end;

procedure TFHoofdscherm.CheckConnectionThreadOnTerminate(ASender: TObject);
begin
  if GeenVerbindingMetDatabase then
  begin
    CheckConnectionThreadTimer.Enabled := False;
    ShowMessage('No connection found or lost');
    ApplicatieWordtAfgesloten;
    Application.Terminate;
    ExitProcess(0);
  end;
end;

Select allOpen in new window

> yes, isn't that the point of this whole exercise ?
> it loops until restored and it tries every second
But what if the connection can't be restored, before a user tries to execute some SQL?
Then I still have the same problem.
I therefore think it would be best to do the following?

• Connection is lost
• Show message that connection is lost and ask if application should try to restore it.
• If the connection can't be restored (f.e. after xx tries), then application is terminated.

I've changed the code a bit and now it works, but the procedure keeps on trying in the background. So the code needs te be changed a little bit.
Can you tell me how to integrate the above functionality correctly?

procedure TFHoofdscherm.CheckConnectionThreadTimerTimer(Sender: TObject);
begin
  CheckConnection(Format('File Name=%s;', [UDLBestandnaam]), ConnectionLost);
end;

procedure TFHoofdscherm.ConnectionLost(Sender: TObject; ConnectionString: string; ConnectionLost: Boolean);
const CLType: Array[Boolean] of string = ('Restored', 'Lost');
begin
  if CLType[ConnectionLost] = 'Lost' then
    GeenVerbindingMetDatabase := True;
  if GeenVerbindingMetDatabase then
  begin
    CheckConnectionThreadTimer.Enabled := False;
    If MyMessageDlg(Format(blcMessageFout
                        , [ConstantP])
                  , blcVerbindingDatabaseIsVerbroken
                  , dkFoutB, NMV) = drCustom1 then
    begin
      CheckConnectionThreadTimer.Enabled := True;
      Exit;
    end else
    begin
      MyMessageDlg(Format(blcMessageFout
                        , [ConstantP])
                  , blcVerbindingDatabaseNietHersteld
                  , dkFout, NMV);
      ApplicatieWordtAfgesloten;
      Application.Terminate;
      ExitProcess(0);
    end;
  end;
end;

Select allOpen in new window

In the current code "procedure TFHoofdscherm.ConnectionLost" is called multiple times when a connection is lost (every second). So this gives problems with handling things my way.

You did it again. Thank you very much.