TSQLConnection - zamraża aplikacje przy utracie połączenia

TSQLConnection - zamraża aplikacje przy utracie połączenia
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

Aplikacja klienta łączy się z serwerem po przez komponent TSQLConnection - DataSnap. Klient wysyła zapytanie do serwera które to odbiera i zaczyna realizować i serwer zanim zwróci wynik do klienta przerywam połączenie "WAN" (Klient i Serwer jest na 2 różnych komputerach). W tym momencie aplikacja klienta "zamiera" nie zgłasza żadnego wyjątku nawet jeśli wznowie połączenie WAN to i tak program klienta "wisi" na dobre. Jedyny sposób to wymuszone zamkniecie aplikacji.

Czy jest jakiś sposób abym otrzymywał jakąkolwiek informację o tym że TSQLConnection utraciło połączenie z serwerem? Czy jedynym rozwiązaniem jest obsługa TSQLConnection z poziomu np. pobocznego wątku który to jeśli nie zwraca wyniku przez x - sekund to generuje wyjątek?

U wujka google jest wiele informacji o tym jak rozwiązać problem utraty połączenia klient-serwer ale tylko po stronie serwera.

Zamieszczam przykładowy program: po zalogowaniu klienta i kliknięciu przycisku "Wyślij żądanie" mamy 10 sekund na to aby przerwać połączenie co powoduje piękne zawieszenie aplikacji klienta.

www.lcdk.pl/lost.rar

edytowany 1x, ostatnio: Rafał D
Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

PRZYKŁADOWE ROZWIĄZANIE PROBLEMU - Czy takie rozwiązanie jest dobre?

Kopiuj
type
  TDatasnap = class(TTHread)
  private
    vResult : string;
    linker: TServerMethods1Client;
    SQLConnection : TSQLConnection;
  public
    property Result : string read vResult;
    constructor Create;
  protected
    procedure Execute; override;
  end;

type TTimeOut = class(tthread)
  private
    vRed : string;
    SQL : TdataSnap;
  public
    property Wynik : string read vRed;
    constructor Create;
  protected
    procedure Execute; override;
  end;

type
  TfrmMain = class(TForm)
    Button1: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

constructor TTimeOut.Create;
begin
  inherited Create(True);
  FreeOnTerminate := false;
end;

procedure TTimeOut.Execute;
var
  X : integer;
begin
  SQL := TDataSnap.Create;
  SQL.Resume;
  X := 0;
  Repeat
    inc(X);
    if SQL.Result <> '' then break;
    sleep(1000);
  Until x = 20;
  vRed := SQL.Result;
  SQL.Free;
  if x = 20 then raise Exception.Create('Timeout');
end;


constructor TDatasnap.Create;
begin
  inherited Create(True);
  FreeOnTerminate := False;
  SQLConnection := TSQLConnection.Create(nil);
  SQLConnection.DriverName := 'DataSnap';
  SQLConnection.LoginPrompt := False;
  SQLConnection.Params.Clear;
  SQLConnection.Params.Add('DriverUnit=Data.DBXDataSnap') ;
  SQLConnection.Params.Add('CommunicationProtocol=tcp/ip') ;
  SQLConnection.Params.Add('DatasnapContext=datasnap/') ;
  SQLConnection.Params.Add('DriverAssemblyLoader=Borland.Data.TDBXClientDriverLoader,Borland.Data.DbxClientDriver,Version=19.0.0.0,Culture=neutral,PublicKeyToken=91d62ebb5b0d1b1b');
  SQLConnection.Params.Add('DriverName=DataSnap') ;
  SQLConnection.Params.Add('HostName=192.168.1.101') ;
  SQLConnection.Params.Add('port=211');
  SQLConnection.Params.Values['DSAuthenticationUser'] := 'Wątek';
end;

procedure TDatasnap.Execute;
begin
  try
    SQLConnection.Open;
    linker := TServerMethods1Client.Create(SQLConnection.DBXConnection, true);
    vResult := linker.DlugaOperacja;
  finally
    linker.Free;
  end;
