Ticket #570 -> Controlar mejor la aplicación cuando se queda sin conexión con el servidor

git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@1048 0c75b7a4-871f-7646-8a2f-f78d34cc349f

Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas

@@ -174,7 +174,7 @@ uses
   uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App, Dialogs,
   uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin,
   uIEditorUsuarios, uIEditorUsuario, uIEditorPerfilesUsuario,
-  uIEditorPerfilUsuario, uEditorCambiarPassword;
+  uIEditorPerfilUsuario, uEditorCambiarPassword, uDataModuleConexion;
 
 { TUsuariosController }
 
@@ -498,7 +498,14 @@ end;
 
 function TUsuariosController.GetCurrentUser: IBizUsuario;
 begin
-  if not Assigned(FCurrentUser) or (FCurrentUser.ID <> FUserControl.CurrentUser.UserID) then
+  if FUserControl.CurrentUser.UserID = 0 then // todavía no hemos hecho login
+  begin
+    Result := NIL;
+    exit;
+  end;
+
+  if not Assigned(FCurrentUser) or
+    (Assigned(FUserControl.CurrentUser) and (FCurrentUser.ID <> FUserControl.CurrentUser.UserID)) then
     FCurrentUser := BuscarUsuario(FUserControl.CurrentUser.UserID);
 
   if not FCurrentUser.Active then
@@ -574,7 +581,12 @@ end;
 
 procedure TUsuariosController.Logoff;
 begin
