Acana_Interiorismo/FactuGES2
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Módulo de usuarios: añadida la gestión de usuarios y perfiles.

Browse Source 
git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES2/trunk@102 f4e31baf-9722-1c47-927c-6f952f962d4b
This commit is contained in:
David Arranz 2008-01-15 12:20:25 +00:00
parent 5af8478052
commit eb8b5dd235
55 changed files with 4111 additions and 3191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Source/ApplicationBase/ApplicationBase.dpk
View File

Binary file not shown.

160
Source/ApplicationBase/ApplicationBase.dproj
View File

@ -66,6 +66,55 @@
<Excluded_Packages Name="$(BDS)\Bin\dclintraweb_90_100.bpl">VCL for the Web Design Package for CodeGear RAD Studio</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclwebsnap100.bpl">CodeGear WebSnap Components</Excluded_Packages>
@ -81,53 +130,8 @@
<DelphiCompile Include="ApplicationBase.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\Modulos\Presupuestos de cliente\adortl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\Base.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\ccpackD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cfpack_d11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxDataD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxEditorsD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxExportD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxExtEditorsD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxGridD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxIntlPrintSys3D11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxLibraryD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\cxPageControlD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\DataAbstract_Core_D11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\dbrtl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\designide.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\dsnap.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\dxGDIPlusD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\dxThemeD11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\GUIBase.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\GUISDK_D11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\Jcl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JclVcl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JSDialog100.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvAppFrmD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvCoreD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvCtrlsD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvJansD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvMMD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvPageCompsD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvStdCtrlsD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\JvSystemD11R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\pckUCDataConnector.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\pckUserControl_RT.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\PluginSDK_D10R.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\PngComponentsD10.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\PNG_D10.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\RemObjects_Core_D11.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\rtl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\tb2k_d10.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\tbx_d10.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vcl.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vclactnband.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vcldb.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vcljpg.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vclshlctrls.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\vclx.dcp" />
<DCCReference Include="..\Modulos\Presupuestos de cliente\xmlrtl.dcp" />
<DCCReference Include="Base.dcp" />
<DCCReference Include="dbrtl.dcp" />
<DCCReference Include="Ejercicios\Controller\uEjerciciosController.pas" />
<DCCReference Include="Ejercicios\Controller\View\uIEditorEjercicio.pas" />
<DCCReference Include="Ejercicios\Controller\View\uIEditorEjercicios.pas" />
@ -200,9 +204,16 @@
<Form>frViewTiendas</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="GUIBase.dcp" />
<DCCReference Include="JvJansD11R.dcp" />
<DCCReference Include="rtl.dcp" />
<DCCReference Include="uFactuGES_App.pas" />
<DCCReference Include="Usuarios\Controller\uUsuariosController.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorLogin.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorPerfilesUsuario.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorPerfilUsuario.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorUsuario.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorUsuarios.pas" />
<DCCReference Include="Usuarios\Data\uDataModuleUsuarios.pas">
<Form>DataModuleUsuarios</Form>
</DCCReference>
@ -210,12 +221,65 @@
<DCCReference Include="Usuarios\Model\Data\uIDataModuleUsuarios.pas" />
<DCCReference Include="Usuarios\Model\schUsuariosClient_Intf.pas" />
<DCCReference Include="Usuarios\Model\schUsuariosServer_Intf.pas" />
<DCCReference Include="Usuarios\Model\uUsuarios.pas" />
<DCCReference Include="Usuarios\Model\uBizUsuarios.pas" />
<DCCReference Include="Usuarios\Views\PBase.dcp" />
<DCCReference Include="Usuarios\Views\PlBase.dcp" />
<DCCReference Include="Usuarios\Views\PluBase.dcp" />
<DCCReference Include="Usuarios\Views\PlugBase.dcp" />
<DCCReference Include="Usuarios\Views\PlugiBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginSBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDKBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_Base.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_D11.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_D11Base.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_D11R.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_D11RBase.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_D1Base.dcp" />
<DCCReference Include="Usuarios\Views\PluginSDK_DBase.dcp" />
<DCCReference Include="Usuarios\Views\uEditorCambiarPassword.pas">
<Form>fEditorCambiarPassword</Form>
<DesignClass>TCustomEditor</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorLogin.pas">
<Form>fEditorLogin</Form>
<DesignClass>TCustomEditor</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorPerfilesUsuario.pas">
<Form>fEditorPerfilesUsuario</Form>
<DesignClass>TCustomEditor</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorPerfilUsuario.pas">
<Form>fEditorPerfilUsuario</Form>
<DesignClass>TCustomEditor</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorUsuario.pas">
<Form>fEditorUsuario</Form>
<DesignClass>TCustomEditor</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorUsuarios.pas">
<Form>fEditorUsuarios</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uUsuariosViewRegister.pas" />
<DCCReference Include="Usuarios\Views\uViewPerfilesUsuario.pas">
<Form>frViewPerfilesUsuario</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewPerfilUsuario.pas">
<Form>frViewPerfilUsuario</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewUsuario.pas">
<Form>frViewUsuario</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewUsuarios.pas">
<Form>frUsuarios</Form>
<DesignClass>TCustomView</DesignClass>
</DCCReference>
<DCCReference Include="vcl.dcp" />
</ItemGroup>
</Project>
<!-- EurekaLog First Line

BIN
Source/ApplicationBase/ApplicationBase.res
View File

Binary file not shown.

23
Source/ApplicationBase/Usuarios/Controller/View/uIEditorPerfilUsuario.pas Normal file
View File

@ -0,0 +1,23 @@
unit uIEditorPerfilUsuario;
interface
uses
uEditorDBBase, uBizUsuarios, uUsuariosController;
type
IEditorPerfilUsuario = interface(IEditorDBBase)
['{1DE19CC0-E4FA-4FD7-AE70-6430781CAFE4}']
function GetPerfilUsuario: IBizPerfilUsuario;
procedure SetPerfilUsuario(const Value: IBizPerfilUsuario);
property PerfilUsuario: IBizPerfilUsuario read GetPerfilUsuario write SetPerfilUsuario;
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
end;
implementation
end.

23
Source/ApplicationBase/Usuarios/Controller/View/uIEditorPerfilesUsuario.pas Normal file
View File

@ -0,0 +1,23 @@
unit uIEditorPerfilesUsuario;
interface
uses
uEditorDBBase, uBizUsuarios, uUsuariosController;
type
IEditorPerfilesUsuario = interface(IEditorDBBase)
['{A4EDC876-8290-4AFF-B307-E935CD750842}']
function GetPerfilesUsuario: IBizPerfilUsuario;
procedure SetPerfilesUsuario(const Value: IBizPerfilUsuario);
property PerfilesUsuario: IBizPerfilUsuario read GetPerfilesUsuario write SetPerfilesUsuario;
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
end;
implementation
end.

22
Source/ApplicationBase/Usuarios/Controller/View/uIEditorUsuario.pas Normal file
View File

@ -0,0 +1,22 @@
unit uIEditorUsuario;
interface
uses
uEditorDBItem, uUsuariosController, uBizUsuarios;
type
IEditorUsuario = interface(IEditorDBItem)
['{D016C4C2-F204-47AA-9327-00379CFFFB14}']
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
function GetUsuario: IBizUsuario;
procedure SetUsuario(const Value: IBizUsuario);
property Usuario: IBizUsuario read GetUsuario write SetUsuario;
end;
implementation
end.

23
Source/ApplicationBase/Usuarios/Controller/View/uIEditorUsuarios.pas Normal file
View File

@ -0,0 +1,23 @@
unit uIEditorUsuarios;
interface
uses
uEditorGridBase, uUsuariosController, uBizUsuarios;
type
IEditorUsuarios = interface(IEditorGridBase)
['{236534A8-F225-4EA0-8917-4228E530C604}']
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
function GetUsuarios: IBizUsuario;
procedure SetUsuarios(const Value: IBizUsuario);
property Usuarios: IBizUsuario read GetUsuarios write SetUsuarios;
end;
implementation
end.

657
Source/ApplicationBase/Usuarios/Controller/uUsuariosController.pas
View File

