Tecistel/Tecsitel_FactuGES2
0
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.Tecsitel_FactuGES2/trunk@212 0c75b7a4-871f-7646-8a2f-f78d34cc349f
This commit is contained in:
David Arranz 2008-01-13 21:37:20 +00:00
parent 284291b41f
commit 7742905e27
37 changed files with 4280 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Source/ApplicationBase/ApplicationBase.dpk
View File

@ -29,25 +29,24 @@ requires
rtl, rtl,
vcl, vcl,
dbrtl, dbrtl,
PLuginSDK_D10R,
Base, Base,
GUIBase, GUIBase,
PluginSDK_D10R,
pckUCDataConnector,
pckUserControl_RT,
JvJansD11R, JvJansD11R,
vcljpg, pckUserControl_RT,
vcldb, dclIndyCore,
PNG_D10, IndyCore,
PngComponentsD10, IndySystem,
designide,
xmlrtl,
vclactnband, vclactnband,
vclx, vclx,
JvCoreD11R, IndyProtocols,
Jcl, VclSmp,
JclVcl, pckUCDataConnector,
JvSystemD11R, pckMD5,
JvMMD11R, vcldb,
JvStdCtrlsD11R, vcljpg;
JvCtrlsD11R;
contains contains
uFactuGES_App in 'uFactuGES_App.pas', uFactuGES_App in 'uFactuGES_App.pas',
@ -71,11 +70,24 @@ contains
uEditorEmpresa in 'Empresas\Views\uEditorEmpresa.pas', uEditorEmpresa in 'Empresas\Views\uEditorEmpresa.pas',
uEmpresasViewRegister in 'Empresas\Views\uEmpresasViewRegister.pas', uEmpresasViewRegister in 'Empresas\Views\uEmpresasViewRegister.pas',
uViewDatosBancarios in 'Empresas\Views\uViewDatosBancarios.pas', uViewDatosBancarios in 'Empresas\Views\uViewDatosBancarios.pas',
uUsuarios in 'Usuarios\Model\uUsuarios.pas', uBizUsuarios in 'Usuarios\Model\uBizUsuarios.pas',
schUsuariosServer_Intf in 'Usuarios\Model\schUsuariosServer_Intf.pas', schUsuariosServer_Intf in 'Usuarios\Model\schUsuariosServer_Intf.pas',
schUsuariosClient_Intf in 'Usuarios\Model\schUsuariosClient_Intf.pas', schUsuariosClient_Intf in 'Usuarios\Model\schUsuariosClient_Intf.pas',
uIEditorLogin in 'Usuarios\Controller\View\uIEditorLogin.pas', uIEditorLogin in 'Usuarios\Controller\View\uIEditorLogin.pas',
uEditorLogin in 'Usuarios\Views\uEditorLogin.pas', uEditorLogin in 'Usuarios\Views\uEditorLogin.pas' {fEditorLogin},
uUsuariosViewRegister in 'Usuarios\Views\uUsuariosViewRegister.pas'; uUsuariosViewRegister in 'Usuarios\Views\uUsuariosViewRegister.pas',
uViewPerfilesUsuario in 'Usuarios\Views\uViewPerfilesUsuario.pas' {frViewPerfilesUsuario: TFrame},
uEditorPerfilesUsuario in 'Usuarios\Views\uEditorPerfilesUsuario.pas' {fEditorPerfilesUsuario},
uIEditorUsuarios in 'Usuarios\Controller\View\uIEditorUsuarios.pas',
uEditorPerfilUsuario in 'Usuarios\Views\uEditorPerfilUsuario.pas' {fEditorPerfilUsuario},
uIEditorUsuario in 'Usuarios\Controller\View\uIEditorUsuario.pas',
uViewPerfilUsuario in 'Usuarios\Views\uViewPerfilUsuario.pas' {frViewPerfilUsuario: TFrame},
uIEditorPerfilesUsuario in 'Usuarios\Controller\View\uIEditorPerfilesUsuario.pas',
uIEditorPerfilUsuario in 'Usuarios\Controller\View\uIEditorPerfilUsuario.pas',
uEditorUsuarios in 'Usuarios\Views\uEditorUsuarios.pas' {fEditorUsuarios},
uViewUsuarios in 'Usuarios\Views\uViewUsuarios.pas' {frViewUsuarios: TFrame},
uEditorUsuario in 'Usuarios\Views\uEditorUsuario.pas' {fEditorUsuario: TFrame},
uViewUsuario in 'Usuarios\Views\uViewUsuario.pas' {frViewUsuario: TFrame},
uEditorCambiarPassword in 'Usuarios\Views\uEditorCambiarPassword.pas' {fEditorCambiarPassword};
end. end.

120
Source/ApplicationBase/ApplicationBase.dproj
View File