-  FUserControl.Logoff;
+  try
+    if dmConexion.HayConexion then
+      FUserControl.Logoff;
+  finally
+    FUserControl.UsersLogged.Active := False;
+  end;
 end;
 
 function TUsuariosController.ModificarPerfil(

Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm

@@ -264,12 +264,12 @@ inherited DataModuleUsuarios: TDataModuleUsuarios
     Top = 16
   end
   object rda_Usuarios: TDARemoteDataAdapter
+    DataStreamer = Bin2DataStreamer
     GetSchemaCall.RemoteService = srvUsuarios
     GetDataCall.RemoteService = srvUsuarios
     UpdateDataCall.RemoteService = srvUsuarios
     GetScriptsCall.RemoteService = srvUsuarios
     RemoteService = srvUsuarios
-    DataStreamer = Bin2DataStreamer
     Left = 176
     Top = 16
   end
@@ -362,8 +362,6 @@ inherited DataModuleUsuarios: TDataModuleUsuarios
     Params = <>
     StreamingOptions = [soDisableEventsWhileStreaming]
     RemoteDataAdapter = rda_Usuarios
-    DetailOptions = [dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch]
-    MasterOptions = [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]
     LogicalName = 'USUARIOS'
     IndexDefs = <>
     Left = 176
@@ -410,8 +408,6 @@ inherited DataModuleUsuarios: TDataModuleUsuarios
     Params = <>
     StreamingOptions = [soDisableEventsWhileStreaming]
     RemoteDataAdapter = rda_Usuarios
-    DetailOptions = [dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch]
-    MasterOptions = [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]
     LogicalName = 'PERFILES'
     IndexDefs = <>
     Left = 272

Source/ApplicationBase/uFactuGES_App.pas

@@ -438,6 +438,9 @@ end;
 
 procedure TAppFactuGES.Terminate;
 begin
+  if Assigned(UsuarioActivo) then
+    UsuariosController.Logoff;
+    
   ModuleManager.UnloadModules;
   FTerminated := True;
 end;

Source/Base/Conexion/uDataModuleConexion.dfm

@@ -5,15 +5,17 @@ object dmConexion: TdmConexion
   Height = 177
   Width = 265
   object ROMessage: TROBinMessage
+    Envelopes = <>
     Left = 42
-    Top = 88
+    Top = 80
   end
   object ROChannel: TROWinInetHTTPChannel
     UserAgent = 'RemObjects SDK'
     TargetURL = 'http://localhost:8099/bin'
+    KeepConnection = True
     ServerLocators = <>
     DispatchOptions = []
-    Left = 48
-    Top = 8
+    Left = 40
+    Top = 24
   end
 end

Source/Base/Conexion/uDataModuleConexion.pas

@@ -42,14 +42,20 @@ implementation
 
 uses
   uROEncryption, Windows, WinInet, cxControls, uConfigurarConexion, Dialogs, Controls,
-  uDMBase, FactuGES_Intf;
+  uDMBase, FactuGES_Intf, uDialogUtils;
 
 const
   IE_OFFLINE_ERROR = 'Unexpected error in WinInet HTTP Channel (2)';
+  SIN_CONEXION_ERROR = 'No se ha podido establecer una conexión con el servidor';
 
 
 function TdmConexion.HayConexion: Boolean;
 begin
+  if not ROChannel.Connected then
+  begin
+    if ProbarConexion(ROChannel.TargetURL) then
+      ROChannel.Connected := True;
+  end;
   Result := ROChannel.Connected;
 end;
 
@@ -86,11 +92,22 @@ end;
 procedure TdmConexion.DataModuleCreate(Sender: TObject);
 begin
   ConfigurarEncriptacionConexion;
+
+  {
+    This property specifies can we reuse the same TCP connection to send and
+    receive multiple HTTP requests/responses or not. If it set to False then
+    each pair request/response creates new one connection.
+    Uses KeepConnection = True allows to improve HTTP performance
+    for multiple requests.
+  }
+  ROChannel.KeepConnection := True;
+  ROChannel.OnException := ROChannel2Failure;
 end;
 
 procedure TdmConexion.DataModuleDestroy(Sender: TObject);
 begin
-  ROChannel.Connected := False;
+  if ROChannel.Connected then
+    ROChannel.Connected := False;
 end;
 
 function TdmConexion.GetChannel: TROTransportChannel;
@@ -126,6 +143,8 @@ begin
     AROBinMessage.Assign(ROMessage);
 
     AHTTPChannel.Assign(ROChannel);
+    AHTTPChannel.OnException := NIL;
+    
     with AHTTPChannel do
     begin
       Name := 'HTTPChannel';
@@ -159,15 +178,36 @@ end;
 
 procedure TdmConexion.ROChannel2Failure(Sender: TROTransportChannel;
   anException: Exception; var aRetry: Boolean);
+var
+  AResult : TModalResult;
 begin
   if (Pos(anException.Message, IE_OFFLINE_ERROR) > 0) then
   begin
     // Preguntar al usuario si se quiere conectar
     if InternetGoOnline(PAnsiChar(ROChannel.TargetURL), GetDesktopWindow(), 0) then
       aRetry := True  // Si el usuario pulsa en 'Conectar' reintentar la operación
-    else
+    else begin
+      aRetry := False;
+      ROChannel.Connected := False;
       Abort; // Si el usuario pulsa en 'Seguir desconectado' parar todo
-  end
+    end;
+  end;
+
+  if (Pos(anException.Message, SIN_CONEXION_ERROR) > 0) then
+  begin
+    AResult := ShowErrorMessage('No se ha podido establecer una conexión con el servidor',
+      'No se puede continuar porque no se puede establecer una conexión con el servidor.' + #10#13 +
+      'Puede reintentar establecer la conexión o anular la operación.',
+      anException, [TDlgButton_REINTENTAR, TDlgButton_ABORTAR]);
+    case AResult of
+      mrRetry : aRetry := True;
+      mrAbort : begin
+                  aRetry := False;
+                  ROChannel.Connected := False;
+                  Abort;
+                end;
+    end;
+  end;
 end;
 
 procedure TdmConexion.SetTargetURL(const Value: String);

Source/Base/Utiles/uDialogUtils.pas

@@ -7,7 +7,8 @@ uses
 
 type
   TDlgButton = (TDlgButton_SI, TDlgButton_NO, TDlgButton_CANCELAR,
-      TDlgButton_ACEPTAR, TDlgButton_OK, TDlgButton_CERRAR);
+      TDlgButton_ACEPTAR, TDlgButton_OK, TDlgButton_CERRAR, TDlgButton_REINTENTAR,
+      TDlgButton_ABORTAR, TDlgButton_IGNORAR);
   TDlgButtonSet = set of TDlgButton;
 
 