@ -5,20 +5,30 @@ interface
uses
Classes, SysUtils, Forms, uDADataTable, uControllerBase,
uIDataModuleUsuarios, uDataModuleUsuarios, UCBase;
uIDataModuleUsuarios, uDataModuleUsuarios, UCBase, uBizUsuarios;
type
TUCCriptografia = (ucStandard, ucMD5);
IUsuariosController = interface(IControllerBase)
['{DD963EEC-5880-4DE7-AF55-B5080B538D84}']
procedure Logoff;
function StartLogin : Boolean;
procedure ShowUserManager;
procedure ShowProfileManager;
procedure ShowLogManager;
procedure ShowChangePassword;
procedure VerUsuarios;
procedure VerPerfiles;
procedure VerUsuario(const AIDUser: Integer); overload;
procedure VerUsuario(AUser : IBizUsuario); overload;
procedure VerPerfil(const AIDPerfil: Integer); overload;
procedure VerPerfil(APerfil : IBizPerfilUsuario); overload;
procedure _ShowUserManager;
procedure _ShowProfileManager;
procedure _ShowLogManager;
procedure _ShowChangePassword;
function ComprobarUsuario(const User : String; const Password: String): Boolean;
procedure CambiarPassword(const AIDUser: Integer; const ANewPassword: String);
function CambiarPassword(const AIDUser: Integer): Boolean;
function GetMaxIntentosLogin: Integer;
procedure SetMaxIntentosLogin(const Value: Integer);
@ -27,8 +37,29 @@ type
function GetCurrentUser: TUCCurrentUser;
property CurrentUser: TUCCurrentUser read GetCurrentUser;
function GuardarPerfil(APerfil : IBizPerfilUsuario): Boolean;
function GuardarUsuario(AUser : IBizUsuario): Boolean;
{ procedure ChangeUser(IDUser: Integer; Login, Name, Mail: String; Profile,UserExpired,UserDaysSun: Integer; PrivUser: Boolean);
function EliminarUsuario(const AIDUser : integer): Boolean; overload;
function EliminarUsuario(AUser : IBizUsuario): Boolean; overload;
function EliminarPerfil(APerfil : IBizPerfilUsuario): Boolean; overload;
function EliminarPerfil(const AIDPerfil : integer): Boolean; overload;
function HayUsuarioConPerfil(const AIDPerfil : integer): Boolean;
function DarListaPerfilesUsuario: TStringList;
function ValidarPassword(const APassword : string; const ALogin : String;
const ANombre: String; out AMsg : String): boolean;
function NuevoUsuario : IBizUsuario;
function NuevoPerfil : IBizPerfilUsuario;
function GetCriptografia : TUCCriptografia;
property Criptografia: TUCCriptografia read GetCriptografia;
{
procedure ChangePassword(IDUser: Integer; NewPassword: String);
procedure AddRight(idUser: Integer; ItemRight: TObject; FullPath: Boolean = True); overload;
procedure AddRight(idUser: Integer; ItemRight: String); overload;
@ -45,6 +76,8 @@ type
end;
TUsuariosController = class(TControllerBase, IUsuariosController)
private
function Eliminar(const AIDUser: integer): Boolean;
protected
FDataModule : IDataModuleUsuarios;
FUserControl: TUserControl;
@ -60,22 +93,60 @@ type
procedure ComprobarUsuarioInicial;
function GetCurrentUser: TUCCurrentUser;
function AnadirUsuario(AUser : IBizUsuario): Boolean;
function ModificarUsuario(AUser : IBizUsuario): Boolean;
function AnadirPerfil(APerfil : IBizPerfilUsuario): Boolean;
function ModificarPerfil(APerfil : IBizPerfilUsuario): Boolean;
function ValidarUsuario(AUser: IBizUsuario): Boolean;
function ValidarPerfil(APerfil: IBizPerfilUsuario): Boolean;
function GetCriptografia : TUCCriptografia;
function CambiarPassword(const AIDUser: Integer; const ANewPassword: String): Boolean; overload;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Logoff;
function StartLogin : Boolean;
procedure ShowUserManager;
procedure ShowProfileManager;
procedure ShowLogManager;
procedure ShowChangePassword;
procedure VerUsuarios;
procedure VerPerfiles;
procedure VerUsuario(const AIDUser: Integer); overload;
procedure VerUsuario(AUser : IBizUsuario); overload;
procedure VerPerfil(const AIDPerfil: Integer); overload;
procedure VerPerfil(APerfil : IBizPerfilUsuario); overload;
procedure _ShowUserManager;
procedure _ShowProfileManager;
procedure _ShowLogManager;
procedure _ShowChangePassword;
function ComprobarUsuario(const User : String; const Password: String): Boolean;
procedure CambiarPassword(const AIDUser: Integer; const ANewPassword: String);
function CambiarPassword(const AIDUser: Integer): Boolean; overload;
function EliminarUsuario(const AIDUser : integer): Boolean; overload;
function EliminarUsuario(AUser : IBizUsuario): Boolean; overload;
function EliminarPerfil(APerfil : IBizPerfilUsuario): Boolean; overload;
function EliminarPerfil(const AIDPerfil : integer): Boolean; overload;
function NuevoUsuario : IBizUsuario;
function NuevoPerfil : IBizPerfilUsuario;
function GuardarPerfil(APerfil : IBizPerfilUsuario): Boolean;
function GuardarUsuario(AUser : IBizUsuario): Boolean;
function DarListaPerfilesUsuario: TStringList;
function HayUsuarioConPerfil(const AIDPerfil : integer): Boolean;
function ValidarPassword(const APassword : string; const ALogin : String;
const ANombre: String; out AMsg : String): boolean;
property UserControl : TUserControl read FUserControl;
property MaxIntentosLogin : Integer read GetMaxIntentosLogin write SetMaxIntentosLogin;
property CurrentUser: TUCCurrentUser read GetCurrentUser;
property Criptografia: TUCCriptografia read GetCriptografia;
end;
implementation
@ -83,19 +154,148 @@ implementation
uses
cxControls, DB, uEditorRegistryUtils, schUsuariosClient_Intf,
uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App, Dialogs,
uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin;
uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin,
uIEditorUsuarios, uIEditorUsuario, uIEditorPerfilesUsuario,
uIEditorPerfilUsuario, uEditorCambiarPassword;
{ TUsuariosController }
function TUsuariosController.AnadirPerfil(APerfil: IBizPerfilUsuario): Boolean;
function GetNewIdUser: Integer;
var
TempDs: TDataset;
begin
with FUserControl do
TempDS := DataConnector.UCGetSQLDataSet('SELECT ' + TableUsers.FieldUserID + ' as MaxUserID from ' + TableUsers.TableName +
' ORDER BY ' + TableUsers.FieldUserID + ' DESC');
Result := TempDs.FieldByName('MaxUserID').AsInteger + 1;
TempDS.Close;
FreeAndNil(TempDS);
end;
var
ANuevoID : Integer;
begin
Result := False;
if not Assigned(APerfil) then
raise Exception.Create('No hay perfil asignado (AnadirPerfil)');
if ValidarPerfil(APerfil) then
begin
ShowHourglassCursor;
try
ANuevoID := GetNewIdUser;
with FUserControl do
begin
DataConnector.UCExecSQL(Format('INSERT INTO %s(%s, %s, %s) Values(%d,%s,%s)',
[TableUsers.TableName,
TableUsers.FieldUserID,
TableUsers.FieldUserName,
TableUsers.FieldTypeRec,
ANuevoID,
QuotedStr(APerfil.USERNAME),
QuotedStr('P')]));
end;
Result := (ANuevoID > 0);
if Result then
begin
APerfil.Edit;
APerfil.ID := ANuevoID;
APerfil.Post;
end;
finally
HideHourglassCursor;
end;
end;
end;
function TUsuariosController.AnadirUsuario(AUser: IBizUsuario): Boolean;
var
ANuevoID : Integer;
begin
Result := False;
if not Assigned(AUser) then
raise Exception.Create('No hay usuario asignado (AnadirUsuario)');
if FUserControl.ExisteUsuario(AUser.LOGIN) then
begin
MessageDlg(Format(FUserControl.UserSettings.CommonMessages.UsuarioExiste, [AUser.LOGIN]), mtWarning, [mbOK], 0);
Exit;
end;
if ValidarUsuario(AUser) then
begin
ShowHourglassCursor;
try
ANuevoID := FUserControl.AddUser(AUser.LOGIN, AUser.PASS, AUser.USERNAME, AUser.EMAIL,
AUser.ID_PERFIL, AUser.BLOQUEADO, AUser.USERDAYSSUN, (AUser.PRIVILEGED = 1));
Result := (ANuevoID > 0);
if Result then
begin
AUser.Edit;
AUser.ID := ANuevoID;
AUser.Post;
end;
{ TODO -oLuiz -cUpgrade : Consertar a Senha para poder avisar MD5 }
{if (Assigned(MailUserControl)) and (MailUserControl.AdicionaUsuario.Ativo) then
try
MailUserControl.EnviaEmailAdicionaUsuario(vNome, vLogin, Encrypt(vNovaSenha, EncryptKey), vEmail, IntToStr(vPerfil), EncryptKey);
except
on E: Exception do
Log(E.Message, llMedio);
end;}
finally
HideHourglassCursor;
end;
end;
end;
procedure TUsuariosController.AsignarDataModule;
begin
FDataModule := TDataModuleUsuarios.Create(Nil);
end;
procedure TUsuariosController.CambiarPassword(const AIDUser: Integer;
const ANewPassword: String);
function TUsuariosController.CambiarPassword(const AIDUser: Integer;
const ANewPassword: String): Boolean;
begin
FUserControl.ChangePassword(AIDUser, ANewPassword);
Result := True;
end;
function TUsuariosController.CambiarPassword(const AIDUser: Integer) : Boolean;
var
AUser : IBizUsuario;
AEditorCambiar : TfEditorCambiarPassword;
begin
AUser := FDataModule.GetUsuario(AIDUser);
if Assigned(AUser) then
begin
AUser.Active := True;
AEditorCambiar := TfEditorCambiarPassword.Create(NIL);
with AEditorCambiar do
try
Controller := Self;
Usuario := AUser;
CambioObligatorio := False;
if (Length(Trim(AUser.PASS)) = 0) then
EditAtu.Enabled := False;
if (ShowModal = mrOk) then
Result := CambiarPassword(AIDUser, EditNova.Text);
finally
Release;
AUser.Active := False;
AUser := NIL;
end;
end;
end;
function TUsuariosController.ComprobarUsuario(const User,
@ -116,7 +316,7 @@ begin
AsignarDataModule;
FUserControl := TUserControl.Create(nil);
InicializarUserControl;
ComprobarUsuarioInicial;
// ComprobarUsuarioInicial; <- Desactivado porque casca cuando el servidor no está lanzado. Hay que arreglarlo.
end;
function TUsuariosController.CreateEditor(const AName: String; const IID: TGUID; out Intf): Boolean;
@ -124,14 +324,122 @@ begin
Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf);
end;
function TUsuariosController.DarListaPerfilesUsuario: TStringList;
var
APerfilesUsuario: IBizPerfilUsuario;
i : integer;
begin
APerfilesUsuario := FDataModule.GetPerfiles;
APerfilesUsuario.DataTable.Active := True;
Result := TStringList.Create;
try
with Result do
begin
APerfilesUsuario.DataTable.First;
while not APerfilesUsuario.DataTable.EOF do
begin
Add(Format('%s=%d', [APerfilesUsuario.USERNAME, APerfilesUsuario.ID]));
{i := Add(APerfilesUsuario.USERNAME);
ValueFromIndex[i] := IntToStr(APerfilesUsuario.ID);}
APerfilesUsuario.DataTable.Next;
end;
end;
finally
APerfilesUsuario := NIL;
end;
end;
destructor TUsuariosController.Destroy;
begin
FreeAndNIL(FUserControl);
FDataModule := NIL;
inherited;
end;
function TUsuariosController.Eliminar(const AIDUser: integer): Boolean;
begin
//
end;
function TUsuariosController.EliminarPerfil(
APerfil: IBizPerfilUsuario): Boolean;
var
CanDelete: Boolean;
ErrorMsg: String;
begin
Result := False;
if not Assigned(APerfil) then
raise Exception.Create('No hay perfil asignado (EliminarPerfil)');
if not APerfil.Active then
APerfil.Active := True;
if APerfil.DataTable.RecordCount = 0 then
Exit;
if HayUsuarioConPerfil(APerfil.ID) then
begin
//changed by fduenas: PromptDelete_WindowCaption
if MessageBox(Application.Handle, PChar(Format(FUserControl.UserSettings.UsersProfile.PromptDelete, [APerfil.USERNAME])),
PChar(FUserControl.UserSettings.UsersProfile.PromptDelete_WindowCaption), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> idYes then
Exit;
end;
CanDelete := True;
if Assigned(FUserControl.onDeleteProfile) then
FUserControl.onDeleteProfile(NIL, APerfil.ID, CanDelete, ErrorMsg);
if not CanDelete then
begin
MessageDlg(ErrorMSG, mtWarning, [mbOK], 0);
Exit;
end;
with FUserControl do
begin
DataConnector.UCExecSQL('Delete from ' + TableUsers.TableName + ' where ' + TableUsers.FieldUserID + ' = ' + IntToStr(APerfil.ID));
DataConnector.UCExecSQL('Delete from ' + TableRights.TableName + ' where ' + TableRights.FieldUserID + ' = ' + IntToStr(APerfil.ID));
DataConnector.UCExecSQL('Delete from ' + TableRights.TableName + 'EX where ' + TableRights.FieldUserID + ' = ' + IntToStr(APerfil.ID));
DataConnector.UCExecSQL('Update ' + TableUsers.TableName +
' Set ' + TableUsers.FieldProfile + ' = null where ' + TableUsers.FieldUserID + ' = ' + IntToStr(APerfil.ID));
end;
Result := True;
end;
function TUsuariosController.EliminarPerfil(const AIDPerfil: integer): Boolean;
begin
Result := EliminarPerfil(FDataModule.GetPerfil(AIDPerfil));
end;
function TUsuariosController.EliminarUsuario(AUser: IBizUsuario): Boolean;
begin
if not Assigned(AUser) then
raise Exception.Create('No hay usuario asignado (EliminarUsuario)');
if not AUser.Active then
AUser.Active := True;
if AUser.DataTable.RecordCount > 0 then
Result := EliminarUsuario(AUser.ID);
end;
function TUsuariosController.EliminarUsuario(const AIDUser: integer): Boolean;
begin
FUserControl.DataConnector.UCExecSQL('Delete from ' + FUserControl.TableRights.TableName + ' where ' + FUserControl.TableRights.FieldUserID + ' = ' + IntToStr(AIDUser));
FUserControl.DataConnector.UCExecSQL('Delete from ' + FUserControl.TableUsers.TableName + ' where ' + FUserControl.TableUsers.FieldUserID + ' = ' + IntToStr(AIDUser));
Result := True;
end;
function TUsuariosController.GetCriptografia: TUCCriptografia;
begin
case FUserControl.Criptografia of
cPadrao: Result := ucStandard;
cMD5: Result := ucMD5;
end;
end;
function TUsuariosController.GetCurrentUser: TUCCurrentUser;
begin
Result := FUserControl.CurrentUser;
@ -142,6 +450,52 @@ begin
Result := FUserControl.Login.MaxLoginAttempts;
end;
function TUsuariosController.GuardarPerfil(APerfil: IBizPerfilUsuario): Boolean;
begin
Result := False;
if not Assigned(APerfil) then
raise Exception.Create('No hay perfil asignado (GuardarPerfil)');
if APerfil.EsNuevo then
Result := AnadirPerfil(APerfil)
else
Result := ModificarPerfil(APerfil);
end;
function TUsuariosController.GuardarUsuario(AUser: IBizUsuario): Boolean;
begin
Result := False;
if not Assigned(AUser) then
raise Exception.Create('No hay usuario asignado (GuardarUsuario)');
if AUser.EsNuevo then
Result := AnadirUsuario(AUser)
else
Result := ModificarUsuario(AUser);
end;
function TUsuariosController.HayUsuarioConPerfil(
const AIDPerfil: integer): Boolean;
var
TempDS: TDataset;
begin
Result := False;
try
TempDS := FUserControl.DataConnector.UCGetSQLDataset('Select ' + FUserControl.TableUsers.FieldUserID + ' as IdUser from ' +
FUserControl.TableUsers.TableName +
' Where ' + FUserControl.TableUsers.FieldTypeRec + ' = ' + QuotedStr('U') +
' AND ' + FUserControl.TableUsers.FieldProfile + ' = ' + IntToStr(AIDPerfil));
Result := (TempDS.FieldByName('IdUser').AsInteger > 0);
TempDS.Close;
finally
FreeAndNil(TempDS);
end;
end;
procedure TUsuariosController.InicializarUserControl;
begin
with FUserControl do
@ -151,6 +505,8 @@ begin
Criptografia := cMD5;
CheckValidationKey := True;
Login.MaxLoginAttempts := 3;
UserPasswordChange.ForcePassword := True;
UserPasswordChange.MinPasswordLength := 3;
end;
FDataModule.InicializarUserControl(FUserControl);
end;
@ -160,6 +516,90 @@ begin
FUserControl.Logoff;
end;
function TUsuariosController.ModificarPerfil(
APerfil: IBizPerfilUsuario): Boolean;
begin
Result := False;
if not Assigned(APerfil) then
raise Exception.Create('No hay perfil asignado (ModificarPerfil)');
if ValidarPerfil(APerfil) then
begin
ShowHourglassCursor;
try
with FUserControl do
begin
DataConnector.UCExecSQL(Format('UPDATE %s SET %s = %s WHERE %s = %d',
[TableUsers.TableName,
TableUsers.FieldUserName,
QuotedStr(APerfil.USERNAME),
TableUsers.FieldUserID,
APerfil.ID]));
end;
Result := True;
finally
HideHourglassCursor;
end;
end;
end;
function TUsuariosController.ModificarUsuario(AUser: IBizUsuario): Boolean;
begin
Result := False;
if not Assigned(AUser) then
raise Exception.Create('No hay usuario asignado (ModificarUsuario)');
if ValidarUsuario(AUser) then
begin
ShowHourglassCursor;
try
FUserControl.ChangeUser(AUser.ID, AUser.LOGIN, AUser.USERNAME, AUser.EMAIL,
AUser.ID_PERFIL, AUser.BLOQUEADO , AUser.USERDAYSSUN, (AUser.PRIVILEGED = 1));
Result := True;
{ TODO -oLuiz -cUpgrade : Consertar a Senha para poder avisar MD5 }
{if (Assigned(MailUserControl)) and (MailUserControl.AlteraUsuario.Ativo) then
try
MailUserControl.EnviaEmailAlteraUsuario(vNome,
vLogin,
TfrmCadastrarUsuario(Self.Owner).FDataSetCadastroUsuario.FieldByName('SENHA').AsString,
vEmail,
IntToStr(vPerfil),
EncryptKey);
except
on E: Exception do
Log(E.Message, 2);
end;}
finally
HideHourglassCursor;
end;
end;
end;
function TUsuariosController.NuevoPerfil: IBizPerfilUsuario;
var
APerfil : IBizPerfilUsuario;
begin
APerfil := FDataModule.NuevoPerfil;
APerfil.DataTable.Active := True;
APerfil.Insert;
Result := APerfil;
end;
function TUsuariosController.NuevoUsuario: IBizUsuario;
var
AUsuario : IBizUsuario;
begin
AUsuario := FDataModule.NuevoUsuario;
AUsuario.DataTable.Active := True;
AUsuario.Insert;
Result := AUsuario;
end;
procedure TUsuariosController.RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable);
begin
inherited;
@ -171,22 +611,195 @@ begin
FUserControl.Login.MaxLoginAttempts := Value;
end;
procedure TUsuariosController.ShowChangePassword;
procedure TUsuariosController._ShowChangePassword;
begin
FUserControl.ShowChangePassword;
end;
procedure TUsuariosController.ShowLogManager;
procedure TUsuariosController._ShowLogManager;
begin
FUserControl.ShowLogManager;
end;
procedure TUsuariosController.ShowProfileManager;
procedure TUsuariosController._ShowProfileManager;
begin
FUserControl.ShowProfileManager;
end;
procedure TUsuariosController.ShowUserManager;
function TUsuariosController.ValidarPassword(const APassword : string;
const ALogin : String; const ANombre: String; out AMsg : String): boolean;
begin
Result := False;
AMsg := '';
if (FUserControl.UserPasswordChange.ForcePassword) and (Length(Trim(APassword)) = 0) then
AMsg := FUserControl.UserSettings.CommonMessages.ChangePasswordError.PasswordRequired
else
if (Length(Trim(APassword)) < FUserControl.UserPasswordChange.MinPasswordLength) then
AMsg := Format(FUserControl.UserSettings.CommonMessages.ChangePasswordError.MinPasswordLength, [FUserControl.UserPasswordChange.MinPasswordLength])
else
if Pos(LowerCase(APassword), 'abcdeasdfqwerzxcv1234567890321654987test' + LowerCase(ALogin) + LowerCase(AMsg)) > 0 then
AMsg := FUserControl.UserSettings.CommonMessages.ChangePasswordError.InvalidNewPassword
else
Result := true;
end;
function TUsuariosController.ValidarPerfil(APerfil: IBizPerfilUsuario): Boolean;
begin
Result := False;
if not Assigned(APerfil) then
raise Exception.Create ('Perfil no asignado (ValidarPerfil)');
if (APerfil.DataTable.State in dsEditModes) then
APerfil.DataTable.Post;
if Length(APerfil.USERNAME) = 0 then
raise Exception.Create('Debe indicar el nombre del perfil.');
Result := True;
end;
function TUsuariosController.ValidarUsuario(AUser: IBizUsuario): Boolean;
begin
Result := False;
if not Assigned(AUser) then
raise Exception.Create ('Usuario no asignado (ValidarUsuario)');
if (AUser.DataTable.State in dsEditModes) then
AUser.DataTable.Post;
if Length(AUser.USERNAME) = 0 then
raise Exception.Create('Debe indicar el nombre completo del usuario.');
if Length(AUser.LOGIN) = 0 then
raise Exception.Create('Debe indicar un login para el usuario.');
Result := True;
end;
procedure TUsuariosController.VerPerfil(const AIDPerfil: Integer);
var
FPerfil : IBizPerfilUsuario;
begin
FPerfil := FDataModule.GetPerfil(AIDPerfil);
VerPerfil(FPerfil);
end;
procedure TUsuariosController.VerPerfil(APerfil: IBizPerfilUsuario);
var
AEditor : IEditorPerfilUsuario;
begin
if not Assigned(APerfil) then
raise Exception.Create('Perfil no asignado (VerPerfil)');
APerfil.Active := True;
ShowHourglassCursor;
try
CreateEditor('EditorPerfilUsuario', IEditorPerfilUsuario, AEditor);
if Assigned(AEditor) then
with (AEditor as IEditorPerfilUsuario) do
begin
Controller := Self; //OJO ORDEN MUY IMPORTANTE
PerfilUsuario := APerfil;
ShowModal;
Release;
end;
finally
AEditor := NIL;
HideHourglassCursor;
end;
end;
procedure TUsuariosController.VerPerfiles;
var
AEditor : IEditorPerfilesUsuario;
APerfilesUsuario: IBizPerfilUsuario;
begin
APerfilesUsuario := FDataModule.GetPerfiles;
if Assigned(APerfilesUsuario) then
begin
APerfilesUsuario.Active := True;
ShowHourglassCursor;
try
CreateEditor('EditorPerfilesUsuario', IEditorPerfilesUsuario, AEditor);
if Assigned(AEditor) then
with (AEditor as IEditorPerfilesUsuario) do
begin
Controller := Self; //OJO ORDEN MUY IMPORTANTE
PerfilesUsuario := APerfilesUsuario;
ShowEmbedded;
end;
finally
AEditor := NIL;
APerfilesUsuario := NIL;
HideHourglassCursor;
end;
end;
end;
procedure TUsuariosController.VerUsuario(const AIDUser: Integer);
var
FUsuario : IBizUsuario;
begin
FUsuario := FDataModule.GetUsuario(AIDUser);
VerUsuario(FUsuario);
end;
procedure TUsuariosController.VerUsuario(AUser: IBizUsuario);
var
AEditor : IEditorUsuario;
begin
if not Assigned(AUser) then
raise Exception.Create('Usuario no asignado (VerUsuario)');
AUser.Active := True;
ShowHourglassCursor;
try
CreateEditor('EditorUsuario', IEditorUsuario, AEditor);
if Assigned(AEditor) then
with (AEditor as IEditorUsuario) do
begin
Controller := Self; //OJO ORDEN MUY IMPORTANTE
Usuario := AUser;
ShowModal;
Release;
end;
finally
AEditor := NIL;
HideHourglassCursor;
end;
end;
procedure TUsuariosController.VerUsuarios;
var
AEditor : IEditorUsuarios;
FUsuarios : IBizUsuario;
begin
FUsuarios := FDataModule.GetUsuarios;
if Assigned(FUsuarios) then
begin
FUsuarios.Active := True;
ShowHourglassCursor;
try
CreateEditor('EditorUsuarios', IEditorUsuarios, AEditor);
if Assigned(AEditor) then
with (AEditor as IEditorUsuarios) do
begin
Controller := Self; //OJO ORDEN MUY IMPORTANTE
Usuarios := FUsuarios;
ShowEmbedded;
end;
finally
AEditor := NIL;
FUsuarios := NIL;
HideHourglassCursor;
end;
end;
end;
procedure TUsuariosController._ShowUserManager;
begin
FUserControl.ShowUserManager;
end;

166
Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.dfm
View File

@ -1,11 +1,13 @@
inherited DataModuleUsuarios: TDataModuleUsuarios
Height = 179
OnCreate = DataModuleCreate
Height = 284
Width = 468
object srvUsuarios: TRORemoteService
Message = dmConexion.ROMessage
Channel = dmConexion.ROChannel
ServiceName = 'srvUsuarios'
Left = 40
Top = 72
Top = 80
end
object UCSettingsSpanish: TUCSettings
AppMessages.MsgsForm_BtNew = '&Nuevo Mensaje'
@ -261,4 +263,164 @@ inherited DataModuleUsuarios: TDataModuleUsuarios
Left = 40
Top = 16
end
object rda_Usuarios: TDARemoteDataAdapter
GetSchemaCall.RemoteService = srvUsuarios
GetDataCall.RemoteService = srvUsuarios
UpdateDataCall.RemoteService = srvUsuarios
GetScriptsCall.RemoteService = srvUsuarios
RemoteService = srvUsuarios
DataStreamer = Bin2DataStreamer
Left = 176
Top = 16
end
object Bin2DataStreamer: TDABin2DataStreamer
Left = 40
Top = 144
end
object tbl_USUARIOS: TDAMemDataTable
RemoteUpdatesOptions = []
Fields = <
item
Name = 'ID'
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
Required = True
DictionaryEntry = 'USUARIOS_ID'
InPrimaryKey = True
end
item
Name = 'USERNAME'
DataType = datString
Size = 30
DisplayLabel = 'Nombre'
DictionaryEntry = 'USUARIOS_USERNAME'
end
item
Name = 'LOGIN'
DataType = datString
Size = 30
DisplayLabel = 'Login'
DictionaryEntry = 'USUARIOS_LOGIN'
end
item
Name = 'PASS'
DataType = datString
Size = 250
DisplayLabel = 'Password'
DictionaryEntry = 'USUARIOS_PASS'
end
item
Name = 'PASSEXPIRED'
DataType = datDateTime
DisplayLabel = 'Expiraci'#243'n de password'
DictionaryEntry = 'USUARIOS_PASSEXPIRED'
end
item
Name = 'BLOQUEADO'
DataType = datSmallInt
DisplayLabel = 'Bloqueado'
DictionaryEntry = 'USUARIOS_BLOQUEADO'
end
item
Name = 'EMAIL'
DataType = datString
Size = 150
DisplayLabel = 'Correo electr'#243'nico'
DictionaryEntry = 'USUARIOS_EMAIL'
end
item
Name = 'USERDAYSSUN'
DataType = datInteger
DisplayLabel = 'USUARIOS_USERDAYSSUN'
DictionaryEntry = 'USUARIOS_USERDAYSSUN'
end
item
Name = 'PRIVILEGED'
DataType = datInteger
DisplayLabel = 'Privilegiado'
DictionaryEntry = 'USUARIOS_PRIVILEGED'
end
item
Name = 'TIPO'
DataType = datString
Size = 1
DisplayLabel = 'Tipo'
DictionaryEntry = 'USUARIOS_TIPO'
end
item
Name = 'ID_PERFIL'
DataType = datInteger
DictionaryEntry = 'USUARIOS_ID_PERFIL'
end
item
Name = 'CHECKSUM'
DataType = datString
Size = 250
DisplayLabel = 'Checksum'
DictionaryEntry = 'USUARIOS_CHECKSUM'
end>
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
Top = 80
end
object ds_USUARIOS: TDADataSource
DataSet = tbl_USUARIOS.Dataset
DataTable = tbl_USUARIOS
Left = 176
Top = 136
end
object tbl_PERFILES: TDAMemDataTable
RemoteUpdatesOptions = []
Fields = <
item
Name = 'ID'
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
Required = True
DictionaryEntry = 'PERFILES_ID'
InPrimaryKey = True
end
item
Name = 'USERNAME'
DataType = datString
Size = 30
DisplayLabel = 'Nombre'
DictionaryEntry = 'PERFILES_USERNAME'
end
item
Name = 'LOGIN'
DataType = datString
Size = 30
DisplayLabel = 'Login'
DictionaryEntry = 'PERFILES_LOGIN'
end
item
Name = 'TIPO'
DataType = datString
Size = 1
DisplayLabel = 'Tipo'
DictionaryEntry = 'PERFILES_TIPO'
end>
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
Top = 80
end
object ds_PERFILES: TDADataSource
DataSet = tbl_PERFILES.Dataset
DataTable = tbl_PERFILES
Left = 272
Top = 136
end
end

103
Source/ApplicationBase/Usuarios/Data/uDataModuleUsuarios.pas
View File

@ -8,17 +8,32 @@ uses
UCBase, UCDataConnector, uUCROConn, uDARemoteDataAdapter,
uDARemoteCommand, uROClient, uRORemoteService, uDADataStreamer,
uDABin2DataStreamer, uDAScriptingProvider, uIDataModuleUsuarios, UCSettings,
uDataModuleBase;
uDataModuleBase, uDAInterfaces, uDAMemDataTable, uBizUsuarios;
type
TDataModuleUsuarios = class(TDataModuleBase, IDataModuleUsuarios)
srvUsuarios: TRORemoteService;
UCSettingsSpanish: TUCSettings;
rda_Usuarios: TDARemoteDataAdapter;
Bin2DataStreamer: TDABin2DataStreamer;
tbl_USUARIOS: TDAMemDataTable;
ds_USUARIOS: TDADataSource;
tbl_PERFILES: TDAMemDataTable;
ds_PERFILES: TDADataSource;
procedure DataModuleCreate(Sender: TObject);
private
procedure InicializarCamposUserControl(AUserControl: TUserControl);
procedure InicializarSettingsUserControl(AUserControl: TUserControl);
function CreateConnectorInstance : TUCDataConnector;
public
function GetUsuario(const ID : Integer) : IBizUsuario;
function NuevoUsuario : IBizUsuario;
function GetUsuarios : IBizUsuario;
function NuevoPerfil : IBizPerfilUsuario;
function GetPerfiles : IBizPerfilUsuario;
function GetPerfil (const ID : Integer) : IBizPerfilUsuario;
procedure InicializarUserControl (AUserControl : TUserControl);
end;
@ -29,10 +44,10 @@ implementation
uses
Forms, Controls, uDataTableUtils, uDataModuleConexion,
Dialogs, Windows, uEmpresasController,
Dialogs, Windows, uEmpresasController, cxControls,
schUsuariosClient_Intf;
{ TDAClientDataModule1 }
{ TDataModuleUsuarios }
function TDataModuleUsuarios.CreateConnectorInstance: TUCDataConnector;
begin
@ -47,6 +62,87 @@ begin
end;
end;
function TDataModuleUsuarios.NuevoPerfil: IBizPerfilUsuario;
begin
Result := GetPerfil(ID_NULO)
end;
function TDataModuleUsuarios.NuevoUsuario: IBizUsuario;
begin
Result := GetUsuario(ID_NULO)
end;
procedure TDataModuleUsuarios.DataModuleCreate(Sender: TObject);
begin
inherited;
srvUsuarios.Channel := dmConexion.Channel;
srvUsuarios.Message := dmConexion.Message;
end;
function TDataModuleUsuarios.GetPerfil(const ID: Integer): IBizPerfilUsuario;
begin
ShowHourglassCursor;
try
Result := Self.GetPerfiles;
with Result.DataTable.DynamicWhere do
begin
Clear;
// (ID = :ID)
Expression := NewBinaryExpression(NewField('', fld_PERFILESID), NewConstant(ID, datInteger), dboEqual);
end;
finally
HideHourglassCursor;
end;
end;
function TDataModuleUsuarios.GetPerfiles: IBizPerfilUsuario;
var
AUsuarios : TDAMemDataTable;
begin
ShowHourglassCursor;
try
AUsuarios := CloneDataTable(tbl_PERFILES);
AUsuarios.BusinessRulesID := BIZ_CLIENT_PERFIL_USUARIO;
Result := (AUsuarios as IBizPerfilUsuario);
finally
HideHourglassCursor;
end;
end;
function TDataModuleUsuarios.GetUsuario(const ID: Integer): IBizUsuario;
begin
ShowHourglassCursor;
try
Result := Self.GetUsuarios;
with Result.DataTable.DynamicWhere do
begin
Clear;
// (ID = :ID)
Expression := NewBinaryExpression(NewField('', fld_USUARIOSID), NewConstant(ID, datInteger), dboEqual);
end;
finally
HideHourglassCursor;
end;
end;
function TDataModuleUsuarios.GetUsuarios: IBizUsuario;
var
AUsuarios : TDAMemDataTable;
begin
ShowHourglassCursor;
try
AUsuarios := CloneDataTable(tbl_Usuarios);
AUsuarios.BusinessRulesID := BIZ_CLIENT_USUARIO;
Result := (AUsuarios as IBizUsuario);
finally
HideHourglassCursor;
end;
end;
procedure TDataModuleUsuarios.InicializarCamposUserControl(
AUserControl: TUserControl);
begin
@ -361,4 +457,5 @@ begin
end;
end;
end.

15
Source/ApplicationBase/Usuarios/Model/Data/uIDataModuleUsuarios.pas
View File

@ -3,14 +3,23 @@ unit uIDataModuleUsuarios;
interface
uses
UCBase, UCSettings;
UCBase, UCSettings, uBizUsuarios;
type
IDataModuleUsuarios = interface
['{35907569-6900-4567-91AC-4EAC14F3D43B}']
procedure InicializarUserControl (AUserControl : TUserControl);
['{C0A8481F-4920-414D-A906-EE1EB18DE946}']
procedure InicializarUserControl (AUserControl : TUserControl);
function GetUsuario(const ID : Integer) : IBizUsuario;
function NuevoUsuario : IBizUsuario;
function GetUsuarios : IBizUsuario;
function NuevoPerfil : IBizPerfilUsuario;
function GetPerfiles : IBizPerfilUsuario;
function GetPerfil(const ID : Integer) : IBizPerfilUsuario;
end;
implementation
end.

202
Source/ApplicationBase/Usuarios/Model/schUsuariosClient_Intf.pas
View File

@ -9,11 +9,12 @@ const
{ Data table rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_USUARIOS = '{1A97AED1-832A-46A9-9894-8CB44D7AFBBD}';
RID_USUARIOS_EVENTOS = '{16F186E3-A7CF-40DD-B040-EB735A5F1FDD}';
RID_USUARIOS_LOGON = '{8005FBCF-1276-473D-A3BE-15C8159AB6CE}';
RID_PERMISOS = '{802AF8DD-DA72-412A-AB43-4D5F0EA5630F}';
RID_PERMISOSEX = '{B2319D8E-0423-41D1-B166-7BD9EC069549}';
RID_USUARIOS = '{CFE175CF-EB6D-4BF8-91B4-F0140B57453E}';
RID_USUARIOS_EVENTOS = '{6013DEA6-697A-4A8C-8D92-51677BB6F39F}';
RID_USUARIOS_LOGON = '{C666C96E-401A-4FB5-A0E2-F3DB7BAB5F3D}';
RID_PERMISOS = '{02CCB513-8F98-406C-ADAC-21C189AABA29}';
RID_PERMISOSEX = '{B8D57BF7-0B57-4A0B-8F9E-12E87D0B6B60}';
RID_PERFILES = '{0AF2374A-D201-4B82-BB13-07265E1BAEBE}';
{ Data table names }
nme_USUARIOS = 'USUARIOS';
@ -21,6 +22,7 @@ const
nme_USUARIOS_LOGON = 'USUARIOS_LOGON';
nme_PERMISOS = 'PERMISOS';
nme_PERMISOSEX = 'PERMISOSEX';
nme_PERFILES = 'PERFILES';
{ USUARIOS fields }
fld_USUARIOSID = 'ID';
@ -112,10 +114,22 @@ const
idx_PERMISOSEXNOMBREFORM = 3;
idx_PERMISOSEXCHECKSUM = 4;
{ PERFILES fields }
fld_PERFILESID = 'ID';
fld_PERFILESUSERNAME = 'USERNAME';
fld_PERFILESLOGIN = 'LOGIN';
fld_PERFILESTIPO = 'TIPO';
{ PERFILES field indexes }
idx_PERFILESID = 0;
idx_PERFILESUSERNAME = 1;
idx_PERFILESLOGIN = 2;
idx_PERFILESTIPO = 3;
type
{ IUSUARIOS }
IUSUARIOS = interface(IDAStronglyTypedDataTable)
['{F248A54E-1181-40E9-B9B4-9A1D9F4DA382}']
['{12D98238-4C08-4CB7-BAD1-1E2827ADE7A7}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -282,7 +296,7 @@ type
{ IUSUARIOS_EVENTOS }
IUSUARIOS_EVENTOS = interface(IDAStronglyTypedDataTable)
['{8E5D7E37-04E5-4395-8B3E-E0757F5675B4}']
['{54DEE63E-4D88-43D8-8D34-1F51030428DE}']
{ Property getters and setters }
function GetAPLICACIONValue: String;
procedure SetAPLICACIONValue(const aValue: String);
@ -413,7 +427,7 @@ type
{ IUSUARIOS_LOGON }
IUSUARIOS_LOGON = interface(IDAStronglyTypedDataTable)
['{FF8C8388-9397-4FA2-AB70-491B8299DC00}']
['{D98BF482-EFA8-49ED-894A-E7774859C830}']
{ Property getters and setters }
function GetLOGONIDValue: String;
procedure SetLOGONIDValue(const aValue: String);
@ -496,7 +510,7 @@ type
{ IPERMISOS }
IPERMISOS = interface(IDAStronglyTypedDataTable)
['{7705D3E7-EC27-4CB7-9492-1873D2158F79}']
['{076A52A0-4BD5-4617-80DB-69BB4B4C4E4E}']
{ Property getters and setters }
function GetID_USUARIOValue: Integer;
procedure SetID_USUARIOValue(const aValue: Integer);
@ -567,7 +581,7 @@ type
{ IPERMISOSEX }
IPERMISOSEX = interface(IDAStronglyTypedDataTable)
['{1636E92E-3A74-4F5F-AF20-5831B0D57A38}']
['{5778D823-11A3-4B43-8336-FB2ACBBCFCE5}']
{ Property getters and setters }
function GetID_USUARIOValue: Integer;
procedure SetID_USUARIOValue(const aValue: Integer);
@ -648,6 +662,77 @@ type
end;
{ IPERFILES }
IPERFILES = interface(IDAStronglyTypedDataTable)
['{44741F58-0B27-462C-BA49-A6944FFA7BAC}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
function GetIDIsNull: Boolean;
procedure SetIDIsNull(const aValue: Boolean);
function GetUSERNAMEValue: String;
procedure SetUSERNAMEValue(const aValue: String);
function GetUSERNAMEIsNull: Boolean;
procedure SetUSERNAMEIsNull(const aValue: Boolean);
function GetLOGINValue: String;
procedure SetLOGINValue(const aValue: String);
function GetLOGINIsNull: Boolean;
procedure SetLOGINIsNull(const aValue: Boolean);
function GetTIPOValue: String;
procedure SetTIPOValue(const aValue: String);
function GetTIPOIsNull: Boolean;
procedure SetTIPOIsNull(const aValue: Boolean);
{ Properties }
property ID: Integer read GetIDValue write SetIDValue;
property IDIsNull: Boolean read GetIDIsNull write SetIDIsNull;
property USERNAME: String read GetUSERNAMEValue write SetUSERNAMEValue;
property USERNAMEIsNull: Boolean read GetUSERNAMEIsNull write SetUSERNAMEIsNull;
property LOGIN: String read GetLOGINValue write SetLOGINValue;
property LOGINIsNull: Boolean read GetLOGINIsNull write SetLOGINIsNull;
property TIPO: String read GetTIPOValue write SetTIPOValue;
property TIPOIsNull: Boolean read GetTIPOIsNull write SetTIPOIsNull;
end;
{ TPERFILESDataTableRules }
TPERFILESDataTableRules = class(TIntfObjectDADataTableRules, IPERFILES)
private
protected
{ Property getters and setters }
function GetIDValue: Integer; virtual;
procedure SetIDValue(const aValue: Integer); virtual;
function GetIDIsNull: Boolean; virtual;
procedure SetIDIsNull(const aValue: Boolean); virtual;
function GetUSERNAMEValue: String; virtual;
procedure SetUSERNAMEValue(const aValue: String); virtual;
function GetUSERNAMEIsNull: Boolean; virtual;
procedure SetUSERNAMEIsNull(const aValue: Boolean); virtual;
function GetLOGINValue: String; virtual;
procedure SetLOGINValue(const aValue: String); virtual;
function GetLOGINIsNull: Boolean; virtual;
procedure SetLOGINIsNull(const aValue: Boolean); virtual;
function GetTIPOValue: String; virtual;
procedure SetTIPOValue(const aValue: String); virtual;
function GetTIPOIsNull: Boolean; virtual;
procedure SetTIPOIsNull(const aValue: Boolean); virtual;
{ Properties }
property ID: Integer read GetIDValue write SetIDValue;
property IDIsNull: Boolean read GetIDIsNull write SetIDIsNull;
property USERNAME: String read GetUSERNAMEValue write SetUSERNAMEValue;
property USERNAMEIsNull: Boolean read GetUSERNAMEIsNull write SetUSERNAMEIsNull;
property LOGIN: String read GetLOGINValue write SetLOGINValue;
property LOGINIsNull: Boolean read GetLOGINIsNull write SetLOGINIsNull;
property TIPO: String read GetTIPOValue write SetTIPOValue;
property TIPOIsNull: Boolean read GetTIPOIsNull write SetTIPOIsNull;
public
constructor Create(aDataTable: TDADataTable); override;
destructor Destroy; override;
end;
implementation
uses Variants, uROBinaryHelpers;
@ -1454,11 +1539,108 @@ begin
end;
{ TPERFILESDataTableRules }
constructor TPERFILESDataTableRules.Create(aDataTable: TDADataTable);
begin
inherited;
end;
destructor TPERFILESDataTableRules.Destroy;
begin
inherited;
end;
function TPERFILESDataTableRules.GetIDValue: Integer;
begin
result := DataTable.Fields[idx_PERFILESID].AsInteger;
end;
procedure TPERFILESDataTableRules.SetIDValue(const aValue: Integer);
begin
DataTable.Fields[idx_PERFILESID].AsInteger := aValue;
end;
function TPERFILESDataTableRules.GetIDIsNull: boolean;
begin
result := DataTable.Fields[idx_PERFILESID].IsNull;
end;
procedure TPERFILESDataTableRules.SetIDIsNull(const aValue: Boolean);
begin
if aValue then
DataTable.Fields[idx_PERFILESID].AsVariant := Null;
end;
function TPERFILESDataTableRules.GetUSERNAMEValue: String;
begin
result := DataTable.Fields[idx_PERFILESUSERNAME].AsString;
end;
procedure TPERFILESDataTableRules.SetUSERNAMEValue(const aValue: String);
begin
DataTable.Fields[idx_PERFILESUSERNAME].AsString := aValue;
end;
function TPERFILESDataTableRules.GetUSERNAMEIsNull: boolean;
begin
result := DataTable.Fields[idx_PERFILESUSERNAME].IsNull;
end;
procedure TPERFILESDataTableRules.SetUSERNAMEIsNull(const aValue: Boolean);
begin
if aValue then
DataTable.Fields[idx_PERFILESUSERNAME].AsVariant := Null;
end;
function TPERFILESDataTableRules.GetLOGINValue: String;
begin
result := DataTable.Fields[idx_PERFILESLOGIN].AsString;
end;
procedure TPERFILESDataTableRules.SetLOGINValue(const aValue: String);
begin
DataTable.Fields[idx_PERFILESLOGIN].AsString := aValue;
end;
function TPERFILESDataTableRules.GetLOGINIsNull: boolean;
begin
result := DataTable.Fields[idx_PERFILESLOGIN].IsNull;
end;
procedure TPERFILESDataTableRules.SetLOGINIsNull(const aValue: Boolean);
begin
if aValue then
DataTable.Fields[idx_PERFILESLOGIN].AsVariant := Null;
end;
function TPERFILESDataTableRules.GetTIPOValue: String;
begin
result := DataTable.Fields[idx_PERFILESTIPO].AsString;
end;
procedure TPERFILESDataTableRules.SetTIPOValue(const aValue: String);
begin
DataTable.Fields[idx_PERFILESTIPO].AsString := aValue;
end;
function TPERFILESDataTableRules.GetTIPOIsNull: boolean;
begin
result := DataTable.Fields[idx_PERFILESTIPO].IsNull;
end;
procedure TPERFILESDataTableRules.SetTIPOIsNull(const aValue: Boolean);
begin
if aValue then
DataTable.Fields[idx_PERFILESTIPO].AsVariant := Null;
end;
initialization
RegisterDataTableRules(RID_USUARIOS, TUSUARIOSDataTableRules);
RegisterDataTableRules(RID_USUARIOS_EVENTOS, TUSUARIOS_EVENTOSDataTableRules);
RegisterDataTableRules(RID_USUARIOS_LOGON, TUSUARIOS_LOGONDataTableRules);
RegisterDataTableRules(RID_PERMISOS, TPERMISOSDataTableRules);
RegisterDataTableRules(RID_PERMISOSEX, TPERMISOSEXDataTableRules);
RegisterDataTableRules(RID_PERFILES, TPERFILESDataTableRules);
end.

228
Source/ApplicationBase/Usuarios/Model/schUsuariosServer_Intf.pas
View File

@ -9,16 +9,17 @@ const
{ Delta rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_USUARIOSDelta = '{30AE63B9-1580-4117-9B4F-448F309BD6AC}';
RID_USUARIOS_EVENTOSDelta = '{81DD56BF-BBB5-4311-9AF3-E72EF8B5EC32}';
RID_USUARIOS_LOGONDelta = '{BE275431-94DF-4C1C-83D0-C09B4E0DA9D9}';
RID_PERMISOSDelta = '{F99C6E2E-FE0E-4943-9B69-37B2F48AF314}';
RID_PERMISOSEXDelta = '{43B62FCB-7C4A-4F3A-9F77-85339308E91A}';
RID_USUARIOSDelta = '{D0217428-91FB-4128-8A0D-AF4A8A742D5A}';
RID_USUARIOS_EVENTOSDelta = '{16B87039-04DC-47AD-81D6-E8648C69A484}';
RID_USUARIOS_LOGONDelta = '{856F2E25-24EE-43BB-94F5-70DD65E4FD02}';
RID_PERMISOSDelta = '{DB34A951-27E2-4A70-843F-9C41FF29179D}';
RID_PERMISOSEXDelta = '{F40FC2C9-2DFF-4B12-8EE6-DAD609901516}';
RID_PERFILESDelta = '{07C28883-A52C-4111-ABBE-14E908E7C705}';
type
{ IUSUARIOSDelta }
IUSUARIOSDelta = interface(IUSUARIOS)
['{30AE63B9-1580-4117-9B4F-448F309BD6AC}']
['{D0217428-91FB-4128-8A0D-AF4A8A742D5A}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldUSERNAMEValue : String;
@ -184,7 +185,7 @@ type
{ IUSUARIOS_EVENTOSDelta }
IUSUARIOS_EVENTOSDelta = interface(IUSUARIOS_EVENTOS)
['{81DD56BF-BBB5-4311-9AF3-E72EF8B5EC32}']
['{16B87039-04DC-47AD-81D6-E8648C69A484}']
{ Property getters and setters }
function GetOldAPLICACIONValue : String;
function GetOldID_USUARIOValue : Integer;
@ -315,7 +316,7 @@ type
{ IUSUARIOS_LOGONDelta }
IUSUARIOS_LOGONDelta = interface(IUSUARIOS_LOGON)
['{BE275431-94DF-4C1C-83D0-C09B4E0DA9D9}']
['{856F2E25-24EE-43BB-94F5-70DD65E4FD02}']
{ Property getters and setters }
function GetOldLOGONIDValue : String;
function GetOldID_USUARIOValue : Integer;
@ -397,7 +398,7 @@ type
{ IPERMISOSDelta }
IPERMISOSDelta = interface(IPERMISOS)
['{F99C6E2E-FE0E-4943-9B69-37B2F48AF314}']
['{DB34A951-27E2-4A70-843F-9C41FF29179D}']
{ Property getters and setters }
function GetOldID_USUARIOValue : Integer;
function GetOldMODULOValue : String;
@ -467,7 +468,7 @@ type
{ IPERMISOSEXDelta }
IPERMISOSEXDelta = interface(IPERMISOSEX)
['{43B62FCB-7C4A-4F3A-9F77-85339308E91A}']
['{F40FC2C9-2DFF-4B12-8EE6-DAD609901516}']
{ Property getters and setters }
function GetOldID_USUARIOValue : Integer;
function GetOldMODULOValue : String;
@ -547,6 +548,76 @@ type
end;
{ IPERFILESDelta }
IPERFILESDelta = interface(IPERFILES)
['{07C28883-A52C-4111-ABBE-14E908E7C705}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldUSERNAMEValue : String;
function GetOldLOGINValue : String;
function GetOldTIPOValue : String;
{ Properties }
property OldID : Integer read GetOldIDValue;
property OldUSERNAME : String read GetOldUSERNAMEValue;
property OldLOGIN : String read GetOldLOGINValue;
property OldTIPO : String read GetOldTIPOValue;
end;
{ TPERFILESBusinessProcessorRules }
TPERFILESBusinessProcessorRules = class(TDABusinessProcessorRules, IPERFILES, IPERFILESDelta)
private
protected
{ Property getters and setters }
function GetIDValue: Integer; virtual;
function GetIDIsNull: Boolean; virtual;
function GetOldIDValue: Integer; virtual;
function GetOldIDIsNull: Boolean; virtual;
procedure SetIDValue(const aValue: Integer); virtual;
procedure SetIDIsNull(const aValue: Boolean); virtual;
function GetUSERNAMEValue: String; virtual;
function GetUSERNAMEIsNull: Boolean; virtual;
function GetOldUSERNAMEValue: String; virtual;
function GetOldUSERNAMEIsNull: Boolean; virtual;
procedure SetUSERNAMEValue(const aValue: String); virtual;
procedure SetUSERNAMEIsNull(const aValue: Boolean); virtual;
function GetLOGINValue: String; virtual;
function GetLOGINIsNull: Boolean; virtual;
function GetOldLOGINValue: String; virtual;
function GetOldLOGINIsNull: Boolean; virtual;
procedure SetLOGINValue(const aValue: String); virtual;
procedure SetLOGINIsNull(const aValue: Boolean); virtual;
function GetTIPOValue: String; virtual;
function GetTIPOIsNull: Boolean; virtual;
function GetOldTIPOValue: String; virtual;
function GetOldTIPOIsNull: Boolean; virtual;
procedure SetTIPOValue(const aValue: String); virtual;
procedure SetTIPOIsNull(const aValue: Boolean); virtual;
{ Properties }
property ID : Integer read GetIDValue write SetIDValue;
property IDIsNull : Boolean read GetIDIsNull write SetIDIsNull;
property OldID : Integer read GetOldIDValue;
property OldIDIsNull : Boolean read GetOldIDIsNull;
property USERNAME : String read GetUSERNAMEValue write SetUSERNAMEValue;
property USERNAMEIsNull : Boolean read GetUSERNAMEIsNull write SetUSERNAMEIsNull;
property OldUSERNAME : String read GetOldUSERNAMEValue;
property OldUSERNAMEIsNull : Boolean read GetOldUSERNAMEIsNull;
property LOGIN : String read GetLOGINValue write SetLOGINValue;
property LOGINIsNull : Boolean read GetLOGINIsNull write SetLOGINIsNull;
property OldLOGIN : String read GetOldLOGINValue;
property OldLOGINIsNull : Boolean read GetOldLOGINIsNull;
property TIPO : String read GetTIPOValue write SetTIPOValue;
property TIPOIsNull : Boolean read GetTIPOIsNull write SetTIPOIsNull;
property OldTIPO : String read GetOldTIPOValue;
property OldTIPOIsNull : Boolean read GetOldTIPOIsNull;
public
constructor Create(aBusinessProcessor: TDABusinessProcessor); override;
destructor Destroy; override;
end;
implementation
uses
@ -1705,11 +1776,148 @@ begin
end;
{ TPERFILESBusinessProcessorRules }
constructor TPERFILESBusinessProcessorRules.Create(aBusinessProcessor: TDABusinessProcessor);
begin
inherited;
end;
destructor TPERFILESBusinessProcessorRules.Destroy;
begin
inherited;
end;
function TPERFILESBusinessProcessorRules.GetIDValue: Integer;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESID];
end;
function TPERFILESBusinessProcessorRules.GetIDIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESID]);
end;
function TPERFILESBusinessProcessorRules.GetOldIDValue: Integer;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESID];
end;
function TPERFILESBusinessProcessorRules.GetOldIDIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESID]);
end;
procedure TPERFILESBusinessProcessorRules.SetIDValue(const aValue: Integer);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESID] := aValue;
end;
procedure TPERFILESBusinessProcessorRules.SetIDIsNull(const aValue: Boolean);
begin
if aValue then
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESID] := Null;
end;
function TPERFILESBusinessProcessorRules.GetUSERNAMEValue: String;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESUSERNAME];
end;
function TPERFILESBusinessProcessorRules.GetUSERNAMEIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESUSERNAME]);
end;
function TPERFILESBusinessProcessorRules.GetOldUSERNAMEValue: String;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESUSERNAME];
end;
function TPERFILESBusinessProcessorRules.GetOldUSERNAMEIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESUSERNAME]);
end;
procedure TPERFILESBusinessProcessorRules.SetUSERNAMEValue(const aValue: String);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESUSERNAME] := aValue;
end;
procedure TPERFILESBusinessProcessorRules.SetUSERNAMEIsNull(const aValue: Boolean);
begin
if aValue then
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESUSERNAME] := Null;
end;
function TPERFILESBusinessProcessorRules.GetLOGINValue: String;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESLOGIN];
end;
function TPERFILESBusinessProcessorRules.GetLOGINIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESLOGIN]);
end;
function TPERFILESBusinessProcessorRules.GetOldLOGINValue: String;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESLOGIN];
end;
function TPERFILESBusinessProcessorRules.GetOldLOGINIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESLOGIN]);
end;
procedure TPERFILESBusinessProcessorRules.SetLOGINValue(const aValue: String);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESLOGIN] := aValue;
end;
procedure TPERFILESBusinessProcessorRules.SetLOGINIsNull(const aValue: Boolean);
begin
if aValue then
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESLOGIN] := Null;
end;
function TPERFILESBusinessProcessorRules.GetTIPOValue: String;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESTIPO];
end;
function TPERFILESBusinessProcessorRules.GetTIPOIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESTIPO]);
end;
function TPERFILESBusinessProcessorRules.GetOldTIPOValue: String;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESTIPO];
end;
function TPERFILESBusinessProcessorRules.GetOldTIPOIsNull: Boolean;
begin
result := VarIsNull(BusinessProcessor.CurrentChange.OldValueByName[fld_PERFILESTIPO]);
end;
procedure TPERFILESBusinessProcessorRules.SetTIPOValue(const aValue: String);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESTIPO] := aValue;
end;
procedure TPERFILESBusinessProcessorRules.SetTIPOIsNull(const aValue: Boolean);
begin
if aValue then
BusinessProcessor.CurrentChange.NewValueByName[fld_PERFILESTIPO] := Null;
end;
initialization
RegisterBusinessProcessorRules(RID_USUARIOSDelta, TUSUARIOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_USUARIOS_EVENTOSDelta, TUSUARIOS_EVENTOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_USUARIOS_LOGONDelta, TUSUARIOS_LOGONBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERMISOSDelta, TPERMISOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERMISOSEXDelta, TPERMISOSEXBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERFILESDelta, TPERFILESBusinessProcessorRules);
end.