end;


procedure TfrmMain.Button1Click(Sender: TObject);
var
  watek : ttimeout;
begin
  watek := ttimeout.Create;
  watek.Execute;  //Zawiesza program na czas wykonania wątku
  showmessage(watek.Wynik);
  watek.Free;
end;

Opis działania:

Klikając Button1 uruchamiam wątek TimeOut który to uruchamia wątek kolejny TDataSnap który to łączy się z serwerem wysyła zapytanie i oczekuje wyniku od serwera. W tym samym czasie wątek TimeOut czeka na wynik 20 sekund jeśli TDataSnap nie zwróci w tym czasie wyniku to generuje wyjątek o przekroczonym czasie oczekiwania na odpowiedź z serwera. I dalej wyjątek musi zostać obsłużony w naszej aplikacji.

Czy takie podejście do problemu jest poprawne?

edytowany 1x, ostatnio: flowCRANE
Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
szopenfx
szopenfx
szopenfx
szopenfx
  • Rejestracja:prawie 21 lat
  • Ostatnio:6 miesięcy
0

Chyba coś nie bardzo.

Kopiuj
  watek := ttimeout.Create;
  watek.Execute;  //Zawiesza program na czas wykonania wątku

Dlaczego nie watek.Resume; skoro startujesz wątek suspended? w ten sposób zawieszasz program przez wykonanie Metody Execute z głównego wątku i wątki w taki sposób nie mają sensu - równie dobrze możesz sobie klasę ttimeout dziedziczyć po TObject.

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

Fakt to już chyba zmęczenie poniżej poprawiony mój tok myślenia :)

Kopiuj
type
  TDatasnap = class(TTHread)
  private
    vResult : string;
    linker: TServerMethods1Client;
    SQLConnection : TSQLConnection;
  public
    property Result : string read vResult;
    constructor Create;
  protected
    procedure Execute; override;
  end;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    function DataSnap: String;

    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

constructor TDatasnap.Create;
begin
  inherited Create(True);
  FreeOnTerminate := False;
  SQLConnection := TSQLConnection.Create(nil);
  SQLConnection.DriverName := 'DataSnap';
  SQLConnection.LoginPrompt := False;
  SQLConnection.Params.Clear;
  SQLConnection.Params.Add('DriverUnit=Data.DBXDataSnap') ;
  SQLConnection.Params.Add('CommunicationProtocol=tcp/ip') ;
  SQLConnection.Params.Add('DatasnapContext=datasnap/') ;
  SQLConnection.Params.Add('DriverAssemblyLoader=Borland.Data.TDBXClientDriverLoader,Borland.Data.DbxClientDriver,Version=19.0.0.0,Culture=neutral,PublicKeyToken=91d62ebb5b0d1b1b');
  SQLConnection.Params.Add('DriverName=DataSnap') ;
  SQLConnection.Params.Add('HostName=192.168.1.101') ;
  SQLConnection.Params.Add('port=211');
  SQLConnection.Params.Values['DSAuthenticationUser'] := 'Wątek';
end;

procedure TDatasnap.Execute;
begin
  try
    SQLConnection.Open;
    linker := TServerMethods1Client.Create(SQLConnection.DBXConnection, true);
    vResult := linker.DlugaOperacja;
  finally
    linker.Free;
  end;
end;

function TfrmMain.DataSnap: String;
var
  X : integer;
  SQL : TDataSnap;
begin
  SQL := TDataSnap.Create;
  SQL.Resume;
  X := 0;
  Repeat
    inc(X);
    if SQL.Result <> '' then break;
    sleep(1000);
  Until x = 20;
  Result := SQL.Result;
  SQL.Free;
  if x = 20 then raise Exception.Create('Timeout');
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  showmessage(DataSnap);
end;
edytowany 1x, ostatnio: Rafał D
Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
szopenfx
szopenfx
szopenfx
szopenfx
  • Rejestracja:prawie 21 lat
  • Ostatnio:6 miesięcy