@@ -36,6 +37,8 @@ procedure ShowWarningMessage(const AMessage : String); overload;
 procedure ShowWarningMessage(const AHeader : String; const AMessage : String); overload;
 procedure ShowErrorMessage(const AHeader : String; const AMessage : String); overload;
 procedure ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception); overload;
+function ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception; const AButtonSet: TDlgButtonSet) : TModalResult; overload;
+
 
 function ShowConfirmMessage(const AHeader : String;
   const AMessage : String) : TModalResult; overload;
@@ -61,7 +64,10 @@ const
   sBtnCancelar = '&Cancelar';
   sBtnAceptar = '&Aceptar';
   sBtnOK = '&OK';
-  sBtnCerrar = '&Cerrar';  
+  sBtnCerrar = 'C&errar';
+  sBtnReintentar = '&Reintentar';
+  sBtnAbortar = 'A&bortar';  
+  sBtnIgnorar = '&Ignorar';
 
 
 function CharReplace(const Source: string; oldChar, newChar: Char): string;
@@ -174,6 +180,15 @@ begin
   begin
     Clear;
 
+    if TDlgButton_REINTENTAR in AButtonSet then
+      CreateButton(sBtnReintentar, mrRetry);
+
+    if TDlgButton_IGNORAR in AButtonSet then
+      CreateButton(sBtnIgnorar, mrIgnore);
+
+    if TDlgButton_ABORTAR in AButtonSet then
+      CreateButton(sBtnAbortar, mrAbort);
+
     if TDlgButton_SI in AButtonSet then
       CreateButton(sBtnSi, mrYes);
 
@@ -260,6 +275,25 @@ begin
   end;
 end;
 
+function ShowErrorMessage(const AHeader : String; const AMessage : String;
+  AException: Exception; const AButtonSet: TDlgButtonSet) : TModalResult;
+var
+  ADialog : TJSDialog;
+begin
+  ADialog := CreateTaskDialog(Application.Title, AHeader, AMessage, tdiError);
+  try
+    CreateCustomButtons(AButtonSet, ADialog.CustomButtons);
+    ADialog.Expando.Lines.Text := #13#13 + AException.Message;
+    ADialog.Expando.ShowText := 'Mostrar información sobre el error';
+    ADialog.Expando.HideText := 'No mostrar información sobre el error';
+    ADialog.Expando.Visible := True;
+    Result := ADialog.Execute;
+  finally
+    FreeAndNIL(ADialog);
+  end;
+end;
+
+
 function ShowConfirmMessage(const AHeader : String;
   const AMessage : String) : TModalResult;
 begin

Source/Cliente/uPantallaPrincipal.dfm

@@ -1,7 +1,8 @@
 object fPantallaPrincipal: TfPantallaPrincipal
   Left = 358
   Top = 250
-  Caption = 'Pantalla principal'
+  Action = actAcerca
+  Caption = 'Acerca de...'
   ClientHeight = 553
   ClientWidth = 886
   Color = clWindow
@@ -13,8 +14,8 @@ object fPantallaPrincipal: TfPantallaPrincipal
   Menu = HostMenu
   OldCreateOrder = False
   Position = poScreenCenter
-  Visible = True
   WindowState = wsMaximized
+  OnClick = actAcercaExecute
   OnClose = FormClose
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
@@ -220,10 +221,6 @@ object fPantallaPrincipal: TfPantallaPrincipal
         Size = 150
         Tag = 0
         TextTruncation = twEndEllipsis