90
Source/ApplicationBase/Usuarios/Model/uBizUsuarios.pas Normal file
View File

@ -0,0 +1,90 @@
unit uBizUsuarios;
interface
uses
UCBase, uDAInterfaces, uDADataTable, schUsuariosClient_Intf;
const
BIZ_CLIENT_USUARIO = 'Client.Usuario';
BIZ_CLIENT_PERFIL_USUARIO = 'Client.PerfilUsuario';
type
TUsuario = TUCCurrentUser;
IBizUsuario = interface (IUSUARIOS)
['{1DB69F36-969C-4078-B862-6D697670BCFD}']
function EsNuevo : Boolean;
end;
IBizPerfilUsuario = interface (IPERFILES)
['{D14DF996-A8CD-400A-BF74-C8B660199C74}']
function EsNuevo : Boolean;
end;
TBizUsuario = class(TUsuariosDataTableRules, IBizUsuario)
protected
procedure OnNewRecord(Sender: TDADataTable); override;
public
function EsNuevo : Boolean;
procedure IniciarValoresUsuarioNuevo;
end;
TBizPerfilUsuario = class(TPerfilesDataTableRules, IBizPerfilUsuario)
protected
procedure OnNewRecord(Sender: TDADataTable); override;
public
function EsNuevo : Boolean;
procedure IniciarValoresPerfilNuevo;
end;
implementation
{ TBizUsuario }
function TBizUsuario.EsNuevo: Boolean;
begin
Result := (ID < 0);
end;
procedure TBizUsuario.IniciarValoresUsuarioNuevo;
begin
TIPO := 'U'; // Usuario;
end;
procedure TBizUsuario.OnNewRecord(Sender: TDADataTable);
begin
inherited;
IniciarValoresUsuarioNuevo;
end;
{ TBizPerfilUsuario }
function TBizPerfilUsuario.EsNuevo: Boolean;
begin
Result := (ID < 0);
end;
procedure TBizPerfilUsuario.IniciarValoresPerfilNuevo;
begin
TIPO := 'P'; // Perfil
end;
procedure TBizPerfilUsuario.OnNewRecord(Sender: TDADataTable);
begin
inherited;
IniciarValoresPerfilNuevo;
end;
initialization
RegisterDataTableRules(BIZ_CLIENT_USUARIO, TBizUsuario);
RegisterDataTableRules(BIZ_CLIENT_PERFIL_USUARIO, TBizPerfilUsuario);
finalization
end.

173
Source/ApplicationBase/Usuarios/Servidor/srvUsuarios_Impl.dfm
View File

@ -16,7 +16,99 @@ object srvUsuarios: TsrvUsuarios
DiagramData = '<Diagrams>'#13#10'</Diagrams>'#13#10
end
object DataDictionary: TDADataDictionary
Fields = <>
Fields = <
item
Name = 'USUARIOS_ID'
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
Required = True
DisplayLabel = 'ID'
end
item
Name = 'USUARIOS_USERNAME'
DataType = datString
Size = 30
DisplayLabel = 'Nombre'
end
item
Name = 'USUARIOS_LOGIN'
DataType = datString
Size = 30
DisplayLabel = 'Login'
end
item
Name = 'USUARIOS_PASS'
DataType = datString
Size = 250
DisplayLabel = 'Password'
end
item
Name = 'USUARIOS_PASSEXPIRED'
DataType = datDateTime
DisplayLabel = 'Expiraci'#243'n de password'
end
item
Name = 'USUARIOS_BLOQUEADO'
DataType = datSmallInt
DisplayLabel = 'Bloqueado'
end
item
Name = 'USUARIOS_EMAIL'
DataType = datString
Size = 150
DisplayLabel = 'Correo electr'#243'nico'
end
item
Name = 'USUARIOS_USERDAYSSUN'
DataType = datInteger
end
item
Name = 'USUARIOS_PRIVILEGED'
DataType = datInteger
DisplayLabel = 'Privilegiado'
end
item
Name = 'USUARIOS_TIPO'
DataType = datString
Size = 1
DisplayLabel = 'Tipo'
end
item
Name = 'USUARIOS_ID_PERFIL'
DataType = datInteger
DisplayLabel = 'ID_PERFIL'
end
item
Name = 'USUARIOS_CHECKSUM'
DataType = datString
Size = 250
DisplayLabel = 'Checksum'
end
item
Name = 'PERFILES_ID'
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
Required = True
DisplayLabel = 'ID'
end
item
Name = 'PERFILES_USERNAME'
DataType = datString
Size = 30
DisplayLabel = 'Nombre'
end
item
Name = 'PERFILES_LOGIN'
DataType = datString
Size = 30
DisplayLabel = 'Login'
end
item
Name = 'PERFILES_TIPO'
DataType = datString
Size = 1
DisplayLabel = 'Tipo'
end>
Left = 150
Top = 24
end
@ -33,7 +125,12 @@ object srvUsuarios: TsrvUsuarios
ConnectionType = 'Interbase'
Default = True
TargetTable = 'USUARIOS'
StatementType = stAutoSQL
SQL =
'SELECT '#10' ID, USERNAME, LOGIN, PASS, PASSEXPIRED, BLOQUEADO,'#10' ' +
' EMAIL, USERDAYSSUN, PRIVILEGED, TIPO, ID_PERFIL, CHECKSUM'#10' F' +
'ROM'#10' USUARIOS'#10' WHERE TIPO = '#39'U'#39' AND {Where}'#10' ORDER BY USERN' +
'AME'#10
StatementType = stSQL
ColumnMappings = <
item
DatasetField = 'ID'
@ -88,59 +185,71 @@ object srvUsuarios: TsrvUsuarios
Fields = <
item
Name = 'ID'
DataType = datInteger
Required = True
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
DictionaryEntry = 'USUARIOS_ID'
InPrimaryKey = True
end
item
Name = 'USERNAME'
DataType = datString
Size = 30
DictionaryEntry = 'USUARIOS_USERNAME'
end
item
Name = 'LOGIN'
DataType = datString
Size = 30
DictionaryEntry = 'USUARIOS_LOGIN'
end
item
Name = 'PASS'
DataType = datString
Size = 250
DictionaryEntry = 'USUARIOS_PASS'
end
item
Name = 'PASSEXPIRED'
DataType = datDateTime
DictionaryEntry = 'USUARIOS_PASSEXPIRED'
end
item
Name = 'BLOQUEADO'
DataType = datSmallInt
DictionaryEntry = 'USUARIOS_BLOQUEADO'
end
item
Name = 'EMAIL'
DataType = datString
Size = 150
DictionaryEntry = 'USUARIOS_EMAIL'
end
item
Name = 'USERDAYSSUN'
DataType = datInteger
DictionaryEntry = 'USUARIOS_USERDAYSSUN'
end
item
Name = 'PRIVILEGED'
DataType = datInteger
DictionaryEntry = 'USUARIOS_PRIVILEGED'
end
item
Name = 'TIPO'
DataType = datString
Size = 1
DictionaryEntry = 'USUARIOS_TIPO'
end
item
Name = 'ID_PERFIL'
DataType = datInteger
DictionaryEntry = 'USUARIOS_ID_PERFIL'
end
item
Name = 'CHECKSUM'
DataType = datString
Size = 250
DictionaryEntry = 'USUARIOS_CHECKSUM'
end>
end
item
@ -402,6 +511,62 @@ object srvUsuarios: TsrvUsuarios
DataType = datString
Size = 250
end>
end
item
Params = <>
Statements = <
item
Connection = 'IBX'
TargetTable = 'USUARIOS'
SQL =
'SELECT '#10' ID, USERNAME, LOGIN, TIPO'#10' FROM'#10' USUARIOS'#10' WHER' +
'E TIPO = '#39'P'#39' AND {Where}'#10' ORDER BY USERNAME'#10
StatementType = stSQL
ColumnMappings = <
item
DatasetField = 'ID'
TableField = 'ID'
end
item
DatasetField = 'USERNAME'
TableField = 'USERNAME'
end
item
DatasetField = 'LOGIN'
TableField = 'LOGIN'
end
item
DatasetField = 'TIPO'
TableField = 'TIPO'
end>
end>
Name = 'PERFILES'
Fields = <
item
Name = 'ID'
DataType = datAutoInc
GeneratorName = 'GEN_USUARIOS_ID'
DictionaryEntry = 'PERFILES_ID'
InPrimaryKey = True
end
item
Name = 'USERNAME'
DataType = datString
Size = 30
DictionaryEntry = 'PERFILES_USERNAME'
end
item
Name = 'LOGIN'
DataType = datString
Size = 30
DictionaryEntry = 'PERFILES_LOGIN'
end
item
Name = 'TIPO'
DataType = datString
Size = 1
DictionaryEntry = 'PERFILES_TIPO'
end>
end>
JoinDataTables = <>
UnionDataTables = <>

123
Source/ApplicationBase/Usuarios/Views/uEditorCambiarPassword.dfm Normal file
View File

@ -0,0 +1,123 @@
object fEditorCambiarPassword: TfEditorCambiarPassword
Left = 398
Top = 263
BorderStyle = bsDialog
Caption = 'Cambiar la contrase'#241'a'
ClientHeight = 217
ClientWidth = 406
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCloseQuery = FormCloseQuery
PixelsPerInch = 96
TextHeight = 13
object Bevel4: TBevel
Left = 8
Top = 154
Width = 388
Height = 10
Shape = bsBottomLine
end
object lbConfirma: TLabel
Left = 35
Top = 88
Width = 103
Height = 13
Alignment = taRightJustify
Caption = 'Confirmar contrase'#241'a:'
end
object lbNovaSenha: TLabel
Left = 47
Top = 57
Width = 91
Height = 13
Alignment = taRightJustify
Caption = 'Nueva contrase'#241'a:'
end
object lbSenhaAtu: TLabel
Left = 49
Top = 27
Width = 89
Height = 13
Alignment = taRightJustify
Caption = 'Contrase'#241'a actual:'
end
object Label1: TLabel
Left = 19
Top = 132
Width = 360
Height = 13
Caption =
'Si hace clic en Cancelar, no se realizar'#225' ning'#250'n cambio sobre la' +
' contrase'#241'a.'
end
object bAceptar: TButton
Left = 234
Top = 178
Width = 75
Height = 23
Action = actAceptar
TabOrder = 0
end
object bCancelar: TButton
Left = 319
Top = 178
Width = 75
Height = 23
Action = actCancelar
Cancel = True
ModalResult = 2
TabOrder = 1
end
object EditAtu: TEdit
Left = 143
Top = 24
Width = 202
Height = 21
Ctl3D = True
MaxLength = 10
ParentCtl3D = False
PasswordChar = '*'
TabOrder = 2
end
object EditConfirma: TEdit
Left = 143
Top = 85
Width = 202
Height = 21
Ctl3D = True
MaxLength = 10
ParentCtl3D = False
PasswordChar = '*'
TabOrder = 3
end
object EditNova: TEdit
Left = 143
Top = 54
Width = 202
Height = 21
Ctl3D = True
MaxLength = 10
ParentCtl3D = False
PasswordChar = '*'
TabOrder = 4
end
object ActionList1: TActionList
Left = 136
Top = 169
object actAceptar: TAction
Caption = 'C&ambiar'
OnExecute = actAceptarExecute
end
object actCancelar: TAction
Caption = '&Cancelar'
OnExecute = actCancelarExecute
end
end
end

