Implement an automatic, non-configurable keep-alive ping, to prevent SSH tunnels from disconnecting. Fixes issue #2935.

This commit is contained in:
Ansgar Becker
2012-10-12 15:01:34 +00:00
parent 1855f6b57d
commit 2f10329e62

View File

@ -4,7 +4,7 @@ interface
uses uses
Classes, SysUtils, windows, mysql_structures, SynRegExpr, Generics.Collections, Generics.Defaults, Classes, SysUtils, windows, mysql_structures, SynRegExpr, Generics.Collections, Generics.Defaults,
DateUtils, Types, Math, Dialogs, ADODB, DB, DBCommon, ComObj, Graphics; DateUtils, Types, Math, Dialogs, ADODB, DB, DBCommon, ComObj, Graphics, ExtCtrls;
type type
@ -265,6 +265,7 @@ type
FDatatypes: TDBDataTypeArray; FDatatypes: TDBDataTypeArray;
FThreadID: Cardinal; FThreadID: Cardinal;
FSQLSpecifities: Array[TSQLSpecifityId] of String; FSQLSpecifities: Array[TSQLSpecifityId] of String;
FKeepAliveTimer: TTimer;
procedure SetActive(Value: Boolean); virtual; abstract; procedure SetActive(Value: Boolean); virtual; abstract;
procedure DoBeforeConnect; virtual; procedure DoBeforeConnect; virtual;
procedure DoAfterConnect; virtual; procedure DoAfterConnect; virtual;
@ -291,6 +292,7 @@ type
procedure FetchDbObjects(db: String; var Cache: TDBObjectList); virtual; abstract; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); virtual; abstract;
procedure SetObjectNamesInSelectedDB; procedure SetObjectNamesInSelectedDB;
procedure SetLockedByThread(Value: TThread); virtual; procedure SetLockedByThread(Value: TThread); virtual;
procedure KeepAliveTimerEvent(Sender: TObject);
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -899,6 +901,9 @@ begin
FDatabaseCache := TDatabaseCache.Create(True); FDatabaseCache := TDatabaseCache.Create(True);
FLoginPromptDone := False; FLoginPromptDone := False;
FCurrentUserHostCombination := ''; FCurrentUserHostCombination := '';
FKeepAliveTimer := TTimer.Create(Self);
FKeepAliveTimer.Interval := 20000;
FKeepAliveTimer.OnTimer := KeepAliveTimerEvent;
end; end;
@ -933,6 +938,7 @@ begin
if Active then Active := False; if Active then Active := False;
FOnDBObjectsCleared := nil; FOnDBObjectsCleared := nil;
ClearCache(True); ClearCache(True);
FKeepAliveTimer.Free;
inherited; inherited;
end; end;
@ -1439,6 +1445,9 @@ begin
Active := True; Active := True;
end; end;
Result := FActive; Result := FActive;
// Restart keep-alive timer
FKeepAliveTimer.Enabled := False;
FKeepAliveTimer.Enabled := True;
end; end;
@ -1455,8 +1464,18 @@ begin
Active := True; Active := True;
end; end;
end; end;
Result := FActive; Result := FActive;
// Restart keep-alive timer
FKeepAliveTimer.Enabled := False;
FKeepAliveTimer.Enabled := True;
end;
procedure TDBConnection.KeepAliveTimerEvent(Sender: TObject);
begin
// Ping server in intervals, without automatically reconnecting
if Active then
Ping(False);
end; end;