Automatically checks the network connection status. If an exception occurs, the system automatically reconnects.

{
Author: cxg
Automatically checks for network disconnection and prompts for automatic Reconnection
}

Unit clienttestconnected;

Interface

Uses
Sysutils, classes, sqlexpr, unetcommon;

type
twaitthread = Class (tthread)
private
{private Declarations}
fnetconnect: Boolean;
fcheckinterval: integer;
fmsg: string;
protected
procedure showmsg;
procedure execute; override;
procedure serveropen;
procedure serverclose;
function connremotesvr (CN: tsqlconnection; const hostname, username, password: string;
const port: integer): Boolean;
Public
netcheck1: tnetcheck;
constructor create (const acheckinterval: integer);
destructor destroy; override;

Procedure checknetconnect (Sender: tobject; var ob1_bemobject,
Objwbemasynccontext: olevariant );
Procedure checknetdisconnect (Sender: tobject; var ob1_bemobject,
Objwbemasynccontext: olevariant );
End;

Implementation

Uses clientform;

Procedure twaitthread. serverclose;
Begin
Frmmain. sqlconnection1.close;
End;

Procedure twaitthread. serveropen;
Begin
If fnetconnect then
Fmsg: = 'Connection ...'
Else fmsg: = 'network exception ';
Synchronize (showmsg );
If connremotesvr (frmmain. sqlconnection1, 'localhost', 'cxg', '123', 123) then
Begin
Fmsg: = 'network normal ';
Synchronize (showmsg );
End;
End;

Procedure twaitthread. showmsg;
Begin
Frmmain. label1.caption: = fmsg;
End;

Procedure twaitthread. Execute;
Begin
Try
Serveropen;
Fnetconnect: = true;
Except
Fnetconnect: = false;
End;

Repeat
Sleep (fcheckinterval );
If not fnetconnect then
Begin
Fcheckinterval: = 3000;
Serverclose;
Serveropen;
End;
Until terminated;
End;

Procedure twaitthread. checknetconnect (Sender: tobject; var ob1_bemobject,
Objwbemasynccontext: olevariant );
Begin
Fnetconnect: = true;
End;

Procedure twaitthread. checknetdisconnect (Sender: tobject; var ob1_bemobject,
Objwbemasynccontext: olevariant );
Begin
Fnetconnect: = false;
End;

Function twaitthread. connremotesvr (CN: tsqlconnection; const hostname, username,
Password: string; const port: integer): Boolean;
Begin
Try
CN. close;
CN. drivername: = 'datasnap ';
CN. loginprompt: = false;
CN. connectionname: = 'datasnapconnection ';
CN. Params. Clear;
CN. Params. Add ('drivername = datasnap ');
CN. Params. Add ('hostname = '+ hostname );
CN. Params. Add ('port = '+ inttostr (port ));
CN. Params. Add ('user _ name = '+ username );
CN. Params. Add ('password = '+ password );
CN. open;
Result: = true;
Except
Result: = false;
End;
End;

Constructor twaitthread. Create (const acheckinterval: integer );
Begin
Fcheckinterval: = acheckinterval;
Netcheck1: = tnetcheck. Create (NiL );
Netcheck1.onnetwireconnect: = checknetconnect;
Netcheck1.onnetwiredisconnect: = checknetdisconnect;
Inherited create (false );
End;

Destructor twaitthread. Destroy;
Begin
Netcheck1.free;
Netcheck1: = nil;
Inherited;
End;

End.