101
Source/ApplicationBase/Usuarios/Views/uEditorCambiarPassword.pas Normal file
View File

@ -0,0 +1,101 @@
unit uEditorCambiarPassword;
interface
uses
Forms, UCBase, ExtCtrls, Classes, ActnList, StdCtrls, Controls, Buttons,
uBizUsuarios, uUsuariosController;
type
TfEditorCambiarPassword = class(TForm)
lbSenhaAtu: TLabel;
lbNovaSenha: TLabel;
lbConfirma: TLabel;
EditAtu: TEdit;
EditNova: TEdit;
EditConfirma: TEdit;
ActionList1: TActionList;
actAceptar: TAction;
actCancelar: TAction;
Bevel4: TBevel;
bAceptar: TButton;
bCancelar: TButton;
Label1: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure actCancelarExecute(Sender: TObject);
procedure actAceptarExecute(Sender: TObject);
public
Usuario : IBizUsuario;
Controller : IUsuariosController;
CambioObligatorio : Boolean;
end;
implementation
{$R *.dfm}
uses
uDialogUtils;
procedure TfEditorCambiarPassword.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caHide;
end;
procedure TfEditorCambiarPassword.actAceptarExecute(Sender: TObject);
var
AuxPass : String;
AMensaje : String;
begin
case Controller.Criptografia of
ucStandard: AuxPass := EditAtu.Text;
ucMD5: AuxPass := MD5Sum(EditAtu.Text);
end;
if Usuario.PASS <> AuxPass then
begin
ShowWarningMessage('Cambiar la contraseña', 'La contraseña actual no es correcta.' + #10#13 +
'Asegúrese de que la contraseña actual está bien introduccida.');
EditAtu.SetFocus;
Exit;
end;
if (EditNova.Text <> EditConfirma.Text) then
begin
ShowWarningMessage('Cambiar la contraseña', 'La contraseña no se confirmó correctamente' + #10#13 +
'Asegúrese de que la contraseña y su confirmación sean iguales.');
EditNova.SetFocus;
Exit;
end
else begin
if not Controller.ValidarPassword(EditNova.Text, Usuario.LOGIN, Usuario.USERNAME, AMensaje) then
begin
ShowWarningMessage('Cambiar la contraseña', AMensaje);
EditNova.SetFocus;
Exit;
end
else begin
if CambioObligatorio = True then
CambioObligatorio := False;
ModalResult := mrOK;
end;
end;
end;
procedure TfEditorCambiarPassword.actCancelarExecute(Sender: TObject);
begin
Close;
end;
procedure TfEditorCambiarPassword.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if CambioObligatorio then
begin
CanClose := False;
ShowWarningMessage('Cambiar la contraseña', 'El cambio de la contraseña es obligatorio');
end;
end;
end.

54
Source/ApplicationBase/Usuarios/Views/uEditorPerfilUsuario.dfm Normal file
View File

@ -0,0 +1,54 @@
inherited fEditorPerfilUsuario: TfEditorPerfilUsuario
Caption = 'fEditorPerfilUsuario'
PixelsPerInch = 96
TextHeight = 13
inherited TBXDock: TTBXDock
inherited tbxMain: TTBXToolbar
ExplicitWidth = 330
end
end
inherited pgPaginas: TPageControl
inherited pagGeneral: TTabSheet
ExplicitLeft = 4
ExplicitTop = 24
ExplicitWidth = 638
ExplicitHeight = 332
end
end
inherited StatusBar: TJvStatusBar
Panels = <
item
Width = 200
end>
end
inherited EditorActionList: TActionList
inherited actNuevo: TAction
Visible = False
end
inherited actModificar: TAction
Visible = False
end
inherited actPrevisualizar: TAction
Visible = False
end
inherited actImprimir: TAction
Visible = False
end
inherited actDuplicar: TAction
Visible = False
end
end
object dxLayoutLookAndFeelList1: TdxLayoutLookAndFeelList
Left = 248
Top = 168
object dxLayoutOfficeLookAndFeel1: TdxLayoutOfficeLookAndFeel
GroupOptions.CaptionOptions.Font.Charset = DEFAULT_CHARSET
GroupOptions.CaptionOptions.Font.Color = clWindowText
GroupOptions.CaptionOptions.Font.Height = -11
GroupOptions.CaptionOptions.Font.Name = 'Tahoma'
GroupOptions.CaptionOptions.Font.Style = [fsBold]
GroupOptions.CaptionOptions.TextColor = clHighlight
GroupOptions.CaptionOptions.UseDefaultFont = False
end
end
end

164
Source/ApplicationBase/Usuarios/Views/uEditorPerfilUsuario.pas Normal file
View File

@ -0,0 +1,164 @@
unit uEditorPerfilUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uEditorDBItem, JvAppStorage, JvAppRegistryStorage, DB, uDAInterfaces,
uDADataTable, JvComponentBase, JvFormPlacement, ImgList, PngImageList,
StdActns, ActnList, ComCtrls, JvExComCtrls, JvStatusBar, TBX, TB2Item,
TB2Dock, TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvNavigationPane,
uIEditorPerfilUsuario, uUsuariosController, uCustomView, uViewBase,
uViewPerfilUsuario, uBizUsuarios, dxLayoutLookAndFeels;
type
TfEditorPerfilUsuario = class(TfEditorDBItem, IEditorPerfilUsuario)
dxLayoutLookAndFeelList1: TdxLayoutLookAndFeelList;
dxLayoutOfficeLookAndFeel1: TdxLayoutOfficeLookAndFeel;
private
FController : IUsuariosController;
FPerfilUsuario : IBizPerfilUsuario;
FViewPerfilUsuario : IViewPerfilUsuario;
protected
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetPerfilUsuario: IBizPerfilUsuario;
procedure SetPerfilUsuario(const Value: IBizPerfilUsuario);
procedure GuardarInterno; override;
procedure EliminarInterno; override;
//Si queremos crear otra vista para el editor heredado solo tendriamos que
//sobreescribir este metodo
procedure AsignarVista; virtual;
procedure PonerTitulos(const ATitulo: string = ''); override;
function GetViewPerfilUsuario: IViewPerfilUsuario;
procedure SetViewPerfilUsuario(const Value: IViewPerfilUsuario);
property ViewPerfilUsuario: IViewPerfilUsuario read GetViewPerfilUsuario write SetViewPerfilUsuario;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Controller : IUsuariosController read GetController write SetController;
property PerfilUsuario: IBizPerfilUsuario read GetPerfilUsuario write SetPerfilUsuario;
end;
implementation
{$R *.dfm}
{ TfEditorUsuario }
var
FIDNuevoGuardado : Integer = -1;
procedure TfEditorPerfilUsuario.AsignarVista;
var
AViewPerfilUsuario: TfrViewPerfilUsuario;
begin
AViewPerfilUsuario := TfrViewPerfilUsuario.Create(Self);
with AViewPerfilUsuario do
begin
Parent := pagGeneral;
Align := alClient;
dxLayoutControlArticulo.LookAndFeel := dxLayoutOfficeLookAndFeel1;
end;
ViewPerfilUsuario := AViewPerfilUsuario;
end;
constructor TfEditorPerfilUsuario.Create(AOwner: TComponent);
begin
inherited;
pgPaginas.ActivePageIndex := 0;
AsignarVista;
end;
destructor TfEditorPerfilUsuario.Destroy;
begin
// Utilizar mejor OnClose;
inherited;
end;
procedure TfEditorPerfilUsuario.EliminarInterno;
begin
if (Application.MessageBox('¿Desea borrar este perfil?', 'Atención', MB_YESNO) = IDYES) then
begin
inherited;
if not FController.EliminarPerfil(FPerfilUsuario) then
actRefrescar.Execute;
end;
end;
function TfEditorPerfilUsuario.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfEditorPerfilUsuario.GetPerfilUsuario: IBizPerfilUsuario;
begin
Result := FPerfilUsuario;
end;
function TfEditorPerfilUsuario.GetViewPerfilUsuario: IViewPerfilUsuario;
begin
Result := FViewPerfilUsuario;
end;
procedure TfEditorPerfilUsuario.GuardarInterno;
begin
inherited;
if FController.GuardarPerfil(FPerfilUsuario) then
begin
FIDNuevoGuardado := FPerfilUsuario.ID;
FPerfilUsuario.DataTable.CancelUpdates;
Modified := False;
actRefrescar.Execute;
end;
end;
procedure TfEditorPerfilUsuario.PonerTitulos(const ATitulo: string);
var
FTitulo : String;
begin
if Assigned(FPerfilUsuario) then
begin
if FPerfilUsuario.EsNuevo then
FTitulo := 'Nuevo perfil'
else
FTitulo := 'Perfil';
if Length(FPerfilUsuario.USERNAME) > 0 then
FTitulo := FTitulo + ' - ' + FPerfilUsuario.USERNAME;
end;
inherited PonerTitulos(FTitulo);
end;
procedure TfEditorPerfilUsuario.SetController(const Value: IUsuariosController);
begin
FController := Value;
if Assigned(FViewPerfilUsuario) and Assigned(FController) then
FViewPerfilUsuario.Controller := FController;
end;
procedure TfEditorPerfilUsuario.SetPerfilUsuario(
const Value: IBizPerfilUsuario);
begin
FPerfilUsuario := Value;
dsDataTable.DataTable := FPerfilUsuario.DataTable;
if Assigned(FViewPerfilUsuario) and Assigned(FPerfilUsuario) then
FViewPerfilUsuario.PerfilUsuario := FPerfilUsuario;
end;
procedure TfEditorPerfilUsuario.SetViewPerfilUsuario(const Value: IViewPerfilUsuario);
begin
FViewPerfilUsuario := Value;
if Assigned(FViewPerfilUsuario) and Assigned(FPerfilUsuario) then
FViewPerfilUsuario.PerfilUsuario := FPerfilUsuario;
end;
end.

41
Source/ApplicationBase/Usuarios/Views/uEditorPerfilesUsuario.dfm Normal file
View File

@ -0,0 +1,41 @@
inherited fEditorPerfilesUsuario: TfEditorPerfilesUsuario
Caption = 'fEditorPerfilesUsuario'
ClientHeight = 493
ClientWidth = 840
ExplicitWidth = 848
ExplicitHeight = 527
PixelsPerInch = 96
TextHeight = 13
inherited JvNavPanelHeader: TJvNavPanelHeader
Width = 840
ExplicitWidth = 840
inherited Image1: TImage
Left = 813
ExplicitLeft = 813
end
end
inherited TBXDock: TTBXDock
Width = 840
ExplicitWidth = 840
inherited tbxMain: TTBXToolbar
ExplicitWidth = 386
end
inherited tbxFiltro: TTBXToolbar
Visible = False
end
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 840
end
end
inherited StatusBar: TJvStatusBar
Top = 474
Width = 840
ExplicitTop = 474
ExplicitWidth = 840
end
inherited EditorActionList: TActionList
inherited actDuplicar: TAction
Visible = False
end
end
end

130
Source/ApplicationBase/Usuarios/Views/uEditorPerfilesUsuario.pas Normal file
View File

@ -0,0 +1,130 @@
unit uEditorPerfilesUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uEditorGridBase, Menus, JvAppStorage, JvAppRegistryStorage, DB,
uDAInterfaces, uDADataTable, JvComponentBase, JvFormPlacement, ImgList,
PngImageList, StdActns, ActnList, ComCtrls, JvExComCtrls, JvStatusBar, TBX,
TB2ExtItems, TBXExtItems, TB2Item, TB2Dock, TB2Toolbar, pngimage, ExtCtrls,
JvExControls, JvNavigationPane, uIEditorPerfilesUsuario,
uUsuariosController, uBizUsuarios, uViewPerfilesUsuario;
type
TfEditorPerfilesUsuario = class(TfEditorGridBase, IEditorPerfilesUsuario)
private
FPerfiles : IBizPerfilUsuario;
FController : IUsuariosController;
protected
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetPerfilesUsuario: IBizPerfilUsuario;
procedure SetPerfilesUsuario(const Value: IBizPerfilUsuario);
procedure NuevoInterno; override;
procedure EliminarInterno; override;
procedure ModificarInterno; override;
//Si queremos crear otra vista para el editor heredado solo tendriamos que
//sobreescribir este metodo
procedure AsignarVista; virtual;
public
procedure PonerTitulos(const ATitulo: string = ''); override;
property PerfilesUsuario: IBizPerfilUsuario read GetPerfilesUsuario write SetPerfilesUsuario;
property Controller : IUsuariosController read GetController write SetController;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.dfm}
uses
uDialogUtils;
{ TfEditorUsuarios }
procedure TfEditorPerfilesUsuario.AsignarVista;
begin
ViewGrid := CreateView(TfrViewPerfilesUsuario) as IViewPerfilesUsuario;
end;
constructor TfEditorPerfilesUsuario.Create(AOwner: TComponent);
begin
inherited;
AsignarVista;
end;
destructor TfEditorPerfilesUsuario.Destroy;
begin
FPerfiles := NIL;
FController := NIl;
inherited;
end;
procedure TfEditorPerfilesUsuario.EliminarInterno;
begin
if (ShowConfirmMessage('Eliminar un perfil', Format('¿Desea eliminar el perfil %s?', [FPerfiles.USERNAME])) = IDYES) then
begin
inherited;
//Para que en el caso de no poderse realizar la operación se refresquen
//los datos y no nos permita eliminar un registro a la segunda
FController.EliminarPerfil(FPerfiles);
actRefrescar.Execute;
end;
end;
function TfEditorPerfilesUsuario.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfEditorPerfilesUsuario.GetPerfilesUsuario: IBizPerfilUsuario;
begin
Result := FPerfiles;
end;
procedure TfEditorPerfilesUsuario.ModificarInterno;
begin
inherited;
FController.VerPerfil(FPerfiles.ID);
actRefrescar.Execute;
end;
procedure TfEditorPerfilesUsuario.NuevoInterno;
var
ANuevoPerfil : IBizPerfilUsuario;
begin
inherited;
ANuevoPerfil := FController.NuevoPerfil;
FController.VerPerfil(ANuevoPerfil);
actRefrescar.Execute;
end;
procedure TfEditorPerfilesUsuario.PonerTitulos(const ATitulo: string);
var
FTitulo : String;
begin
FTitulo := 'Lista de perfiles de usuario';
inherited PonerTitulos(FTitulo);
end;
procedure TfEditorPerfilesUsuario.SetController(const Value: IUsuariosController);
begin
FController := Value;
end;
procedure TfEditorPerfilesUsuario.SetPerfilesUsuario(
const Value: IBizPerfilUsuario);
begin
FPerfiles := Value;
dsDataTable.DataTable := FPerfiles.DataTable;
if Assigned(ViewGrid) then
(ViewGrid as IViewPerfilesUsuario).PerfilesUsuario := FPerfiles;
end;
end.

141
Source/ApplicationBase/Usuarios/Views/uEditorUsuario.dfm Normal file
View File

@ -0,0 +1,141 @@
inherited fEditorUsuario: TfEditorUsuario
Caption = 'fEditorUsuario'
PixelsPerInch = 96
TextHeight = 13
inherited TBXDock: TTBXDock
inherited tbxMain: TTBXToolbar
ExplicitWidth = 465
object TBXSeparatorItem6: TTBXSeparatorItem [6]
end
object TBXItem33: TTBXItem [7]
Action = actCambiarPassword
end
end
inherited tbxMenu: TTBXToolbar
object TBXSubmenuItem2: TTBXSubmenuItem [4]
Caption = '&Herramientas'
object TBXItem7: TTBXItem
Action = actCambiarPassword
end
end
end
end
inherited pgPaginas: TPageControl
inherited pagGeneral: TTabSheet
ExplicitLeft = 4
ExplicitTop = 24
ExplicitWidth = 638
ExplicitHeight = 332
inline frViewUsuario1: TfrViewUsuario
Left = 0
Top = 0
Width = 638
Height = 332
Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 638
ExplicitHeight = 332
inherited dxLayoutControlArticulo: TdxLayoutControl
Width = 638
LookAndFeel = dxLayoutOfficeLookAndFeel1
ExplicitWidth = 638
DesignSize = (
638
249)
inherited PngSpeedButton3: TPngSpeedButton
Top = 84
ExplicitTop = 84
end
inherited eNombre: TcxDBTextEdit
Top = 30
ExplicitTop = 30
ExplicitWidth = 164
Width = 164
end
inherited eUsuario: TcxDBTextEdit
Top = 57
ExplicitTop = 57
ExplicitWidth = 108
Width = 108
end
inherited eMail: TcxDBHyperLinkEdit
Top = 84
Properties.Prefix = 'mailto:'
ExplicitTop = 84
end
inherited ePassword: TcxTextEdit
Top = 163
ExplicitTop = 163
ExplicitWidth = 121
Width = 121
end
inherited eConfirmarPassword: TcxTextEdit
Top = 190
ExplicitTop = 190
ExplicitWidth = 372
Width = 372
end
inherited cbPerfil: TcxComboBox
Top = 112
ExplicitTop = 112
end
end
end
end
end
inherited StatusBar: TJvStatusBar
Panels = <
item
Width = 200
end>
end
inherited EditorActionList: TActionList
inherited actNuevo: TAction
Visible = False
end
inherited actModificar: TAction
Visible = False
end
inherited actConfPagina: TAction
Visible = False
end
inherited actPrevisualizar: TAction
Visible = False
end
inherited actImprimir: TAction
Visible = False
end
inherited actDuplicar: TAction
Visible = False
end
object actCambiarPassword: TAction
Category = 'Herramientas'
Caption = 'Cambiar la contrase'#241'a...'
OnExecute = actCambiarPasswordExecute
OnUpdate = actCambiarPasswordUpdate
end
end
inherited StatusBarImages: TPngImageList
Top = 312
end
object dxLayoutLookAndFeelList1: TdxLayoutLookAndFeelList
Left = 336
Top = 160
object dxLayoutOfficeLookAndFeel1: TdxLayoutOfficeLookAndFeel
GroupOptions.CaptionOptions.Font.Charset = DEFAULT_CHARSET
GroupOptions.CaptionOptions.Font.Color = clWindowText
GroupOptions.CaptionOptions.Font.Height = -11
GroupOptions.CaptionOptions.Font.Name = 'Tahoma'
GroupOptions.CaptionOptions.Font.Style = [fsBold]
GroupOptions.CaptionOptions.TextColor = clHighlight
GroupOptions.CaptionOptions.UseDefaultFont = False
end
end
end

227
Source/ApplicationBase/Usuarios/Views/uEditorUsuario.pas Normal file
View File

@ -0,0 +1,227 @@
unit uEditorUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uEditorDBItem, JvAppStorage, JvAppRegistryStorage, DB, uDAInterfaces,
uDADataTable, JvComponentBase, JvFormPlacement, ImgList, PngImageList,
StdActns, ActnList, ComCtrls, JvExComCtrls, JvStatusBar, TBX, TB2Item,
TB2Dock, TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvNavigationPane,
uIEditorUsuario, uUsuariosController, uCustomView, uViewBase, uViewUsuario,
uBizUsuarios, dxLayoutLookAndFeels;
type
TfEditorUsuario = class(TfEditorDBItem, IEditorUsuario)
frViewUsuario1: TfrViewUsuario;
dxLayoutLookAndFeelList1: TdxLayoutLookAndFeelList;
dxLayoutOfficeLookAndFeel1: TdxLayoutOfficeLookAndFeel;
actCambiarPassword: TAction;
TBXSubmenuItem2: TTBXSubmenuItem;
TBXItem7: TTBXItem;
TBXSeparatorItem6: TTBXSeparatorItem;
TBXItem33: TTBXItem;
procedure actEliminarUpdate(Sender: TObject);
procedure actCambiarPasswordExecute(Sender: TObject);
procedure actCambiarPasswordUpdate(Sender: TObject);
private
FController : IUsuariosController;
FUsuario : IBizUsuario;
FViewUsuario : IViewUsuario;
protected
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetUsuario: IBizUsuario;
procedure SetUsuario(const Value: IBizUsuario);
procedure GuardarInterno; override;
procedure EliminarInterno; override;
procedure RefrescarInterno; override;
procedure PonerTitulos(const ATitulo: string = ''); override;
function GetViewUsuario: IViewUsuario;
procedure SetViewUsuario(const Value: IViewUsuario);
property ViewUsuario: IViewUsuario read GetViewUsuario write SetViewUsuario;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Controller : IUsuariosController read GetController write SetController;
property Usuario: IBizUsuario read GetUsuario write SetUsuario;
end;
implementation
{$R *.dfm}
uses
uDialogUtils, cxControls;
{ TfEditorUsuario }
var
FIDNuevoGuardado : Integer = -1;
procedure TfEditorUsuario.actCambiarPasswordExecute(Sender: TObject);
begin
inherited;
FController.CambiarPassword(FUsuario.ID);
end;
procedure TfEditorUsuario.actCambiarPasswordUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := not FUsuario.EsNuevo;
end;
procedure TfEditorUsuario.actEliminarUpdate(Sender: TObject);
begin
inherited;
if (Sender as TAction).Enabled then
(Sender as TAction).Enabled := (FUsuario.PRIVILEGED = 0);
end;
constructor TfEditorUsuario.Create(AOwner: TComponent);
begin
inherited;
pgPaginas.ActivePageIndex := 0;
FViewUsuario := frViewUsuario1;
end;
destructor TfEditorUsuario.Destroy;
begin
// Utilizar mejor OnClose;
inherited;
end;
procedure TfEditorUsuario.EliminarInterno;
begin
if (Application.MessageBox('¿Desea borrar este usuario?', 'Atención', MB_YESNO) = IDYES) then
begin
inherited;
if not FController.EliminarUsuario(FUsuario.ID) then
actRefrescar.Execute;
end;
end;
function TfEditorUsuario.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfEditorUsuario.GetUsuario: IBizUsuario;
begin
Result := FUsuario;
end;
function TfEditorUsuario.GetViewUsuario: IViewUsuario;
begin
Result := FViewUsuario;
end;
procedure TfEditorUsuario.GuardarInterno;
var
AMensaje : String;
AContinuar : Boolean;
begin
inherited;
AContinuar := False;
if FUsuario.EsNuevo then
begin
if (frViewUsuario1.ePassword.Text <> frViewUsuario1.eConfirmarPassword.Text) then
raise Exception.Create('La contraseña no se confirmó correctamente' + #10#13 +
'Asegúrese de que la contraseña y su confirmación sean iguales.')
else
if not FController.ValidarPassword(frViewUsuario1.ePassword.Text,
frViewUsuario1.eUsuario.Text, frViewUsuario1.eNombre.Text, AMensaje) then
raise Exception.Create(AMensaje)
else begin
FUsuario.Edit;
FUsuario.PASS := frViewUsuario1.ePassword.Text;
FUsuario.Edit;
AContinuar := True;
end;
end
else
AContinuar := True;
if AContinuar then
begin
if FController.GuardarUsuario(FUsuario) then
begin
FIDNuevoGuardado := FUsuario.ID;
FUsuario.DataTable.CancelUpdates;
Modified := False;
actRefrescar.Execute;
end;
end
end;
procedure TfEditorUsuario.PonerTitulos(const ATitulo: string);
var
FTitulo : String;
begin
if Assigned(Usuario) then
begin
if Usuario.EsNuevo then
FTitulo := 'Nuevo usuario'
else
FTitulo := 'Usuario';
if Length(Usuario.USERNAME) > 0 then
FTitulo := FTitulo + ' - ' + Usuario.USERNAME;
end;
inherited PonerTitulos(FTitulo);
end;
procedure TfEditorUsuario.RefrescarInterno;
begin
inherited;
if (FIDNuevoGuardado > 0) and (FUsuario.ID <> FIDNuevoGuardado) then
begin
if (dsDataTable.DataTable.IsEmpty) or (not ModifiedQuery) then
Exit; // No continuar con el refresco
dsDataTable.DataTable.DisableControls; //<- No descomentar
ShowHourglassCursor;
try
dsDataTable.DataTable.First;
if dsDataTable.DataTable.Locate('ID', FIDNuevoGuardado, []) then
FIDNuevoGuardado := -1;
finally
dsDataTable.DataTable.EnableControls; //<- No descomentar
HideHourglassCursor;
end;
end;
end;
procedure TfEditorUsuario.SetController(const Value: IUsuariosController);
begin
FController := Value;
if Assigned(FViewUsuario) and Assigned(FController) then
FViewUsuario.Controller := FController;
end;
procedure TfEditorUsuario.SetUsuario(const Value: IBizUsuario);
begin
FUsuario := Value;
dsDataTable.DataTable := FUsuario.DataTable;
if Assigned(FViewUsuario) and Assigned(Usuario) then
FViewUsuario.Usuario := Usuario;
end;
procedure TfEditorUsuario.SetViewUsuario(const Value: IViewUsuario);
begin
FViewUsuario := Value;
if Assigned(FViewUsuario) and Assigned(Usuario) then
FViewUsuario.Usuario := Usuario;
end;
end.