@ -46,6 +46,41 @@
<Borland.ProjectType>Package</Borland.ProjectType> <Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject> <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="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</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.0.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><Excluded_Packages> <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="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</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.0.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><Excluded_Packages>
<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\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> <Excluded_Packages Name="$(BDS)\bin\dclwebsnap100.bpl">CodeGear WebSnap Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages>
@ -60,28 +95,6 @@
<DelphiCompile Include="ApplicationBase.dpk"> <DelphiCompile Include="ApplicationBase.dpk">
<MainSource>MainSource</MainSource> <MainSource>MainSource</MainSource>
</DelphiCompile> </DelphiCompile>
<DCCReference Include="..\GUIBase\Base.dcp" />
<DCCReference Include="..\GUIBase\dbrtl.dcp" />
<DCCReference Include="..\GUIBase\GUIBase.dcp" />
<DCCReference Include="..\GUIBase\Jcl.dcp" />
<DCCReference Include="..\GUIBase\JclVcl.dcp" />
<DCCReference Include="..\GUIBase\JvCoreD11R.dcp" />
<DCCReference Include="..\GUIBase\JvCtrlsD11R.dcp" />
<DCCReference Include="..\GUIBase\JvJansD11R.dcp" />
<DCCReference Include="..\GUIBase\JvMMD11R.dcp" />
<DCCReference Include="..\GUIBase\JvStdCtrlsD11R.dcp" />
<DCCReference Include="..\GUIBase\JvSystemD11R.dcp" />
<DCCReference Include="..\GUIBase\pckUCDataConnector.dcp" />
<DCCReference Include="..\GUIBase\pckUserControl_RT.dcp" />
<DCCReference Include="..\GUIBase\PluginSDK_D10R.dcp" />
<DCCReference Include="..\GUIBase\PngComponentsD10.dcp" />
<DCCReference Include="..\GUIBase\PNG_D10.dcp" />
<DCCReference Include="..\GUIBase\rtl.dcp" />
<DCCReference Include="..\GUIBase\vcl.dcp" />
<DCCReference Include="..\GUIBase\vclactnband.dcp" />
<DCCReference Include="..\GUIBase\vcldb.dcp" />
<DCCReference Include="..\GUIBase\vcljpg.dcp" />
<DCCReference Include="..\GUIBase\vclx.dcp" />
<DCCReference Include="Empresas\Controller\uDatosBancariosEmpresaController.pas" /> <DCCReference Include="Empresas\Controller\uDatosBancariosEmpresaController.pas" />
<DCCReference Include="Empresas\Controller\uEmpresasController.pas" /> <DCCReference Include="Empresas\Controller\uEmpresasController.pas" />
<DCCReference Include="Empresas\Controller\View\uIEditorDatosBancarioEmpresa.pas" /> <DCCReference Include="Empresas\Controller\View\uIEditorDatosBancarioEmpresa.pas" />
@ -103,6 +116,10 @@
<DCCReference Include="uFactuGES_App.pas" /> <DCCReference Include="uFactuGES_App.pas" />
<DCCReference Include="Usuarios\Controller\uUsuariosController.pas" /> <DCCReference Include="Usuarios\Controller\uUsuariosController.pas" />
<DCCReference Include="Usuarios\Controller\View\uIEditorLogin.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"> <DCCReference Include="Usuarios\Data\uDataModuleUsuarios.pas">
<Form>DataModuleUsuarios</Form> <Form>DataModuleUsuarios</Form>
</DCCReference> </DCCReference>
@ -110,9 +127,64 @@
<DCCReference Include="Usuarios\Model\Data\uIDataModuleUsuarios.pas" /> <DCCReference Include="Usuarios\Model\Data\uIDataModuleUsuarios.pas" />
<DCCReference Include="Usuarios\Model\schUsuariosClient_Intf.pas" /> <DCCReference Include="Usuarios\Model\schUsuariosClient_Intf.pas" />
<DCCReference Include="Usuarios\Model\schUsuariosServer_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\uEditorLogin.pas" /> <DCCReference Include="Usuarios\Views\Base.dcp" />
<DCCReference Include="Usuarios\Views\dbrtl.dcp" />
<DCCReference Include="Usuarios\Views\dclIndyCore.dcp" />
<DCCReference Include="Usuarios\Views\designide.dcp" />
<DCCReference Include="Usuarios\Views\GUIBase.dcp" />
<DCCReference Include="Usuarios\Views\IndyCore.dcp" />
<DCCReference Include="Usuarios\Views\IndyProtocols.dcp" />
<DCCReference Include="Usuarios\Views\IndySystem.dcp" />
<DCCReference Include="Usuarios\Views\JvJansD11R.dcp" />
<DCCReference Include="Usuarios\Views\pckMD5.dcp" />
<DCCReference Include="Usuarios\Views\pckUCDataConnector.dcp" />
<DCCReference Include="Usuarios\Views\pckUserControl_RT.dcp" />
<DCCReference Include="Usuarios\Views\PLuginSDK_D10R.dcp" />
<DCCReference Include="Usuarios\Views\rtl.dcp" />
<DCCReference Include="Usuarios\Views\uEditorCambiarPassword.pas">
<Form>fEditorCambiarPassword</Form>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorLogin.pas">
<Form>fEditorLogin</Form>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorPerfilesUsuario.pas">
<Form>fEditorPerfilesUsuario</Form>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorPerfilUsuario.pas">
<Form>fEditorPerfilUsuario</Form>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorUsuario.pas">
<Form>fEditorUsuario</Form>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uEditorUsuarios.pas">
<Form>fEditorUsuarios</Form>
</DCCReference>
<DCCReference Include="Usuarios\Views\uUsuariosViewRegister.pas" /> <DCCReference Include="Usuarios\Views\uUsuariosViewRegister.pas" />
<DCCReference Include="Usuarios\Views\uViewPerfilesUsuario.pas">
<Form>frViewPerfilesUsuario</Form>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewPerfilUsuario.pas">
<Form>frViewPerfilUsuario</Form>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewUsuario.pas">
<Form>frViewUsuario</Form>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\uViewUsuarios.pas">
<Form>frViewUsuarios</Form>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Usuarios\Views\vcl.dcp" />
<DCCReference Include="Usuarios\Views\vclactnband.dcp" />
<DCCReference Include="Usuarios\Views\vcldb.dcp" />
<DCCReference Include="Usuarios\Views\vcljpg.dcp" />
<DCCReference Include="Usuarios\Views\VclSmp.dcp" />
<DCCReference Include="Usuarios\Views\vclx.dcp" />
<DCCReference Include="Usuarios\Views\xmlrtl.dcp" />
</ItemGroup> </ItemGroup>
</Project> </Project>
<!-- EurekaLog First Line <!-- EurekaLog First Line

BIN
Source/ApplicationBase/Empresas/Model/uBizEmpresas.pas
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.

287
Source/ApplicationBase/Usuarios/Controller/uPerfilesUsuarioController.pas Normal file
View File