-      end
-      item
-        Size = 200
-        Tag = 0
       end>
     UseSystemFont = False
   end

Source/Cliente/uPantallaPrincipal.pas

@@ -9,7 +9,7 @@ uses
   TBXStatusBars, JvXPCore, JvXPContainer, pngimage, ExtCtrls, StdCtrls,
   JvPageList, JvExControls, JvExExtCtrls, JvSplitter, JvSyncSplitter,
   TBXDkPanels, uCustomEditor, uHostManager, uGUIBase,
-  Dialogs, jpeg;
+  Dialogs, jpeg, uROClient, ComCtrls;
 
 type
   IMainForm = interface(IHostForm)
@@ -118,6 +118,7 @@ type
     procedure actMenuInformesExecute(Sender: TObject);
     procedure Listadeempresas1_OLDClick(Sender: TObject);
     procedure actInformacionEmpresaExecute(Sender: TObject);
+    procedure OnROProgressEvent (iSender:TObject; iType:TProgressType; iDirection:TProgressDirection; iTransferred,iTotal:integer);
   private
     FContenido : TCustomEditor;
     procedure ShowEmbedded(AEditor : ICustomEditor);
@@ -146,7 +147,7 @@ implementation
 
 uses
   uSplash, uAcercaDe, UxTheme, Themes, uMenuUtils, uBizEmpresas,
-  uFactuGES_App, uDMBase, uDataModuleConexion,
+  uFactuGES_App, uDMBase, uDataModuleConexion, JSDialog,
   uModuleController, uMainMenuController, uNavPaneController,
   uDialogUtils, cxControls;
 
@@ -206,7 +207,7 @@ begin
   Caption := Application.Title;
 
   if dmConexion.HayConexion then 
-    TBXStatusBar1.Panels[0].Caption := 'Conectado a: ' + dmConexion.TargetURL
+    TBXStatusBar1.Panels[0].Caption := 'Servidor: ' + dmConexion.TargetURL
   else
     TBXStatusBar1.Panels[0].Caption := 'Desconectado';
 
@@ -269,6 +270,38 @@ begin
   (Sender as TAction).Checked := JvNavigationPane.Visible and (JvNavigationPane.Width > 0);
 end;
 
+procedure TfPantallaPrincipal.OnROProgressEvent(iSender: TObject;
+  iType: TProgressType; iDirection: TProgressDirection; iTransferred,
+  iTotal: integer);
+begin
+
+{  with (TBXStatusBar1.Panels[3].Control) as TProgressBar do
+  begin
+    Min := 0;
+    Max := iTotal;
+
+    case iType of
+      ptUnknown: begin
+                    Position := 0;
+                    TBXStatusBar1.Panels[2].Caption := 'Desconocido';
+                  end;
+      ptStart: begin
+                    Position := 0;
+                    TBXStatusBar1.Panels[2].Caption := 'Comienzo';
+                  end;
+      ptInProgress: begin
+                    Position := iTransferred;
+                    TBXStatusBar1.Panels[2].Caption := 'Desconocido';
+                  end;
+      ptDone: begin
+                    Position := 100;
+                    TBXStatusBar1.Panels[2].Caption := 'Fin';
+                  end;
+    end;
+
+  end;}
+end;
+
 procedure TfPantallaPrincipal.OnThemeChange(Sender: TObject);
 begin
   LockWindowUpdate(Handle);
@@ -349,6 +382,8 @@ begin
     AListaEmpresas := NIL;
   end;
 
+  //  dmConexion.ROChannel.OnProgress := OnROProgressEvent;
+
   RefrescarUI;
   finally
      HideHourglassCursor;
@@ -549,7 +584,7 @@ begin
 end;
 
 function TfPantallaPrincipal.IsShortcut(var Message: TWMKey): Boolean;
-Var
+var
    ctrl: TWinControl;
    comp: TComponent;
    i: Integer;