0

Nie używałem nigdy DataSnap.
Domyślam się, że próbowałeś dodać parametr Params.Values['ConnectTimeout'] := '3000'; ? Ponoć jest z tym jakiś problem, ale wolę się upewnić, że próbowałeś.
Co do kodu obawiam się jeszcze, że SQL.Free; i tak nie zadziała jeśli będzie wątek zawieszony - zwolnienie wątku odbędzie się tylko gdy Metoda Execute wykona się w całości poprawnie, żeby to sprawdzić możesz dodać obsługę zdarzenia OnTerminate. Tutaj będzie chyba konieczne zabicie wątku po upływie timeout'a funkcją TerminateThread(SQL.ThreadId);.

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

Tak o tym wiem. Chciałem przedstawić tylko ideę jak otrzymywać wyjątek Timeout. A jest duży problem z tym i różnie sobie z tym radzą. Ja zamierzam przebudować komponent tSQLConnection tak aby dodać przynajmniej zdarzenie onLostConnection;

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

Dlaczego nie wykonuję mi się procedura Destroy w TDataSnap?

Kopiuj
unit RClient;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Data.DB, Data.SqlExpr, Metody, Dialogs;

type
  TDataSnap = class(TTHread)
  private
    hEvent: THandle;
    vResult: string;
    linker: TServerMethods1Client;
    SQLConnection: TSQLConnection;
  public
    property Result: string read vResult;
    property SQL: TSQLConnection read SQLConnection write SQLConnection;
    constructor Create(var hDataSnap: THandle);
    destructor Destroy;
    procedure Awake;
  protected
    procedure Execute; override;
  end;

  TTimeOut = procedure(Sender: TObject; var VisibleException: boolean) of object;

type
  TRafloClient = class(TComponent)
  private
    hDataSnap : THandle;
    fTimeOut: TTimeOut;
    SQL: TDataSnap;
    fTime: Integer;
    fAdress: string;
    fPort: string;
    fUserName: string;
    fPassword: string;
    procedure CreateConnection(var SQL: TDataSnap);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetTest: String;
    procedure Connect;
    procedure Disconnect;
  published
    property Adress: string read fAdress write fAdress;
    property Port: string read fPort write fPort;
    property UserName: string read fUserName write fUserName;
    property Password: string read fPassword write fPassword;
    property TimeOut: Integer read fTime write fTime default 10000;
    property OnTimeOut: TTimeOut read fTimeOut write fTimeOut;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Raflo Component', [TRafloClient]);
end;

constructor TDataSnap.Create(var hDataSnap: THandle);
begin
  inherited Create(False);
  hEvent := CreateEvent(nil, False, False, nil);
  if hEvent = 0 then
    raise Exception.Create('Unable to create hEvent in TDataSnap');
  hDataSnap := Handle;
  FreeOnTerminate := True;
  SQLConnection := TSQLConnection.Create(nil);
  SQLConnection.DriverName := 'DataSnap';
  SQLConnection.LoginPrompt := False;
  SQLConnection.Params.Clear;
  SQLConnection.Params.Add('DriverUnit=Data.DBXDataSnap');
  SQLConnection.Params.Add('CommunicationProtocol=tcp/ip');
  SQLConnection.Params.Add('DatasnapContext=datasnap/');
  SQLConnection.Params.Add
    ('DriverAssemblyLoader=Borland.Data.TDBXClientDriverLoader,Borland.Data.DbxClientDriver,Version=19.0.0.0,Culture=neutral,PublicKeyToken=91d62ebb5b0d1b1b');
  SQLConnection.Params.Add('DriverName=DataSnap');
  SQLConnection.Params.Add('HostName=localhost');
  SQLConnection.Params.Add('port=211');
  SQLConnection.Params.Add('DSAuthenticationUser=');
  SQLConnection.Params.Add('DSAuthenticationPassword=');
end;

procedure TDataSnap.Awake;
begin
  PulseEvent(hEvent);
end;