@ -0,0 +1,287 @@
unit uPerfilesUsuarioController;
interface
uses
Classes, SysUtils, uDADataTable, uControllerBase, uEditorDBItem,
uIDataModuleUsuarios, uBizUsuarios;
type
IPerfilesUsuarioController = interface(IObservador)
['{3D60BC4E-B244-4C08-9A1A-00A7C3B74558}']
function BuscarTodos: IBizPerfilUsuario;
procedure VerTodos;
procedure Ver(const AIDPerfil : Integer);
procedure Anadir(APerfilUsuario : IBizPerfilUsuario);
function Eliminar(APerfilUsuario : IBizPerfilUsuario): Boolean; overload;
function Eliminar(const AIDPerfil : Integer): Boolean; overload;
function Guardar(APerfilUsuario : IBizPerfilUsuario): Boolean;
procedure DescartarCambios(APerfilUsuario : IBizPerfilUsuario);
function Localizar(APerfilesUsuario: IBizPerfilUsuario; ADescripcion:String): Boolean;
function DarListaPerfilesUsuario: TStringList;
end;
TPerfilesUsuarioController = class(TObservador, IPerfilesUsuarioController)
protected
FDataModule : IDataModuleUsuarios;
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); override;
function CreateEditor(const AName : String; const IID: TGUID; out Intf): Boolean;
//Estos son los tres métodos a sobre escribir si se desea heredar toda la logica de
//este controller
procedure AsignarDataModule; virtual;
procedure ValidarObjetos; virtual;
public
constructor Create; override;
destructor Destroy; override;
function Eliminar(APerfilUsuario : IBizPerfilUsuario): Boolean; overload;
function Eliminar(const AIDPerfil : Integer): Boolean; overload;
function Guardar(APerfilUsuario : IBizPerfilUsuario): Boolean;
procedure DescartarCambios(APerfilUsuario : IBizPerfilUsuario); virtual;
procedure Anadir(APerfilUsuario : IBizPerfilUsuario);
function BuscarTodos: IBizPerfilUsuario;
procedure VerTodos;
procedure Ver(const AIDPerfil : Integer);
function Localizar(APerfilesUsuario: IBizPerfilUsuario; ADescripcion:String): Boolean;
function DarListaPerfilesUsuario: TStringList;
end;
implementation
uses
cxControls, DB, uEditorRegistryUtils,
uDAInterfaces, uDataTableUtils,
uDateUtils, uROTypes, DateUtils, Controls, Windows, schUsuariosClient_Intf,
uDataModuleUsuarios, uIEditorPerfilesUsuario, uIEditorPerfilUsuario;
{ TPerfilesUsuarioController }
procedure TPerfilesUsuarioController.Anadir(APerfilUsuario: IBizPerfilUsuario);
begin
APerfilUsuario.Insert;
end;
procedure TPerfilesUsuarioController.AsignarDataModule;
begin
FDataModule := TDataModuleUsuarios.Create(Nil);
end;
function TPerfilesUsuarioController.BuscarTodos: IBizPerfilUsuario;
begin
Result := FDataModule.GetPerfiles;
end;
constructor TPerfilesUsuarioController.Create;
begin
inherited;
AsignarDataModule;
end;
function TPerfilesUsuarioController.CreateEditor(const AName: String; const IID: TGUID; out Intf): Boolean;
begin
Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf);
end;
function TPerfilesUsuarioController.DarListaPerfilesUsuario: TStringList;
var
APerfilesUsuario: IBizPerfilUsuario;
begin
APerfilesUsuario := BuscarTodos;
APerfilesUsuario.DataTable.Active := True;
Result := TStringList.Create;
try
with Result do
begin
APerfilesUsuario.DataTable.First;
while not APerfilesUsuario.DataTable.EOF do
begin
Add(APerfilesUsuario.USERNAME);
APerfilesUsuario.DataTable.Next;
end;
end;
finally
APerfilesUsuario := NIL;
end;
end;
procedure TPerfilesUsuarioController.DescartarCambios(APerfilUsuario: IBizPerfilUsuario);
begin
if not Assigned(APerfilUsuario) then
raise Exception.Create ('Perfil no asignado');
ShowHourglassCursor;
try
if (APerfilUsuario.State in dsEditModes) then
APerfilUsuario.Cancel;
APerfilUsuario.DataTable.CancelUpdates;
finally
HideHourglassCursor;
end;
end;
destructor TPerfilesUsuarioController.Destroy;
begin
FDataModule := Nil;
inherited;
end;
function TPerfilesUsuarioController.Eliminar(const AIDPerfil: Integer): Boolean;
begin
end;
procedure TPerfilesUsuarioController.ValidarObjetos;
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 TPerfilesUsuarioController.Ver(const AIDPerfil: Integer);
var
AEditor : IEditorPerfilUsuario;
FPerfil : IBizPerfilUsuario;
begin
FPerfil := FDataModule.GetPerfil(AIDPerfil);
if Assigned(FPerfil) then
begin
FPerfil.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 := FPerfil;
ShowModal;
Release;
end;
finally
AEditor := NIL;
FPerfil := NIL;
HideHourglassCursor;
end;
end;
end;
procedure TPerfilesUsuarioController.VerTodos;
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;
function TPerfilesUsuarioController.Eliminar(APerfilUsuario: IBizPerfilUsuario): Boolean;
begin
Result := False;
if not Assigned(APerfilUsuario) then
raise Exception.Create ('Perfil no asignado');
ShowHourglassCursor;
try
if (APerfilUsuario.State in dsEditModes) then
APerfilUsuario.Cancel;
APerfilUsuario.Delete;
APerfilUsuario.DataTable.ApplyUpdates;
HideHourglassCursor;
Result := True;
finally
HideHourglassCursor;
end;
end;
procedure TPerfilesUsuarioController.RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable);
begin
inherited;
//
end;
function TPerfilesUsuarioController.Guardar(APerfilUsuario: IBizPerfilUsuario): Boolean;
begin
Result := False;
if not Assigned(APerfilUsuario) then
raise Exception.Create ('Perfil no asignado');
ValidarObjetos;
ShowHourglassCursor;
try
if (APerfilUsuario.DataTable.State in dsEditModes) then
APerfilUsuario.DataTable.Post;
APerfilUsuario.DataTable.ApplyUpdates;
Result := True;
finally
HideHourglassCursor;
end;
end;
function TPerfilesUsuarioController.Localizar(APerfilesUsuario: IBizPerfilUsuario; ADescripcion: String): Boolean;
begin
Result := True;
ShowHourglassCursor;
try
with APerfilesUsuario.DataTable do
begin
DisableControls;
First;
if not Locate(fld_PERFILESUSERNAME, ADescripcion, []) then
Result := False;
EnableControls;
end;
finally
HideHourglassCursor;
end;
end;
end.

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