56
Source/ApplicationBase/Usuarios/Views/uEditorUsuarios.dfm Normal file
View File

@ -0,0 +1,56 @@
inherited fEditorUsuarios: TfEditorUsuarios
Caption = 'fEditorUsuarios'
ClientHeight = 493
ClientWidth = 840
ExplicitWidth = 848
ExplicitHeight = 527
PixelsPerInch = 96
TextHeight = 13
inherited JvNavPanelHeader: TJvNavPanelHeader
Width = 840
ExplicitWidth = 840
inherited Image1: TImage
Left = 813
ExplicitLeft = 813
end
end
inherited TBXDock: TTBXDock
Width = 840
ExplicitWidth = 840
inherited tbxMain: TTBXToolbar
ExplicitWidth = 521
object TBXItem39: TTBXItem [8]
Action = actCambiarPassword
end
end
inherited tbxFiltro: TTBXToolbar
Visible = False
end
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 840
object TBXSubmenuItem2: TTBXSubmenuItem [4]
Caption = '&Herramientas'
object TBXItem38: TTBXItem
Action = actCambiarPassword
end
end
end
end
inherited StatusBar: TJvStatusBar
Top = 474
Width = 840
ExplicitTop = 474
ExplicitWidth = 840
end
inherited EditorActionList: TActionList
inherited actDuplicar: TAction
Visible = False
end
object actCambiarPassword: TAction
Category = 'Herramientas'
Caption = 'Cambiar la contrase'#241'a...'
OnExecute = actCambiarPasswordExecute
OnUpdate = actCambiarPasswordUpdate
end
end
end

176
Source/ApplicationBase/Usuarios/Views/uEditorUsuarios.pas Normal file
View File

@ -0,0 +1,176 @@
unit uEditorUsuarios;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uEditorGridBase, Menus, JvAppStorage, JvAppRegistryStorage, DB,
uDAInterfaces, uDADataTable, JvComponentBase, JvFormPlacement, ImgList,
PngImageList, StdActns, ActnList, ComCtrls, JvExComCtrls, JvStatusBar, TBX,
TB2ExtItems, TBXExtItems, TB2Item, TB2Dock, TB2Toolbar, pngimage, ExtCtrls,
JvExControls, JvNavigationPane, uCustomView, uViewBase, uViewGridBase,
uViewGrid, uViewUsuarios, uIEditorUsuarios, uUsuariosController,
uBizUsuarios;
type
TfEditorUsuarios = class(TfEditorGridBase, IEditorUsuarios)
actCambiarPassword: TAction;
TBXSubmenuItem2: TTBXSubmenuItem;
TBXItem38: TTBXItem;
TBXItem39: TTBXItem;
procedure actEliminarUpdate(Sender: TObject);
procedure actCambiarPasswordUpdate(Sender: TObject);
procedure actCambiarPasswordExecute(Sender: TObject);
private
FUsuarios : IBizUsuario;
FController : IUsuariosController;
protected
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetUsuarios: IBizUsuario;
procedure SetUsuarios(const Value: IBizUsuario);
procedure NuevoInterno; override;
procedure EliminarInterno; override;
procedure ModificarInterno; override;
procedure ImprimirInterno; override;
procedure PrevisualizarInterno; override;
procedure DuplicarInterno; override;
//Si queremos crear otra vista para el editor heredado solo tendriamos que
//sobreescribir este metodo
procedure AsignarVista; virtual;
public
procedure PonerTitulos(const ATitulo: string = ''); override;
property Usuarios: IBizUsuario read GetUsuarios write SetUsuarios;
property Controller : IUsuariosController read GetController write SetController;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.dfm}
uses
uDialogUtils;
{ TfEditorUsuarios }
procedure TfEditorUsuarios.actCambiarPasswordExecute(Sender: TObject);
begin
inherited;
FController.CambiarPassword(FUsuarios.ID);
end;
procedure TfEditorUsuarios.actCambiarPasswordUpdate(Sender: TObject);
begin
inherited;
if (Sender as TAction).Enabled then
(Sender as TAction).Enabled := HayDatos;
end;
procedure TfEditorUsuarios.actEliminarUpdate(Sender: TObject);
begin
inherited;
if (Sender as TAction).Enabled then
(Sender as TAction).Enabled := (FUsuarios.PRIVILEGED = 0);
end;
procedure TfEditorUsuarios.AsignarVista;
begin
ViewGrid := CreateView(TfrViewUsuarios) as IViewUsuarios;
end;
constructor TfEditorUsuarios.Create(AOwner: TComponent);
begin
inherited;
AsignarVista;
end;
destructor TfEditorUsuarios.Destroy;
begin
FUsuarios := NIL;
FController := NIl;
inherited;
end;
procedure TfEditorUsuarios.DuplicarInterno;
begin
inherited;
end;
procedure TfEditorUsuarios.EliminarInterno;
begin
if (ShowConfirmMessage('Eliminar un usuario', Format('¿Desea borrar el usuario %s?', [FUsuarios.USERNAME])) = IDYES) then
begin
inherited;
//Para que en el caso de no poderse realizar la operación se refresquen
//los datos y no nos permita eliminar un registro a la segunda
FController.EliminarUsuario(FUsuarios.ID);
actRefrescar.Execute;
end;
end;
function TfEditorUsuarios.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfEditorUsuarios.GetUsuarios: IBizUsuario;
begin
Result := FUsuarios;
end;
procedure TfEditorUsuarios.ImprimirInterno;
begin
inherited;
end;
procedure TfEditorUsuarios.ModificarInterno;
begin
inherited;
FController.VerUsuario(FUsuarios.ID);
actRefrescar.Execute;
end;
procedure TfEditorUsuarios.NuevoInterno;
var
ANuevoUsuario : IBizUsuario;
begin
inherited;
ANuevoUsuario := FController.NuevoUsuario;
FController.VerUsuario(ANuevoUsuario);
actRefrescar.Execute;
end;
procedure TfEditorUsuarios.PonerTitulos(const ATitulo: string);
var
FTitulo : String;
begin
FTitulo := 'Lista de usuarios';
inherited PonerTitulos(FTitulo);
end;
procedure TfEditorUsuarios.PrevisualizarInterno;
begin
inherited;
end;
procedure TfEditorUsuarios.SetController(const Value: IUsuariosController);
begin
FController := Value;
end;
procedure TfEditorUsuarios.SetUsuarios(const Value: IBizUsuario);
begin
FUsuarios := Value;
dsDataTable.DataTable := FUsuarios.DataTable;
if Assigned(ViewGrid) then
(ViewGrid as IViewUsuarios).Usuarios := FUsuarios;
end;
end.

12
Source/ApplicationBase/Usuarios/Views/uUsuariosViewRegister.pas
View File

@ -8,16 +8,26 @@ procedure UnregisterViews;
implementation
uses
uEditorRegistryUtils, uEditorLogin, Dialogs;
uEditorRegistryUtils, uEditorLogin, Dialogs, uEditorUsuario, uEditorUsuarios,
uEditorPerfilesUsuario, uEditorPerfilUsuario;
procedure RegisterViews;
begin
EditorRegistry.RegisterClass(TfEditorLogin, 'EditorLogin');
EditorRegistry.RegisterClass(TfEditorUsuarios, 'EditorUsuarios');
EditorRegistry.RegisterClass(TfEditorUsuario, 'EditorUsuario');
EditorRegistry.RegisterClass(TfEditorPerfilesUsuario, 'EditorPerfilesUsuario');
EditorRegistry.RegisterClass(TfEditorPerfilUsuario, 'EditorPerfilUsuario');
end;
procedure UnregisterViews;
begin
EditorRegistry.UnRegisterClass(TfEditorLogin);
EditorRegistry.UnRegisterClass(TfEditorUsuarios);
EditorRegistry.UnRegisterClass(TfEditorUsuario);
EditorRegistry.UnRegisterClass(TfEditorPerfilesUsuario);
EditorRegistry.UnRegisterClass(TfEditorPerfilUsuario);
end;
end.

68
Source/ApplicationBase/Usuarios/Views/uViewPerfilUsuario.dfm Normal file
View File

@ -0,0 +1,68 @@
inherited frViewPerfilUsuario: TfrViewPerfilUsuario
Width = 509
Height = 122
ExplicitWidth = 509
ExplicitHeight = 122
object dxLayoutControlArticulo: TdxLayoutControl
Left = 0
Top = 0
Width = 509
Height = 113
Align = alTop
ParentBackground = True
TabOrder = 0
AutoContentSizes = [acsWidth]
DesignSize = (
509
113)
object eNombre: TcxDBTextEdit
Left = 68
Top = 28
Anchors = [akLeft, akTop, akRight]
DataBinding.DataField = 'USERNAME'
DataBinding.DataSource = dsUsuario
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.Color = 14745599
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 0
Width = 164
end
object dxLayoutGroup1: TdxLayoutGroup
ShowCaption = False
Hidden = True
ShowBorder = False
object dxLayoutGroup2: TdxLayoutGroup
AutoAligns = []
AlignHorz = ahClient
AlignVert = avClient
Caption = 'Datos del perfil'
object dxLayoutControlArticuloItem3: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
Caption = 'Nombre:'
Control = eNombre
ControlOptions.ShowBorder = False
end
end
object dxLayoutControlArticuloGroup3: TdxLayoutGroup
Caption = 'New Group'
ShowCaption = False
LayoutDirection = ldHorizontal
ShowBorder = False
end
end
end
object dsUsuario: TDADataSource
Left = 152
Top = 24
end
end

82
Source/ApplicationBase/Usuarios/Views/uViewPerfilUsuario.pas Normal file
View File

@ -0,0 +1,82 @@
unit uViewPerfilUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uViewBase, uUsuariosController, cxGraphics, ImgList, PngImageList,
dxLayoutControl, cxCurrencyEdit, uCustomView, cxControls, DB, uDAInterfaces,
uDADataTable, ActnList, cxCheckBox, cxDBEdit, cxMaskEdit, cxSpinEdit,
cxHyperLinkEdit, cxContainer, cxEdit, cxTextEdit, Buttons, PngSpeedButton,
uBizUsuarios, cxDropDownEdit;
type
IViewPerfilUsuario = interface(IViewBase)
['{555B4B64-BE32-4036-B741-DCC7AD80D7B9}']
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
function GetPerfilUsuario: IBizPerfilUsuario;
procedure SetPerfilUsuario(const Value: IBizPerfilUsuario);
property PerfilUsuario: IBizPerfilUsuario read GetPerfilUsuario write SetPerfilUsuario;
end;
TfrViewPerfilUsuario = class(TfrViewBase, IViewPerfilUsuario)
dsUsuario: TDADataSource;
dxLayoutControlArticulo: TdxLayoutControl;
eNombre: TcxDBTextEdit;
dxLayoutGroup1: TdxLayoutGroup;
dxLayoutGroup2: TdxLayoutGroup;
dxLayoutControlArticuloItem3: TdxLayoutItem;
dxLayoutControlArticuloGroup3: TdxLayoutGroup;
protected
FController: IUsuariosController;
FPerfilUsuario : IBizPerfilUsuario;
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetPerfilUsuario: IBizPerfilUsuario;
procedure SetPerfilUsuario(const Value: IBizPerfilUsuario);
public
property PerfilUsuario: IBizPerfilUsuario read GetPerfilUsuario write SetPerfilUsuario;
property Controller : IUsuariosController read GetController write SetController;
end;
implementation
{$R *.dfm}
{ TfrViewUsuario }
function TfrViewPerfilUsuario.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfrViewPerfilUsuario.GetPerfilUsuario: IBizPerfilUsuario;
begin
Result := FPerfilUsuario;
end;
procedure TfrViewPerfilUsuario.SetController(const Value: IUsuariosController);
begin
FController := Value;
end;
procedure TfrViewPerfilUsuario.SetPerfilUsuario(const Value: IBizPerfilUsuario);
begin
FPerfilUsuario := Value;
if Assigned(FPerfilUsuario) then
dsUsuario.DataTable := FPerfilUsuario.DataTable
else begin
dsUsuario.DataTable := NIL;
FPerfilUsuario := NIL;
end;
end;
end.

75
Source/ApplicationBase/Usuarios/Views/uViewPerfilesUsuario.dfm Normal file
View File

@ -0,0 +1,75 @@
inherited frViewPerfilesUsuario: TfrViewPerfilesUsuario
inherited cxGrid: TcxGrid
inherited cxGridView: TcxGridDBTableView
object cxGridViewID: TcxGridDBColumn
DataBinding.FieldName = 'ID'
Visible = False
BestFitMaxWidth = 20
VisibleForCustomization = False
Width = 20
end
object cxGridViewUSERNAME: TcxGridDBColumn
DataBinding.FieldName = 'USERNAME'
Width = 150
end
object cxGridViewTIPO: TcxGridDBColumn
DataBinding.FieldName = 'TIPO'
Visible = False
VisibleForCustomization = False
end
end
end
inherited frViewFiltroBase1: TfrViewFiltroBase
inherited TBXDockablePanel1: TTBXDockablePanel
inherited dxLayoutControl1: TdxLayoutControl
inherited txtFiltroTodo: TcxTextEdit
ExplicitWidth = 273
Width = 273
end
inherited edtFechaIniFiltro: TcxDateEdit
ExplicitWidth = 121
Width = 121
end
inherited edtFechaFinFiltro: TcxDateEdit
ExplicitWidth = 121
Width = 121
end
end
end
end
inherited pnlAgrupaciones: TTBXDockablePanel
ExplicitWidth = 554
inherited TBXAlignmentPanel1: TTBXAlignmentPanel
inherited TBXToolbar1: TTBXToolbar
Visible = False
end
end
end
inherited dsDataSource: TDADataSource
DataSet = tbl_USUARIOS.Dataset
DataTable = DataModuleUsuarios.tbl_USUARIOS
end
inherited dxComponentPrinter: TdxComponentPrinter
inherited dxComponentPrinterLink: TdxGridReportLink
ReportDocument.CreationDate = 39456.431825266210000000
BuiltInReportLink = True
end
end
inherited dxPSEngineController1: TdxPSEngineController
Left = 304
Top = 168
end
inherited cxStyleRepository1: TcxStyleRepository
Left = 280
Top = 160
end
inherited cxViewGridPopupMenu: TcxGridPopupMenu
Left = 248
Top = 160
end
inherited dxPrintStyleManager1: TdxPrintStyleManager
inherited dxPrintStyleManager1Style1: TdxPSPrintStyle
BuiltInStyle = True
end
end
end

56
Source/ApplicationBase/Usuarios/Views/uViewPerfilesUsuario.pas Normal file
View File

@ -0,0 +1,56 @@
unit uViewPerfilesUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uViewGrid, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, dxPSGlbl, dxPSUtl, dxPSEngn, dxPrnPg,
dxBkgnd, dxWrap, dxPrnDev, dxPSCompsProvider, dxPSFillPatterns,
dxPSEdgePatterns, dxPgsDlg, dxPSCore, ImgList, PngImageList, ActnList,
cxGridCustomPopupMenu, cxGridPopupMenu, dxPScxCommon, dxPScxGrid6Lnk,
uDAInterfaces, uDADataTable, TB2Item, TBX, TB2Toolbar, TBXDkPanels, TB2Dock,
uViewFiltroBase, cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,
uBizUsuarios;
type
IViewPerfilesUsuario = interface(IViewGrid)
['{C6125F2F-5EDC-4019-BD5F-9AC9741F0F77}']
function GetPerfilesUsuario: IBizPerfilUsuario;
procedure SetPerfilesUsuario(const Value: IBizPerfilUsuario);
property PerfilesUsuario: IBizPerfilUsuario read GetPerfilesUsuario write SetPerfilesUsuario;
end;
TfrViewPerfilesUsuario = class(TfrViewGrid, IViewPerfilesUsuario)
cxGridViewID: TcxGridDBColumn;
cxGridViewUSERNAME: TcxGridDBColumn;
cxGridViewTIPO: TcxGridDBColumn;
protected
FPerfiles : IBizPerfilUsuario;
function GetPerfilesUsuario: IBizPerfilUsuario;
procedure SetPerfilesUsuario(const Value: IBizPerfilUsuario);
public
property PerfilesUsuario: IBizPerfilUsuario read GetPerfilesUsuario write SetPerfilesUsuario;
end;
implementation
{$R *.dfm}
{ TfrViewPerfilesUsuario }
function TfrViewPerfilesUsuario.GetPerfilesUsuario: IBizPerfilUsuario;
begin
Result := FPerfiles;
end;
procedure TfrViewPerfilesUsuario.SetPerfilesUsuario(const Value: IBizPerfilUsuario);
begin
FPerfiles := Value;
if Assigned(FPerfiles) then
dsDataSource.DataTable := FPerfiles.DataTable;
end;
end.

301
Source/ApplicationBase/Usuarios/Views/uViewUsuario.dfm Normal file
View File

@ -0,0 +1,301 @@
inherited frViewUsuario: TfrViewUsuario
Width = 509
Height = 275
OnCreate = CustomViewCreate
OnDestroy = CustomViewDestroy
ExplicitWidth = 509
ExplicitHeight = 275
object dxLayoutControlArticulo: TdxLayoutControl
Left = 0
Top = 0
Width = 509
Height = 249
Align = alTop
ParentBackground = True
TabOrder = 0
AutoContentSizes = [acsWidth]
DesignSize = (
509
249)
object PngSpeedButton3: TPngSpeedButton
Left = 335
Top = 82
Width = 23
Height = 22
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
610000000970485973000017120000171201679FD252000001964944415478DA
63FCFFFF3F03232323033A58BCE9F87F647EAC9F258622B05E6C068034873B8A
80D92019C62F8F194C1356339CDF399D91A0014B361FFB1FE6208AA299E1F323
306D52F90CC5100C03566E3DFC3FD04E02A2F9F727064690462066006A66FC02
64FFFAC8603451096E088A01CB361FFDFF8F819981183077D11A86FDAB7B18E1
062CDD7CE27F14573FC3B2EF450CD13E86181ABE7DFFCDF0F5DB6F866FDFFE30
1CB97897218AB38FC1B85B98E1DC8E698C600396000D8861696058FAB7116CC0
94C5FBB0DAEC6CAECF70EED6238668E67AB057500CF8F0E10383A0A0208A0B90
6D06B1BF01D9379E3C67387AFE09C389A37BD15CE06B01B47907434EAC13C3EF
3F7F19662E3F8862BB898606C3EFDFFF1896EF3DCFA0A5C0CD306FE9265403FC
9D20362F5CB71F4CE7C47AA01890D5BC164C7716F980D56018606BAC0656B079
EF2986F82047AC6150DEB785A13CD911AC06C300234D05867DC72F30B8D818E1
8DC2494B0E63F702281075D455884A07576EDEC134404A5480E1DAED07441900
021806F44D5D44B46618801B400900007F4518F05E90AAF20000000049454E44
AE426082}
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
end
object eNombre: TcxDBTextEdit
Left = 135
Top = 28
Anchors = [akLeft, akTop, akRight]
DataBinding.DataField = 'USERNAME'
DataBinding.DataSource = dsUsuario
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.Color = 14745599
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 0
Width = 164
end
object eUsuario: TcxDBTextEdit
Left = 135
Top = 55
DataBinding.DataField = 'LOGIN'
DataBinding.DataSource = dsUsuario
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.Color = 14745599
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 1
Width = 108
end
object eMail: TcxDBHyperLinkEdit
Left = 135
Top = 82
DataBinding.DataField = 'EMAIL'
DataBinding.DataSource = dsUsuario
Properties.UsePrefix = upOnlyOnExecute
Properties.ValidateOnEnter = True
Properties.OnEditValueChanged = eMailPropertiesEditValueChanged
Properties.OnValidate = eMailPropertiesValidate
Properties.Prefix = 'mailto:'
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 2
Width = 194
end
object ePassword: TcxTextEdit
Left = 135
Top = 167
Properties.EchoMode = eemPassword
Properties.PasswordChar = '*'
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 4
Width = 121
end
object eConfirmarPassword: TcxTextEdit
Left = 135
Top = 194
Properties.EchoMode = eemPassword
Properties.PasswordChar = '*'
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 5
Width = 372
end
object cbPerfil: TcxComboBox
Left = 135
Top = 110
Properties.DropDownListStyle = lsEditFixedList
Properties.ImmediatePost = True
Properties.ImmediateUpdateText = True
Properties.PostPopupValueOnTab = True
Properties.OnValidate = cbPerfilPropertiesValidate
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 3
Width = 194
end
object dxLayoutGroup1: TdxLayoutGroup
ShowCaption = False
Hidden = True
ShowBorder = False
object dxLayoutGroup2: TdxLayoutGroup
AutoAligns = []
AlignHorz = ahClient
AlignVert = avClient
Caption = 'Datos del usuario'
object dxLayoutControlArticuloItem3: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
Caption = 'Nombre completo:'
Control = eNombre
ControlOptions.ShowBorder = False
end
object dxLayoutControlArticuloItem8: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
Caption = 'Usuario:'
Control = eUsuario
ControlOptions.ShowBorder = False
end
object dxLayoutControlArticuloGroup2: TdxLayoutGroup
ShowCaption = False
Hidden = True
LayoutDirection = ldHorizontal
ShowBorder = False
object dxLayoutControlArticuloItem4: TdxLayoutItem
AutoAligns = [aaVertical]
Caption = 'Correo electr'#243'nico'
Control = eMail
ControlOptions.ShowBorder = False
end
object dxLayoutControlArticuloItem5: TdxLayoutItem
ShowCaption = False
Control = PngSpeedButton3
ControlOptions.ShowBorder = False
end
end
object dxLayoutControlArticuloItem1: TdxLayoutItem
AutoAligns = [aaVertical]
Caption = 'Perfil de usuario:'
Control = cbPerfil
ControlOptions.ShowBorder = False
end
end
object dxLayoutControlArticuloGroup5: TdxLayoutGroup
Caption = 'Seguridad'
object dxLayoutControlArticuloItem11: TdxLayoutItem
Caption = 'Contrase'#241'a:'
Control = ePassword
ControlOptions.ShowBorder = False
end
object dxLayoutControlArticuloItem12: TdxLayoutItem
Caption = 'Confirmar contrase'#241'a:'
Control = eConfirmarPassword
ControlOptions.ShowBorder = False
end
end
object dxLayoutControlArticuloGroup3: TdxLayoutGroup
Caption = 'New Group'
ShowCaption = False
LayoutDirection = ldHorizontal
ShowBorder = False
end
end
end
object ActionList1: TActionList
Images = SmallImages
Left = 72
Top = 48
object actMandarCorreo: TAction
Caption = 'Mandar un correo'
ImageIndex = 0
OnExecute = actMandarCorreoExecute
OnUpdate = actMandarCorreoUpdate
end
end
object dsUsuario: TDADataSource
Left = 104
Top = 48
end
object SmallImages: TPngImageList
PngImages = <
item
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
610000000970485973000017120000171201679FD252000001EB4944415478DA
A5D34B68135114C6F1FF746692462D24D5A8F5B52B81B448501475E142D4EAA2
3420E8C68A0A45345BC19DE24A74D50AE2424A11041105DD28A8881411174A70
E58BA4149A1A0D8D1D9B669E997B9D14B1A44491E6C2D9DDF3BB1F877B94DB8F
5E4B5A384A1D3831B06759CDDB0E9D5B04865FD9CD6F49C95A374B4ADC20AAE4
9936B6F244CF70299DFA3F40F5AB1C74CEB225FE1C654E4796DA7963A6D977F2
FABF81E061EAC3D1EC0247C531A27A017E846026CC844890CC3CFE3B506F1641
D9025CCFA4DF384FD27F419BA1231C9D67917ED267AE3507A414E4BF8DD3B1AA
07A97562F92A31EB037B8D313658137CD292DC5D719A7B83C9E640AEF892F1DC
454A5FABEC4E5D21BEBE0FD397411217E15599911D547C8DEC60A411B8FC34C7
C3F7C71710BD73927CB686E785D87FE01D22483267FDC45156620A0DAB069F4F
B53702A9ABBB08AF2E20DB7C1CB386517698FE52A56BE31136272EF0F16D1F44
7610EF7D802554A68696003B6F6D42517DAC6A0D3B006CCB67B6686356248944
0F8635C9F7A90A91F800E1EE51CA99D81260B40B27C8F607307DECF91AF38687
A6AB74A7A2940A26E5A28B164FE38CDC67FBE1CC22D03BB226007E2708202700
5CAB5E62E14344D785084734664B0EBE8CE18D951A81967661F8E69DE56FA394
2D6D33BF00C89C2C72EBA3BC190000000049454E44AE426082}
Name = 'PngImage0'
Background = clWindow
end
item
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
61000000097048597300000AEB00000AEB01828B0D5A000002854944415478DA
A5935D48536118C7FFAFDB8CCD557E7F34B33167F9119617A91596495D781304
451021A651362821B1ABA49B6EA4460961D88542055D84DD6545415992174994
9625CC8F9C329D9B5F3BE9CED9D9797BCEA1C932A3A0079EC3CBE13CBFE7FF7F
9FF330CE39FE2798FAB80BA4E61559EB2551E67B07279AE8D51FA98F2CC99546
031A3D6E5FF329993F631D80B52227A6D7929F9BAEA459D1D73BE8DC3330D6B8
1AD206641414DA5A6224E1E8ECA47779660955D532EF642F1371BD74331A14FA
9C27A4439F5D88777DAE1B65FD230D11485786B9363D65FD35C1EB4B9817427E
9F80C335C05BD53E23B2A934132FB23662B71406C2B14698F38AF0E9EB9473E8
E3C8655BD686D6F858A5DA3F27B04511E37E0195B5C0A00AD6003FE5259758F0
3AD1843C15125218CCB6AD707FF34EAC93973217041154ECF608D8770E188BD8
5A01A8A1DEC5F60CF4980CB0A890E8A47AFFF477EC3F037C8EBE975F006ADC37
60A7351E3D061DE222C522A5270047AD82DBAB27B21AC09EDA373525E9A52BCB
7E5F4CB4822509BE80848AB3C0C09A806380EE7CA1BDC55EB4CDE17AF2984932
75A60CCA088739742A84CE1E49C1010730F41BA03B27CD595C517CB1FFF92B04
E6035AF142101DCB12DA743AB413243FA468331D0F01E51780D1154057AAF148
D92E7BE794778E8DB92634C901116FA6451CAA27214EC06802AE5227AA839ED2
45A0729AC6A406182DD9329C10A7B7F57D18D63A93DF99D92076905F4FB4DF56
A08C20ED9476027CD1209C7BD9FBDC947BC1C0E2C9596A4B003E27E2F8E9301E
AEB507B700334968A6631D019C759C5F627780822413BA194312CDFB41958C13
7FDB4052739000430ECEDD913F313B568F9B8B326AC8F7CCBFAEB27A073F0058
5538F0EAB25B380000000049454E44AE426082}
Name = 'PngImage1'
Background = clWindow
end>
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
Left = 43
Top = 48
Bitmap = {}
end
end