destructor TDataSnap.Destroy;
begin
  try
    SQLConnection.Close;
  finally
    SQLConnection.Free;
  end;
  CloseHandle(hEvent);
  inherited Destroy;
end;

procedure TDataSnap.Execute;
begin
  while not Terminated do
  begin
    WaitForSingleObject(hEvent, INFINITE);
    if Terminated then
        Exit;
    vResult := 'Wynik';
  end;
end;

constructor TRafloClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CreateConnection(SQL);
  fTime := 10000;
end;

destructor TRafloClient.Destroy;
var
  lpCreationTime: _FileTime;
  lpExitTime: _FileTime;
  lpKarnelTime: _FileTime;
  lpUserTime: _FileTime;
begin
  { Sprawdź czy wątek istnieje / jest uruchomiony }
  if GetThreadTimes(hDataSnap, lpCreationTime, lpExitTime, lpKarnelTime, lpUserTime) then
  begin
    SQL.Terminate;
    SQL.Awake;
    { Jeśli czas na zamkniecie wątku minął zabij go gwałtownie }
    If WaitForSingleObject(hDataSnap, 5000) = WAIT_TIMEOUT then
      TerminateThread(hDataSnap, 0);
  end;
  inherited Destroy;
end;

procedure TRafloClient.CreateConnection(var SQL: TDataSnap);
begin
  SQL := TDataSnap.Create(hDataSnap);
  SQL.SQL.Params.Values['HostName'] := fAdress;
  SQL.SQL.Params.Values['Port'] := fPort;
  SQL.SQL.Params.Values['DSAuthenticationUser'] := fUserName;
  SQL.SQL.Params.Values['DSAuthenticationPassword'] := fPassword;
end;

function TRafloClient.GetTest;
var
  X: Integer;
  CzyRaise: boolean;
begin
  CzyRaise := True;
  SQL.Awake;
  X := 0;
  Repeat
    inc(X);
    if SQL.Result <> '' then
      break;
    sleep(100);
  Until X >= fTime div 100;
  if X >= fTime div 100 then
    if assigned(OnTimeOut) then
      OnTimeOut(Self, CzyRaise);
  Result := SQL.Result;
end;

end.
Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
szopenfx
szopenfx
szopenfx
szopenfx
  • Rejestracja:prawie 21 lat
  • Ostatnio:6 miesięcy
0

override?

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

To była pierwsza rzecz jaką chiałęm zrobić ale jeśli dopiszę override do Destroy to kompilator wywala błąd: "Method 'Destroy' not found in base class".

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
szopenfx
szopenfx
szopenfx
szopenfx
  • Rejestracja:prawie 21 lat
  • Ostatnio:6 miesięcy
0

Przykładowa (działająca) klasa dziedzicząca po TThread jak u ciebie:

Kopiuj
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTest = class (TThread)
    constructor Create;
    destructor Destroy; override;
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TTest }

constructor TTest.Create;
begin
  inherited Create(false);
  FreeOnTerminate := false;
end;

destructor TTest.Destroy;
begin
  Beep;
  inherited Destroy;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Test: TTest;
begin
  Test := TTest.Create;
  Test.Free;
end;

procedure TTest.Execute;
begin
  inherited;

end;

end.
Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj
Rafał D
RD
Rafał D
RD
  • Rejestracja:około 12 lat
  • Ostatnio:12 miesięcy
  • Postów:212
0

Dziwne dopiero przeinstalowanie delphi pomogło.

Ale jedna rzecz w którą nie mogę uwierzyć to to że datasnap jest mocno rozwinięta w XE a nadal TSQLConnection nie obsługuje Timeout. Używam Delphi Xe5.

Niewierze w to że nie ma prostszego rozwiązania na mój problem. Nie uwierzę w to także że Embarcadero po tylu latach nie naprawiło tego błędu, że jedno głupie wypięcie kabelka od internetu zawiesza całą aplikację lub wątek.

Udostępnij
Kopiuj link do postu Kopiuj link do postu jako Markdown
Komentuj

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.

Utwórz konto