@ -5,20 +5,30 @@ interface
uses uses
Classes, SysUtils, Forms, uDADataTable, uControllerBase, Classes, SysUtils, Forms, uDADataTable, uControllerBase,
uIDataModuleUsuarios, uDataModuleUsuarios, UCBase; uIDataModuleUsuarios, uDataModuleUsuarios, UCBase, uBizUsuarios;
type type
TUCCriptografia = (ucStandard, ucMD5);
IUsuariosController = interface(IControllerBase) IUsuariosController = interface(IControllerBase)
['{DD963EEC-5880-4DE7-AF55-B5080B538D84}'] ['{DD963EEC-5880-4DE7-AF55-B5080B538D84}']
procedure Logoff; procedure Logoff;
function StartLogin : Boolean; function StartLogin : Boolean;
procedure ShowUserManager; procedure VerUsuarios;
procedure ShowProfileManager; procedure VerPerfiles;
procedure ShowLogManager; procedure VerUsuario(const AIDUser: Integer); overload;
procedure ShowChangePassword; 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; 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; function GetMaxIntentosLogin: Integer;
procedure SetMaxIntentosLogin(const Value: Integer); procedure SetMaxIntentosLogin(const Value: Integer);
@ -27,8 +37,29 @@ type
function GetCurrentUser: TUCCurrentUser; function GetCurrentUser: TUCCurrentUser;
property CurrentUser: TUCCurrentUser read GetCurrentUser; 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 ChangePassword(IDUser: Integer; NewPassword: String);
procedure AddRight(idUser: Integer; ItemRight: TObject; FullPath: Boolean = True); overload; procedure AddRight(idUser: Integer; ItemRight: TObject; FullPath: Boolean = True); overload;
procedure AddRight(idUser: Integer; ItemRight: String); overload; procedure AddRight(idUser: Integer; ItemRight: String); overload;
@ -45,6 +76,8 @@ type
end; end;
TUsuariosController = class(TControllerBase, IUsuariosController) TUsuariosController = class(TControllerBase, IUsuariosController)
private
function Eliminar(const AIDUser: integer): Boolean;
protected protected
FDataModule : IDataModuleUsuarios; FDataModule : IDataModuleUsuarios;
FUserControl: TUserControl; FUserControl: TUserControl;
@ -60,22 +93,60 @@ type
procedure ComprobarUsuarioInicial; procedure ComprobarUsuarioInicial;
function GetCurrentUser: TUCCurrentUser; 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 public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
procedure Logoff; procedure Logoff;
function StartLogin : Boolean; function StartLogin : Boolean;
procedure ShowUserManager; procedure VerUsuarios;
procedure ShowProfileManager; procedure VerPerfiles;
procedure ShowLogManager;
procedure ShowChangePassword; 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; 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 UserControl : TUserControl read FUserControl;
property MaxIntentosLogin : Integer read GetMaxIntentosLogin write SetMaxIntentosLogin; property MaxIntentosLogin : Integer read GetMaxIntentosLogin write SetMaxIntentosLogin;
property CurrentUser: TUCCurrentUser read GetCurrentUser; property CurrentUser: TUCCurrentUser read GetCurrentUser;
property Criptografia: TUCCriptografia read GetCriptografia;
end; end;
implementation implementation
@ -83,19 +154,148 @@ implementation
uses uses
cxControls, DB, uEditorRegistryUtils, schUsuariosClient_Intf, cxControls, DB, uEditorRegistryUtils, schUsuariosClient_Intf,
uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App, Dialogs, uDAInterfaces, uDataTableUtils, uDialogUtils, uFactuGES_App, Dialogs,
uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin; uDateUtils, uROTypes, DateUtils, Controls, Windows, uIEditorLogin,
uIEditorUsuarios, uIEditorUsuario, uIEditorPerfilesUsuario,
uIEditorPerfilUsuario, uEditorCambiarPassword;
{ TUsuariosController } { 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; procedure TUsuariosController.AsignarDataModule;
begin begin
FDataModule := TDataModuleUsuarios.Create(Nil); FDataModule := TDataModuleUsuarios.Create(Nil);
end; end;
procedure TUsuariosController.CambiarPassword(const AIDUser: Integer; function TUsuariosController.CambiarPassword(const AIDUser: Integer;
const ANewPassword: String); const ANewPassword: String): Boolean;
begin begin
FUserControl.ChangePassword(AIDUser, ANewPassword); 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; end;
function TUsuariosController.ComprobarUsuario(const User, function TUsuariosController.ComprobarUsuario(const User,
@ -124,14 +324,122 @@ begin
Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf); Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf);
end; 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; destructor TUsuariosController.Destroy;
begin begin
FreeAndNIL(FUserControl); FreeAndNIL(FUserControl);
FDataModule := NIL; FDataModule := NIL;
inherited; inherited;
end; 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; function TUsuariosController.GetCurrentUser: TUCCurrentUser;
begin begin
Result := FUserControl.CurrentUser; Result := FUserControl.CurrentUser;
@ -142,6 +450,52 @@ begin
Result := FUserControl.Login.MaxLoginAttempts; Result := FUserControl.Login.MaxLoginAttempts;
end; 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; procedure TUsuariosController.InicializarUserControl;
begin begin
with FUserControl do with FUserControl do
@ -151,6 +505,8 @@ begin
Criptografia := cMD5; Criptografia := cMD5;
CheckValidationKey := True; CheckValidationKey := True;
Login.MaxLoginAttempts := 3; Login.MaxLoginAttempts := 3;
UserPasswordChange.ForcePassword := True;
UserPasswordChange.MinPasswordLength := 3;
end; end;
FDataModule.InicializarUserControl(FUserControl); FDataModule.InicializarUserControl(FUserControl);
end; end;
@ -160,6 +516,90 @@ begin
FUserControl.Logoff; FUserControl.Logoff;
end; 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); procedure TUsuariosController.RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable);
begin begin
inherited; inherited;
@ -171,22 +611,195 @@ begin
FUserControl.Login.MaxLoginAttempts := Value; FUserControl.Login.MaxLoginAttempts := Value;
end; end;
procedure TUsuariosController.ShowChangePassword; procedure TUsuariosController._ShowChangePassword;
begin begin
FUserControl.ShowChangePassword; FUserControl.ShowChangePassword;
end; end;
procedure TUsuariosController.ShowLogManager; procedure TUsuariosController._ShowLogManager;
begin begin
FUserControl.ShowLogManager; FUserControl.ShowLogManager;
end; end;
procedure TUsuariosController.ShowProfileManager; procedure TUsuariosController._ShowProfileManager;
begin begin
FUserControl.ShowProfileManager; FUserControl.ShowProfileManager;
end; 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 begin
FUserControl.ShowUserManager; FUserControl.ShowUserManager;
end; end;

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

