diff --git a/Database/FACTUGES.FDB b/Database/FACTUGES.FDB
deleted file mode 100644
index a7d98b15..00000000
Binary files a/Database/FACTUGES.FDB and /dev/null differ
diff --git a/Database/FACTUGES.FDB_ b/Database/FACTUGES.FDB_
deleted file mode 100644
index e8c72d9d..00000000
Binary files a/Database/FACTUGES.FDB_ and /dev/null differ
diff --git a/Database/FACTUGES_USERSCONTROL.FDB b/Database/FACTUGES_USERSCONTROL.FDB
deleted file mode 100644
index d790511a..00000000
Binary files a/Database/FACTUGES_USERSCONTROL.FDB and /dev/null differ
diff --git a/Source/ApplicationBase/ApplicationBase.dpk b/Source/ApplicationBase/ApplicationBase.dpk
index 4bf5dfec..a10c758c 100644
--- a/Source/ApplicationBase/ApplicationBase.dpk
+++ b/Source/ApplicationBase/ApplicationBase.dpk
@@ -11,12 +11,12 @@ package ApplicationBase;
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
-{$OPTIMIZATION ON}
+{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
-{$STACKFRAMES OFF}
+{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
@@ -31,6 +31,7 @@ requires
dbrtl,
Base,
GUIBase,
+ PluginSDK_D10R,
pckUCDataConnector,
pckUserControl_RT,
JvJansD11R,
@@ -55,7 +56,7 @@ requires
contains
uFactuGES_App in 'uFactuGES_App.pas',
uIDataModuleUsuarios in 'Usuarios\Model\Data\uIDataModuleUsuarios.pas',
- uDataModuleUsuarios in 'Usuarios\Data\uDataModuleUsuarios.pas',
+ uDataModuleUsuarios in 'Usuarios\Data\uDataModuleUsuarios.pas' {DataModuleUsuariosObj},
uUCROConn in 'Usuarios\Data\uUCROConn.pas',
uUsuariosController in 'Usuarios\Controller\uUsuariosController.pas',
uBizEmpresasDatosBancarios in 'Empresas\Model\uBizEmpresasDatosBancarios.pas',
@@ -63,7 +64,7 @@ contains
schEmpresasServer_Intf in 'Empresas\Model\schEmpresasServer_Intf.pas',
uBizEmpresas in 'Empresas\Model\uBizEmpresas.pas',
uIDataModuleEmpresas in 'Empresas\Model\Data\uIDataModuleEmpresas.pas',
- uDataModuleEmpresas in 'Empresas\Data\uDataModuleEmpresas.pas',
+ uDataModuleEmpresas in 'Empresas\Data\uDataModuleEmpresas.pas' {DataModuleEmpresasObj},
uEmpresasController in 'Empresas\Controller\uEmpresasController.pas',
uDatosBancariosEmpresaController in 'Empresas\Controller\uDatosBancariosEmpresaController.pas',
uIEditorEmpresas in 'Empresas\Controller\View\uIEditorEmpresas.pas',
diff --git a/Source/ApplicationBase/ApplicationBase.dproj b/Source/ApplicationBase/ApplicationBase.dproj
index 04e4a093..d506142a 100644
--- a/Source/ApplicationBase/ApplicationBase.dproj
+++ b/Source/ApplicationBase/ApplicationBase.dproj
@@ -31,11 +31,13 @@
.\
..\..\Output\Debug\Cliente
..\Lib
- ..\Lib
- ..\Lib
- ..\Lib
- ..\Lib
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib
DEBUG
+ False
+ True
Delphi.Personality
@@ -56,37 +58,40 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
@@ -100,7 +105,9 @@
-
+
+
+
diff --git a/Source/ApplicationBase/Empresas/Controller/uDatosBancariosEmpresaController.pas b/Source/ApplicationBase/Empresas/Controller/uDatosBancariosEmpresaController.pas
index 64e6b6a7..d7be9c8a 100644
--- a/Source/ApplicationBase/Empresas/Controller/uDatosBancariosEmpresaController.pas
+++ b/Source/ApplicationBase/Empresas/Controller/uDatosBancariosEmpresaController.pas
@@ -32,7 +32,7 @@ uses
constructor TDatosBancariosEmpresaController.Create;
begin
inherited;
- FDataModule := TDataModuleEmpresas.Create(Nil);
+// FDataModule := TDataModuleEmpresas.Create(Nil);
end;
destructor TDatosBancariosEmpresaController.Destroy;
diff --git a/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas b/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
index f38cb497..14dd7073 100644
--- a/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
+++ b/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
@@ -72,7 +72,7 @@ end;
constructor TEmpresasController.Create;
begin
- FDataModule := TDataModuleEmpresas.Create(Nil);
+ FDataModule := TDataModuleEmpresas.Create;
end;
procedure TEmpresasController.DescartarCambios(AEmpresa: IBizEmpresa);
diff --git a/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.dfm b/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.dfm
index c0305bb9..d24532a6 100644
--- a/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.dfm
+++ b/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.dfm
@@ -1,4 +1,4 @@
-object DataModuleEmpresas: TDataModuleEmpresas
+object DataModuleEmpresasObj: TDataModuleEmpresasObj
OldCreateOrder = True
OnCreate = DAClientDataModuleCreate
Height = 267
diff --git a/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.pas b/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.pas
index 87ab37d2..e5aedc6a 100644
--- a/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.pas
+++ b/Source/ApplicationBase/Empresas/Data/uDataModuleEmpresas.pas
@@ -11,7 +11,7 @@ uses {vcl:} SysUtils, Classes, DB, DBClient,
uDAMemDataTable, uDABin2DataStreamer, uIntegerListUtils;
type
- TDataModuleEmpresas = class(TDataModule, IDataModuleEmpresas)
+ TDataModuleEmpresasObj = class(TDataModule, IDataModuleEmpresas)
RORemoteService: TRORemoteService;
rda_Empresas: TDARemoteDataAdapter;
Bin2DataStreamer: TDABin2DataStreamer;
@@ -28,6 +28,14 @@ type
function GetItems : IBizEmpresa;
end;
+ TDataModuleEmpresas = class(TInterfacedObject, IDataModuleEmpresas)
+ private
+ FDataModule : TDataModuleEmpresasObj;
+ property DataModule : TDataModuleEmpresasObj read FDataModule implements IDataModuleEmpresas;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
implementation
@@ -37,13 +45,13 @@ uses
uDataModuleConexion, uDataTableUtils,
FactuGES_Intf, schEmpresasClient_Intf, cxControls;
-procedure TDataModuleEmpresas.DAClientDataModuleCreate(Sender: TObject);
+procedure TDataModuleEmpresasObj.DAClientDataModuleCreate(Sender: TObject);
begin
RORemoteService.Channel := dmConexion.Channel;
RORemoteService.Message := dmConexion.Message;
end;
-function TDataModuleEmpresas.GetItem(const ID: Integer): IBizEmpresa;
+function TDataModuleEmpresasObj.GetItem(const ID: Integer): IBizEmpresa;
begin
ShowHourglassCursor;
try
@@ -61,7 +69,7 @@ begin
end;
end;
-function TDataModuleEmpresas.GetItems: IBizEmpresa;
+function TDataModuleEmpresasObj.GetItems: IBizEmpresa;
var
AEmpresa : TDAMemDataTable;
begin
@@ -81,12 +89,12 @@ begin
end;
end;
-function TDataModuleEmpresas.NewItem: IBizEmpresa;
+function TDataModuleEmpresasObj.NewItem: IBizEmpresa;
begin
Result := GetItem(ID_NULO)
end;
-function TDataModuleEmpresas._GetDatosBancarios: IBizEmpresasDatosBancarios;
+function TDataModuleEmpresasObj._GetDatosBancarios: IBizEmpresasDatosBancarios;
var
ADatosBancarios : TDAMemDataTable;
begin
@@ -106,6 +114,17 @@ begin
end;
-initialization
+{ TDataModuleEmpresas }
-end.
\ No newline at end of file
+constructor TDataModuleEmpresas.Create;
+begin
+ FDataModule := TDataModuleEmpresasObj.Create(NIL);
+end;
+
+destructor TDataModuleEmpresas.Destroy;
+begin
+ FreeANDNIL(FDataModule);
+ inherited;
+end;
+
+end.
diff --git a/Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas b/Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas
index 95a5f2da..c7916e98 100644
--- a/Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas
+++ b/Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas
@@ -42,16 +42,6 @@ type
property CurrentEmpresa : TEmpresaDef read FEmpresaAtual write FEmpresaAtual;
property UserSettings: TUCUserSettings read FUserSettings write SetUserSettings;}
-{ function BuscarTodos: IBizFormaPago;
- function Buscar(ID: Integer): IBizFormaPago;
- procedure VerTodos(AUsuarios: IBizFormaPago);
- procedure Ver(AFormaPago: IBizFormaPago);
- procedure Anadir(AFormaPago : IBizFormaPago);
- function Eliminar(AFormaPago : IBizFormaPago): Boolean;
- function Guardar(AFormaPago : IBizFormaPago): Boolean;
- procedure DescartarCambios(AFormaPago : IBizFormaPago);
- function Localizar(AUsuarios: IBizFormaPago; ADescripcion:String): Boolean;
- function DarListaUsuarios: TStringList;}
end;
TUsuariosController = class(TControllerBase, IUsuariosController)
@@ -65,13 +55,11 @@ type
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); override;
function CreateEditor(const AName : String; const IID: TGUID; out Intf): Boolean;
-// function ValidarFormaPago(AFormaPago: IBizFormaPago): Boolean;
procedure AsignarDataModule;
procedure InicializarUserControl;
procedure ComprobarUsuarioInicial;
function GetCurrentUser: TUCCurrentUser;
- procedure OnLoginForm(Sender: TObject; var CustomForm: TCustomForm);
public
constructor Create; virtual;
destructor Destroy; override;
@@ -84,17 +72,7 @@ type
procedure ShowChangePassword;
function ComprobarUsuario(const User : String; const Password: String): Boolean;
procedure CambiarPassword(const AIDUser: Integer; const ANewPassword: String);
-
-{ function Eliminar(AFormaPago : IBizFormaPago): Boolean;
- function Guardar(AFormaPago : IBizFormaPago): Boolean; virtual;
- procedure DescartarCambios(AFormaPago : IBizFormaPago); virtual;
- procedure Anadir(AFormaPago : IBizFormaPago);
- function BuscarTodos: IBizFormaPago;
- function Buscar(ID: Integer): IBizFormaPago;
- procedure VerTodos(AUsuarios: IBizFormaPago);
- procedure Ver(AFormaPago: IBizFormaPago);
- function Localizar(AUsuarios: IBizFormaPago; ADescripcion:String): Boolean;
- function DarListaUsuarios: TStringList;}
+
property UserControl : TUserControl read FUserControl;
property MaxIntentosLogin : Integer read GetMaxIntentosLogin write SetMaxIntentosLogin;
property CurrentUser: TUCCurrentUser read GetCurrentUser;
@@ -104,44 +82,16 @@ implementation
uses
cxControls, DB, uEditorRegistryUtils, schUsuariosClient_Intf,
- uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App,
+ uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App, Dialogs,
uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin;
{ TUsuariosController }
-{procedure TUsuariosController.Anadir(AFormaPago: IBizFormaPago);
-begin
- AFormaPago.Insert;
-end;}
-
procedure TUsuariosController.AsignarDataModule;
begin
- FDataModule := TDataModuleUsuarios.Create(Nil);
+ FDataModule := TDataModuleUsuarios.Create;
end;
-{function TUsuariosController.Buscar(ID: Integer): IBizFormaPago;
-begin
- ShowHourglassCursor;
- try
- Result := BuscarTodos;
- with Result.DataTable.Where do
- begin
- if NotEmpty then
- AddOperator(opAND);
- OpenBraket;
- AddText(fld_UsuariosID + ' = ' + IntToStr(ID));
- CloseBraket;
- end;
- finally
- HideHourglassCursor;
- end;
-end;
-
-function TUsuariosController.BuscarTodos: IBizFormaPago;
-begin
- Result := FDataModule.GetItems;
-end;}
-
procedure TUsuariosController.CambiarPassword(const AIDUser: Integer;
const ANewPassword: String);
begin
@@ -174,49 +124,11 @@ begin
Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf);
end;
-{
-function TUsuariosController.DarListaUsuarios: TStringList;
-var
- AUsuarios: IBizFormaPago;
-begin
- AUsuarios := BuscarTodos;
- AUsuarios.DataTable.Active := True;
- Result := TStringList.Create;
- try
- with Result do
- begin
- AUsuarios.DataTable.First;
- while not AUsuarios.DataTable.EOF do
- begin
- Add(AUsuarios.DESCRIPCION);
- AUsuarios.DataTable.Next;
- end;
- end;
- finally
- AUsuarios := NIL;
- end;
-end;
-
-procedure TUsuariosController.DescartarCambios(AFormaPago: IBizFormaPago);
-begin
- if not Assigned(AFormaPago) then
- raise Exception.Create ('Forma de pago no asignada');
-
- ShowHourglassCursor;
- try
- if (AFormaPago.State in dsEditModes) then
- AFormaPago.Cancel;
-
- AFormaPago.DataTable.CancelUpdates;
- finally
- HideHourglassCursor;
- end;
-end;
-}
destructor TUsuariosController.Destroy;
begin
- FreeANDNIL(FUserControl);
+ FreeAndNIL(FUserControl);
FDataModule := NIL;
+
inherited;
end;
@@ -239,8 +151,6 @@ begin
Criptografia := cMD5;
CheckValidationKey := True;
Login.MaxLoginAttempts := 3;
-
- OnCustomLoginForm := OnLoginForm;
end;
FDataModule.InicializarUserControl(FUserControl);
end;
@@ -250,99 +160,6 @@ begin
FUserControl.Logoff;
end;
-procedure TUsuariosController.OnLoginForm(Sender: TObject;
- var CustomForm: TCustomForm);
-begin
-// CustomForm := TfLoginForm.Create(NIL);
-end;
-
-{
-function TUsuariosController.ValidarFormaPago(AFormaPago: IBizFormaPago): Boolean;
-begin
- Result := False;
-
- if not Assigned(AFormaPago) then
- raise Exception.Create ('Forma de pago no asignada');
-
- if (AFormaPago.DataTable.State in dsEditModes) then
- AFormaPago.DataTable.Post;
-
- if Length(AFormaPago.REFERENCIA) = 0 then
- raise Exception.Create('Debe indicar una referencia para esta forma de pago.');
-
- if Length(AFormaPago.DESCRIPCION) = 0 then
- raise Exception.Create('Debe indicar una descripción para esta forma de pago.');
-
- Result := True;
-end;
-
-procedure TUsuariosController.Ver(AFormaPago: IBizFormaPago);
-var
- AEditor : IEditorFormaPago;
-begin
- AEditor := NIL;
- ShowHourglassCursor;
- try
- CreateEditor('EditorFormaPago', IEditorFormaPago, AEditor);
- with AEditor do
- FormaPago := AFormaPago;
- finally
- HideHourglassCursor;
- end;
-
- if Assigned(AEditor) then
- try
- AEditor.ShowModal;
- AEditor.Release;
- finally
- AEditor := NIL;
- end;
-end;
-
-procedure TUsuariosController.VerTodos(AUsuarios: IBizFormaPago);
-var
- AEditor : IEditorUsuarios;
-begin
- AEditor := NIL;
- ShowHourglassCursor;
- try
- CreateEditor('EditorUsuarios', IEditorUsuarios, AEditor);
- with AEditor do
- Usuarios := AUsuarios;
- finally
- HideHourglassCursor;
- end;
-
- if Assigned(AEditor) then
- try
- AEditor.ShowModal;
- AEditor.Release;
- finally
- AEditor := NIL;
- end;
-end;
-
-function TUsuariosController.Eliminar(AFormaPago: IBizFormaPago): Boolean;
-begin
- Result := False;
-
- if not Assigned(AFormaPago) then
- raise Exception.Create ('Forma de pago no asignada');
-
- ShowHourglassCursor;
- try
- if (AFormaPago.State in dsEditModes) then
- AFormaPago.Cancel;
-
- AFormaPago.Delete;
- AFormaPago.DataTable.ApplyUpdates;
- HideHourglassCursor;
- Result := True;
- finally
- HideHourglassCursor;
- end;
-end;}
-
procedure TUsuariosController.RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable);
begin
inherited;
@@ -382,6 +199,7 @@ begin
ShowHourglassCursor;
try
CreateEditor('EditorLogin', IEditorLogin, AEditor);
+
with AEditor do
Controller := Self;
finally
@@ -399,38 +217,4 @@ begin
end;
end;
-{function TUsuariosController.Guardar(AFormaPago: IBizFormaPago): Boolean;
-begin
- Result := False;
-
- if ValidarFormaPago(AFormaPago) then
- begin
- ShowHourglassCursor;
- try
- AFormaPago.DataTable.ApplyUpdates;
- Result := True;
- finally
- HideHourglassCursor;
- end;
- end;
-end;
-
-function TUsuariosController.Localizar(AUsuarios: IBizFormaPago; ADescripcion: String): Boolean;
-begin
- Result := True;
- ShowHourglassCursor;
- try
- with AUsuarios.DataTable do
- begin
- DisableControls;
- First;
- if not Locate(fld_UsuariosDESCRIPCION, ADescripcion, []) then
- Result := False;
- EnableControls;
- end;
- finally
- HideHourglassCursor;
- end;
-end;}
-
end.
diff --git a/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm b/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm
index cb3187d7..b01ed2dd 100644
--- a/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm
+++ b/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm
@@ -1,43 +1,31 @@
-object DataModuleUsuarios: TDataModuleUsuarios
+object DataModuleUsuariosObj: TDataModuleUsuariosObj
OldCreateOrder = True
- OnCreate = DAClientDataModuleCreate
- Height = 205
- Width = 355
- object ROLoginService: TRORemoteService
- Message = dmConexion.ROMessage
- Channel = dmConexion.ROChannel
- ServiceName = 'srvLogin'
- Left = 48
- Top = 32
- end
+ Height = 149
+ Width = 273
object srvUsuarios: TRORemoteService
Message = dmConexion.ROMessage
Channel = dmConexion.ROChannel
ServiceName = 'srvUsuarios'
- Left = 152
- Top = 32
- end
- object Bin2DataStreamer: TDABin2DataStreamer
- Left = 48
- Top = 104
+ Left = 40
+ Top = 72
end
object UCSettingsSpanish: TUCSettings
- AppMessages.MsgsForm_BtNew = '&Nuevo mensaje'
- AppMessages.MsgsForm_BtReplay = '&Repetir'
- AppMessages.MsgsForm_BtForward = '&Siguiente'
- AppMessages.MsgsForm_BtDelete = '&Eliminar'
+ AppMessages.MsgsForm_BtNew = '&Nuevo Mensaje'
+ AppMessages.MsgsForm_BtReplay = '&Responder'
+ AppMessages.MsgsForm_BtForward = '&Reenviar'
+ AppMessages.MsgsForm_BtDelete = '&Borrar'
AppMessages.MsgsForm_BtClose = '&Cerrar'
- AppMessages.MsgsForm_WindowCaption = 'Mensajes del sistema'
- AppMessages.MsgsForm_ColFrom = 'De'
+ AppMessages.MsgsForm_WindowCaption = 'Mensajes de Sistema'
+ AppMessages.MsgsForm_ColFrom = 'Remitente'
AppMessages.MsgsForm_ColSubject = 'Asunto'
AppMessages.MsgsForm_ColDate = 'Fecha'
- AppMessages.MsgsForm_PromptDelete = #194#191'Desea eliminar los mensajes seleccionados?'
+ AppMessages.MsgsForm_PromptDelete = #191'Est'#225' seguro de eliminar los mensajes seleccionados?'
AppMessages.MsgsForm_PromptDelete_WindowCaption = 'Eliminar mensajes'
- AppMessages.MsgsForm_NoMessagesSelected = 'No hay mensajes seleccionados'
- AppMessages.MsgsForm_NoMessagesSelected_WindowCaption = 'Informaci'#195#179'n'
+ AppMessages.MsgsForm_NoMessagesSelected = '!Ning'#250'n mensaje seleccionado'#161
+ AppMessages.MsgsForm_NoMessagesSelected_WindowCaption = 'Informaci'#243'n'
AppMessages.MsgRec_BtClose = '&Cerrar'
AppMessages.MsgRec_WindowCaption = 'Mensaje'
- AppMessages.MsgRec_Title = 'Mensaje recibido'
+ AppMessages.MsgRec_Title = 'Mensaje Recibido'
AppMessages.MsgRec_LabelFrom = 'De:'
AppMessages.MsgRec_LabelDate = 'Fecha'
AppMessages.MsgRec_LabelSubject = 'Asunto'
@@ -45,42 +33,42 @@ object DataModuleUsuarios: TDataModuleUsuarios
AppMessages.MsgSend_BtSend = '&Enviar'
AppMessages.MsgSend_BtCancel = '&Cancelar'
AppMessages.MsgSend_WindowCaption = 'Mensaje'
- AppMessages.MsgSend_Title = 'Enviar un nuevo mensaje'
- AppMessages.MsgSend_GroupTo = 'A'
+ AppMessages.MsgSend_Title = 'Enviar Nuevo Mensaje'
+ AppMessages.MsgSend_GroupTo = 'Para:'
AppMessages.MsgSend_RadioUser = 'Usuario:'
AppMessages.MsgSend_RadioAll = 'Todos'
AppMessages.MsgSend_GroupMessage = 'Mensaje'
AppMessages.MsgSend_LabelSubject = 'Asunto'
AppMessages.MsgSend_LabelMessageText = 'Texto del mensaje'
- CommonMessages.AutoLogonError = 'Fault of Car Logon !'#13#10'Inform a valid user and password.'
- CommonMessages.ChangePasswordError.InvalidCurrentPassword = 'Current password does not tally!'
+ CommonMessages.AutoLogonError =
+ 'Error de Ingreso Autom'#225'tico!'#13#10'Especifique un Usuario y Contrase'#241 +
+ 'a V'#225'lidos.'
+ CommonMessages.ChangePasswordError.InvalidCurrentPassword = #161'Contrase'#241'a Actual Incorrecta!'
CommonMessages.ChangePasswordError.NewPasswordError =
- 'Los campos de nueva contrase'#195#177'a y confirmaci'#195#179'n deben ser iguale' +
- 's.'
- CommonMessages.ChangePasswordError.NewEqualCurrent = 'La nueva contrase'#195#177'a es la misma que la contrase'#195#177'a actual '
- CommonMessages.ChangePasswordError.PasswordRequired = 'The password is compulsory '
- CommonMessages.ChangePasswordError.MinPasswordLength = 'La contrase'#195#177'a debe contener al menos %d caracteres '
- CommonMessages.ChangePasswordError.InvalidNewPassword = #194#161'La nueva contrase'#195#177'a no es v'#195#161'lida por ser demasiado f'#195#161'cil!'
- CommonMessages.InvalidLogin = 'User invalids or password !'
+ 'Los campos Contrase'#241'a Nueva y Confirme Contrase'#241'a deben ser igua' +
+ 'les'
+ CommonMessages.ChangePasswordError.NewEqualCurrent = 'Nueva Contrase'#241'a y Contrase'#241'a Actual deben ser diferentes'
+ CommonMessages.ChangePasswordError.PasswordRequired = #161'La Contrase'#241'a es obligatoria!'
+ CommonMessages.ChangePasswordError.MinPasswordLength = 'La Contrase'#241'a debe tener un m'#237'nimo de %d caracteres'
+ CommonMessages.ChangePasswordError.InvalidNewPassword = #161'Prohibido utilizar contrase'#241'as NO Seguras!'
+ CommonMessages.InvalidLogin = 'Usuario y/o Contrase'#241'a Incorrectos!'
CommonMessages.InitialMessage.Strings = (
- 'ATTENTION, Inicial Login :'
+ 'ATENCION! Conecci'#243'n Inicial:'
''
- 'User: :user'
- 'Password : :password'
+ 'Usuario : :user'
+ 'Contrase'#241'a : :password'
''
- 'Define the permissions for this user.')
- CommonMessages.MaxLoginAttemptsError =
- '%d Attempts of login invalid. By reasons of segun'#231'a the system w' +
- 'ill be closed.'
- CommonMessages.PasswordChanged = #194#161'Contrase'#195#177'a cambiada!'
- CommonMessages.BlankPassword = 'Retired password of the Login %s'
- CommonMessages.UsuarioExiste = 'The User "%s" is already set up in the system !!'
- CommonMessages.PasswordExpired = 'Attention, his sign died, favor exchanges it '
+ 'Defina permisos para este usuario')
+ CommonMessages.MaxLoginAttemptsError = '%d Intentos de conecci'#243'n inv'#225'lidos !'
+ CommonMessages.PasswordChanged = #161'Se ha cambiado la Contrase'#241'a con '#233'xito!'
+ CommonMessages.BlankPassword = 'Contrase'#241'a vac'#237'a para el Usuario %s'
+ CommonMessages.UsuarioExiste = 'O Usu'#225'rio "%s" j'#225' est'#225' cadastrado no sistema !!'
+ CommonMessages.PasswordExpired = 'Aten'#231#227'o, sua senha expirou, favor troca-la'
CommonMessages.ForcaTrocaSenha = 'Mudan'#231'a de senha obrigat'#243'ria'
- Login.WindowCaption = 'Login'
- Login.LabelUser = 'Usuario :'
- Login.LabelPassword = 'Contrase'#195#177'a :'
- Login.BtOk = '&Aceptar'
+ Login.WindowCaption = 'Conecci'#243'n'
+ Login.LabelUser = 'Usuario: '
+ Login.LabelPassword = 'Contrase'#241'a:'
+ Login.BtOk = 'Aceptar'
Login.BtCancel = '&Cancelar'
Login.LeftImage.Data = {
07544269746D617016090000424D160900000000000036040000280000003200
@@ -157,118 +145,122 @@ object DataModuleUsuarios: TDataModuleUsuarios
A3A3FDFDFDFDFDFDFDFDFDFD0000FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFD
FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFD
0000}
- Login.LabelTentativa = 'Attempt : '
- Login.LabelTentativas = 'Max of Attempts: '
- Log.WindowCaption = 'Security'
- Log.LabelDescription = 'Log of system'
- Log.LabelUser = 'User :'
- Log.LabelDate = 'Date :'
- Log.LabelLevel = 'Least level:'
+ Login.LabelTentativa = 'Tentativa : '
+ Login.LabelTentativas = 'M'#225'ximo de Tentativas : '
+ Log.WindowCaption = 'Seguridad'
+ Log.LabelDescription = 'Visor de Eventos'
+ Log.LabelUser = 'Usuario:'
+ Log.LabelDate = 'Fecha:'
+ Log.LabelLevel = 'Nivel M'#237'nimo: '
Log.ColAppID = 'AppID'
- Log.ColLevel = 'Level '
- Log.ColMessage = 'Message'
- Log.ColUser = 'User'
- Log.ColDate = 'Date'
- Log.BtFilter = '&Apply Filter'
- Log.BtDelete = '&Erase Log'
- Log.BtClose = '&Close'
- Log.PromptDelete = 'It confirms to exclude all the registers of log selected ?'
- Log.PromptDelete_WindowCaption = 'Delete confirmation'
- Log.OptionUserAll = 'All'
- Log.OptionLevelLow = 'Low'
+ Log.ColLevel = 'Nivel'
+ Log.ColMessage = 'Mensaje'
+ Log.ColUser = 'Usuario'
+ Log.ColDate = 'Fecha'
+ Log.BtFilter = '&Aplicar Filtro'
+ Log.BtDelete = '&Borrar Bit'#225'cora'
+ Log.BtClose = '&Cerrar'
+ Log.PromptDelete =
+ #191'Est'#225' seguro de Eliminar todos todos los registros de Bit'#225'cora s' +
+ 'eleccionados?'
+ Log.PromptDelete_WindowCaption = 'Confirmaci'#243'n'
+ Log.OptionUserAll = 'Todos'
+ Log.OptionLevelLow = 'Bajo'
Log.OptionLevelNormal = 'Normal'
- Log.OptionLevelHigh = 'High'
- Log.OptionLevelCritic = 'Critic'
+ Log.OptionLevelHigh = 'Alto'
+ Log.OptionLevelCritic = 'Cr'#237'tico'
Log.DeletePerformed =
- 'Deletion of system log done: User = "%s" | Date = %s a %s | Leve' +
- 'l <= %s'
- UsersForm.WindowCaption = 'Security'
- UsersForm.LabelDescription = 'Users register '
- UsersForm.ColName = 'Name'
- UsersForm.ColLogin = 'Login'
- UsersForm.ColEmail = 'Email'
- UsersForm.BtAdd = '&Add'
- UsersForm.BtChange = 'A<er'
- UsersForm.BtDelete = '&Erase'
- UsersForm.PromptDelete = 'Confirm erase the user "%s" ?'
- UsersForm.PromptDelete_WindowCaption = 'Delete user'
- UsersForm.BtRights = 'A&ccesses'
- UsersForm.BtPassword = '&Password'
- UsersForm.BtClose = '&Close'
- AddChangeUser.WindowCaption = 'Users register '
- AddChangeUser.LabelAdd = 'Add User'
- AddChangeUser.LabelChange = 'Change User'
- AddChangeUser.LabelName = 'Name :'
- AddChangeUser.LabelLogin = 'Login :'
- AddChangeUser.LabelEmail = 'Email :'
- AddChangeUser.LabelPerfil = 'Profile :'
- AddChangeUser.CheckPrivileged = 'Privileged user '
- AddChangeUser.BtSave = '&Save'
- AddChangeUser.BtCancel = 'Cancel'
+ 'Borrado de registros de bit'#225'cora realizado: Usuario = "%s" | Fec' +
+ 'ha = %s a %s | Nivel <= %s'
+ UsersForm.WindowCaption = 'Seguridad'
+ UsersForm.LabelDescription = 'Administraci'#243'n de Usuarios'
+ UsersForm.ColName = 'Nombre'
+ UsersForm.ColLogin = 'Usuario'
+ UsersForm.ColEmail = 'Correo'
+ UsersForm.BtAdd = '&Nuevo'
+ UsersForm.BtChange = '&Editar'
+ UsersForm.BtDelete = 'E&liminar'
+ UsersForm.PromptDelete = #191'Est'#225' seguro de Eliminar al Usuario "%s"?'
+ UsersForm.PromptDelete_WindowCaption = 'Eliminar usuario'
+ UsersForm.BtRights = '&Accesos'
+ UsersForm.BtPassword = 'C&ontrase'#241'a'
+ UsersForm.BtClose = '&Cerrar'
+ AddChangeUser.WindowCaption = 'Administraci'#243'n de Usuarios'
+ AddChangeUser.LabelAdd = 'Nuevo Usuario'
+ AddChangeUser.LabelChange = 'Editar Usuario'
+ AddChangeUser.LabelName = 'Nombre:'
+ AddChangeUser.LabelLogin = 'Usuario: '
+ AddChangeUser.LabelEmail = 'Correo: '
+ AddChangeUser.LabelPerfil = 'Perfil: '
+ AddChangeUser.CheckPrivileged = 'Usuario Privilegiado'
+ AddChangeUser.BtSave = '&Guardar'
+ AddChangeUser.BtCancel = 'Cancelar'
AddChangeUser.CheckExpira = 'Senha do usu'#225'rio n'#227'o expira'
AddChangeUser.Day = 'Dias'
AddChangeUser.ExpiredIn = 'Expira em'
- AddChangeProfile.WindowCaption = 'Profile the Users'
- AddChangeProfile.LabelAdd = 'Add Profile'
- AddChangeProfile.LabelChange = 'Change Profile '
- AddChangeProfile.LabelName = 'Description :'
- AddChangeProfile.BtSave = '&Save'
- AddChangeProfile.BtCancel = 'Cancel'
- UsersProfile.WindowCaption = 'Security'
- UsersProfile.LabelDescription = 'Users profile '
- UsersProfile.ColProfile = 'Profile'
- UsersProfile.BtAdd = '&Add'
- UsersProfile.BtChange = 'A<er'
- UsersProfile.BtDelete = '&Delete'
- UsersProfile.BtRights = 'A&ccesses'
- UsersProfile.PromptDelete = 'There are users with the profile "%s". Confirm erase ?'
- UsersProfile.PromptDelete_WindowCaption = 'Delete profile'
- UsersProfile.BtClose = '&Close'
+ AddChangeProfile.WindowCaption = 'Perfiles de Usuarios'
+ AddChangeProfile.LabelAdd = 'Nuevo Perfil'
+ AddChangeProfile.LabelChange = 'Editar Perfil'
+ AddChangeProfile.LabelName = 'Descripci'#243'n: '
+ AddChangeProfile.BtSave = '&Guardar'
+ AddChangeProfile.BtCancel = 'Cancelar'
+ UsersProfile.WindowCaption = 'Seguridad'
+ UsersProfile.LabelDescription = 'Perfil de Usuario'
+ UsersProfile.ColProfile = 'Perfil'
+ UsersProfile.BtAdd = '&Nuevo'
+ UsersProfile.BtChange = '&Editar'
+ UsersProfile.BtDelete = 'E&liminar'
+ UsersProfile.BtRights = '&Accesos'
+ UsersProfile.PromptDelete =
+ 'Existe(n) usuario(s) con el Perfil "%s". '#191'Est'#225' seguro de elimina' +
+ 'r el perfil?'
+ UsersProfile.PromptDelete_WindowCaption = 'Eliminar perfil'
+ UsersProfile.BtClose = '&Cerrar'
Rights.WindowCaption = 'Seguridad'
- Rights.LabelUser = 'Permissions of the User :'
- Rights.LabelProfile = 'Permissions of the Profile :'
- Rights.PageMenu = 'Items of the Menu'
- Rights.PageActions = 'Actions'
- Rights.PageControls = 'Controls'
- Rights.BtUnlock = '&Desbloquear'
+ Rights.LabelUser = 'Permisos de Usuario : '
+ Rights.LabelProfile = 'Permisos del Perfil : '
+ Rights.PageMenu = 'Elementos del Men'#250
+ Rights.PageActions = 'Acciones'
+ Rights.PageControls = 'Controles'
+ Rights.BtUnlock = '&Permitir'
Rights.BtLock = '&Bloquear'
Rights.BtSave = '&Guardar'
Rights.BtCancel = '&Cancelar'
ChangePassword.WindowCaption = 'Seguridad'
- ChangePassword.LabelDescription = 'Cambiar la contrase'#195#177'a'
- ChangePassword.LabelCurrentPassword = 'Contrase'#195#177'a actual: '
- ChangePassword.LabelNewPassword = 'Nueva contrase'#195#177'a: '
- ChangePassword.LabelConfirm = 'Confirmar contrase'#195#177'a: '
- ChangePassword.BtSave = 'C&ambiar'
+ ChangePassword.LabelDescription = 'Cambiar Contrase'#241'a'
+ ChangePassword.LabelCurrentPassword = 'Contrase'#241'a Actual:'
+ ChangePassword.LabelNewPassword = 'Nueva Contrase'#241'a:'
+ ChangePassword.LabelConfirm = 'Confirme Contrase'#241'a:'
+ ChangePassword.BtSave = '&Guardar'
ChangePassword.BtCancel = 'Cancelar'
- ResetPassword.WindowCaption = 'Define Password of the user : "%s"'
- ResetPassword.LabelPassword = 'Password :'
- History.Evento_Insert = 'Inserido'
- History.Evento_Delete = 'Apagado'
- History.Evento_Edit = 'Editado'
- History.Evento_NewRecord = 'Novo registro'
+ ResetPassword.WindowCaption = 'Ingrese Contrase'#241'a de Usuario: "%s"'
+ ResetPassword.LabelPassword = 'Contrase'#241'a: '
+ History.Evento_Insert = 'Nuevo'
+ History.Evento_Delete = 'Eliminar'
+ History.Evento_Edit = 'Editar'
+ History.Evento_NewRecord = 'Nuevo registro'
History.Hist_All = 'Todos'
- History.Msg_LimpHistorico = 'Excluir todo o conte'#250'do do hist'#243'rico ?'
- History.Msg_MensConfirma = 'Confirma'#231#227'o'
- History.Msg_LogEmptyHistory = 'Usu'#225'rio %s apagou todo o hist'#243'rico as %s'
+ History.Msg_LimpHistorico = 'Excluir el contenido entero del hist'#243'rico ?'
+ History.Msg_MensConfirma = 'Confirme'
+ History.Msg_LogEmptyHistory = 'El usuario %s borra la historia de mesa en %s '
History.LabelDescricao = 'Hist'#243'rico de tabelas'
- History.LabelUser = 'Usu'#225'rio'
+ History.LabelUser = 'Usuario'
History.LabelForm = 'Formul'#225'rio'
History.LabelEvento = 'Evento'
History.LabelTabela = 'Tabela'
History.LabelDataEvento = 'Data'
History.LabelHoraEvento = 'Hora'
- History.Msg_NewRecord = '%s inseriu um novo registro'
- History.Hist_MsgExceptPropr = 'Favor informar a propriedade %s'
+ History.Msg_NewRecord = '%s Inserte el nuevo registro'
+ History.Hist_MsgExceptPropr = 'Por favor informe la propiedad %s'
History.Hist_BtnFiltro = '&Aplicar Filtro'
- History.Hist_BtnExcluir = '&Excluir Hist'#243'rico'
- History.Hist_BtnFechar = '&Fechar'
+ History.Hist_BtnExcluir = '&Borrar Hist'#243'rico'
+ History.Hist_BtnFechar = '&Cerrar'
TypeFieldsDB.Type_VarChar = 'VarChar'
TypeFieldsDB.Type_Char = 'Char'
TypeFieldsDB.Type_Int = 'Int'
TypeFieldsDB.Type_MemoField = 'BLOB SUB_TYPE 1 SEGMENT SIZE 1024'
- Language = ucPortuguesBr
- Left = 152
- Top = 104
+ Language = ucSpanish
+ Left = 40
+ Top = 16
end
end
diff --git a/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.pas b/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.pas
index 213d74f3..efccab10 100644
--- a/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.pas
+++ b/Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.pas
@@ -9,203 +9,53 @@ uses
uDARemoteCommand, uROClient, uRORemoteService, uDADataStreamer,
uDABin2DataStreamer, uDAScriptingProvider, uIDataModuleUsuarios, UCSettings;
-const
- PERFIL_ADMINISTRADORES = 'Administradores';
-
type
- TDataModuleUsuarios = class(TDataModule, IDataModuleUsuarios)
- ROLoginService: TRORemoteService;
+ TDataModuleUsuariosObj = class(TDataModule)
srvUsuarios: TRORemoteService;
- Bin2DataStreamer: TDABin2DataStreamer;
UCSettingsSpanish: TUCSettings;
- procedure DAClientDataModuleCreate(Sender: TObject);
- procedure DAClientDataModuleDestroy(Sender: TObject);
private
- FDataConnector : TUCROConn;
- FUsuario : String;
- FPassword : String; // Lo guardo para poder hacer una reconexión
-
- FLoginInfo: TRdxLoginInfo;
-// function GetEsAdministrador: Boolean;
-
- //function GetEmpresas: TIntegerList;
-
- {procedure SetEmpresaActual(const Value: IBizEmpresa);
- function GetIDEmpresaActual: Integer;
- procedure SetIDEmpresaActual(const Value: Integer);}
- function GetDataConnector : TUCDataConnector;
- function GetUCSettings : TUCSettings;
procedure InicializarCamposUserControl(AUserControl: TUserControl);
procedure InicializarSettingsUserControl(AUserControl: TUserControl);
+ function CreateConnectorInstance : TUCDataConnector;
public
procedure InicializarUserControl (AUserControl : TUserControl);
-{ function Login: Boolean; overload;
- function Login(Usuario: String; Password: String): Boolean; overload;
- procedure Logout;
- procedure CambiarPassword; overload;}
-
-// property EsAdministrador : Boolean read GetEsAdministrador;
-// property IDEmpresaActual : Integer read GetIDEmpresaActual write SetIDEmpresaActual;
-// property EmpresaActual : IBizEmpresa read FEmpresaActual write SetEmpresaActual;
-// property Empresas : TIntegerList read GetEmpresas;
-// property LoginInfo: TRdxLoginInfo read FLoginInfo;
- property DataConnector : TUCDataConnector read GetDataConnector;
- property UCSettings: TUCSettings read GetUCSettings;
end;
+ TDataModuleUsuarios = class(TInterfacedObject, IDataModuleUsuarios)
+ private
+ FDataModule : TDataModuleUsuariosObj;
+ public
+ procedure InicializarUserControl (AUserControl : TUserControl);
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+
implementation
{$R *.DFM}
uses
Forms, Controls, uDataTableUtils, uDataModuleConexion,
- Dialogs, Windows, uEmpresasController,
+ Dialogs, Windows, uEmpresasController, uDataModuleBase,
schUsuariosClient_Intf;
{ TDAClientDataModule1 }
-procedure TDataModuleUsuarios.DAClientDataModuleCreate(Sender: TObject);
+function TDataModuleUsuariosObj.CreateConnectorInstance: TUCDataConnector;
begin
- ROLoginService.Channel := dmConexion.Channel;
- ROLoginService.Message := dmConexion.Message;
-
- FDataConnector := TUCROConn.Create(nil);
- FDataConnector.RemoteService := srvUsuarios;
-
- FUsuario := '';
- FPassword := '';
- FLoginInfo := NIL;
-end;
-
-{function TDataModuleUsuarios.Login: Boolean;
-begin
- // Intento hacer login si el usuario ya lo había hecho antes
- if (Length(FUsuario) > 0) then
- if Login(FUsuario, FPassword) then
- begin
- Result := True;
- Exit;
- end;
-
- // Si no funcionar el login anterior o es la primera vez,
- // saco la pantalla de login
- with TfLoginForm.Create(NIL) do
- try
- if Assigned(FLoginInfo) then
- edtUser.Text := FLoginInfo.Usuario;
- Result := (ShowModal = mrOK)
- finally
- Free;
- end;
-end;}
-
-{function TDataModuleUsuarios.Login(Usuario: String; Password: String): Boolean;
-begin
- // Libero la información del login anterior (sesión, etc)
- if Assigned(FLoginInfo) then
- FreeANDNil(FLoginInfo);
-
- Result := (ROLoginService as IsrvLogin).Login(Usuario, Password, FLoginInfo);
-
- if Result then
+ // El propietario (Owner) es Application para que se encarge de la
+ // liberación del conector que estamos creando.
+ Result := TUCROConn.Create(Application);
+ with TUCROConn(Result) do
begin
- // Lo guardo para poder reconectarme
- FUsuario := Usuario;
- FPassword := Password;
+ ROServiceName := srvUsuarios.ServiceName;
+ ROChannel := dmConexion.ROChannel;
+ ROMessage := dmConexion.ROMessage;
end;
-end;}
-
-{procedure TDataModuleUsuarios.Logout;
-begin
- (ROLoginService as IsrvLogin).Logout;
- if Assigned(FLoginInfo) then
- FreeANDNil(FLoginInfo);
- FUsuario := '';
- FPassword := '';
-end;}
-
-{procedure TDataModuleUsuarios.SetEmpresaActual(const Value: IBizEmpresa);
-begin
- FEmpresaActual := Value;
- FEmpresaActual.DataTable.Active := True;
-end;}
-
-{procedure TDataModuleUsuarios.SetIDEmpresaActual(const Value: Integer);
-var
- AEmpresasController : IEmpresasController;
- AEmpresa : IBizEmpresa;
-begin
- AEmpresasController := TEmpresasController.Create;
- AEmpresa := AEmpresasController.Buscar(Value);
- AEmpresa.DataTable.Active := True;
-
- if not AEmpresa.IsEmpty then
- begin
- FEmpresaActual := AEmpresa;
- FEmpresaActual.DataTable.Active := True;
- end
- else
- FEmpresaActual := NIL;
-end;}
-
-procedure TDataModuleUsuarios.DAClientDataModuleDestroy(Sender: TObject);
-begin
- if Assigned(FDataConnector) then
- FreeANDNIL(FDataConnector);
-
- if Assigned(FLoginInfo) then
- FreeANDNIL(FLoginInfo);
end;
-function TDataModuleUsuarios.GetDataConnector: TUCDataConnector;
-begin
- Result := FDataConnector;
-end;
-
-{function TDataModuleUsuarios.GetEmpresas: TIntegerList;
-var
- i : integer;
-begin
- Result := TIntegerList.Create;
-
- if not Assigned(FLoginInfo) then
- raise Exception.Create('Usuario no validado en el sistema (login)');
-
- for i := 0 to FLoginInfo.Empresas.Count - 1 do
- Result.Add(FLoginInfo.Empresas.Items[i]);
-end;
-
-function TDataModuleUsuarios.GetEsAdministrador: Boolean;
-var
- I: Integer;
-begin
- Result := False;
-
- if not Assigned(FLoginInfo) then
- raise Exception.Create('Usuario no validado en el sistema (login)');
-
- for I := 0 to FLoginInfo.Perfiles.Count - 1 do
- if FLoginInfo.Perfiles.Items[I] = PERFIL_ADMINISTRADORES then
- begin
- Result := True;
- Break;
- end;
-end;
-
-function TDataModuleUsuarios.GetIDEmpresaActual: Integer;
-begin
- if not Assigned(FEmpresaActual) then
- Result := ID_NULO
- else
- Result := FEmpresaActual.ID;
-end; }
-
-function TDataModuleUsuarios.GetUCSettings: TUCSettings;
-begin
- Result := UCSettingsSpanish;
-end;
-
-procedure TDataModuleUsuarios.InicializarCamposUserControl(
+procedure TDataModuleUsuariosObj.InicializarCamposUserControl(
AUserControl: TUserControl);
begin
if not Assigned(AUserControl) then
@@ -213,7 +63,7 @@ begin
with AUserControl do
begin
- DataConnector := FDataConnector;
+ DataConnector := CreateConnectorInstance;
with TableUsers do
begin
@@ -269,7 +119,7 @@ begin
end;
end;
-procedure TDataModuleUsuarios.InicializarSettingsUserControl(
+procedure TDataModuleUsuariosObj.InicializarSettingsUserControl(
AUserControl: TUserControl);
var
SourceSettings : TUCSettings;
@@ -510,7 +360,7 @@ begin
end;
end;
-procedure TDataModuleUsuarios.InicializarUserControl(
+procedure TDataModuleUsuariosObj.InicializarUserControl(
AUserControl: TUserControl);
begin
if Assigned(AUserControl) then
@@ -520,16 +370,23 @@ begin
end;
end;
-{procedure TDataModuleUsuarios.CambiarPassword;
+{ TDataModuleUsuarios }
+
+constructor TDataModuleUsuarios.Create;
begin
- with TfCambiarPassword.Create(NIL) do
- try
- if ShowModal = mrOk then
- if CambiarPassword(edtPassword.Text) then
- Application.MessageBox('La contraseña ha sido cambiada correctamente.', 'Información', MB_OK);
- finally
- Free;
- end;
-end;}
+ FDataModule := TDataModuleUsuariosObj.Create(NIL);
+end;
+
+destructor TDataModuleUsuarios.Destroy;
+begin
+ FreeANDNIL(FDataModule);
+ inherited;
+end;
+
+procedure TDataModuleUsuarios.InicializarUserControl(
+ AUserControl: TUserControl);
+begin
+ FDataModule.InicializarUserControl(AUserControl);
+end;
end.
diff --git a/Source/ApplicationBase/Usuarios/Data/uUCROConn.pas b/Source/ApplicationBase/Usuarios/Data/uUCROConn.pas
index 19895e5b..f1f6cbde 100644
--- a/Source/ApplicationBase/Usuarios/Data/uUCROConn.pas
+++ b/Source/ApplicationBase/Usuarios/Data/uUCROConn.pas
@@ -22,21 +22,24 @@ uses
DB,
DBClient,
SysUtils,
- UCDataConnector,
- uRORemoteService,
- uDADataStreamer,
- uDABin2DataStreamer,
- uDARemoteDataAdapter;
+ uRORemoteService, uDADataStreamer, uROBinMessage, uROWinInetHttpChannel,
+ uDABin2DataStreamer, uDARemoteDataAdapter, UCDataConnector;
type
TUCROConn = class(TUCDataConnector)
private
+ FMessage: TROBinMessage;
+ FChannel: TROWinInetHTTPChannel;
FRemoteService: TRORemoteService;
FDataAdapter : TDARemoteDataAdapter;
FDataStreamer : TDABin2DataStreamer;
- procedure SetRemoteService(const Value: TRORemoteService);
+ procedure SetServiceName(const Value: String);
+ function GetServiceName: String;
+ procedure SetChannel(const Value: TROWinInetHTTPChannel);
+ procedure SetMessage(const Value: TROBinMessage);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure RefreshROConnection;
public
function GetDBObjectName: String; override;
function GetTransObjectName: String; override;
@@ -47,7 +50,9 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
- property RemoteService : TRORemoteService read FRemoteService write SetRemoteService;
+ property ROServiceName : String read GetServiceName write SetServiceName;
+ property ROMessage : TROBinMessage read FMessage write SetMessage;
+ property ROChannel : TROWinInetHTTPChannel read FChannel write SetChannel;
end;
implementation
@@ -61,6 +66,7 @@ uses
constructor TUCROConn.Create(AOwner: TComponent);
begin
inherited;
+ FRemoteService := TRORemoteService.Create(nil);
FDataStreamer := TDABin2DataStreamer.Create(nil);
FDataAdapter := TDARemoteDataAdapter.Create(nil);
FDataAdapter.DataStreamer := FDataStreamer;
@@ -69,6 +75,7 @@ end;
destructor TUCROConn.Destroy;
begin
+ FreeAndNil(FRemoteService);
FreeAndNil(FDataAdapter);
FreeAndNil(FDataStreamer);
inherited;
@@ -87,6 +94,11 @@ begin
Result := '';
end;
+function TUCROConn.GetServiceName: String;
+begin
+ Result := FRemoteService.ServiceName;
+end;
+
function TUCROConn.GetTransObjectName: String;
begin
Result := '';
@@ -102,11 +114,12 @@ begin
inherited Notification(AComponent, Operation);
end;
-procedure TUCROConn.SetRemoteService(const Value: TRORemoteService);
+procedure TUCROConn.RefreshROConnection;
begin
- FRemoteService := Value;
- if Assigned(FRemoteService) then
+ with FRemoteService do
begin
+ FRemoteService.Message := FMessage;
+ FRemoteService.Channel := FChannel;
with FDataAdapter do
begin
RemoteService := FRemoteService;
@@ -118,6 +131,23 @@ begin
end;
end;
+procedure TUCROConn.SetChannel(const Value: TROWinInetHTTPChannel);
+begin
+ FChannel := Value;
+ RefreshROConnection;
+end;
+
+procedure TUCROConn.SetMessage(const Value: TROBinMessage);
+begin
+ FMessage := Value;
+ RefreshROConnection;
+end;
+
+procedure TUCROConn.SetServiceName(const Value: String);
+begin
+ FRemoteService.ServiceName := Value;
+end;
+
procedure TUCROConn.UCExecSQL(FSQL: String);
begin
(FRemoteService as IsrvUsuarios).SQLExecuteCommand(FSQL);
diff --git a/Source/ApplicationBase/Usuarios/Model/Data/uIDataModuleUsuarios.pas b/Source/ApplicationBase/Usuarios/Model/Data/uIDataModuleUsuarios.pas
index 3e96b9cc..ce846342 100644
--- a/Source/ApplicationBase/Usuarios/Model/Data/uIDataModuleUsuarios.pas
+++ b/Source/ApplicationBase/Usuarios/Model/Data/uIDataModuleUsuarios.pas
@@ -3,14 +3,12 @@ unit uIDataModuleUsuarios;
interface
uses
- UCBase, UCDataConnector, UCSettings;
+ UCBase, UCSettings;
type
IDataModuleUsuarios = interface
- ['{F2D2E969-5E87-42DE-A550-E839C4607C72}']
+ ['{35907569-6900-4567-91AC-4EAC14F3D43B}']
procedure InicializarUserControl (AUserControl : TUserControl);
- function GetDataConnector : TUCDataConnector;
- property DataConnector : TUCDataConnector read GetDataConnector;
end;
implementation
diff --git a/Source/ApplicationBase/Usuarios/Views/uEditorLogin.dfm b/Source/ApplicationBase/Usuarios/Views/uEditorLogin.dfm
index fb4b5560..d0bd09c2 100644
--- a/Source/ApplicationBase/Usuarios/Views/uEditorLogin.dfm
+++ b/Source/ApplicationBase/Usuarios/Views/uEditorLogin.dfm
@@ -15,6 +15,7 @@ object fEditorLogin: TfEditorLogin
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
+ OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
diff --git a/Source/ApplicationBase/Usuarios/Views/uEditorLogin.pas b/Source/ApplicationBase/Usuarios/Views/uEditorLogin.pas
index e1790fc8..8c8f3dfa 100644
--- a/Source/ApplicationBase/Usuarios/Views/uEditorLogin.pas
+++ b/Source/ApplicationBase/Usuarios/Views/uEditorLogin.pas
@@ -31,6 +31,7 @@ type
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
private
FController : IUsuariosController;
FIntentos : Integer;
@@ -96,6 +97,11 @@ begin
FIntentos := 0;
end;
+procedure TfEditorLogin.FormDestroy(Sender: TObject);
+begin
+ FController := NIL;
+end;
+
procedure TfEditorLogin.FormShow(Sender: TObject);
begin
Self.Caption := Self.Caption + ' - ' + AppFactuGES.AppVersion;
diff --git a/Source/ApplicationBase/uFactuGES_App.pas b/Source/ApplicationBase/uFactuGES_App.pas
index 3741e919..c0b69f36 100644
--- a/Source/ApplicationBase/uFactuGES_App.pas
+++ b/Source/ApplicationBase/uFactuGES_App.pas
@@ -3,51 +3,141 @@ unit uFactuGES_App;
interface
uses
- SysUtils, Classes, Forms, uUsuarios, uBizEmpresas,
- uEmpresasController, JclFileUtils, uUsuariosController;
+ SysUtils, Classes, Forms, uUsuarios, uBizEmpresas, uControllerBase,
+ uEmpresasController, JclFileUtils, uUsuariosController, uHostManager;
type
- TAppFactuGES = class(TObject)
- private
- FAppInfo : TJclFileVersionInfo;
- FEmpresasController : IEmpresasController;
- FUsuariosController: IUsuariosController;
- FEmpresaActiva: IBizEmpresa;
- function GetAppForm: TCustomForm;
+ TDoLoadModulesEvent = procedure;
+ TDoMainFormEvent = procedure;
+
+ IAppSplashForm = interface
+ ['{9905DF57-4476-42E6-A7CD-B1479A84E220}']
+ procedure Show;
+ procedure Hide;
+ procedure Update;
+ function GetMensaje: String;
+ procedure SetMensaje(const AMensaje : String);
+ property Mensaje : String read GetMensaje write SetMensaje;
+ end;
+
+ IAppFactuGES = interface
+ ['{FB6A0F3C-C1D1-462D-AFD4-2A368F85E920}']
+ function GetMainForm: TCustomForm;
function GetEmpresasController: IEmpresasController;
function GetUsuariosController: IUsuariosController;
function GetAppName: String;
function GetAppVersion: String;
function GetUsuarioActivo: TUsuario;
- protected
- procedure InitializeInstance; virtual;
- procedure DestroyInstance; virtual;
- public
- class function NewInstance: TObject; override;
- procedure FreeInstance; override;
- class function RefCount: Integer;
- procedure CambarEmpresa(const AIDEmpresa : Integer);
+ function GetEmpresaActiva: IBizEmpresa;
+ function GetModuleManager : THostManager;
+ function GetTerminated: Boolean;
+
+ function GetLoadModulesEvent : TDoLoadModulesEvent;
+ procedure SetLoadModulesEvent (ALoadModulesEvent : TDoLoadModulesEvent);
+
+ function GetDoMainFormEvent : TDoMainFormEvent;
+ procedure SetDoMainFormEvent (AMainFormEvent : TDoMainFormEvent);
+
+ function GetAppSplashForm : IAppSplashForm;
+ procedure SetAppSplashForm (AAppSplashForm : IAppSplashForm);
+
+ procedure CambiarEmpresa(const AIDEmpresa : Integer);
+
+ procedure ShowSplashForm;
+ procedure HideSplashForm;
+
+ procedure Run;
+ procedure Terminate;
+
property AppVersion : String read GetAppVersion;
property AppName : String read GetAppName;
- property AppForm : TCustomForm read GetAppForm;
- property EmpresaActiva : IBizEmpresa read FEmpresaActiva;
+ property MainForm : TCustomForm read GetMainForm;
+ property EmpresaActiva : IBizEmpresa read GetEmpresaActiva;
property UsuarioActivo : TUsuario read GetUsuarioActivo;
property EmpresasController : IEmpresasController read GetEmpresasController;
property UsuariosController : IUsuariosController read GetUsuariosController;
+ property AppSplashForm : IAppSplashForm read GetAppSplashForm write SetAppSplashForm;
+ property ModuleManager : THostManager read GetModuleManager;
+ property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent;
+ property DoLoadModulesEvent : TDoLoadModulesEvent read GetLoadModulesEvent write SetLoadModulesEvent;
+ property Terminated : Boolean read GetTerminated;
+ end;
+
+
+ TAppFactuGES = class(TInterfacedObject, IAppFactuGES)
+ private
+ FAppInfo : TJclFileVersionInfo;
+ FEmpresasController : IEmpresasController;
+ FUsuariosController: IUsuariosController;
+ FEmpresaActiva: IBizEmpresa;
+ FAppSplashForm : IAppSplashForm;
+ FHostManager : THostManager;
+ FTerminated : Boolean;
+
+ FDoMainFormEvent: TDoMainFormEvent;
+ FDoLoadModulesEvent: TDoMainFormEvent;
+
+ function GetMainForm: TCustomForm;
+ function GetEmpresasController: IEmpresasController;
+ function GetUsuariosController: IUsuariosController;
+ function GetAppName: String;
+ function GetAppVersion: String;
+ function GetUsuarioActivo: TUsuario;
+ function GetEmpresaActiva: IBizEmpresa;
+ function GetModuleManager : THostManager;
+ function GetTerminated: Boolean;
+
+ function GetLoadModulesEvent : TDoLoadModulesEvent;
+ procedure SetLoadModulesEvent (ALoadModulesEvent : TDoLoadModulesEvent);
+
+ function GetDoMainFormEvent : TDoMainFormEvent;
+ procedure SetDoMainFormEvent (AMainFormEvent : TDoMainFormEvent);
+
+ function GetAppSplashForm : IAppSplashForm;
+ procedure SetAppSplashForm (AAppSplashForm : IAppSplashForm);
+
+ procedure AfterLoadModule(Sender: TObject; AModuleInfo: TModuleInfo);
+ procedure RegisterModule(AModuleInfo : TModuleInfo);
+ protected
+ procedure DoMainForm;
+
+ procedure CargarModulos;
+ procedure ShowSplashForm;
+ procedure HideSplashForm;
+ procedure UpdateSplashForm;
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+
+ procedure Run;
+ procedure Terminate;
+
+ procedure CambiarEmpresa(const AIDEmpresa : Integer);
+
+ property AppVersion : String read GetAppVersion;
+ property AppName : String read GetAppName;
+ property MainForm : TCustomForm read GetMainForm;
+ property EmpresaActiva : IBizEmpresa read GetEmpresaActiva;
+ property AppSplashForm : IAppSplashForm read GetAppSplashForm write SetAppSplashForm;
+ property UsuarioActivo : TUsuario read GetUsuarioActivo;
+ property EmpresasController : IEmpresasController read GetEmpresasController;
+ property UsuariosController : IUsuariosController read GetUsuariosController;
+ property ModuleManager : THostManager read GetModuleManager;
+ property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent;
+ property DoLoadModulesEvent : TDoLoadModulesEvent read GetLoadModulesEvent write SetLoadModulesEvent;
+ property Terminated : Boolean read GetTerminated;
end;
var
- AppFactuGES : TAppFactuGES = nil;
+ AppFactuGES : IAppFactuGES = nil;
implementation
uses
- uDataModuleBase, uUsuariosViewRegister, uEmpresasViewRegister;
+ cxControls, uDataModuleBase, uUsuariosViewRegister,
+ uEmpresasViewRegister;
-var
- Ref_Count : Integer = 0;
-
-procedure TAppFactuGES.CambarEmpresa(const AIDEmpresa: Integer);
+procedure TAppFactuGES.CambiarEmpresa(const AIDEmpresa: Integer);
var
Aux : IBizEmpresa;
begin
@@ -60,93 +150,211 @@ begin
end;
end;
-procedure TAppFactuGES.DestroyInstance;
+procedure TAppFactuGES.CargarModulos;
begin
- FreeAndNIL(FAppInfo);
+ if not Assigned(FDoLoadModulesEvent) then
+ raise Exception.Create('Evento para la carga de los módulos de la aplicación no asignado (CargarModulos)');
+
+ FDoLoadModulesEvent();
end;
-procedure TAppFactuGES.FreeInstance;
+constructor TAppFactuGES.Create;
begin
- Dec(Ref_Count);
- if (Ref_Count = 0) then
+ FTerminated := False;
+ FDoMainFormEvent := NIL;
+ FDoLoadModulesEvent := NIL;
+ FAppSplashForm := NIL;
+ FEmpresaActiva := NIL;
+ FUsuariosController := NIL; // Se crea la primera vez que se usa
+ FEmpresasController := NIL; // Se crea la primera vez que se usa
+
+ FAppInfo := TJclFileVersionInfo.Create(Application.ExeName);
+ FHostManager := THostManager.Create(NIL);
+ with FHostManager do
begin
- AppFactuGES := NIL;
-
- // Destroy private variables here
- DestroyInstance;
-
- inherited FreeInstance;
+ OnAfterLoad := AfterLoadModule;
+ // Ruta por defecto de los módulos
+ BPLPath := ExtractFilePath(Application.ExeName) + '\';
end;
end;
-function TAppFactuGES.GetAppForm: TCustomForm;
+destructor TAppFactuGES.Destroy;
+begin
+ FAppSplashForm := NIL;
+
+ FHostManager.UnloadModules;
+ FreeAndNIL(FHostManager);
+
+ FEmpresaActiva := NIL;
+ FUsuariosController := NIL;
+ FEmpresasController := NIL;
+
+ FreeAndNIL(FAppInfo);
+ inherited;
+end;
+
+procedure TAppFactuGES.DoMainForm;
+begin
+ if not Assigned(FDoMainFormEvent) then
+ raise Exception.Create('Evento para la creación del formulario principal no asignado (DoMainForm)');
+
+ FDoMainFormEvent();
+end;
+
+function TAppFactuGES.GetMainForm: TCustomForm;
begin
Result := Application.MainForm;
end;
+function TAppFactuGES.GetDoMainFormEvent: TDoMainFormEvent;
+begin
+ Result := FDoMainFormEvent;
+end;
+
function TAppFactuGES.GetAppName: String;
begin
Result := FAppInfo.ProductName;
end;
+function TAppFactuGES.GetAppSplashForm: IAppSplashForm;
+begin
+ Result := FAppSplashForm;
+end;
+
function TAppFactuGES.GetAppVersion: String;
begin
Result := FAppInfo.ProductVersion;
end;
+function TAppFactuGES.GetEmpresaActiva: IBizEmpresa;
+begin
+ Result := FEmpresaActiva;
+end;
+
function TAppFactuGES.GetEmpresasController: IEmpresasController;
begin
+ if not Assigned(FEmpresasController) then
+ FEmpresasController := TEmpresasController.Create;
+
Result := FEmpresasController;
end;
+function TAppFactuGES.GetLoadModulesEvent: TDoLoadModulesEvent;
+begin
+ Result := FDoLoadModulesEvent;
+end;
+
+function TAppFactuGES.GetModuleManager: THostManager;
+begin
+ Result := FHostManager;
+end;
+
+function TAppFactuGES.GetTerminated: Boolean;
+begin
+ Result := FTerminated;
+end;
+
function TAppFactuGES.GetUsuarioActivo: TUsuario;
begin
- Result := FUsuariosController.CurrentUser;
+ Result := UsuariosController.CurrentUser;
end;
function TAppFactuGES.GetUsuariosController: IUsuariosController;
begin
+ if not Assigned(FUsuariosController) then
+ FUsuariosController := TUsuariosController.Create;
+
Result := FUsuariosController;
end;
-procedure TAppFactuGES.InitializeInstance;
+procedure TAppFactuGES.HideSplashForm;
begin
- FEmpresaActiva := NIL;
- FAppInfo := TJclFileVersionInfo.Create(Application.ExeName);
- FUsuariosController := TUsuariosController.Create;
- FEmpresasController := TEmpresasController.Create;
+ if not Assigned(FAppSplashForm) then
+ raise Exception.Create('AppSplashForm no asignado (HideSplashForm)');
+
+ FAppSplashForm.Hide;
end;
-class function TAppFactuGES.NewInstance: TObject;
+procedure TAppFactuGES.AfterLoadModule(Sender: TObject;
+ AModuleInfo: TModuleInfo);
begin
- if (not Assigned(AppFactuGES)) then
+ RegisterModule(AModuleInfo);
+end;
+
+procedure TAppFactuGES.RegisterModule(AModuleInfo: TModuleInfo);
+begin
+ AppSplashForm.Mensaje := 'Cargando ''' + AModuleInfo.Module.ModuleName + '''...';
+end;
+
+procedure TAppFactuGES.Run;
+begin
+ if UsuariosController.StartLogin then
begin
- AppFactuGES := TAppFactuGES(inherited NewInstance);
- // Initialize private variables here
- AppFactuGES.InitializeInstance;
+ ShowHourglassCursor;
+ try
+ ShowSplashForm;
+ CargarModulos;
+ DoMainForm;
+ finally
+ HideHourglassCursor;
+ HideSplashForm;
+ end;
+
+ //InicializarUI;
+ //Application.ProcessMessages;
+ //Visible := True;
+ //AplicarPerfil;
+// Application.CreateForm();
end;
- Result := AppFactuGES;
- Inc(Ref_Count);
+ Application.Run;
+ Terminate;
end;
-class function TAppFactuGES.RefCount: Integer;
+procedure TAppFactuGES.SetDoMainFormEvent(
+ AMainFormEvent: TDoMainFormEvent);
begin
- Result := Ref_Count;
+ FDoMainFormEvent := AMainFormEvent;
end;
+procedure TAppFactuGES.SetAppSplashForm(AAppSplashForm: IAppSplashForm);
+begin
+ FAppSplashForm := AAppSplashForm;
+end;
+
+procedure TAppFactuGES.SetLoadModulesEvent(
+ ALoadModulesEvent: TDoLoadModulesEvent);
+begin
+ FDoLoadModulesEvent := ALoadModulesEvent;
+end;
+
+procedure TAppFactuGES.ShowSplashForm;
+begin
+ if not Assigned(FAppSplashForm) then
+ raise Exception.Create('AppSplashForm no asignado (ShowSplashForm)');
+
+ FAppSplashForm.Show;
+ FAppSplashForm.Update;
+end;
+
+procedure TAppFactuGES.Terminate;
+begin
+ ModuleManager.UnloadModules;
+ FTerminated := True;
+end;
+
+procedure TAppFactuGES.UpdateSplashForm;
+begin
+ FAppSplashForm.Update;
+end;
initialization
- AppFactuGES := TAppFactuGES.Create;
-
// Pongo esto aquí por ahora
uUsuariosViewRegister.RegisterViews;
uEmpresasViewRegister.RegisterViews;
finalization
- FreeAndNIL(AppFactuGES);
-
// Pongo esto aquí por ahora
uUsuariosViewRegister.UnregisterViews;
uEmpresasViewRegister.UnregisterViews;
-
+
end.
diff --git a/Source/Base/Base.dproj b/Source/Base/Base.dproj
index 96f58149..40cf7b90 100644
--- a/Source/Base/Base.dproj
+++ b/Source/Base/Base.dproj
@@ -31,19 +31,16 @@
..\..\Output\Debug\Cliente
..\Lib
DEBUG
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp
+ $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp
Delphi.Personality
Package
FalseTrueFalseLibreria base de FactuGESTrueFalseFalseTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.01.0.0.0
-
-
-
-
-
-
-
VCL for the Web Design Package for CodeGear RAD Studio
CodeGear WebSnap Components
CodeGear SOAP Components
@@ -58,7 +55,6 @@
MainSource
-
diff --git a/Source/Base/Conexion/uDataModuleConexion.dfm b/Source/Base/Conexion/uDataModuleConexion.dfm
index f858c3e8..0cf1e8e0 100644
--- a/Source/Base/Conexion/uDataModuleConexion.dfm
+++ b/Source/Base/Conexion/uDataModuleConexion.dfm
@@ -1,5 +1,6 @@
object dmConexion: TdmConexion
OldCreateOrder = False
+ OnDestroy = DataModuleDestroy
Height = 177
Width = 121
object ROChannel: TROWinInetHTTPChannel
diff --git a/Source/Base/Conexion/uDataModuleConexion.pas b/Source/Base/Conexion/uDataModuleConexion.pas
index 55043fd7..5b484cd5 100644
--- a/Source/Base/Conexion/uDataModuleConexion.pas
+++ b/Source/Base/Conexion/uDataModuleConexion.pas
@@ -16,13 +16,14 @@ type
ROMessage: TROBinMessage;
procedure ROChannelFailure(Sender: TROTransportChannel;
anException: Exception; var Retry: Boolean);
+ procedure DataModuleDestroy(Sender: TObject);
private
function GetChannel: TROWinInetHTTPChannel;
function GetMessage: TROBinMessage;
function GetTargetURL: String;
procedure SetTargetURL(const Value: String);
public
- function HayConexion : Boolean;
+ function HayConexion : Boolean;
function ProbarConexion(const ATargetURL : String): Boolean;
procedure ConfigurarConexion;
property TargetURL : String read GetTargetURL write SetTargetURL;
@@ -66,6 +67,11 @@ begin
end;
end;
+procedure TdmConexion.DataModuleDestroy(Sender: TObject);
+begin
+ ROChannel.Connected := False;
+end;
+
function TdmConexion.GetChannel: TROWinInetHTTPChannel;
begin
Result := ROChannel;
diff --git a/Source/Base/Controladores/uControllerBase.pas b/Source/Base/Controladores/uControllerBase.pas
index b710af87..41e73b0e 100644
--- a/Source/Base/Controladores/uControllerBase.pas
+++ b/Source/Base/Controladores/uControllerBase.pas
@@ -8,18 +8,42 @@ uses
type
ISujeto = interface;
- IObservador = interface
+ IObservador = interface(IInterface)
['{679D5CF2-D5DC-4A52-9FF3-04AD91402483}']
procedure RecibirAviso(ASujeto: ISujeto); overload;
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload;
end;
- ISujeto = interface
+ ISujeto = interface(IInterface)
['{CDB691CD-D1D6-4F2E-AA34-93B1CD0E6030}']
procedure AddObservador(Observador: IObservador);
procedure DeleteObservador(Observador: IObservador);
end;
+
+ { ******************* PARA PRUEBAS ******************************************}
+ IMiInterface = interface(IInterface)
+ ['{C4C3F81D-4318-457C-860A-6034617FE39E}']
+ function GetRefCount : Integer;
+ end;
+
+ TMiInterfacedObject = class(TObject, IInterface)
+ protected
+ FRefCount: Integer;
+ function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ function GetRefCount : Integer;
+ public
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+ class function NewInstance: TObject; override;
+ property RefCount: Integer read FRefCount;
+ end;
+ { ***************************************************************************}
+
+
+
TObservador = class(TInterfacedObject, IObservador)
protected
procedure RecibirAviso(ASujeto: ISujeto); overload; virtual;
@@ -45,7 +69,74 @@ type
implementation
uses
- SysUtils;
+ Dialogs, SysUtils;
+
+
+function InterlockedIncrement(var I: Integer): Integer;
+asm
+ MOV EDX,1
+ XCHG EAX,EDX
+ LOCK XADD [EDX],EAX
+ INC EAX
+end;
+
+function InterlockedDecrement(var I: Integer): Integer;
+asm
+ MOV EDX,-1
+ XCHG EAX,EDX
+ LOCK XADD [EDX],EAX
+ DEC EAX
+end;
+
+{ TMiInterfacedObject }
+
+procedure TMiInterfacedObject.AfterConstruction;
+begin
+// Release the constructor's implicit refcount
+ InterlockedDecrement(FRefCount);
+end;
+
+procedure TMiInterfacedObject.BeforeDestruction;
+begin
+ if RefCount <> 0 then
+ Error(reInvalidPtr);
+end;
+
+function TMiInterfacedObject.GetRefCount: Integer;
+begin
+ Result := FRefCount;
+end;
+
+// Set an implicit refcount so that refcounting
+// during construction won't destroy the object.
+class function TMiInterfacedObject.NewInstance: TObject;
+begin
+ Result := inherited NewInstance;
+ TMiInterfacedObject(Result).FRefCount := 1;
+end;
+
+function TMiInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
+begin
+ if GetInterface(IID, Obj) then
+ Result := 0
+ else
+ Result := E_NOINTERFACE;
+end;
+
+function TMiInterfacedObject._AddRef: Integer;
+begin
+ Result := InterlockedIncrement(FRefCount);
+ ShowMessage('_AddRef: ' + ClassName + ' - RefCount: ' + IntToStr(FRefCount));
+end;
+
+function TMiInterfacedObject._Release: Integer;
+begin
+ Result := InterlockedDecrement(FRefCount);
+ ShowMessage('_Release: ' + ClassName + ' - RefCount: ' + IntToStr(FRefCount));
+ if Result = 0 then
+ Destroy;
+end;
+
{ TSujeto }
@@ -102,4 +193,5 @@ begin
//
end;
+
end.
diff --git a/Source/Base/uDataModuleBase.dfm b/Source/Base/uDataModuleBase.dfm
index 202efa5e..71da85e0 100644
--- a/Source/Base/uDataModuleBase.dfm
+++ b/Source/Base/uDataModuleBase.dfm
@@ -1620,4 +1620,8 @@ object dmBase: TdmBase
Left = 184
Top = 16
end
+ object JvLogFile: TJvLogFile
+ Left = 184
+ Top = 80
+ end
end
diff --git a/Source/Base/uDataModuleBase.pas b/Source/Base/uDataModuleBase.pas
index 35ee011f..bbc4c23b 100644
--- a/Source/Base/uDataModuleBase.pas
+++ b/Source/Base/uDataModuleBase.pas
@@ -3,10 +3,10 @@ unit uDataModuleBase;
interface
uses
- Controls, PngImageList, JvComponent, JvNavigationPane, TBXSwitcher,
+ Controls, SyncObjs, PngImageList, JvComponent, JvNavigationPane, TBXSwitcher,
TBXOffice2003Theme, Classes, ImgList,
DataAbstract4_Intf, uDADataTable, JvAppStorage, JvAppRegistryStorage, cxintl,
- JvComponentBase, cxIntlPrintSys3;
+ JvComponentBase, cxIntlPrintSys3, JvLogFile;
type
TdmBase = class(TDataModule)
@@ -15,21 +15,26 @@ type
TBXSwitcher: TTBXSwitcher;
cxIntl: TcxIntl;
cxIntlPrintSys31: TcxIntlPrintSys3;
+ JvLogFile: TJvLogFile;
procedure DAClientDataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
FOnThemeChange: TNotifyEvent;
+ FEscribirLog : TCriticalSection;
+ procedure IniciarLog;
+ procedure DetenerLog;
procedure InitStyleManager;
procedure OnTBXThemeChange(Sender: TObject);
procedure LeerConfiguracion;
public
+ procedure EscribirLog(const AMensaje : String);
procedure SalvarConfiguracion;
property OnThemeChange: TNotifyEvent read FOnThemeChange write
FOnThemeChange;
end;
var
- dmBase: TdmBase;
+ dmBase: TdmBase = nil;
implementation
@@ -44,8 +49,7 @@ uses
}
procedure TdmBase.DAClientDataModuleCreate(Sender: TObject);
begin
- dmConexion := TdmConexion.Create(NIL);
- dmConfiguracion := TdmConfiguracion.Create(NIL);
+ IniciarLog;
TBXSwitcher.OnThemeChange := OnTBXThemeChange;
TBXSetTheme('Office2003');
@@ -53,6 +57,17 @@ begin
LeerConfiguracion;
end;
+procedure TdmBase.IniciarLog;
+begin
+ FEscribirLog := TCriticalSection.Create;
+
+ JvLogFile.Active := False;
+ JvLogFile.FileName := ExtractFilePath(Application.ExeName) + 'ClientLog.txt';
+ JvLogFile.AutoSave := True;
+ JvLogFile.Active := True;
+ JvLogFile.Clear;
+end;
+
procedure TdmBase.InitStyleManager;
begin
if not USE_THEMES then
@@ -99,14 +114,22 @@ end;
procedure TdmBase.DataModuleDestroy(Sender: TObject);
begin
- FreeANDNIL(dmConfiguracion);
- FreeAndNil(dmConexion);
+ DetenerLog;
end;
-initialization
- dmBase := TdmBase.Create(NIL);
+procedure TdmBase.DetenerLog;
+begin
+ FreeAndNIL(FEscribirLog);
+end;
-finalization
- dmBase.Free;
+procedure TdmBase.EscribirLog(const AMensaje: String);
+begin
+ FEscribirLog.Acquire;
+ try
+ JvLogFile.Add(AMensaje);
+ finally
+ FEscribirLog.Release;
+ end;
+end;
end.
diff --git a/Source/Cliente/FactuGES.dpr b/Source/Cliente/FactuGES.dpr
index ffc937f7..10a482a8 100644
--- a/Source/Cliente/FactuGES.dpr
+++ b/Source/Cliente/FactuGES.dpr
@@ -1,10 +1,13 @@
program FactuGES;
uses
+ ExceptionLog,
Forms,
Windows,
SysUtils,
uFactuGES_App,
+ Dialogs,
+ uDataModuleBase,
uPantallaPrincipal in 'uPantallaPrincipal.pas' {fPantallaPrincipal},
uMenuUtils in 'Utiles\uMenuUtils.pas',
uSplash in 'uSplash.pas' {SplashScreen},
@@ -12,35 +15,26 @@ uses
uNavPaneController in 'uNavPaneController.pas',
uNavPaneUtils in 'Utiles\uNavPaneUtils.pas',
uMainMenuController in 'uMainMenuController.pas',
- uClienteUtils in 'Utiles\uClienteUtils.pas';
+ uClienteUtils in 'Utiles\uClienteUtils.pas',
+ uBootStrap in 'uBootStrap.pas';
{$R *.res}
-var
- Version : String;
-
begin
Application.Initialize;
+ Application.ShowMainForm := False;
+
ReportMemoryLeaksOnShutdown := True;
// ¡¡¡Fallo en Delphi 2007!!!
// Tengo que ponerlo a false porque si no el formulario principal no se puede poner por encima de los formularios hijos.
// Luego, en el formulario principal cambio los paramátros para obligar a que aparezca el icono en la barra de tareas.
- Application.MainFormOnTaskbar := False;
- Application.Title := AppFactuGES.AppName;
+ uBootStrap.Initialize;
+ uBootStrap.Run; // <- Aquí dentro esta Application.Run
+ uBootStrap.Terminate;
-{ fActualizacion := TfActualizacion.Create(Application);
- try
- if fActualizacion.HayConfiguracion then
- fActualizacion.Actualizar;
- Version := fActualizacion.DarVersion;
- finally
- FreeAndNIL(fActualizacion);
- end;}
- Application.CreateForm(TfPantallaPrincipal, fPantallaPrincipal);
- Application.Run;
- Application.Terminate;
+ //Application.Terminate; //<- No descomentar para así ver los Memory Leaks
end.
diff --git a/Source/Cliente/FactuGES.dproj b/Source/Cliente/FactuGES.dproj
index 57a9487f..3ff7f264 100644
--- a/Source/Cliente/FactuGES.dproj
+++ b/Source/Cliente/FactuGES.dproj
@@ -45,13 +45,14 @@
$(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib;..\Modulos\Lib
$(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib;..\Modulos\Lib
$(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10;T:\COMPON~1\jcl\lib\d11\debug;$(BDSCOMMONDIR)\Dcp;..\Lib;..\Modulos\Lib
- DEBUG;
+ DEBUG;EUREKALOG;EUREKALOG_VER6
Delphi.Personality
VCLApplication
T:\Codigo (Luis Leon)\Source\Modulos\Pedidos de cliente\Controller\FalseTrueFalseC:\Archivos de programa\Borland\Delphi7\Bin\TrueFalse2220FalseFalseFalseFalseFalse30821252Rodax Software S.L.2.2.2.0FactuGESFactuGES2.1.4
+ Internet Explorer Hosting Support Package
CodeGear Control Panel Applet Package
CodeGear WebSnap Components
CodeGear SOAP Components
@@ -70,6 +71,7 @@
MainSource
+
@@ -86,7 +88,7 @@