210
Source/ApplicationBase/Usuarios/Views/uViewUsuario.pas Normal file
View File

@ -0,0 +1,210 @@
unit uViewUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uViewBase, uUsuariosController, cxGraphics, ImgList, PngImageList,
dxLayoutControl, cxCurrencyEdit, uCustomView, cxControls, DB, uDAInterfaces,
uDADataTable, ActnList, cxCheckBox, cxDBEdit, cxMaskEdit, cxSpinEdit,
cxHyperLinkEdit, cxContainer, cxEdit, cxTextEdit, Buttons, PngSpeedButton,
uBizUsuarios, cxDropDownEdit, ExtCtrls;
type
IViewUsuario = interface(IViewBase)
['{E47D5136-A50C-4757-9352-4745518A899D}']
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
property Controller : IUsuariosController read GetController write SetController;
function GetUsuario: IBizUsuario;
procedure SetUsuario(const Value: IBizUsuario);
property Usuario: IBizUsuario read GetUsuario write SetUsuario;
end;
TfrViewUsuario = class(TfrViewBase, IViewUsuario)
ActionList1: TActionList;
dsUsuario: TDADataSource;
dxLayoutControlArticulo: TdxLayoutControl;
eNombre: TcxDBTextEdit;
eUsuario: TcxDBTextEdit;
dxLayoutGroup1: TdxLayoutGroup;
dxLayoutGroup2: TdxLayoutGroup;
dxLayoutControlArticuloItem3: TdxLayoutItem;
dxLayoutControlArticuloItem8: TdxLayoutItem;
dxLayoutControlArticuloGroup3: TdxLayoutGroup;
SmallImages: TPngImageList;
dxLayoutControlArticuloItem4: TdxLayoutItem;
eMail: TcxDBHyperLinkEdit;
dxLayoutControlArticuloItem5: TdxLayoutItem;
PngSpeedButton3: TPngSpeedButton;
actMandarCorreo: TAction;
dxLayoutControlArticuloGroup2: TdxLayoutGroup;
ePassword: TcxTextEdit;
dxLayoutControlArticuloItem11: TdxLayoutItem;
dxLayoutControlArticuloItem12: TdxLayoutItem;
eConfirmarPassword: TcxTextEdit;
dxLayoutControlArticuloGroup5: TdxLayoutGroup;
cbPerfil: TcxComboBox;
dxLayoutControlArticuloItem1: TdxLayoutItem;
procedure actMandarCorreoExecute(Sender: TObject);
procedure actMandarCorreoUpdate(Sender: TObject);
procedure cbPerfilPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
procedure CustomViewCreate(Sender: TObject);
procedure CustomViewDestroy(Sender: TObject);
procedure eMailPropertiesEditValueChanged(Sender: TObject);
procedure eMailPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
protected
FController: IUsuariosController;
FUsuario : IBizUsuario;
FListaPerfiles : TStringList;
function GetController : IUsuariosController;
procedure SetController (const Value : IUsuariosController);
function GetUsuario: IBizUsuario;
procedure SetUsuario(const Value: IBizUsuario);
public
property Usuario: IBizUsuario read GetUsuario write SetUsuario;
property Controller : IUsuariosController read GetController write SetController;
end;
implementation
{$R *.dfm}
type
THackcxDBHyperLinkEdit = class(TcxDBHyperLinkEdit);
{ TfrViewUsuario }
procedure TfrViewUsuario.actMandarCorreoExecute(Sender: TObject);
begin
inherited;
THackcxDBHyperLinkEdit(eMail).DoStart;
end;
procedure TfrViewUsuario.actMandarCorreoUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (Length(eMail.Text) > 0)
end;
procedure TfrViewUsuario.cbPerfilPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
var
AIndex : integer;
begin
inherited;
if Assigned(FUsuario) and FUsuario.Active then
begin
if DisplayValue = cbPerfil.Properties.Items[0] then
AIndex := 0
else
AIndex := StrToInt(FListaPerfiles.Values[DisplayValue]);
FUsuario.Edit;
FUsuario.ID_PERFIL := AIndex;
FUsuario.Post;
end;
end;
procedure TfrViewUsuario.CustomViewCreate(Sender: TObject);
begin
inherited;
FListaPerfiles := NIL;
end;
procedure TfrViewUsuario.CustomViewDestroy(Sender: TObject);
begin
inherited;
FreeAndNIL(FListaPerfiles);
end;
procedure TfrViewUsuario.eMailPropertiesEditValueChanged(Sender: TObject);
begin
if not VarIsNull((Sender as TcxDBHyperLinkEdit).EditValue) then
(Sender as TcxDBHyperLinkEdit).EditValue := StringReplace((Sender as TcxDBHyperLinkEdit).EditValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
procedure TfrViewUsuario.eMailPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
begin
if not VarIsNull(DisplayValue) then
DisplayValue := StringReplace(DisplayValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
function TfrViewUsuario.GetController: IUsuariosController;
begin
Result := FController;
end;
function TfrViewUsuario.GetUsuario: IBizUsuario;
begin
Result := FUsuario;
end;
procedure TfrViewUsuario.SetController(const Value: IUsuariosController);
var
i : integer;
begin
FController := Value;
if Assigned(FController) then
begin
FListaPerfiles := FController.DarListaPerfilesUsuario;
with cbPerfil.Properties.Items do
begin
BeginUpdate;
try
Clear;
Add('<Ninguno>');
for i := 0 to FListaPerfiles.Count - 1 do
Add(FListaPerfiles.Names[i]);
finally
EndUpdate;
end;
end;
end;
end;
procedure TfrViewUsuario.SetUsuario(const Value: IBizUsuario);
var
i : integer;
begin
FUsuario := Value;
if Assigned(FUsuario) then
begin
dsUsuario.DataTable := FUsuario.DataTable;
if FUsuario.EsNuevo then
begin
dxLayoutControlArticuloGroup5.Visible := True;
cbPerfil.Text := cbPerfil.Properties.Items[0];
end
else begin
dxLayoutControlArticuloGroup5.Visible := False;
cbPerfil.Text := cbPerfil.Properties.Items[0];
for i := 0 to FListaPerfiles.Count-1 do
begin
if FListaPerfiles.ValueFromIndex[i] = IntToStr(FUsuario.ID_PERFIL) then
begin
cbPerfil.Text := FListaPerfiles.Names[i];
break;
end;
end;
end;
end
else begin
dsUsuario.DataTable := NIL;
FUsuario := NIL;
end;
end;
end.

115
Source/ApplicationBase/Usuarios/Views/uViewUsuarios.dfm Normal file
View File

@ -0,0 +1,115 @@
inherited frViewUsuarios: TfrViewUsuarios
inherited cxGrid: TcxGrid
inherited cxGridView: TcxGridDBTableView
object cxGridViewID: TcxGridDBColumn
DataBinding.FieldName = 'ID'
Visible = False
BestFitMaxWidth = 20
VisibleForCustomization = False
Width = 20
end
object cxGridViewUSERNAME: TcxGridDBColumn
DataBinding.FieldName = 'USERNAME'
Width = 150
end
object cxGridViewLOGIN: TcxGridDBColumn
DataBinding.FieldName = 'LOGIN'
BestFitMaxWidth = 75
Width = 75
end
object cxGridViewPASS: TcxGridDBColumn
DataBinding.FieldName = 'PASS'
Visible = False
VisibleForCustomization = False
end
object cxGridViewPASSEXPIRED: TcxGridDBColumn
DataBinding.FieldName = 'PASSEXPIRED'
Visible = False
VisibleForCustomization = False
end
object cxGridViewBLOQUEADO: TcxGridDBColumn
DataBinding.FieldName = 'BLOQUEADO'
Visible = False
VisibleForCustomization = False
end
object cxGridViewEMAIL: TcxGridDBColumn
DataBinding.FieldName = 'EMAIL'
BestFitMaxWidth = 120
Width = 120
end
object cxGridViewUSERDAYSSUN: TcxGridDBColumn
DataBinding.FieldName = 'USERDAYSSUN'
Visible = False
VisibleForCustomization = False
end
object cxGridViewPRIVILEGED: TcxGridDBColumn
DataBinding.FieldName = 'PRIVILEGED'
Visible = False
VisibleForCustomization = False
end
object cxGridViewTIPO: TcxGridDBColumn
DataBinding.FieldName = 'TIPO'
Visible = False
VisibleForCustomization = False
end
object cxGridViewID_PERFIL: TcxGridDBColumn
DataBinding.FieldName = 'ID_PERFIL'
Visible = False
VisibleForCustomization = False
end
end
end
inherited frViewFiltroBase1: TfrViewFiltroBase
inherited TBXDockablePanel1: TTBXDockablePanel
inherited dxLayoutControl1: TdxLayoutControl
inherited txtFiltroTodo: TcxTextEdit
ExplicitWidth = 273
Width = 273
end
inherited edtFechaIniFiltro: TcxDateEdit
ExplicitWidth = 121
Width = 121
end
inherited edtFechaFinFiltro: TcxDateEdit
ExplicitWidth = 121
Width = 121
end
end
end
end
inherited pnlAgrupaciones: TTBXDockablePanel
ExplicitWidth = 554
inherited TBXAlignmentPanel1: TTBXAlignmentPanel
inherited TBXToolbar1: TTBXToolbar
Visible = False
end
end
end
inherited dsDataSource: TDADataSource
DataSet = tbl_USUARIOS.Dataset
DataTable = DataModuleUsuarios.tbl_USUARIOS
end
inherited dxComponentPrinter: TdxComponentPrinter
inherited dxComponentPrinterLink: TdxGridReportLink
ReportDocument.CreationDate = 39456.431825266210000000
BuiltInReportLink = True
end
end
inherited dxPSEngineController1: TdxPSEngineController
Left = 304
Top = 168
end
inherited cxStyleRepository1: TcxStyleRepository
Left = 280
Top = 160
end
inherited cxViewGridPopupMenu: TcxGridPopupMenu
Left = 248
Top = 160
end
inherited dxPrintStyleManager1: TdxPrintStyleManager
inherited dxPrintStyleManager1Style1: TdxPSPrintStyle
BuiltInStyle = True
end
end
end

64
Source/ApplicationBase/Usuarios/Views/uViewUsuarios.pas Normal file
View File

@ -0,0 +1,64 @@
unit uViewUsuarios;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uViewGrid, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, dxPSGlbl, dxPSUtl, dxPSEngn, dxPrnPg,
dxBkgnd, dxWrap, dxPrnDev, dxPSCompsProvider, dxPSFillPatterns,
dxPSEdgePatterns, dxPgsDlg, dxPSCore, ImgList, PngImageList, ActnList,
cxGridCustomPopupMenu, cxGridPopupMenu, dxPScxCommon, dxPScxGrid6Lnk,
uDAInterfaces, uDADataTable, TB2Item, TBX, TB2Toolbar, TBXDkPanels, TB2Dock,
uViewFiltroBase, cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,
uBizUsuarios;
type
IViewUsuarios = interface(IViewGrid)
['{2F46A4FC-6501-47B2-AAB3-28B552DDA455}']
function GetUsuarios: IBizUsuario;
procedure SetUsuarios(const Value: IBizUsuario);
property Usuarios: IBizUsuario read GetUsuarios write SetUsuarios;
end;
TfrViewUsuarios = class(TfrViewGrid, IViewUsuarios)
cxGridViewID: TcxGridDBColumn;
cxGridViewUSERNAME: TcxGridDBColumn;
cxGridViewLOGIN: TcxGridDBColumn;
cxGridViewPASS: TcxGridDBColumn;
cxGridViewPASSEXPIRED: TcxGridDBColumn;
cxGridViewBLOQUEADO: TcxGridDBColumn;
cxGridViewEMAIL: TcxGridDBColumn;
cxGridViewUSERDAYSSUN: TcxGridDBColumn;
cxGridViewPRIVILEGED: TcxGridDBColumn;
cxGridViewTIPO: TcxGridDBColumn;
cxGridViewID_PERFIL: TcxGridDBColumn;
protected
FUsuarios : IBizUsuario;
function GetUsuarios: IBizUsuario;
procedure SetUsuarios(const Value: IBizUsuario);
public
property Usuarios: IBizUsuario read GetUsuarios write SetUsuarios;
end;
implementation
{$R *.dfm}
{ TfrViewUsuarios }
function TfrViewUsuarios.GetUsuarios: IBizUsuario;
begin
Result := FUsuarios;
end;
procedure TfrViewUsuarios.SetUsuarios(const Value: IBizUsuario);
begin
FUsuarios := Value;
if Assigned(FUsuarios) then
dsDataSource.DataTable := FUsuarios.DataTable;
end;
end.

492
Source/ApplicationBase/_Usuarios_/Usuarios.bdsproj
View File

@ -1,492 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{0E3D28A9-51AF-483B-B478-472A086EE120}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">Usuarios.dpk</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">0</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">1</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">1</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">3</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="GenerateHpps">False</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription">Gestión de usuarios</Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir">.\</Directories>
<Directories Name="PackageDLLOutputDir">..\..\..\Output\Debug\Cliente</Directories>
<Directories Name="PackageDCPOutputDir">..\..\Lib</Directories>
<Directories Name="SearchPath">..\..\Lib;..\..\Modulos\Lib</Directories>
<Directories Name="Packages">vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;dclOfficeXP;cxLibraryVCLD7;dxThemeD7;cxTreeListVCLD7;cxEditorsVCLD7;cxDataD7;cxExtEditorsVCLD7;cxGridVCLD7;cxPageControlVCLD7;cxSchedulerVCLD7;dxComnD7;dxsbD7;dxBarD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxLayoutControlD7;dxNavBarD7;dxPSCoreD7;cxExportVCLD7;cxIntl5D7;cxIntlPrintSys3D7;cxIntlSchedulerD7;fsIBX7;fs7;fqb70;frx7;frxADO7;frxBDE7;frxcs7;frxDB7;frxDBX7;frxe7;frxIBX7;fsADO7;fsBDE7;fsDB7;cxVerticalGridVCLD7</Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir">C:\Archivos de programa\Borland\Delphi7\Bin\</Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">3</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">3082</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.3.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=519
Activate=1
Activate Handle=1
Save Log File=1
Foreground Tab=0
Freeze Activate=0
Freeze Timeout=60
Freeze Message=The application seems to be frozen.
SMTP From=eurekalog@email.com
SMTP Host=
SMTP Port=25
SMTP UserID=
SMTP Password=
Append to Log=0
Show TerminateBtn=1
TerminateBtn Operation=1
Errors Number=32
Errors Terminate=3
Email Address=
Email Object=
Email Send Options=0
Output Path=
Encrypt Password=
AutoCloseDialogSecs=0
WebSendMode=0
SupportULR=
HTMLLayout Count=15
HTMLLine0="%3Chtml%3E"
HTMLLine1=" %3Chead%3E"
HTMLLine2=" %3C/head%3E"
HTMLLine3=" %3Cbody TopMargin=10 LeftMargin=10%3E"
HTMLLine4=" %3Ctable width="100%%" border="0"%3E"
HTMLLine5=" %3Ctr%3E"
HTMLLine6=" %3Ctd nowrap%3E"
HTMLLine7=" %3Cfont face="Lucida Console, Courier" size="2"%3E"
HTMLLine8=" %3C%%HTML_TAG%%%3E"
HTMLLine9=" %3C/font%3E"
HTMLLine10=" %3C/td%3E"
HTMLLine11=" %3C/tr%3E"
HTMLLine12=" %3C/table%3E"
HTMLLine13=" %3C/body%3E"
HTMLLine14="%3C/html%3E"
AutoCrashOperation=1
AutoCrashNumber=10
AutoCrashMinutes=1
WebURL=
WebUserID=
WebPassword=
WebPort=0
AttachedFiles=
Count=0
EMail Message Line Count=0
loNoDuplicateErrors=0
loAppendReproduceText=0
loDeleteLogAtVersionChange=0
loAddComputerNameInLogFileName=0
loSaveModulesSection=1
loSaveCPUSection=1
soAppStartDate=1
soAppName=1
soAppVersionNumber=1
soAppParameters=1
soAppCompilationDate=1
soExcDate=1
soExcAddress=1
soExcModule=1
soExcType=1
soExcMessage=1
soActCtlsFormClass=1
soActCtlsFormText=1
soActCtlsControlClass=1
soActCtlsControlText=1
soCmpName=1
soCmpUser=1
soCmpTotalMemory=1
soCmpFreeMemory=1
soCmpTotalDisk=1
soCmpFreeDisk=1
soCmpSysUpTime=1
soCmpProcessor=1
soCmpDisplayMode=1
soOSType=1
soOSBuildN=1
soOSUpdate=1
soOSLanguage=1
soNetIP=1
soNetSubmask=1
soNetGateway=1
soNetDNS1=1
soNetDNS2=1
soNetDHCP=1
sndShowSendDialog=1
sndShowSuccessFailureMsg=0
sndSendEntireLog=0
sndSendXMLLogCopy=0
sndSendScreenshot=1
sndUseOnlyActiveWindow=0
sndSendLastHTMLPage=1
sndSendInSeparatedThread=0
sndAddDateInFileName=0
sndCompressAllFiles=0
edoShowExceptionDialog=1
edoSendEmailChecked=1
edoAttachScreenshotChecked=1
edoShowCopyToClipOption=1
edoShowDetailsButton=1
edoShowInDetailedMode=0
edoShowInTopMostMode=0
edoUseEurekaLogLookAndFeel=0
csoShowDLLs=1
csoShowBPLs=1
csoShowBorlandThreads=1
csoShowWindowsThreads=1
csoShowProcedureOffset=0
boActivateCrashDetection=0
boPauseBorlandThreads=0
boDoNotPauseMainThread=0
boPauseWindowsThreads=0
boUseMainModuleOptions=1
boCopyLogInCaseOfError=1
boSaveCompressedCopyInCaseOfError=0
Count mtInformationMsgCaption=1
mtInformationMsgCaption0="Information."
Count mtQuestionMsgCaption=1
mtQuestionMsgCaption0="Question."
Count mtDialog_Caption=1
mtDialog_Caption0="Error."
Count mtDialog_ErrorMsgCaption=2
mtDialog_ErrorMsgCaption0="An error has occurred during program execution."
mtDialog_ErrorMsgCaption1="Please read the following information for further details."
Count mtDialog_GeneralCaption=1
mtDialog_GeneralCaption0="General"
Count mtDialog_GeneralHeader=1
mtDialog_GeneralHeader0="General Information"
Count mtDialog_CallStackCaption=1
mtDialog_CallStackCaption0="Call Stack"
Count mtDialog_CallStackHeader=1
mtDialog_CallStackHeader0="Call Stack Information"
Count mtDialog_ModulesCaption=1
mtDialog_ModulesCaption0="Modules"
Count mtDialog_ModulesHeader=1
mtDialog_ModulesHeader0="Modules Information"
Count mtDialog_CPUCaption=1
mtDialog_CPUCaption0="CPU"
Count mtDialog_CPUHeader=1
mtDialog_CPUHeader0="CPU Information"
Count mtDialog_CustomDataCaption=1
mtDialog_CustomDataCaption0="Other"
Count mtDialog_CustomDataHeader=1
mtDialog_CustomDataHeader0="Other Information"
Count mtDialog_OKButtonCaption=1
mtDialog_OKButtonCaption0="%26OK"
Count mtDialog_TerminateButtonCaption=1
mtDialog_TerminateButtonCaption0="%26Terminate"
Count mtDialog_RestartButtonCaption=1
mtDialog_RestartButtonCaption0="%26Restart"
Count mtDialog_DetailsButtonCaption=1
mtDialog_DetailsButtonCaption0="%26Details"
Count mtDialog_SendMessage=1
mtDialog_SendMessage0="%26Send this error via Internet"
Count mtDialog_ScreenshotMessage=1
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
Count mtDialog_CopyMessage=1
mtDialog_CopyMessage0="%26Copy to Clipboard"
Count mtDialog_SupportMessage=1
mtDialog_SupportMessage0="Go to the Support Page"
Count mtLog_AppHeader=1
mtLog_AppHeader0="Application"
Count mtLog_AppStartDate=1
mtLog_AppStartDate0="Start Date"
Count mtLog_AppName=1
mtLog_AppName0="Name/Description"
Count mtLog_AppVersionNumber=1
mtLog_AppVersionNumber0="Version Number"
Count mtLog_AppParameters=1
mtLog_AppParameters0="Parameters"
Count mtLog_AppCompilationDate=1
mtLog_AppCompilationDate0="Compilation Date"
Count mtLog_ExcHeader=1
mtLog_ExcHeader0="Exception"
Count mtLog_ExcDate=1
mtLog_ExcDate0="Date"
Count mtLog_ExcAddress=1
mtLog_ExcAddress0="Address"
Count mtLog_ExcModule=1
mtLog_ExcModule0="Module"
Count mtLog_ExcType=1
mtLog_ExcType0="Type"
Count mtLog_ExcMessage=1
mtLog_ExcMessage0="Message"
Count mtLog_ActCtrlsHeader=1
mtLog_ActCtrlsHeader0="Active Controls"
Count mtLog_ActCtrlsFormClass=1
mtLog_ActCtrlsFormClass0="Form Class"
Count mtLog_ActCtrlsFormText=1
mtLog_ActCtrlsFormText0="Form Text"
Count mtLog_ActCtrlsControlClass=1
mtLog_ActCtrlsControlClass0="Control Class"
Count mtLog_ActCtrlsControlText=1
mtLog_ActCtrlsControlText0="Control Text"
Count mtLog_CmpHeader=1
mtLog_CmpHeader0="Computer"
Count mtLog_CmpName=1
mtLog_CmpName0="Name"
Count mtLog_CmpUser=1
mtLog_CmpUser0="User"
Count mtLog_CmpTotalMemory=1
mtLog_CmpTotalMemory0="Total Memory"
Count mtLog_CmpFreeMemory=1
mtLog_CmpFreeMemory0="Free Memory"
Count mtLog_CmpTotalDisk=1
mtLog_CmpTotalDisk0="Total Disk"
Count mtLog_CmpFreeDisk=1
mtLog_CmpFreeDisk0="Free Disk"
Count mtLog_CmpSystemUpTime=1
mtLog_CmpSystemUpTime0="System Up Time"
Count mtLog_CmpProcessor=1
mtLog_CmpProcessor0="Processor"
Count mtLog_CmpDisplayMode=1
mtLog_CmpDisplayMode0="Display Mode"
Count mtLog_OSHeader=1
mtLog_OSHeader0="Operating System"
Count mtLog_OSType=1
mtLog_OSType0="Type"
Count mtLog_OSBuildN=1
mtLog_OSBuildN0="Build #"
Count mtLog_OSUpdate=1
mtLog_OSUpdate0="Update"
Count mtLog_OSLanguage=1
mtLog_OSLanguage0="Language"
Count mtLog_NetHeader=1
mtLog_NetHeader0="Network"
Count mtLog_NetIP=1
mtLog_NetIP0="IP Address"
Count mtLog_NetSubmask=1
mtLog_NetSubmask0="Submask"
Count mtLog_NetGateway=1
mtLog_NetGateway0="Gateway"
Count mtLog_NetDNS1=1
mtLog_NetDNS10="DNS 1"
Count mtLog_NetDNS2=1
mtLog_NetDNS20="DNS 2"
Count mtLog_NetDHCP=1
mtLog_NetDHCP0="DHCP"
Count mtLog_CustInfoHeader=1
mtLog_CustInfoHeader0="Custom Information"
Count mtCallStack_Address=1
mtCallStack_Address0="Address"
Count mtCallStack_Name=1
mtCallStack_Name0="Module"
Count mtCallStack_Unit=1
mtCallStack_Unit0="Unit"
Count mtCallStack_Class=1
mtCallStack_Class0="Class"
Count mtCallStack_Procedure=1
mtCallStack_Procedure0="Procedure/Method"
Count mtCallStack_Line=1
mtCallStack_Line0="Line"
Count mtCallStack_MainThread=1
mtCallStack_MainThread0="Main"
Count mtCallStack_ExceptionThread=1
mtCallStack_ExceptionThread0="Exception Thread"
Count mtCallStack_RunningThread=1
mtCallStack_RunningThread0="Running Thread"
Count mtCallStack_CallingThread=1
mtCallStack_CallingThread0="Calling Thread"
Count mtCallStack_ThreadID=1
mtCallStack_ThreadID0="ID"
Count mtCallStack_ThreadPriority=1
mtCallStack_ThreadPriority0="Priority"
Count mtCallStack_ThreadClass=1
mtCallStack_ThreadClass0="Class"
Count mtSendDialog_Caption=1
mtSendDialog_Caption0="Send."
Count mtSendDialog_Message=1
mtSendDialog_Message0="Message"
Count mtSendDialog_Resolving=1
mtSendDialog_Resolving0="Resolving DNS..."
Count mtSendDialog_Connecting=1
mtSendDialog_Connecting0="Connecting with server..."
Count mtSendDialog_Connected=1
mtSendDialog_Connected0="Connected with server."
Count mtSendDialog_Sending=1
mtSendDialog_Sending0="Sending message..."
Count mtReproduceDialog_Caption=1
mtReproduceDialog_Caption0="Request"
Count mtReproduceDialog_Request=1
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
Count mtReproduceDialog_OKButtonCaption=1
mtReproduceDialog_OKButtonCaption0="%26OK"
Count mtModules_Handle=1
mtModules_Handle0="Handle"
Count mtModules_Name=1
mtModules_Name0="Name"
Count mtModules_Description=1
mtModules_Description0="Description"
Count mtModules_Version=1
mtModules_Version0="Version"
Count mtModules_Size=1
mtModules_Size0="Size"
Count mtModules_LastModified=1
mtModules_LastModified0="Modified"
Count mtModules_Path=1
mtModules_Path0="Path"
Count mtCPU_Registers=1
mtCPU_Registers0="Registers"
Count mtCPU_Stack=1
mtCPU_Stack0="Stack"
Count mtCPU_MemoryDump=1
mtCPU_MemoryDump0="Memory Dump"
Count mtSend_SuccessMsg=1
mtSend_SuccessMsg0="The message was sent successfully."
Count mtSend_FailureMsg=1
mtSend_FailureMsg0="Sorry, sending the message didn't work."
EurekaLog Last Line -->
</BorlandProject>

43
Source/ApplicationBase/_Usuarios_/Usuarios.dpk
View File

@ -1,43 +0,0 @@
package Usuarios;
{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'Gestión de usuarios'}
{$IMPLICITBUILD ON}
requires
vcl,
vcldb,
Base,
Empresas_model,
Empresas_controller,
JvMMD11R;
contains
uDataModuleUsuarios in 'uDataModuleUsuarios.pas' {dmUsuarios: TDAClientDataModule},
uUsuarios in 'uUsuarios.pas' {fUsuarios},
uUsuario in 'uUsuario.pas' {fUsuario},
uLoginForm in 'uLoginForm.pas' {fLoginForm},
uCambiarPassword in 'uCambiarPassword.pas' {fCambiarPassword};
end.

557
Source/ApplicationBase/_Usuarios_/Usuarios.dproj
View File

@ -1,557 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{0e3d28a9-51af-483b-b478-472a086ee120}</ProjectGuid>
<MainSource>Usuarios.dpk</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>..\..\..\Output\Debug\Cliente\Usuarios.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_MapFile>3</DCC_MapFile>
<DCC_DcuOutput>.\</DCC_DcuOutput>
<DCC_ObjOutput>.\</DCC_ObjOutput>
<DCC_HppOutput>.\</DCC_HppOutput>
<DCC_BplOutput>..\..\..\Output\Debug\Cliente</DCC_BplOutput>
<DCC_DcpOutput>..\..\Lib</DCC_DcpOutput>
<DCC_UnitSearchPath>..\..\Lib;..\..\Modulos\Lib</DCC_UnitSearchPath>
<DCC_ResourcePath>..\..\Lib;..\..\Modulos\Lib</DCC_ResourcePath>
<DCC_ObjPath>..\..\Lib;..\..\Modulos\Lib</DCC_ObjPath>
<DCC_IncludePath>..\..\Lib;..\..\Modulos\Lib</DCC_IncludePath>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_MapFile>3</DCC_MapFile>
<DCC_DcuOutput>.\</DCC_DcuOutput>
<DCC_ObjOutput>.\</DCC_ObjOutput>
<DCC_HppOutput>.\</DCC_HppOutput>
<DCC_BplOutput>..\..\..\Output\Debug\Cliente</DCC_BplOutput>
<DCC_DcpOutput>..\..\Lib</DCC_DcpOutput>
<DCC_UnitSearchPath>..\..\Lib;..\..\Modulos\Lib</DCC_UnitSearchPath>
<DCC_ResourcePath>..\..\Lib;..\..\Modulos\Lib</DCC_ResourcePath>
<DCC_ObjPath>..\..\Lib;..\..\Modulos\Lib</DCC_ObjPath>
<DCC_IncludePath>..\..\Lib;..\..\Modulos\Lib</DCC_IncludePath>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">Gestión de usuarios</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options></Package_Options><Language><Language Name="RootDir">C:\Archivos de programa\Borland\Delphi7\Bin\</Language></Language><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">3</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">3082</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.3.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">Usuarios.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="Usuarios.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\Modulos\Usuarios\Controller\Base.dcp" />
<DCCReference Include="..\..\Modulos\Usuarios\Controller\Empresas_controller.dcp" />
<DCCReference Include="..\..\Modulos\Usuarios\Controller\Empresas_model.dcp" />
<DCCReference Include="..\..\Modulos\Usuarios\Controller\JvMMD11R.dcp" />
<DCCReference Include="..\..\Modulos\Usuarios\Controller\vcl.dcp" />
<DCCReference Include="..\..\Modulos\Usuarios\Controller\vcldb.dcp" />
<DCCReference Include="uCambiarPassword.pas">
<Form>fCambiarPassword</Form>
</DCCReference>
<DCCReference Include="uDataModuleUsuarios.pas">
<Form>dmUsuarios</Form>
</DCCReference>
<DCCReference Include="uLoginForm.pas">
<Form>fLoginForm</Form>
</DCCReference>
<DCCReference Include="uUsuario.pas">
<Form>fUsuario</Form>
</DCCReference>
<DCCReference Include="uUsuarios.pas">
<Form>fUsuarios</Form>
</DCCReference>
</ItemGroup>
</Project>
<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=6006
Activate=1
Activate Handle=1
Save Log File=1
Foreground Tab=0
Freeze Activate=0
Freeze Timeout=60
SMTP From=eurekalog@email.com
SMTP Host=
SMTP Port=25
SMTP UserID=
SMTP Password=
Append to Log=0
TerminateBtn Operation=1
Errors Number=32
Errors Terminate=3
Email Address=
Email Object=
Email Send Options=0
Output Path=
Encrypt Password=
AutoCloseDialogSecs=0
WebSendMode=0
SupportULR=
HTMLLayout Count=15
HTMLLine0="%3Chtml%3E"
HTMLLine1=" %3Chead%3E"
HTMLLine2=" %3C/head%3E"
HTMLLine3=" %3Cbody TopMargin=10 LeftMargin=10%3E"
HTMLLine4=" %3Ctable width="100%%" border="0"%3E"
HTMLLine5=" %3Ctr%3E"
HTMLLine6=" %3Ctd nowrap%3E"
HTMLLine7=" %3Cfont face="Lucida Console, Courier" size="2"%3E"
HTMLLine8=" %3C%%HTML_TAG%%%3E"
HTMLLine9=" %3C/font%3E"
HTMLLine10=" %3C/td%3E"
HTMLLine11=" %3C/tr%3E"
HTMLLine12=" %3C/table%3E"
HTMLLine13=" %3C/body%3E"
HTMLLine14="%3C/html%3E"
AutoCrashOperation=1
AutoCrashNumber=10
AutoCrashMinutes=1
WebURL=
WebUserID=
WebPassword=
WebPort=0
AttachedFiles=
ProxyURL=
ProxyUser=
ProxyPassword=
ProxyPort=8080
TrakerUser=
TrakerPassword=
TrakerAssignTo=
TrakerProject=
TrakerCategory=
TrakerTrialID=
ZipPassword=
PreBuildEvent=
PostSuccessfulBuildEvent=
PostFailureBuildEvent=
ExceptionDialogType=2
Count=0
EMail Message Line Count=0
loNoDuplicateErrors=0
loAppendReproduceText=0
loDeleteLogAtVersionChange=0
loAddComputerNameInLogFileName=0
loSaveModulesAndProcessesSections=1
loSaveAssemblerAndCPUSections=1
soAppStartDate=1
soAppName=1
soAppVersionNumber=1
soAppParameters=1
soAppCompilationDate=1
soAppUpTime=1
soExcDate=1
soExcAddress=1
soExcModuleName=1
soExcModuleVersion=1
soExcType=1
soExcMessage=1
soExcID=1
soExcCount=1
soExcStatus=1
soExcNote=1
soUserID=1
soUserName=1
soUserEmail=1
soUserPrivileges=1
soUserCompany=1
soActCtlsFormClass=1
soActCtlsFormText=1
soActCtlsControlClass=1
soActCtlsControlText=1
soCmpName=1
soCmpTotalMemory=1
soCmpFreeMemory=1
soCmpTotalDisk=1
soCmpFreeDisk=1
soCmpSysUpTime=1
soCmpProcessor=1
soCmpDisplayMode=1
soCmpDisplayDPI=1
soCmpVideoCard=1
soCmpPrinter=1
soOSType=1
soOSBuildN=1
soOSUpdate=1
soOSLanguage=1
soOSCharset=1
soNetIP=1
soNetSubmask=1
soNetGateway=1
soNetDNS1=1
soNetDNS2=1
soNetDHCP=1
soCustomData=1
sndShowSendDialog=1
sndShowSuccessFailureMsg=0
sndSendEntireLog=0
sndSendXMLLogCopy=0
sndSendScreenshot=1
sndUseOnlyActiveWindow=0
sndSendLastHTMLPage=1
sndSendInSeparatedThread=0
sndAddDateInFileName=0
sndAddComputerNameInFileName=0
edoSendErrorReportChecked=1
edoAttachScreenshotChecked=1
edoShowCopyToClipOption=1
edoShowDetailsButton=1
edoShowInDetailedMode=0
edoShowInTopMostMode=0
edoUseEurekaLogLookAndFeel=0
edoShowSendErrorReportOption=1
edoShowAttachScreenshotOption=1
edoShowCustomButton=0
csoShowDLLs=1
csoShowBPLs=1
csoShowBorlandThreads=1
csoShowWindowsThreads=1
csoDoNotStoreProcNames=0
boPauseBorlandThreads=0
boDoNotPauseMainThread=0
boPauseWindowsThreads=0
boUseMainModuleOptions=1
boCopyLogInCaseOfError=1
boSaveCompressedCopyInCaseOfError=0
boHandleSafeCallExceptions=1
boCallRTLExceptionEvent=0
boCatchHandledExceptions=0
loCatchLeaks=0
loGroupsSonLeaks=1
loHideBorlandLeaks=1
loFreeAllLeaks=1
loCatchLeaksExceptions=1
cfoReduceFileSize=1
cfoCheckFileCorruption=0
Count mtInformationMsgCaption=1
mtInformationMsgCaption0="Information."
Count mtQuestionMsgCaption=1
mtQuestionMsgCaption0="Question."
Count mtErrorMsgCaption=1
mtErrorMsgCaption0="Error."
Count mtDialog_Caption=1
mtDialog_Caption0="Error."
Count mtDialog_ErrorMsgCaption=2
mtDialog_ErrorMsgCaption0="An error has occurred during program execution."
mtDialog_ErrorMsgCaption1="Please read the following information for further details."
Count mtDialog_GeneralCaption=1
mtDialog_GeneralCaption0="General"
Count mtDialog_GeneralHeader=1
mtDialog_GeneralHeader0="General Information"
Count mtDialog_CallStackCaption=1
mtDialog_CallStackCaption0="Call Stack"
Count mtDialog_CallStackHeader=1
mtDialog_CallStackHeader0="Call Stack Information"
Count mtDialog_ModulesCaption=1
mtDialog_ModulesCaption0="Modules"
Count mtDialog_ModulesHeader=1
mtDialog_ModulesHeader0="Modules Information"
Count mtDialog_ProcessesCaption=1
mtDialog_ProcessesCaption0="Processes"
Count mtDialog_ProcessesHeader=1
mtDialog_ProcessesHeader0="Processes Information"
Count mtDialog_AsmCaption=1
mtDialog_AsmCaption0="Assembler"
Count mtDialog_AsmHeader=1
mtDialog_AsmHeader0="Assembler Information"
Count mtDialog_CPUCaption=1
mtDialog_CPUCaption0="CPU"
Count mtDialog_CPUHeader=1
mtDialog_CPUHeader0="CPU Information"
Count mtDialog_OKButtonCaption=1
mtDialog_OKButtonCaption0="%26OK"
Count mtDialog_TerminateButtonCaption=1
mtDialog_TerminateButtonCaption0="%26Terminate"
Count mtDialog_RestartButtonCaption=1
mtDialog_RestartButtonCaption0="%26Restart"
Count mtDialog_DetailsButtonCaption=1
mtDialog_DetailsButtonCaption0="%26Details"
Count mtDialog_CustomButtonCaption=1
mtDialog_CustomButtonCaption0="%26Help"
Count mtDialog_SendMessage=1
mtDialog_SendMessage0="%26Send this error via Internet"
Count mtDialog_ScreenshotMessage=1
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
Count mtDialog_CopyMessage=1
mtDialog_CopyMessage0="%26Copy to Clipboard"
Count mtDialog_SupportMessage=1
mtDialog_SupportMessage0="Go to the Support Page"
Count mtMSDialog_ErrorMsgCaption=1
mtMSDialog_ErrorMsgCaption0="The application has encountered a problem. We are sorry for the inconvenience."
Count mtMSDialog_RestartCaption=1
mtMSDialog_RestartCaption0="Restart application."
Count mtMSDialog_TerminateCaption=1
mtMSDialog_TerminateCaption0="Terminate application."
Count mtMSDialog_PleaseCaption=1
mtMSDialog_PleaseCaption0="Please tell us about this problem."
Count mtMSDialog_DescriptionCaption=1
mtMSDialog_DescriptionCaption0="We have created an error report that you can send to us. We will treat this report as confidential and anonymous."
Count mtMSDialog_SeeDetailsCaption=1
mtMSDialog_SeeDetailsCaption0="To see what data the error report contains,"
Count mtMSDialog_SeeClickCaption=1
mtMSDialog_SeeClickCaption0="click here."
Count mtMSDialog_HowToReproduceCaption=1
mtMSDialog_HowToReproduceCaption0="What were you doing when the problem happended (optional)?"
Count mtMSDialog_EmailCaption=1
mtMSDialog_EmailCaption0="Email address (optional):"
Count mtMSDialog_SendButtonCaption=1
mtMSDialog_SendButtonCaption0="%26Send Error Report"
Count mtMSDialog_NoSendButtonCaption=1
mtMSDialog_NoSendButtonCaption0="%26Don't Send"
Count mtLog_AppHeader=1
mtLog_AppHeader0="Application"
Count mtLog_AppStartDate=1
mtLog_AppStartDate0="Start Date"
Count mtLog_AppName=1
mtLog_AppName0="Name/Description"
Count mtLog_AppVersionNumber=1
mtLog_AppVersionNumber0="Version Number"
Count mtLog_AppParameters=1
mtLog_AppParameters0="Parameters"
Count mtLog_AppCompilationDate=1
mtLog_AppCompilationDate0="Compilation Date"
Count mtLog_AppUpTime=1
mtLog_AppUpTime0="Up Time"
Count mtLog_ExcHeader=1
mtLog_ExcHeader0="Exception"
Count mtLog_ExcDate=1
mtLog_ExcDate0="Date"
Count mtLog_ExcAddress=1
mtLog_ExcAddress0="Address"
Count mtLog_ExcModuleName=1
mtLog_ExcModuleName0="Module Name"
Count mtLog_ExcModuleVersion=1
mtLog_ExcModuleVersion0="Module Version"
Count mtLog_ExcType=1
mtLog_ExcType0="Type"
Count mtLog_ExcMessage=1
mtLog_ExcMessage0="Message"
Count mtLog_ExcID=1
mtLog_ExcID0="ID"
Count mtLog_ExcCount=1
mtLog_ExcCount0="Count"
Count mtLog_ExcStatus=1
mtLog_ExcStatus0="Status"
Count mtLog_ExcNote=1
mtLog_ExcNote0="Note"
Count mtLog_UserHeader=1
mtLog_UserHeader0="User"
Count mtLog_UserID=1
mtLog_UserID0="ID"
Count mtLog_UserName=1
mtLog_UserName0="Name"
Count mtLog_UserEmail=1
mtLog_UserEmail0="Email"
Count mtLog_UserCompany=1
mtLog_UserCompany0="Company"
Count mtLog_UserPrivileges=1
mtLog_UserPrivileges0="Privileges"
Count mtLog_ActCtrlsHeader=1
mtLog_ActCtrlsHeader0="Active Controls"
Count mtLog_ActCtrlsFormClass=1
mtLog_ActCtrlsFormClass0="Form Class"
Count mtLog_ActCtrlsFormText=1
mtLog_ActCtrlsFormText0="Form Text"
Count mtLog_ActCtrlsControlClass=1
mtLog_ActCtrlsControlClass0="Control Class"
Count mtLog_ActCtrlsControlText=1
mtLog_ActCtrlsControlText0="Control Text"
Count mtLog_CmpHeader=1
mtLog_CmpHeader0="Computer"
Count mtLog_CmpName=1
mtLog_CmpName0="Name"
Count mtLog_CmpTotalMemory=1
mtLog_CmpTotalMemory0="Total Memory"
Count mtLog_CmpFreeMemory=1
mtLog_CmpFreeMemory0="Free Memory"
Count mtLog_CmpTotalDisk=1
mtLog_CmpTotalDisk0="Total Disk"
Count mtLog_CmpFreeDisk=1
mtLog_CmpFreeDisk0="Free Disk"
Count mtLog_CmpSystemUpTime=1
mtLog_CmpSystemUpTime0="System Up Time"
Count mtLog_CmpProcessor=1
mtLog_CmpProcessor0="Processor"
Count mtLog_CmpDisplayMode=1
mtLog_CmpDisplayMode0="Display Mode"
Count mtLog_CmpDisplayDPI=1
mtLog_CmpDisplayDPI0="Display DPI"
Count mtLog_CmpVideoCard=1
mtLog_CmpVideoCard0="Video Card"
Count mtLog_CmpPrinter=1
mtLog_CmpPrinter0="Printer"
Count mtLog_OSHeader=1
mtLog_OSHeader0="Operating System"
Count mtLog_OSType=1
mtLog_OSType0="Type"
Count mtLog_OSBuildN=1
mtLog_OSBuildN0="Build #"
Count mtLog_OSUpdate=1
mtLog_OSUpdate0="Update"
Count mtLog_OSLanguage=1
mtLog_OSLanguage0="Language"
Count mtLog_OSCharset=1
mtLog_OSCharset0="Charset"
Count mtLog_NetHeader=1
mtLog_NetHeader0="Network"
Count mtLog_NetIP=1
mtLog_NetIP0="IP Address"
Count mtLog_NetSubmask=1
mtLog_NetSubmask0="Submask"
Count mtLog_NetGateway=1
mtLog_NetGateway0="Gateway"
Count mtLog_NetDNS1=1
mtLog_NetDNS10="DNS 1"
Count mtLog_NetDNS2=1
mtLog_NetDNS20="DNS 2"
Count mtLog_NetDHCP=1
mtLog_NetDHCP0="DHCP"
Count mtLog_CustInfoHeader=1
mtLog_CustInfoHeader0="Custom Information"
Count mtCallStack_Address=1
mtCallStack_Address0="Address"
Count mtCallStack_Name=1
mtCallStack_Name0="Module"
Count mtCallStack_Unit=1
mtCallStack_Unit0="Unit"
Count mtCallStack_Class=1
mtCallStack_Class0="Class"
Count mtCallStack_Procedure=1
mtCallStack_Procedure0="Procedure/Method"
Count mtCallStack_Line=1
mtCallStack_Line0="Line"
Count mtCallStack_MainThread=1
mtCallStack_MainThread0="Main"
Count mtCallStack_ExceptionThread=1
mtCallStack_ExceptionThread0="Exception Thread"
Count mtCallStack_RunningThread=1
mtCallStack_RunningThread0="Running Thread"
Count mtCallStack_CallingThread=1
mtCallStack_CallingThread0="Calling Thread"
Count mtCallStack_ThreadID=1
mtCallStack_ThreadID0="ID"
Count mtCallStack_ThreadPriority=1
mtCallStack_ThreadPriority0="Priority"
Count mtCallStack_ThreadClass=1
mtCallStack_ThreadClass0="Class"
Count mtCallStack_LeakCaption=1
mtCallStack_LeakCaption0="Memory Leak"
Count mtCallStack_LeakData=1
mtCallStack_LeakData0="Data"
Count mtCallStack_LeakType=1
mtCallStack_LeakType0="Type"
Count mtCallStack_LeakSize=1
mtCallStack_LeakSize0="Total size"
Count mtCallStack_LeakCount=1
mtCallStack_LeakCount0="Count"
Count mtSendDialog_Caption=1
mtSendDialog_Caption0="Send."
Count mtSendDialog_Message=1
mtSendDialog_Message0="Message"
Count mtSendDialog_Resolving=1
mtSendDialog_Resolving0="Resolving DNS..."
Count mtSendDialog_Login=1
mtSendDialog_Login0="Login..."
Count mtSendDialog_Connecting=1
mtSendDialog_Connecting0="Connecting with server..."
Count mtSendDialog_Connected=1
mtSendDialog_Connected0="Connected with server."
Count mtSendDialog_Sending=1
mtSendDialog_Sending0="Sending message..."
Count mtSendDialog_Sent=1
mtSendDialog_Sent0="Message sent."
Count mtSendDialog_SelectProject=1
mtSendDialog_SelectProject0="Select project..."
Count mtSendDialog_Searching=1
mtSendDialog_Searching0="Searching..."
Count mtSendDialog_Modifying=1
mtSendDialog_Modifying0="Modifying..."
Count mtSendDialog_Disconnecting=1
mtSendDialog_Disconnecting0="Disconnecting..."
Count mtSendDialog_Disconnected=1
mtSendDialog_Disconnected0="Disconnected."
Count mtReproduceDialog_Caption=1
mtReproduceDialog_Caption0="Request"
Count mtReproduceDialog_Request=1
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
Count mtReproduceDialog_OKButtonCaption=1
mtReproduceDialog_OKButtonCaption0="%26OK"
Count mtModules_Handle=1
mtModules_Handle0="Handle"
Count mtModules_Name=1
mtModules_Name0="Name"
Count mtModules_Description=1
mtModules_Description0="Description"
Count mtModules_Version=1
mtModules_Version0="Version"
Count mtModules_Size=1
mtModules_Size0="Size"
Count mtModules_LastModified=1
mtModules_LastModified0="Modified"
Count mtModules_Path=1
mtModules_Path0="Path"
Count mtProcesses_ID=1
mtProcesses_ID0="ID"
Count mtProcesses_Name=1
mtProcesses_Name0="Name"
Count mtProcesses_Description=1
mtProcesses_Description0="Description"
Count mtProcesses_Version=1
mtProcesses_Version0="Version"
Count mtProcesses_Memory=1
mtProcesses_Memory0="Memory"
Count mtProcesses_Priority=1
mtProcesses_Priority0="Priority"
Count mtProcesses_Threads=1
mtProcesses_Threads0="Threads"
Count mtProcesses_Path=1
mtProcesses_Path0="Path"
Count mtCPU_Registers=1
mtCPU_Registers0="Registers"
Count mtCPU_Stack=1
mtCPU_Stack0="Stack"
Count mtCPU_MemoryDump=1
mtCPU_MemoryDump0="Memory Dump"
Count mtSend_SuccessMsg=1
mtSend_SuccessMsg0="The message was sent successfully."
Count mtSend_FailureMsg=1
mtSend_FailureMsg0="Sorry, sending the message didn't work."
Count mtSend_BugClosedMsg=2
mtSend_BugClosedMsg0="These BUG is just closed."
mtSend_BugClosedMsg1="Contact the program support to obtain an update."
Count mtSend_UnknownErrorMsg=1
mtSend_UnknownErrorMsg0="Unknown error."
Count mtSend_InvalidLoginMsg=1
mtSend_InvalidLoginMsg0="Invalid login request."
Count mtSend_InvalidSearchMsg=1
mtSend_InvalidSearchMsg0="Invalid search request."
Count mtSend_InvalidSelectionMsg=1
mtSend_InvalidSelectionMsg0="Invalid selection request."
Count mtSend_InvalidInsertMsg=1
mtSend_InvalidInsertMsg0="Invalid insert request."
Count mtSend_InvalidModifyMsg=1
mtSend_InvalidModifyMsg0="Invalid modify request."
Count mtFileCrackedMsg=2
mtFileCrackedMsg0="This file is cracked."
mtFileCrackedMsg1="The application will be closed."
Count mtException_LeakMultiFree=1
mtException_LeakMultiFree0="Multi Free memory leak."
Count mtException_LeakMemoryOverrun=1
mtException_LeakMemoryOverrun0="Memory Overrun leak."
Count mtException_AntiFreeze=1
mtException_AntiFreeze0="The application seems to be frozen."
Count mtInvalidEmailMsg=1
mtInvalidEmailMsg0="Invalid email."
TextsCollection=English
EurekaLog Last Line -->

22
Source/ApplicationBase/_Usuarios_/Usuarios.rc
View File

@ -1,22 +0,0 @@
1 VERSIONINFO
FILEVERSION 1,0,3,0
PRODUCTVERSION 1,0,3,0
FILEFLAGSMASK 0x3FL
FILEFLAGS 0x00L
FILEOS 0x40004L
FILETYPE 0x1L
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "0C0A04E4"
BEGIN
VALUE "FileVersion", "1.0.3.0\0"
VALUE "ProductVersion", "1.0.0.0\0"
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x0C0A, 1252
END
END

BIN
Source/ApplicationBase/_Usuarios_/Usuarios.res
View File

Binary file not shown.

94
Source/ApplicationBase/_Usuarios_/uCambiarPassword.dfm
View File

@ -1,94 +0,0 @@
object fCambiarPassword: TfCambiarPassword
Left = 460
Top = 492
Width = 361
Height = 299
Caption = 'Cambiar la contrase'#241'a'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object bAceptar: TButton
Left = 136
Top = 230
Width = 120
Height = 25
Caption = '&Cambiar la contrase'#241'a'
Default = True
TabOrder = 0
OnClick = bAceptarClick
end
object bCancelar: TButton
Left = 269
Top = 230
Width = 75
Height = 25
Cancel = True
Caption = '&Cancelar'
ModalResult = 2
TabOrder = 1
end
object PageControl1: TPageControl
Left = 2
Top = 2
Width = 349
Height = 217
ActivePage = pagContrasena
TabOrder = 2
object pagContrasena: TTabSheet
Caption = 'Cambiar la contrase'#241'a'
object Label4: TLabel
Left = 16
Top = 19
Width = 167
Height = 13
Caption = 'Escriba la nueva contrase'#241'a:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
Transparent = True
end
object Label1: TLabel
Left = 16
Top = 72
Width = 257
Height = 13
Caption = 'Repita la nueva contrase'#241'a para confirmarla:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
Transparent = True
end
object edtPassword2: TEdit
Left = 16
Top = 88
Width = 295
Height = 21
CharCase = ecLowerCase
PasswordChar = '*'
TabOrder = 0
end
object edtPassword: TEdit
Left = 16
Top = 39
Width = 295
Height = 21
CharCase = ecLowerCase
PasswordChar = '*'
TabOrder = 1
end
end
end
end

41
Source/ApplicationBase/_Usuarios_/uCambiarPassword.pas
View File

@ -1,41 +0,0 @@
unit uCambiarPassword;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TfCambiarPassword = class(TForm)
bAceptar: TButton;
bCancelar: TButton;
Label4: TLabel;
edtPassword: TEdit;
Label1: TLabel;
edtPassword2: TEdit;
PageControl1: TPageControl;
pagContrasena: TTabSheet;
procedure bAceptarClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fCambiarPassword: TfCambiarPassword;
implementation
{$R *.dfm}
procedure TfCambiarPassword.bAceptarClick(Sender: TObject);
begin
if edtPassword2.Text <> edtPassword.Text then
raise Exception.Create('Por favor, introduzca la MISMA contraseña en los dos campos')
else
ModalResult := mrOK;
end;
end.

17
Source/ApplicationBase/_Usuarios_/uDataModuleUsuarios.dfm
View File

@ -1,17 +0,0 @@
object dmUsuarios: TdmUsuarios
OldCreateOrder = True
OnCreate = DAClientDataModuleCreate
Height = 205
Width = 355
object ROLoginService: TRORemoteService
Message = dmConexion.ROMessage
Channel = dmConexion.ROChannel
ServiceName = 'srvLogin'
Left = 48
Top = 32
end
object DABINAdapter: TDABINAdapter
Left = 48
Top = 104
end
end

209
Source/ApplicationBase/_Usuarios_/uDataModuleUsuarios.pas
View File

@ -1,209 +0,0 @@
unit uDataModuleUsuarios;
interface
uses {vcl:} SysUtils, Classes, DB, DBClient,
{RemObjects:} uDAClientDataModule, uDADataTable, uDABINAdapter,
uROServiceComponent, uRORemoteService, uROClient, uROBinMessage,
uROWinInetHttpChannel, uDAScriptingProvider, uDACDSDataTable,
FactuGES_Intf, uIntegerListUtils, uBizEmpresas, uDADataStreamer;
const
PERFIL_ADMINISTRADORES = 'Administradores';
type
TdmUsuarios = class(TDAClientDataModule)
ROLoginService: TRORemoteService;
DABINAdapter: TDABINAdapter;
procedure DAClientDataModuleCreate(Sender: TObject);
procedure DAClientDataModuleDestroy(Sender: TObject);
private
FUsuario : String;
FPassword : String; // Lo guardo para poder hacer una reconexión
FLoginInfo: TRdxLoginInfo;
FEmpresaActual: IBizEmpresa;
function CambiarPassword (const APassword : String) : boolean; overload;
function GetEsAdministrador: Boolean;
function GetEmpresas: TIntegerList;
procedure SetEmpresaActual(const Value: IBizEmpresa);
function GetIDEmpresaActual: Integer;
procedure SetIDEmpresaActual(const Value: Integer);
public
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;
end;
var
dmUsuarios: TdmUsuarios;
implementation
{$R *.DFM}
uses
Forms, Controls, uDataTableUtils, uDataModuleConexion, uLoginForm,
uCambiarPassword, Dialogs, Windows, uEmpresasController;
{ TDAClientDataModule1 }
procedure TdmUsuarios.DAClientDataModuleCreate(Sender: TObject);
begin
ROLoginService.Channel := dmConexion.Channel;
ROLoginService.Message := dmConexion.Message;
FEmpresaActual := nil;
FUsuario := '';
FPassword := '';
FLoginInfo := NIL;
end;
function TdmUsuarios.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 TdmUsuarios.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
begin
// Lo guardo para poder reconectarme
FUsuario := Usuario;
FPassword := Password;
end;
end;
procedure TdmUsuarios.Logout;
begin
(ROLoginService as IsrvLogin).Logout;
if Assigned(FLoginInfo) then
FreeANDNil(FLoginInfo);
FUsuario := '';
FPassword := '';
end;
procedure TdmUsuarios.SetEmpresaActual(const Value: IBizEmpresa);
begin
FEmpresaActual := Value;
FEmpresaActual.DataTable.Active := True;
end;
procedure TdmUsuarios.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 TdmUsuarios.DAClientDataModuleDestroy(Sender: TObject);
begin
if Assigned(FLoginInfo) then
FreeANDNil(FLoginInfo);
end;
function TdmUsuarios.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 TdmUsuarios.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 TdmUsuarios.GetIDEmpresaActual: Integer;
begin
if not Assigned(FEmpresaActual) then
Result := ID_NULO
else
Result := FEmpresaActual.ID;
end;
procedure TdmUsuarios.CambiarPassword;
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;
function TdmUsuarios.CambiarPassword(const APassword: String): boolean;
begin
{ if not (ROLoginService as IsrvLogin).SetUserPassword(LoginInfo.UserID, APassword) then
raise Exception.Create('Error en el servidor. No se ha podido cambiar la contraseña');}
Result := True;
end;
initialization
dmUsuarios := TdmUsuarios.Create(nil);
finalization
FreeAndNil(dmUsuarios);
end.

1099
Source/ApplicationBase/_Usuarios_/uLoginForm.dfm
View File

File diff suppressed because it is too large Load Diff

101
Source/ApplicationBase/_Usuarios_/uLoginForm.pas
View File

@ -1,101 +0,0 @@
unit uLoginForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, cxGraphics, cxControls,
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit,
cxImageComboBox, ImgList, PngImageList, pngimage, ToolWin, JvExControls,
JvComponent, JvGradient, JvGIF, JvComponentBase, JvFormPlacement,
JvAppStorage, JvAppRegistryStorage;
type
TfLoginForm = class(TForm)
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
edtPassword: TEdit;
bAceptar: TButton;
bCancelar: TButton;
Label1: TLabel;
edtUser: TEdit;
JvGradient1: TJvGradient;
Button1: TButton;
Timer1: TTimer;
JvAppRegistryStorage1: TJvAppRegistryStorage;
JvFormStorage1: TJvFormStorage;
Image1: TImage;
procedure bAceptarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
FIntentos: Integer;
end;
var
fLoginForm: TfLoginForm;
implementation
uses
uDataModuleUsuarios, uDataModuleConexion, uDataModuleBase;
{$R *.dfm}
{
********************************* TfLoginForm **********************************
}
procedure TfLoginForm.bAceptarClick(Sender: TObject);
var
bOk : Boolean;
begin
ShowHourglassCursor;
try
bOK := dmUsuarios.Login(edtUser.Text, edtPassword.Text);
finally
HideHourglassCursor;
end;
if bOk then
ModalResult := mrOK
else begin
Application.MessageBox('Usuario no válido. Compruebe si ha escrito correctamente'
+ #13 + #10 + 'el usuario y la contraseña.', 'Atención', MB_OK);
Dec(FIntentos);
if (FIntentos <= 0) then
ModalResult := mrCancel;
end;
end;
procedure TfLoginForm.FormCreate(Sender: TObject);
begin
FIntentos := 3;
end;
procedure TfLoginForm.ToolButton4Click(Sender: TObject);
begin
Timer1.Enabled := False;
dmConexion.ConfigurarConexion;
Timer1.Enabled := True;
end;
procedure TfLoginForm.FormShow(Sender: TObject);
begin
Self.Caption := Self.Caption + ' - ' + dmBase.DarVersion;
JvFormStorage1.RestoreFormPlacement;
// Hacer login automática si hay usuario/password y no hay más de una base
// de datos como opción para conectarse.
if ((Length(edtUser.Text) > 0) and (Length(edtPassword.Text) > 0)) then
Timer1.Enabled := True;
end;
procedure TfLoginForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
bAceptar.Click;
end;
end.

123
Source/ApplicationBase/_Usuarios_/uUsuario.dfm
View File

@ -1,123 +0,0 @@
object fUsuario: TfUsuario
Left = 523
Top = 415
BorderStyle = bsDialog
Caption = 'Datos del usuario'
ClientHeight = 309
ClientWidth = 308
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 138
Top = 273
Width = 75
Height = 25
Action = actAceptar
TabOrder = 1
end
object Button2: TButton
Left = 226
Top = 273
Width = 75
Height = 25
Action = actCancelar
TabOrder = 2
end
object TabControl1: TPageControl
Left = 8
Top = 8
Width = 293
Height = 257
ActivePage = pagUsuario
TabOrder = 0
object pagUsuario: TTabSheet
Caption = 'Usuario'
object GroupBox1: TGroupBox
Left = 6
Top = 5
Width = 274
Height = 99
Caption = 'GroupBox1'
TabOrder = 0
DesignSize = (
274
99)
object Label4: TLabel
Left = 34
Top = 28
Width = 39
Height = 13
Caption = 'Usuario:'
Transparent = False
end
object Label5: TLabel
Left = 16
Top = 60
Width = 57
Height = 13
Caption = 'Contrase'#241'a:'
Transparent = False
end
object edtUser: TEdit
Left = 88
Top = 24
Width = 169
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
object edtPassword: TEdit
Left = 88
Top = 56
Width = 169
Height = 21
Anchors = [akLeft, akTop, akRight]
PasswordChar = '*'
TabOrder = 1
end
end
object GroupBox2: TGroupBox
Left = 7
Top = 111
Width = 273
Height = 110
Caption = 'Permisos y seguridad'
TabOrder = 1
object Label1: TLabel
Left = 47
Top = 36
Width = 26
Height = 13
Caption = 'Perfil:'
Transparent = False
end
object cbPerfil: TComboBox
Left = 88
Top = 28
Width = 169
Height = 21
ItemHeight = 13
TabOrder = 0
end
end
end
end
object ActionList: TActionList
Left = 8
Top = 272
object actAceptar: TAction
Caption = '&Aceptar'
end
object actCancelar: TAction
Caption = '&Cancelar'
end
end
end

39
Source/ApplicationBase/_Usuarios_/uUsuario.pas
View File

@ -1,39 +0,0 @@
unit uUsuario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ActnList;
type
TfUsuario = class(TForm)
Button1: TButton;
Button2: TButton;
TabControl1: TPageControl;
pagUsuario: TTabSheet;
GroupBox1: TGroupBox;
Label4: TLabel;
Label5: TLabel;
edtUser: TEdit;
edtPassword: TEdit;
GroupBox2: TGroupBox;
Label1: TLabel;
cbPerfil: TComboBox;
ActionList: TActionList;
actAceptar: TAction;
actCancelar: TAction;
private
{ Private declarations }
public
{ Public declarations }
end;
var
fUsuario: TfUsuario;
implementation
{$R *.dfm}
end.

118
Source/ApplicationBase/_Usuarios_/uUsuarios.dfm
View File

@ -1,118 +0,0 @@
object fUsuarios: TfUsuarios
Left = 490
Top = 417
BorderStyle = bsDialog
Caption = 'Administraci'#243'n de usuarios'
ClientHeight = 401
ClientWidth = 550
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Grid: TDBGrid
Left = 8
Top = 40
Width = 425
Height = 313
DataSource = DADataSource
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object JvNavPanelHeader1: TJvNavPanelHeader
Left = 0
Top = 0
Width = 550
Align = alTop
Caption = 'Panel de control'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindow
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ColorFrom = 8684164
ColorTo = 8684164
ImageIndex = 0
StyleManager = dmBase.StyleManager
ParentStyleManager = False
end
object Button1: TButton
Left = 448
Top = 40
Width = 91
Height = 25
Action = actNuevo
TabOrder = 2
end
object Button2: TButton
Left = 448
Top = 136
Width = 91
Height = 25
Action = actModificar
TabOrder = 3
end
object Button3: TButton
Left = 448
Top = 176
Width = 91
Height = 25
Action = actEliminar
TabOrder = 4
end
object Button4: TButton
Left = 448
Top = 368
Width = 91
Height = 25
Action = actCerrar
TabOrder = 5
end
object Button5: TButton
Left = 448
Top = 96
Width = 91
Height = 25
Action = actCambiarPassword
TabOrder = 6
end
object DADataSource: TDADataSource
Left = 368
Top = 40
end
object ActionList: TActionList
Left = 8
Top = 360
object actCerrar: TAction
Caption = '&Cerrar'
OnExecute = actCerrarExecute
end
object actNuevo: TAction
Caption = 'Nuevo usuario'
OnUpdate = actNuevoUpdate
end
object actCambiarPassword: TAction
Caption = 'Cambiar contrase'#241'a'
OnUpdate = actCambiarPasswordUpdate
end
object actModificar: TAction
Caption = 'Modificar usuario'
OnUpdate = actModificarUpdate
end
object actEliminar: TAction
Caption = 'Eliminar usuario'
OnUpdate = actEliminarUpdate
end
end
end

89
Source/ApplicationBase/_Usuarios_/uUsuarios.pas
View File

@ -1,89 +0,0 @@
unit uUsuarios;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, uDADataTable, dbcgrids, uDataModuleUsuarios, StdCtrls,
DBCtrls, uDataModuleBase, JvExControls, JvComponent, JvNavigationPane,
Grids, DBGrids, ActnList, uDAInterfaces;
type
TfUsuarios = class(TForm)
DADataSource: TDADataSource;
Grid: TDBGrid;
JvNavPanelHeader1: TJvNavPanelHeader;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
ActionList: TActionList;
actCerrar: TAction;
actNuevo: TAction;
actCambiarPassword: TAction;
actModificar: TAction;
actEliminar: TAction;
procedure actCerrarExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure actEliminarUpdate(Sender: TObject);
procedure actModificarUpdate(Sender: TObject);
procedure actCambiarPasswordUpdate(Sender: TObject);
procedure actNuevoUpdate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure AdministrarUsuarios;
implementation
{$R *.dfm}
procedure AdministrarUsuarios;
var
fUsuarios: TfUsuarios;
begin
fUsuarios := TfUsuarios.Create(NIL);
try
fUsuarios.ShowModal;
finally
fUsuarios.Free;
end;
end;
procedure TfUsuarios.actCerrarExecute(Sender: TObject);
begin
Close;
end;
procedure TfUsuarios.FormCreate(Sender: TObject);
begin
{ DADataSource.DataTable := dmUsuarios.tbl_Usuarios;
DADataSource.DataTable.Active := True;}
end;
procedure TfUsuarios.actEliminarUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
end;
procedure TfUsuarios.actModificarUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
end;
procedure TfUsuarios.actCambiarPasswordUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
end;
procedure TfUsuarios.actNuevoUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := Assigned(DADataSource.DataTable);
end;
end.

2
Source/ApplicationBase/uFactuGES_App.pas
View File

@ -3,7 +3,7 @@ unit uFactuGES_App;
interface
uses
SysUtils, Classes, Forms, uUsuarios, uBizEmpresas, uBizEjercicios, uControllerBase,
SysUtils, Classes, Forms, uBizUsuarios, uBizEmpresas, uBizEjercicios, uControllerBase,
uEmpresasController, JclFileUtils, uUsuariosController, uHostManager;
type

1
Source/Base/Base.dpk
View File

@ -31,6 +31,7 @@ requires
vcl,
TB2k_D10,
GUISDK_D11,
PluginSDK_D10R,
RemObjects_Core_D11,
DataAbstract_Core_D11,
vcljpg,

94
Source/Base/Base.dproj
View File

@ -65,47 +65,61 @@
<DelphiCompile Include="Base.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\ApplicationBase\Usuarios\Views\adortl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\cxIntl6D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\cxIntlPrintSys3D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\DataAbstract_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\dbrtl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\dclIndyCore.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\designide.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\dsnap.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\GUISDK_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\IndyCore.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\IndyProtocols.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\IndySystem.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\Jcl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JclVcl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JSDialog100.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvCmpD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvCoreD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvCtrlsD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvDlgsD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvMMD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvNetD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvPageCompsD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvStdCtrlsD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\JvSystemD11R.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\pckMD5.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\pckUCDataConnector.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\pckUserControl_RT.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PlRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDKRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDK_D10RemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDK_D10RRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDK_D1RemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDK_DRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDK_RemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSDRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluginSRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PlugiRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PlugRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PluRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PngComponentsD10.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PNG_D10.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\PRemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\RemObjects_Core_D11.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\rtl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\TB2k_D10.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\tbx_d10.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\vcl.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\vclactnband.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\vcldb.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\vcljpg.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\VclSmp.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\vclx.dcp" />
<DCCReference Include="..\ApplicationBase\Usuarios\Views\xmlrtl.dcp" />
<DCCReference Include="..\Servicios\FactuGES_Intf.pas" />
<DCCReference Include="C:\Documents and Settings\Usuario\adortl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\cxIntl6D11.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\cxIntlPrintSys3D11.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\DataAbstract_Core_D11.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\dbrtl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\dclIndyCore.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\designide.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\dsnap.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\GUISDK_D11.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\IndyCore.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\IndyProtocols.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\IndySystem.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\Jcl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JclVcl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JSDialog100.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvCmpD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvCoreD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvCtrlsD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvDlgsD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvMMD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvNetD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvPageCompsD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvStdCtrlsD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\JvSystemD11R.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\pckMD5.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\pckUCDataConnector.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\pckUserControl_RT.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\PngComponentsD10.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\PNG_D10.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\RemObjects_Core_D11.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\rtl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\TB2k_D10.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\tbx_d10.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\vcl.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\vclactnband.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\vcldb.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\vcljpg.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\VclSmp.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\vclx.dcp" />
<DCCReference Include="C:\Documents and Settings\Usuario\xmlrtl.dcp" />
<DCCReference Include="Conexion\uConfigurarConexion.pas">
<Form>fConfigurarConexion</Form>
<DesignClass>TForm</DesignClass>

BIN
Source/Base/Base.res
View File

Binary file not shown.

74
Source/Base_Group.groupproj Normal file
View File

@ -0,0 +1,74 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{f98b1c11-3200-4f80-b23f-3591938de211}</ProjectGuid>
</PropertyGroup>
<ItemGroup />
<ItemGroup>
<Projects Include="ApplicationBase\ApplicationBase.dproj" />
<Projects Include="Base\Base.dproj" />
<Projects Include="Cliente\FactuGES.dproj" />
<Projects Include="GUIBase\GUIBase.dproj" />
<Projects Include="Servidor\FactuGES_Server.dproj" />
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality</Borland.Personality>
<Borland.ProjectType />
<BorlandProject>
<BorlandProject xmlns=""><Default.Personality></Default.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Target Name="Base">
<MSBuild Projects="Base\Base.dproj" Targets="" />
</Target>
<Target Name="Base:Clean">
<MSBuild Projects="Base\Base.dproj" Targets="Clean" />
</Target>
<Target Name="Base:Make">
<MSBuild Projects="Base\Base.dproj" Targets="Make" />
</Target>
<Target Name="GUIBase">
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="" />
</Target>
<Target Name="GUIBase:Clean">
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="Clean" />
</Target>
<Target Name="GUIBase:Make">
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="Make" />
</Target>
<Target Name="ApplicationBase">
<MSBuild Projects="ApplicationBase\ApplicationBase.dproj" Targets="" />
</Target>
<Target Name="ApplicationBase:Clean">
<MSBuild Projects="ApplicationBase\ApplicationBase.dproj" Targets="Clean" />
</Target>
<Target Name="ApplicationBase:Make">
<MSBuild Projects="ApplicationBase\ApplicationBase.dproj" Targets="Make" />
</Target>
<Target Name="FactuGES">
<MSBuild Projects="Cliente\FactuGES.dproj" Targets="" />
</Target>
<Target Name="FactuGES:Clean">
<MSBuild Projects="Cliente\FactuGES.dproj" Targets="Clean" />
</Target>
<Target Name="FactuGES:Make">
<MSBuild Projects="Cliente\FactuGES.dproj" Targets="Make" />
</Target>
<Target Name="FactuGES_Server">
<MSBuild Projects="Servidor\FactuGES_Server.dproj" Targets="" />
</Target>
<Target Name="FactuGES_Server:Clean">
<MSBuild Projects="Servidor\FactuGES_Server.dproj" Targets="Clean" />
</Target>
<Target Name="FactuGES_Server:Make">
<MSBuild Projects="Servidor\FactuGES_Server.dproj" Targets="Make" />
</Target>
<Target Name="Build">
<CallTarget Targets="Base;GUIBase;ApplicationBase;FactuGES;FactuGES_Server" />
</Target>
<Target Name="Clean">
<CallTarget Targets="Base:Clean;GUIBase:Clean;ApplicationBase:Clean;FactuGES:Clean;FactuGES_Server:Clean" />
</Target>
<Target Name="Make">
<CallTarget Targets="Base:Make;GUIBase:Make;ApplicationBase:Make;FactuGES:Make;FactuGES_Server:Make" />
</Target>
<Import Condition="Exists('$(MSBuildBinPath)\Borland.Group.Targets')" Project="$(MSBuildBinPath)\Borland.Group.Targets" />
</Project>

6
Source/Cliente/uPantallaPrincipal.pas
View File

@ -428,7 +428,7 @@ end;
procedure TfPantallaPrincipal.Perfiles1Click(Sender: TObject);
begin
AppFactuGES.UsuariosController.ShowProfileManager;
AppFactuGES.UsuariosController.VerPerfiles
end;
procedure TfPantallaPrincipal.ShowEmbedded(AEditor: ICustomEditor);
@ -465,7 +465,7 @@ end;
procedure TfPantallaPrincipal.Usuarios1Click(Sender: TObject);
begin
AppFactuGES.UsuariosController.ShowUserManager;
AppFactuGES.UsuariosController.VerUsuarios
end;
procedure TfPantallaPrincipal.WMSysCommand(var Msg: TMessage);
@ -515,7 +515,7 @@ end;
procedure TfPantallaPrincipal.actCambiarPassExecute(Sender: TObject);
begin
AppFactuGES.UsuariosController.ShowChangePassword;
AppFactuGES.UsuariosController._ShowChangePassword;
RefrescarUI;
end;