@ -1,11 +1,13 @@
inherited DataModuleUsuarios: TDataModuleUsuarios inherited DataModuleUsuarios: TDataModuleUsuarios
Height = 179 OnCreate = DataModuleCreate
Height = 284
Width = 468
object srvUsuarios: TRORemoteService object srvUsuarios: TRORemoteService
Message = dmConexion.ROMessage Message = dmConexion.ROMessage
Channel = dmConexion.ROChannel Channel = dmConexion.ROChannel
ServiceName = 'srvUsuarios' ServiceName = 'srvUsuarios'
Left = 40 Left = 40
Top = 72 Top = 80
end end
object UCSettingsSpanish: TUCSettings object UCSettingsSpanish: TUCSettings
AppMessages.MsgsForm_BtNew = '&Nuevo Mensaje' AppMessages.MsgsForm_BtNew = '&Nuevo Mensaje'
@ -261,4 +263,164 @@ inherited DataModuleUsuarios: TDataModuleUsuarios
Left = 40 Left = 40
Top = 16 Top = 16
end 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 end

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

@ -8,17 +8,32 @@ uses
UCBase, UCDataConnector, uUCROConn, uDARemoteDataAdapter, UCBase, UCDataConnector, uUCROConn, uDARemoteDataAdapter,
uDARemoteCommand, uROClient, uRORemoteService, uDADataStreamer, uDARemoteCommand, uROClient, uRORemoteService, uDADataStreamer,
uDABin2DataStreamer, uDAScriptingProvider, uIDataModuleUsuarios, UCSettings, uDABin2DataStreamer, uDAScriptingProvider, uIDataModuleUsuarios, UCSettings,
uDataModuleBase; uDataModuleBase, uDAInterfaces, uDAMemDataTable, uBizUsuarios;
type type
TDataModuleUsuarios = class(TDataModuleBase, IDataModuleUsuarios) TDataModuleUsuarios = class(TDataModuleBase, IDataModuleUsuarios)
srvUsuarios: TRORemoteService; srvUsuarios: TRORemoteService;
UCSettingsSpanish: TUCSettings; UCSettingsSpanish: TUCSettings;
rda_Usuarios: TDARemoteDataAdapter;
Bin2DataStreamer: TDABin2DataStreamer;
tbl_USUARIOS: TDAMemDataTable;
ds_USUARIOS: TDADataSource;
tbl_PERFILES: TDAMemDataTable;
ds_PERFILES: TDADataSource;
procedure DataModuleCreate(Sender: TObject);
private private
procedure InicializarCamposUserControl(AUserControl: TUserControl); procedure InicializarCamposUserControl(AUserControl: TUserControl);
procedure InicializarSettingsUserControl(AUserControl: TUserControl); procedure InicializarSettingsUserControl(AUserControl: TUserControl);
function CreateConnectorInstance : TUCDataConnector; function CreateConnectorInstance : TUCDataConnector;
public 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); procedure InicializarUserControl (AUserControl : TUserControl);
end; end;
@ -29,10 +44,10 @@ implementation
uses uses
Forms, Controls, uDataTableUtils, uDataModuleConexion, Forms, Controls, uDataTableUtils, uDataModuleConexion,
Dialogs, Windows, uEmpresasController, Dialogs, Windows, uEmpresasController, cxControls,
schUsuariosClient_Intf; schUsuariosClient_Intf;
{ TDAClientDataModule1 } { TDataModuleUsuarios }
function TDataModuleUsuarios.CreateConnectorInstance: TUCDataConnector; function TDataModuleUsuarios.CreateConnectorInstance: TUCDataConnector;
begin begin
@ -47,6 +62,87 @@ begin
end; end;
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( procedure TDataModuleUsuarios.InicializarCamposUserControl(
AUserControl: TUserControl); AUserControl: TUserControl);
begin begin
@ -361,4 +457,5 @@ begin
end; end;
end; end;
end. end.

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

@ -3,14 +3,23 @@ unit uIDataModuleUsuarios;
interface interface
uses uses
UCBase, UCSettings; UCBase, UCSettings, uBizUsuarios;
type type
IDataModuleUsuarios = interface IDataModuleUsuarios = interface
['{35907569-6900-4567-91AC-4EAC14F3D43B}'] ['{C0A8481F-4920-414D-A906-EE1EB18DE946}']
procedure InicializarUserControl (AUserControl : TUserControl); 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; end;
implementation implementation
end. end.

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

@ -9,11 +9,12 @@ const
{ Data table rules ids { Data table rules ids
Feel free to change them to something more human readable Feel free to change them to something more human readable
but make sure they are unique in the context of your application } but make sure they are unique in the context of your application }
RID_USUARIOS = '{1A97AED1-832A-46A9-9894-8CB44D7AFBBD}'; RID_USUARIOS = '{CFE175CF-EB6D-4BF8-91B4-F0140B57453E}';
RID_USUARIOS_EVENTOS = '{16F186E3-A7CF-40DD-B040-EB735A5F1FDD}'; RID_USUARIOS_EVENTOS = '{6013DEA6-697A-4A8C-8D92-51677BB6F39F}';
RID_USUARIOS_LOGON = '{8005FBCF-1276-473D-A3BE-15C8159AB6CE}'; RID_USUARIOS_LOGON = '{C666C96E-401A-4FB5-A0E2-F3DB7BAB5F3D}';
RID_PERMISOS = '{802AF8DD-DA72-412A-AB43-4D5F0EA5630F}'; RID_PERMISOS = '{02CCB513-8F98-406C-ADAC-21C189AABA29}';
RID_PERMISOSEX = '{B2319D8E-0423-41D1-B166-7BD9EC069549}'; RID_PERMISOSEX = '{B8D57BF7-0B57-4A0B-8F9E-12E87D0B6B60}';
RID_PERFILES = '{0AF2374A-D201-4B82-BB13-07265E1BAEBE}';
{ Data table names } { Data table names }
nme_USUARIOS = 'USUARIOS'; nme_USUARIOS = 'USUARIOS';
@ -21,6 +22,7 @@ const
nme_USUARIOS_LOGON = 'USUARIOS_LOGON'; nme_USUARIOS_LOGON = 'USUARIOS_LOGON';
nme_PERMISOS = 'PERMISOS'; nme_PERMISOS = 'PERMISOS';
nme_PERMISOSEX = 'PERMISOSEX'; nme_PERMISOSEX = 'PERMISOSEX';
nme_PERFILES = 'PERFILES';
{ USUARIOS fields } { USUARIOS fields }
fld_USUARIOSID = 'ID'; fld_USUARIOSID = 'ID';
@ -112,10 +114,22 @@ const
idx_PERMISOSEXNOMBREFORM = 3; idx_PERMISOSEXNOMBREFORM = 3;
idx_PERMISOSEXCHECKSUM = 4; 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 type
{ IUSUARIOS } { IUSUARIOS }
IUSUARIOS = interface(IDAStronglyTypedDataTable) IUSUARIOS = interface(IDAStronglyTypedDataTable)
['{F248A54E-1181-40E9-B9B4-9A1D9F4DA382}'] ['{12D98238-4C08-4CB7-BAD1-1E2827ADE7A7}']
{ Property getters and setters } { Property getters and setters }
function GetIDValue: Integer; function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer); procedure SetIDValue(const aValue: Integer);
@ -282,7 +296,7 @@ type
{ IUSUARIOS_EVENTOS } { IUSUARIOS_EVENTOS }
IUSUARIOS_EVENTOS = interface(IDAStronglyTypedDataTable) IUSUARIOS_EVENTOS = interface(IDAStronglyTypedDataTable)
['{8E5D7E37-04E5-4395-8B3E-E0757F5675B4}'] ['{54DEE63E-4D88-43D8-8D34-1F51030428DE}']
{ Property getters and setters } { Property getters and setters }
function GetAPLICACIONValue: String; function GetAPLICACIONValue: String;
procedure SetAPLICACIONValue(const aValue: String); procedure SetAPLICACIONValue(const aValue: String);
@ -413,7 +427,7 @@ type
{ IUSUARIOS_LOGON } { IUSUARIOS_LOGON }
IUSUARIOS_LOGON = interface(IDAStronglyTypedDataTable) IUSUARIOS_LOGON = interface(IDAStronglyTypedDataTable)
['{FF8C8388-9397-4FA2-AB70-491B8299DC00}'] ['{D98BF482-EFA8-49ED-894A-E7774859C830}']
{ Property getters and setters } { Property getters and setters }
function GetLOGONIDValue: String; function GetLOGONIDValue: String;
procedure SetLOGONIDValue(const aValue: String); procedure SetLOGONIDValue(const aValue: String);
@ -496,7 +510,7 @@ type
{ IPERMISOS } { IPERMISOS }
IPERMISOS = interface(IDAStronglyTypedDataTable) IPERMISOS = interface(IDAStronglyTypedDataTable)
['{7705D3E7-EC27-4CB7-9492-1873D2158F79}'] ['{076A52A0-4BD5-4617-80DB-69BB4B4C4E4E}']
{ Property getters and setters } { Property getters and setters }
function GetID_USUARIOValue: Integer; function GetID_USUARIOValue: Integer;
procedure SetID_USUARIOValue(const aValue: Integer); procedure SetID_USUARIOValue(const aValue: Integer);
@ -567,7 +581,7 @@ type
{ IPERMISOSEX } { IPERMISOSEX }
IPERMISOSEX = interface(IDAStronglyTypedDataTable) IPERMISOSEX = interface(IDAStronglyTypedDataTable)
['{1636E92E-3A74-4F5F-AF20-5831B0D57A38}'] ['{5778D823-11A3-4B43-8336-FB2ACBBCFCE5}']
{ Property getters and setters } { Property getters and setters }
function GetID_USUARIOValue: Integer; function GetID_USUARIOValue: Integer;
procedure SetID_USUARIOValue(const aValue: Integer); procedure SetID_USUARIOValue(const aValue: Integer);
@ -648,6 +662,77 @@ type
end; 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 implementation
uses Variants, uROBinaryHelpers; uses Variants, uROBinaryHelpers;
@ -1454,11 +1539,108 @@ begin
end; 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 initialization
RegisterDataTableRules(RID_USUARIOS, TUSUARIOSDataTableRules); RegisterDataTableRules(RID_USUARIOS, TUSUARIOSDataTableRules);
RegisterDataTableRules(RID_USUARIOS_EVENTOS, TUSUARIOS_EVENTOSDataTableRules); RegisterDataTableRules(RID_USUARIOS_EVENTOS, TUSUARIOS_EVENTOSDataTableRules);
RegisterDataTableRules(RID_USUARIOS_LOGON, TUSUARIOS_LOGONDataTableRules); RegisterDataTableRules(RID_USUARIOS_LOGON, TUSUARIOS_LOGONDataTableRules);
RegisterDataTableRules(RID_PERMISOS, TPERMISOSDataTableRules); RegisterDataTableRules(RID_PERMISOS, TPERMISOSDataTableRules);
RegisterDataTableRules(RID_PERMISOSEX, TPERMISOSEXDataTableRules); RegisterDataTableRules(RID_PERMISOSEX, TPERMISOSEXDataTableRules);
RegisterDataTableRules(RID_PERFILES, TPERFILESDataTableRules);
end. end.

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

@ -9,16 +9,17 @@ const
{ Delta rules ids { Delta rules ids
Feel free to change them to something more human readable Feel free to change them to something more human readable
but make sure they are unique in the context of your application } but make sure they are unique in the context of your application }
RID_USUARIOSDelta = '{30AE63B9-1580-4117-9B4F-448F309BD6AC}'; RID_USUARIOSDelta = '{D0217428-91FB-4128-8A0D-AF4A8A742D5A}';
RID_USUARIOS_EVENTOSDelta = '{81DD56BF-BBB5-4311-9AF3-E72EF8B5EC32}'; RID_USUARIOS_EVENTOSDelta = '{16B87039-04DC-47AD-81D6-E8648C69A484}';
RID_USUARIOS_LOGONDelta = '{BE275431-94DF-4C1C-83D0-C09B4E0DA9D9}'; RID_USUARIOS_LOGONDelta = '{856F2E25-24EE-43BB-94F5-70DD65E4FD02}';
RID_PERMISOSDelta = '{F99C6E2E-FE0E-4943-9B69-37B2F48AF314}'; RID_PERMISOSDelta = '{DB34A951-27E2-4A70-843F-9C41FF29179D}';
RID_PERMISOSEXDelta = '{43B62FCB-7C4A-4F3A-9F77-85339308E91A}'; RID_PERMISOSEXDelta = '{F40FC2C9-2DFF-4B12-8EE6-DAD609901516}';
RID_PERFILESDelta = '{07C28883-A52C-4111-ABBE-14E908E7C705}';
type type
{ IUSUARIOSDelta } { IUSUARIOSDelta }
IUSUARIOSDelta = interface(IUSUARIOS) IUSUARIOSDelta = interface(IUSUARIOS)
['{30AE63B9-1580-4117-9B4F-448F309BD6AC}'] ['{D0217428-91FB-4128-8A0D-AF4A8A742D5A}']
{ Property getters and setters } { Property getters and setters }
function GetOldIDValue : Integer; function GetOldIDValue : Integer;
function GetOldUSERNAMEValue : String; function GetOldUSERNAMEValue : String;
@ -184,7 +185,7 @@ type
{ IUSUARIOS_EVENTOSDelta } { IUSUARIOS_EVENTOSDelta }
IUSUARIOS_EVENTOSDelta = interface(IUSUARIOS_EVENTOS) IUSUARIOS_EVENTOSDelta = interface(IUSUARIOS_EVENTOS)
['{81DD56BF-BBB5-4311-9AF3-E72EF8B5EC32}'] ['{16B87039-04DC-47AD-81D6-E8648C69A484}']
{ Property getters and setters } { Property getters and setters }
function GetOldAPLICACIONValue : String; function GetOldAPLICACIONValue : String;
function GetOldID_USUARIOValue : Integer; function GetOldID_USUARIOValue : Integer;
@ -315,7 +316,7 @@ type
{ IUSUARIOS_LOGONDelta } { IUSUARIOS_LOGONDelta }
IUSUARIOS_LOGONDelta = interface(IUSUARIOS_LOGON) IUSUARIOS_LOGONDelta = interface(IUSUARIOS_LOGON)
['{BE275431-94DF-4C1C-83D0-C09B4E0DA9D9}'] ['{856F2E25-24EE-43BB-94F5-70DD65E4FD02}']
{ Property getters and setters } { Property getters and setters }
function GetOldLOGONIDValue : String; function GetOldLOGONIDValue : String;
function GetOldID_USUARIOValue : Integer; function GetOldID_USUARIOValue : Integer;
@ -397,7 +398,7 @@ type
{ IPERMISOSDelta } { IPERMISOSDelta }
IPERMISOSDelta = interface(IPERMISOS) IPERMISOSDelta = interface(IPERMISOS)
['{F99C6E2E-FE0E-4943-9B69-37B2F48AF314}'] ['{DB34A951-27E2-4A70-843F-9C41FF29179D}']
{ Property getters and setters } { Property getters and setters }
function GetOldID_USUARIOValue : Integer; function GetOldID_USUARIOValue : Integer;
function GetOldMODULOValue : String; function GetOldMODULOValue : String;
@ -467,7 +468,7 @@ type
{ IPERMISOSEXDelta } { IPERMISOSEXDelta }
IPERMISOSEXDelta = interface(IPERMISOSEX) IPERMISOSEXDelta = interface(IPERMISOSEX)
['{43B62FCB-7C4A-4F3A-9F77-85339308E91A}'] ['{F40FC2C9-2DFF-4B12-8EE6-DAD609901516}']
{ Property getters and setters } { Property getters and setters }
function GetOldID_USUARIOValue : Integer; function GetOldID_USUARIOValue : Integer;
function GetOldMODULOValue : String; function GetOldMODULOValue : String;
@ -547,6 +548,76 @@ type
end; 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 implementation
uses uses
@ -1705,11 +1776,148 @@ begin
end; 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 initialization
RegisterBusinessProcessorRules(RID_USUARIOSDelta, TUSUARIOSBusinessProcessorRules); RegisterBusinessProcessorRules(RID_USUARIOSDelta, TUSUARIOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_USUARIOS_EVENTOSDelta, TUSUARIOS_EVENTOSBusinessProcessorRules); RegisterBusinessProcessorRules(RID_USUARIOS_EVENTOSDelta, TUSUARIOS_EVENTOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_USUARIOS_LOGONDelta, TUSUARIOS_LOGONBusinessProcessorRules); RegisterBusinessProcessorRules(RID_USUARIOS_LOGONDelta, TUSUARIOS_LOGONBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERMISOSDelta, TPERMISOSBusinessProcessorRules); RegisterBusinessProcessorRules(RID_PERMISOSDelta, TPERMISOSBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERMISOSEXDelta, TPERMISOSEXBusinessProcessorRules); RegisterBusinessProcessorRules(RID_PERMISOSEXDelta, TPERMISOSEXBusinessProcessorRules);
RegisterBusinessProcessorRules(RID_PERFILESDelta, TPERFILESBusinessProcessorRules);
end. 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.

13
Source/ApplicationBase/Usuarios/Model/uUsuarios.pas
View File

@ -1,13 +0,0 @@
unit uUsuarios;
interface
uses
UCBase;
type
TUsuario = TUCCurrentUser;
implementation
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 DiagramData = '<Diagrams>'#13#10'</Diagrams>'#13#10
end end
object DataDictionary: TDADataDictionary 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 Left = 150
Top = 24 Top = 24
end end
@ -33,7 +125,12 @@ object srvUsuarios: TsrvUsuarios
ConnectionType = 'Interbase' ConnectionType = 'Interbase'
Default = True Default = True
TargetTable = 'USUARIOS' 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 = < ColumnMappings = <
item item
DatasetField = 'ID' DatasetField = 'ID'
@ -88,59 +185,71 @@ object srvUsuarios: TsrvUsuarios
Fields = < Fields = <
item item
Name = 'ID' Name = 'ID'
DataType = datInteger DataType = datAutoInc
Required = True GeneratorName = 'GEN_USUARIOS_ID'
DictionaryEntry = 'USUARIOS_ID'
InPrimaryKey = True InPrimaryKey = True
end end
item item
Name = 'USERNAME' Name = 'USERNAME'
DataType = datString DataType = datString
Size = 30 Size = 30
DictionaryEntry = 'USUARIOS_USERNAME'
end end
item item
Name = 'LOGIN' Name = 'LOGIN'
DataType = datString DataType = datString
Size = 30 Size = 30
DictionaryEntry = 'USUARIOS_LOGIN'
end end
item item
Name = 'PASS' Name = 'PASS'
DataType = datString DataType = datString
Size = 250 Size = 250
DictionaryEntry = 'USUARIOS_PASS'
end end
item item
Name = 'PASSEXPIRED' Name = 'PASSEXPIRED'
DataType = datDateTime DataType = datDateTime
DictionaryEntry = 'USUARIOS_PASSEXPIRED'
end end
item item
Name = 'BLOQUEADO' Name = 'BLOQUEADO'
DataType = datSmallInt DataType = datSmallInt
DictionaryEntry = 'USUARIOS_BLOQUEADO'
end end
item item
Name = 'EMAIL' Name = 'EMAIL'
DataType = datString DataType = datString
Size = 150 Size = 150
DictionaryEntry = 'USUARIOS_EMAIL'
end end
item item
Name = 'USERDAYSSUN' Name = 'USERDAYSSUN'
DataType = datInteger DataType = datInteger
DictionaryEntry = 'USUARIOS_USERDAYSSUN'
end end
item item
Name = 'PRIVILEGED' Name = 'PRIVILEGED'
DataType = datInteger DataType = datInteger
DictionaryEntry = 'USUARIOS_PRIVILEGED'
end end
item item
Name = 'TIPO' Name = 'TIPO'
DataType = datString DataType = datString
Size = 1 Size = 1
DictionaryEntry = 'USUARIOS_TIPO'
end end
item item
Name = 'ID_PERFIL' Name = 'ID_PERFIL'
DataType = datInteger DataType = datInteger
DictionaryEntry = 'USUARIOS_ID_PERFIL'
end end
item item
Name = 'CHECKSUM' Name = 'CHECKSUM'
DataType = datString DataType = datString
Size = 250 Size = 250
DictionaryEntry = 'USUARIOS_CHECKSUM'
end> end>
end end
item item
@ -402,6 +511,62 @@ object srvUsuarios: TsrvUsuarios
DataType = datString DataType = datString
Size = 250 Size = 250
end> 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> end>
JoinDataTables = <> JoinDataTables = <>
UnionDataTables = <> 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 implementation
uses uses
uEditorRegistryUtils, uEditorLogin, Dialogs; uEditorRegistryUtils, uEditorLogin, Dialogs, uEditorUsuario, uEditorUsuarios,
uEditorPerfilesUsuario, uEditorPerfilUsuario;
procedure RegisterViews; procedure RegisterViews;
begin begin
EditorRegistry.RegisterClass(TfEditorLogin, 'EditorLogin'); EditorRegistry.RegisterClass(TfEditorLogin, 'EditorLogin');
EditorRegistry.RegisterClass(TfEditorUsuarios, 'EditorUsuarios');
EditorRegistry.RegisterClass(TfEditorUsuario, 'EditorUsuario');
EditorRegistry.RegisterClass(TfEditorPerfilesUsuario, 'EditorPerfilesUsuario');
EditorRegistry.RegisterClass(TfEditorPerfilUsuario, 'EditorPerfilUsuario');
end; end;
procedure UnregisterViews; procedure UnregisterViews;
begin begin
EditorRegistry.UnRegisterClass(TfEditorLogin); EditorRegistry.UnRegisterClass(TfEditorLogin);
EditorRegistry.UnRegisterClass(TfEditorUsuarios);
EditorRegistry.UnRegisterClass(TfEditorUsuario);
EditorRegistry.UnRegisterClass(TfEditorPerfilesUsuario);
EditorRegistry.UnRegisterClass(TfEditorPerfilUsuario);
end; end;
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.

5
Source/ApplicationBase/uFactuGES_App.pas
View File

@ -3,7 +3,7 @@ unit uFactuGES_App;
interface interface
uses uses
SysUtils, Classes, Forms, uUsuarios, uBizEmpresas, uControllerBase, SysUtils, Classes, Forms, uBizUsuarios, uBizEmpresas, uControllerBase,
uEmpresasController, JclFileUtils, uUsuariosController, uHostManager; uEmpresasController, JclFileUtils, uUsuariosController, uHostManager;
type type
@ -55,7 +55,7 @@ type
property EmpresaActiva : IBizEmpresa read GetEmpresaActiva; property EmpresaActiva : IBizEmpresa read GetEmpresaActiva;
property UsuarioActivo : TUsuario read GetUsuarioActivo; property UsuarioActivo : TUsuario read GetUsuarioActivo;
property EmpresasController : IEmpresasController read GetEmpresasController; property EmpresasController : IEmpresasController read GetEmpresasController;
property UsuariosController : IUsuariosController read GetUsuariosController; property UsuariosController : IUsuariosController read GetUsuariosController;
property AppSplashForm : IAppSplashForm read GetAppSplashForm write SetAppSplashForm; property AppSplashForm : IAppSplashForm read GetAppSplashForm write SetAppSplashForm;
property ModuleManager : THostManager read GetModuleManager; property ModuleManager : THostManager read GetModuleManager;
property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent; property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent;
@ -170,6 +170,7 @@ begin
FAppSplashForm := NIL; FAppSplashForm := NIL;
FEmpresaActiva := NIL; FEmpresaActiva := NIL;
FUsuariosController := NIL; // Se crea la primera vez que se usa FUsuariosController := NIL; // Se crea la primera vez que se usa
FEmpresasController := NIL; // Se crea la primera vez que se usa FEmpresasController := NIL; // Se crea la primera vez que se usa
FAppInfo := TJclFileVersionInfo.Create(Application.ExeName); FAppInfo := TJclFileVersionInfo.Create(Application.ExeName);