git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/branches/D2007-DA5@30 0c75b7a4-871f-7646-8a2f-f78d34cc349f
This commit is contained in:
parent
95b3e2290a
commit
2db7e78811
272
Source/Base/Actualizacion/uActualizacion.dfm
Normal file
272
Source/Base/Actualizacion/uActualizacion.dfm
Normal file
@ -0,0 +1,272 @@
|
||||
object fActualizacion: TfActualizacion
|
||||
Left = 447
|
||||
Top = 316
|
||||
Caption = 'Configuraci'#243'n'
|
||||
ClientHeight = 340
|
||||
ClientWidth = 354
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poOwnerFormCenter
|
||||
OnActivate = FormActivate
|
||||
DesignSize = (
|
||||
354
|
||||
340)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Panel2: TPanel
|
||||
Left = 0
|
||||
Top = 306
|
||||
Width = 354
|
||||
Height = 34
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ParentColor = True
|
||||
TabOrder = 0
|
||||
object OKBtn: TButton
|
||||
Left = 190
|
||||
Top = 2
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = '&Aceptar'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
OnClick = OKBtnClick
|
||||
end
|
||||
object CancelBtn: TButton
|
||||
Left = 270
|
||||
Top = 2
|
||||
Width = 75
|
||||
Height = 25
|
||||
Cancel = True
|
||||
Caption = '&Cancelar'
|
||||
ModalResult = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object PageControl1: TPageControl
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 337
|
||||
Height = 289
|
||||
ActivePage = TabSheet1
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
TabOrder = 1
|
||||
object TabSheet1: TTabSheet
|
||||
Caption = 'Configuraci'#243'n'
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 7
|
||||
Top = 6
|
||||
Width = 313
|
||||
Height = 242
|
||||
Caption = 'Configuraci'#243'n de acceso'
|
||||
TabOrder = 0
|
||||
object Label2: TLabel
|
||||
Left = 32
|
||||
Top = 115
|
||||
Width = 259
|
||||
Height = 26
|
||||
Margins.Bottom = 0
|
||||
Caption =
|
||||
'Para poder descargar actualizaciones de FactuGES desde Internet ' +
|
||||
'debe introducir su usuario y contrase'#241'a:'
|
||||
WordWrap = True
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 41
|
||||
Top = 180
|
||||
Width = 39
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Usuario:'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 23
|
||||
Top = 205
|
||||
Width = 57
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Contrase'#241'a:'
|
||||
end
|
||||
object bDirectorio: TSpeedButton
|
||||
Left = 272
|
||||
Top = 48
|
||||
Width = 23
|
||||
Height = 22
|
||||
Caption = '...'
|
||||
OnClick = bDirectorioClick
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 32
|
||||
Top = 155
|
||||
Width = 48
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Direcci'#243'n:'
|
||||
end
|
||||
object edUsuario: TEdit
|
||||
Left = 87
|
||||
Top = 176
|
||||
Width = 208
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
end
|
||||
object edPassword: TEdit
|
||||
Left = 87
|
||||
Top = 201
|
||||
Width = 208
|
||||
Height = 21
|
||||
PasswordChar = '*'
|
||||
TabOrder = 1
|
||||
end
|
||||
object edRutaLan: TEdit
|
||||
Left = 32
|
||||
Top = 48
|
||||
Width = 241
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 2
|
||||
end
|
||||
object rbInternet: TRadioButton
|
||||
Left = 16
|
||||
Top = 96
|
||||
Width = 257
|
||||
Height = 17
|
||||
Caption = 'Actualizaci'#243'n por Internet'
|
||||
TabOrder = 3
|
||||
OnClick = Action1Update
|
||||
end
|
||||
object rbLan: TRadioButton
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 265
|
||||
Height = 17
|
||||
Caption = 'Actualizaci'#243'n por red local'
|
||||
TabOrder = 4
|
||||
OnClick = Action1Update
|
||||
end
|
||||
object edLocation: TEdit
|
||||
Left = 87
|
||||
Top = 151
|
||||
Width = 208
|
||||
Height = 21
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = 'Opciones avanzadas'
|
||||
ImageIndex = 1
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 8
|
||||
Top = 7
|
||||
Width = 313
|
||||
Height = 242
|
||||
Caption = 'Opciones avanzadas'
|
||||
TabOrder = 0
|
||||
object Label1: TLabel
|
||||
Left = 16
|
||||
Top = 19
|
||||
Width = 282
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Por favor, s'#243'lo modificar si se sabe lo que se est'#225' haciendo.'
|
||||
WordWrap = True
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 16
|
||||
Top = 52
|
||||
Width = 177
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Nombre del archivo de configuraci'#243'n:'
|
||||
end
|
||||
object Label7: TLabel
|
||||
Left = 200
|
||||
Top = 76
|
||||
Width = 90
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'p.e: versionlocal.ini'
|
||||
end
|
||||
object edFicheroConfig: TEdit
|
||||
Left = 16
|
||||
Top = 72
|
||||
Width = 177
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object JvAppRegistryStorage1: TJvAppRegistryStorage
|
||||
StorageOptions.BooleanStringTrueValues = 'TRUE, YES, Y'
|
||||
StorageOptions.BooleanStringFalseValues = 'FALSE, NO, N'
|
||||
StorageOptions.BooleanAsString = False
|
||||
RegRoot = hkLocalMachine
|
||||
Root = 'Software\FactuGES\Update'
|
||||
SubStorages = <>
|
||||
Left = 326
|
||||
end
|
||||
object JvFormStorage1: TJvFormStorage
|
||||
Active = False
|
||||
AppStorage = JvAppRegistryStorage1
|
||||
AppStoragePath = '\'
|
||||
Options = []
|
||||
StoredProps.Strings = (
|
||||
'edPassword.Text'
|
||||
'edUsuario.Text'
|
||||
'edRutaLan.Text'
|
||||
'rbInternet.Checked'
|
||||
'rbLan.Checked'
|
||||
'edFicheroConfig.Text'
|
||||
'edLocation.Text')
|
||||
StoredValues = <
|
||||
item
|
||||
Name = 'TipoActualizacion'
|
||||
Value = ''
|
||||
OnSave = JvFormStorage1StoredValues0Save
|
||||
end>
|
||||
Left = 296
|
||||
end
|
||||
object ActionList1: TActionList
|
||||
Left = 242
|
||||
Top = 2
|
||||
object Action1: TAction
|
||||
Caption = 'Action1'
|
||||
OnUpdate = Action1Update
|
||||
end
|
||||
object Action2: TAction
|
||||
Caption = 'Action2'
|
||||
end
|
||||
end
|
||||
object JvBrowseForFolderDialog1: TJvBrowseForFolderDialog
|
||||
Options = [odOnlyDirectory, odStatusAvailable, odNewDialogStyle]
|
||||
Title = 'Ruta de las actualizaciones'
|
||||
Left = 268
|
||||
Top = 1
|
||||
end
|
||||
object JvProgramVersionCheck1: TJvProgramVersionCheck
|
||||
CheckFrequency = 0
|
||||
LocalDirectory = 'update'
|
||||
LocalVersionInfoFileName = 'versioninfo.ini'
|
||||
LocationNetwork = JvProgramVersionNetworkLocation1
|
||||
LocationType = pvltHTTP
|
||||
UserOptions = [uoLocalDirectory, uoAllowedReleaseType, uoLocationType, uoLocationNetwork, uoLocationHTTP]
|
||||
Left = 176
|
||||
Top = 48
|
||||
end
|
||||
object JvProgramVersionNetworkLocation1: TJvProgramVersionNetworkLocation
|
||||
Left = 208
|
||||
Top = 48
|
||||
end
|
||||
object JvProgramVersionHTTPLocation1: TJvProgramVersionHTTPLocation
|
||||
Left = 232
|
||||
Top = 48
|
||||
end
|
||||
end
|
||||
182
Source/Base/Actualizacion/uActualizacion.pas
Normal file
182
Source/Base/Actualizacion/uActualizacion.pas
Normal file
@ -0,0 +1,182 @@
|
||||
{
|
||||
===============================================================================
|
||||
Copyright (©) 2005. Rodax Software.
|
||||
===============================================================================
|
||||
Los contenidos de este fichero son propiedad de Rodax Software titular del
|
||||
copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
|
||||
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
|
||||
acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
|
||||
bajo el que se suministra.
|
||||
-----------------------------------------------------------------------------
|
||||
Web: www.rodax-software.com
|
||||
===============================================================================
|
||||
Fecha primera versión: 17-05-2005
|
||||
Versión actual: 1.0.0
|
||||
Fecha versión actual: 17-05-2005
|
||||
===============================================================================
|
||||
Modificaciones:
|
||||
|
||||
Fecha Comentarios
|
||||
---------------------------------------------------------------------------
|
||||
===============================================================================
|
||||
}
|
||||
|
||||
unit uActualizacion;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ExtCtrls, ComCtrls, JvComponent, JvAppStorage,
|
||||
JvAppRegistryStorage, JvFormPlacement, JvProgramVersionCheck, JvPropertyStore,
|
||||
JvBaseDlg, JvBrowseFolder, ActnList, JvComponentBase, Buttons, uInfoProjectUtils;
|
||||
|
||||
type
|
||||
TfActualizacion = class(TForm)
|
||||
Panel2: TPanel;
|
||||
OKBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
PageControl1: TPageControl;
|
||||
TabSheet1: TTabSheet;
|
||||
GroupBox1: TGroupBox;
|
||||
Label2: TLabel;
|
||||
edUsuario: TEdit;
|
||||
Label3: TLabel;
|
||||
edPassword: TEdit;
|
||||
Label4: TLabel;
|
||||
JvAppRegistryStorage1: TJvAppRegistryStorage;
|
||||
JvFormStorage1: TJvFormStorage;
|
||||
edRutaLan: TEdit;
|
||||
bDirectorio: TSpeedButton;
|
||||
rbInternet: TRadioButton;
|
||||
rbLan: TRadioButton;
|
||||
ActionList1: TActionList;
|
||||
Action1: TAction;
|
||||
Action2: TAction;
|
||||
TabSheet2: TTabSheet;
|
||||
GroupBox2: TGroupBox;
|
||||
Label1: TLabel;
|
||||
Label5: TLabel;
|
||||
edFicheroConfig: TEdit;
|
||||
JvBrowseForFolderDialog1: TJvBrowseForFolderDialog;
|
||||
JvProgramVersionCheck1: TJvProgramVersionCheck;
|
||||
JvProgramVersionNetworkLocation1: TJvProgramVersionNetworkLocation;
|
||||
Label6: TLabel;
|
||||
edLocation: TEdit;
|
||||
Label7: TLabel;
|
||||
procedure bDirectorioClick(Sender: TObject);
|
||||
procedure Action1Update(Sender: TObject);
|
||||
procedure FormActivate(Sender: TObject);
|
||||
procedure OKBtnClick(Sender: TObject);
|
||||
procedure JvFormStorage1StoredValues0Save(Sender: TJvStoredValue;
|
||||
var AValue: Variant);
|
||||
private
|
||||
InfoProject : TInfoProject;
|
||||
public
|
||||
{ Public declarations }
|
||||
function HayConfiguracion: Boolean;
|
||||
procedure Actualizar;
|
||||
function darVersion: String;
|
||||
end;
|
||||
|
||||
var
|
||||
fActualizacion: TfActualizacion;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
JclFileUtils;
|
||||
|
||||
procedure TfActualizacion.bDirectorioClick(Sender: TObject);
|
||||
begin
|
||||
if Length(edRutaLan.Text) > 0 then
|
||||
JvBrowseForFolderDialog1.Directory := edRutaLan.Text;
|
||||
JvBrowseForFolderDialog1.Execute;
|
||||
if DirectoryExists(JvBrowseForFolderDialog1.Directory) then
|
||||
edRutaLan.Text := JvBrowseForFolderDialog1.Directory + '\'
|
||||
else begin
|
||||
ShowMessage('Directorio no válido');
|
||||
bDirectorio.Click;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfActualizacion.Action1Update(Sender: TObject);
|
||||
begin
|
||||
edRutaLan.Enabled := rbLan.Checked;
|
||||
bDirectorio.Enabled := rbLan.Checked;
|
||||
edLocation.Enabled := rbInternet.Checked;
|
||||
edUsuario.Enabled := rbInternet.Checked;
|
||||
edPassword.Enabled := rbInternet.Checked;
|
||||
end;
|
||||
|
||||
procedure TfActualizacion.FormActivate(Sender: TObject);
|
||||
begin
|
||||
JvFormStorage1.RestoreFormPlacement;
|
||||
PageControl1.TabIndex := 0;
|
||||
end;
|
||||
|
||||
procedure TfActualizacion.OKBtnClick(Sender: TObject);
|
||||
begin
|
||||
JvFormStorage1.SaveFormPlacement;
|
||||
end;
|
||||
|
||||
procedure TfActualizacion.Actualizar;
|
||||
begin
|
||||
JvFormStorage1.RestoreFormPlacement;
|
||||
|
||||
if rbLan.Checked then
|
||||
begin
|
||||
JvProgramVersionCheck1.LocationType := pvltNetwork;
|
||||
with JvProgramVersionNetworkLocation1 do
|
||||
begin
|
||||
VersionInfoLocationPathList.Clear;
|
||||
VersionInfoLocationPathList.Add(edRutaLan.Text);
|
||||
VersionInfoFileName := edFicheroConfig.Text;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
{JvProgramVersionCheck1.LocationType := pvltHTTP;
|
||||
with JvProgramVersionHTTPLocationIndy1 do
|
||||
begin
|
||||
VersionInfoFileName := edFicheroConfig.Text;
|
||||
VersionInfoLocationPathList.Clear;
|
||||
VersionInfoLocationPathList.Add(edLocation.Text);
|
||||
UserName := edUsuario.Text;
|
||||
Password := edPassword.Text;
|
||||
end;}
|
||||
end;
|
||||
|
||||
JvProgramVersionCheck1.LocalVersionInfoFileName := 'versionlocal.ini';//edFicheroConfig.Text;
|
||||
JvProgramVersionCheck1.Execute;
|
||||
end;
|
||||
|
||||
procedure TfActualizacion.JvFormStorage1StoredValues0Save(
|
||||
Sender: TJvStoredValue; var AValue: Variant);
|
||||
begin
|
||||
if rbInternet.Checked then
|
||||
AValue := 'INTERNET'
|
||||
else
|
||||
AValue := 'LAN';
|
||||
end;
|
||||
|
||||
function TfActualizacion.darVersion: String;
|
||||
begin
|
||||
InfoProject := TInfoProject.Create(Self);
|
||||
try
|
||||
Result := InfoProject.FileVersion;
|
||||
finally
|
||||
FreeAndNil(InfoProject);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfActualizacion.HayConfiguracion: Boolean;
|
||||
begin
|
||||
// Cargar la configuración desde el registro.
|
||||
JvFormStorage1.RestoreFormPlacement;
|
||||
|
||||
Result := (rbLan.Checked) or (rbInternet.Checked);
|
||||
end;
|
||||
|
||||
end.
|
||||
675
Source/Base/Base.bdsproj
Normal file
675
Source/Base/Base.bdsproj
Normal file
@ -0,0 +1,675 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<BorlandProject>
|
||||
<PersonalityInfo>
|
||||
<Option>
|
||||
<Option Name="Personality">Delphi.Personality</Option>
|
||||
<Option Name="ProjectType">VCLApplication</Option>
|
||||
<Option Name="Version">1.0</Option>
|
||||
<Option Name="GUID">{70A31E92-41C6-4435-A901-D77C3D82951E}</Option>
|
||||
</Option>
|
||||
</PersonalityInfo>
|
||||
<Delphi.Personality>
|
||||
<Source>
|
||||
<Source Name="MainSource">Base.dpk</Source>
|
||||
</Source>
|
||||
<FileVersion>
|
||||
<FileVersion Name="Version">7.0</FileVersion>
|
||||
</FileVersion>
|
||||
<Compiler>
|
||||
<Compiler Name="A">8</Compiler>
|
||||
<Compiler Name="B">0</Compiler>
|
||||
<Compiler Name="C">1</Compiler>
|
||||
<Compiler Name="D">1</Compiler>
|
||||
<Compiler Name="E">0</Compiler>
|
||||
<Compiler Name="F">0</Compiler>
|
||||
<Compiler Name="G">1</Compiler>
|
||||
<Compiler Name="H">1</Compiler>
|
||||
<Compiler Name="I">1</Compiler>
|
||||
<Compiler Name="J">0</Compiler>
|
||||
<Compiler Name="K">0</Compiler>
|
||||
<Compiler Name="L">1</Compiler>
|
||||
<Compiler Name="M">0</Compiler>
|
||||
<Compiler Name="N">1</Compiler>
|
||||
<Compiler Name="O">0</Compiler>
|
||||
<Compiler Name="P">1</Compiler>
|
||||
<Compiler Name="Q">0</Compiler>
|
||||
<Compiler Name="R">0</Compiler>
|
||||
<Compiler Name="S">0</Compiler>
|
||||
<Compiler Name="T">0</Compiler>
|
||||
<Compiler Name="U">0</Compiler>
|
||||
<Compiler Name="V">1</Compiler>
|
||||
<Compiler Name="W">1</Compiler>
|
||||
<Compiler Name="X">1</Compiler>
|
||||
<Compiler Name="Y">1</Compiler>
|
||||
<Compiler Name="Z">1</Compiler>
|
||||
<Compiler Name="ShowHints">True</Compiler>
|
||||
<Compiler Name="ShowWarnings">True</Compiler>
|
||||
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
|
||||
<Compiler Name="NamespacePrefix"></Compiler>
|
||||
<Compiler Name="GenerateDocumentation">False</Compiler>
|
||||
<Compiler Name="DefaultNamespace"></Compiler>
|
||||
<Compiler Name="SymbolDeprecated">True</Compiler>
|
||||
<Compiler Name="SymbolLibrary">True</Compiler>
|
||||
<Compiler Name="SymbolPlatform">True</Compiler>
|
||||
<Compiler Name="SymbolExperimental">True</Compiler>
|
||||
<Compiler Name="UnitLibrary">True</Compiler>
|
||||
<Compiler Name="UnitPlatform">True</Compiler>
|
||||
<Compiler Name="UnitDeprecated">True</Compiler>
|
||||
<Compiler Name="UnitExperimental">True</Compiler>
|
||||
<Compiler Name="HResultCompat">True</Compiler>
|
||||
<Compiler Name="HidingMember">True</Compiler>
|
||||
<Compiler Name="HiddenVirtual">True</Compiler>
|
||||
<Compiler Name="Garbage">True</Compiler>
|
||||
<Compiler Name="BoundsError">True</Compiler>
|
||||
<Compiler Name="ZeroNilCompat">True</Compiler>
|
||||
<Compiler Name="StringConstTruncated">True</Compiler>
|
||||
<Compiler Name="ForLoopVarVarPar">True</Compiler>
|
||||
<Compiler Name="TypedConstVarPar">True</Compiler>
|
||||
<Compiler Name="AsgToTypedConst">True</Compiler>
|
||||
<Compiler Name="CaseLabelRange">True</Compiler>
|
||||
<Compiler Name="ForVariable">True</Compiler>
|
||||
<Compiler Name="ConstructingAbstract">True</Compiler>
|
||||
<Compiler Name="ComparisonFalse">True</Compiler>
|
||||
<Compiler Name="ComparisonTrue">True</Compiler>
|
||||
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
|
||||
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
|
||||
<Compiler Name="UnsupportedConstruct">True</Compiler>
|
||||
<Compiler Name="FileOpen">True</Compiler>
|
||||
<Compiler Name="FileOpenUnitSrc">True</Compiler>
|
||||
<Compiler Name="BadGlobalSymbol">True</Compiler>
|
||||
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
|
||||
<Compiler Name="InvalidDirective">True</Compiler>
|
||||
<Compiler Name="PackageNoLink">True</Compiler>
|
||||
<Compiler Name="PackageThreadVar">True</Compiler>
|
||||
<Compiler Name="ImplicitImport">True</Compiler>
|
||||
<Compiler Name="HPPEMITIgnored">True</Compiler>
|
||||
<Compiler Name="NoRetVal">True</Compiler>
|
||||
<Compiler Name="UseBeforeDef">True</Compiler>
|
||||
<Compiler Name="ForLoopVarUndef">True</Compiler>
|
||||
<Compiler Name="UnitNameMismatch">True</Compiler>
|
||||
<Compiler Name="NoCFGFileFound">True</Compiler>
|
||||
<Compiler Name="ImplicitVariants">True</Compiler>
|
||||
<Compiler Name="UnicodeToLocale">True</Compiler>
|
||||
<Compiler Name="LocaleToUnicode">True</Compiler>
|
||||
<Compiler Name="ImagebaseMultiple">True</Compiler>
|
||||
<Compiler Name="SuspiciousTypecast">True</Compiler>
|
||||
<Compiler Name="PrivatePropAccessor">True</Compiler>
|
||||
<Compiler Name="UnsafeType">False</Compiler>
|
||||
<Compiler Name="UnsafeCode">False</Compiler>
|
||||
<Compiler Name="UnsafeCast">False</Compiler>
|
||||
<Compiler Name="OptionTruncated">True</Compiler>
|
||||
<Compiler Name="WideCharReduced">True</Compiler>
|
||||
<Compiler Name="DuplicatesIgnored">True</Compiler>
|
||||
<Compiler Name="UnitInitSeq">True</Compiler>
|
||||
<Compiler Name="LocalPInvoke">True</Compiler>
|
||||
<Compiler Name="MessageDirective">True</Compiler>
|
||||
<Compiler Name="TypeInfoImplicitlyAdded">True</Compiler>
|
||||
<Compiler Name="XMLWhitespaceNotAllowed">True</Compiler>
|
||||
<Compiler Name="XMLUnknownEntity">True</Compiler>
|
||||
<Compiler Name="XMLInvalidNameStart">True</Compiler>
|
||||
<Compiler Name="XMLInvalidName">True</Compiler>
|
||||
<Compiler Name="XMLExpectedCharacter">True</Compiler>
|
||||
<Compiler Name="XMLCRefNoResolve">True</Compiler>
|
||||
<Compiler Name="XMLNoParm">True</Compiler>
|
||||
<Compiler Name="XMLNoMatchingParm">True</Compiler>
|
||||
<Compiler Name="CodePage"></Compiler>
|
||||
</Compiler>
|
||||
<Linker>
|
||||
<Linker Name="MapFile">0</Linker>
|
||||
<Linker Name="OutputObjs">0</Linker>
|
||||
<Linker Name="GenerateHpps">False</Linker>
|
||||
<Linker Name="ConsoleApp">1</Linker>
|
||||
<Linker Name="DebugInfo">False</Linker>
|
||||
<Linker Name="RemoteSymbols">False</Linker>
|
||||
<Linker Name="GenerateDRC">False</Linker>
|
||||
<Linker Name="MinStackSize">16384</Linker>
|
||||
<Linker Name="MaxStackSize">1048576</Linker>
|
||||
<Linker Name="ImageBase">4194304</Linker>
|
||||
<Linker Name="ExeDescription">Libreria base de FactuGES</Linker>
|
||||
</Linker>
|
||||
<Directories>
|
||||
<Directories Name="OutputDir"></Directories>
|
||||
<Directories Name="UnitOutputDir">.\</Directories>
|
||||
<Directories Name="PackageDLLOutputDir">..\..\Output\Debug\Cliente</Directories>
|
||||
<Directories Name="PackageDCPOutputDir">..\Lib</Directories>
|
||||
<Directories Name="SearchPath">..\Lib</Directories>
|
||||
<Directories Name="Packages"></Directories>
|
||||
<Directories Name="Conditionals"></Directories>
|
||||
<Directories Name="DebugSourceDirs"></Directories>
|
||||
<Directories Name="UsePackages">False</Directories>
|
||||
</Directories>
|
||||
<Parameters>
|
||||
<Parameters Name="RunParams"></Parameters>
|
||||
<Parameters Name="HostApplication"></Parameters>
|
||||
<Parameters Name="Launcher"></Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="DebugCWD"></Parameters>
|
||||
<Parameters Name="Debug Symbols Search Path"></Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<Signing>
|
||||
<Signing Name="SignAssembly">False</Signing>
|
||||
</Signing>
|
||||
<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>
|
||||
<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\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\bcboffice2k100.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\bcbofficexp100.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
<buildevents/>
|
||||
</Delphi.Personality>
|
||||
</BorlandProject>
|
||||
|
||||
<!-- EurekaLog First Line
|
||||
[Exception Log]
|
||||
EurekaLog Version=6006
|
||||
Activate=0
|
||||
Activate Handle=1
|
||||
Save Log File=1
|
||||
Foreground Tab=0
|
||||
Freeze Activate=0
|
||||
Freeze Timeout=0
|
||||
SMTP From=eurekalog@email.com
|
||||
SMTP Host=
|
||||
SMTP Port=25
|
||||
SMTP UserID=
|
||||
SMTP Password=
|
||||
Append to Log=0
|
||||
TerminateBtn Operation=2
|
||||
Errors Number=32
|
||||
Errors Terminate=3
|
||||
Email Address=
|
||||
Email Object=
|
||||
Email Send Options=0
|
||||
Output Path=
|
||||
Encrypt Password=
|
||||
AutoCloseDialogSecs=0
|
||||
WebSendMode=0
|
||||
SupportULR=
|
||||
HTMLLayout Count=15
|
||||
HTMLLine0="%3Chtml%3E"
|
||||
HTMLLine1=" %3Chead%3E"
|
||||
HTMLLine2=" %3C/head%3E"
|
||||
HTMLLine3=" %3Cbody TopMargin=10 LeftMargin=10%3E"
|
||||
HTMLLine4=" %3Ctable width="100%%" border="0"%3E"
|
||||
HTMLLine5=" %3Ctr%3E"
|
||||
HTMLLine6=" %3Ctd nowrap%3E"
|
||||
HTMLLine7=" %3Cfont face="Lucida Console, Courier" size="2"%3E"
|
||||
HTMLLine8=" %3C%%HTML_TAG%%%3E"
|
||||
HTMLLine9=" %3C/font%3E"
|
||||
HTMLLine10=" %3C/td%3E"
|
||||
HTMLLine11=" %3C/tr%3E"
|
||||
HTMLLine12=" %3C/table%3E"
|
||||
HTMLLine13=" %3C/body%3E"
|
||||
HTMLLine14="%3C/html%3E"
|
||||
AutoCrashOperation=2
|
||||
AutoCrashNumber=10
|
||||
AutoCrashMinutes=1
|
||||
WebURL=
|
||||
WebUserID=
|
||||
WebPassword=
|
||||
WebPort=0
|
||||
AttachedFiles=
|
||||
ProxyURL=
|
||||
ProxyUser=
|
||||
ProxyPassword=
|
||||
ProxyPort=8080
|
||||
TrakerUser=
|
||||
TrakerPassword=
|
||||
TrakerAssignTo=
|
||||
TrakerProject=
|
||||
TrakerCategory=
|
||||
TrakerTrialID=
|
||||
ZipPassword=
|
||||
PreBuildEvent=
|
||||
PostSuccessfulBuildEvent=
|
||||
PostFailureBuildEvent=
|
||||
ExceptionDialogType=2
|
||||
Count=0
|
||||
EMail Message Line Count=0
|
||||
loNoDuplicateErrors=0
|
||||
loAppendReproduceText=0
|
||||
loDeleteLogAtVersionChange=0
|
||||
loAddComputerNameInLogFileName=0
|
||||
loSaveModulesAndProcessesSections=1
|
||||
loSaveAssemblerAndCPUSections=1
|
||||
soAppStartDate=1
|
||||
soAppName=1
|
||||
soAppVersionNumber=1
|
||||
soAppParameters=1
|
||||
soAppCompilationDate=1
|
||||
soAppUpTime=1
|
||||
soExcDate=1
|
||||
soExcAddress=1
|
||||
soExcModuleName=1
|
||||
soExcModuleVersion=1
|
||||
soExcType=1
|
||||
soExcMessage=1
|
||||
soExcID=1
|
||||
soExcCount=1
|
||||
soExcStatus=1
|
||||
soExcNote=1
|
||||
soUserID=1
|
||||
soUserName=1
|
||||
soUserEmail=1
|
||||
soUserPrivileges=1
|
||||
soUserCompany=1
|
||||
soActCtlsFormClass=1
|
||||
soActCtlsFormText=1
|
||||
soActCtlsControlClass=1
|
||||
soActCtlsControlText=1
|
||||
soCmpName=1
|
||||
soCmpTotalMemory=1
|
||||
soCmpFreeMemory=1
|
||||
soCmpTotalDisk=1
|
||||
soCmpFreeDisk=1
|
||||
soCmpSysUpTime=1
|
||||
soCmpProcessor=1
|
||||
soCmpDisplayMode=1
|
||||
soCmpDisplayDPI=1
|
||||
soCmpVideoCard=1
|
||||
soCmpPrinter=1
|
||||
soOSType=1
|
||||
soOSBuildN=1
|
||||
soOSUpdate=1
|
||||
soOSLanguage=1
|
||||
soOSCharset=1
|
||||
soNetIP=1
|
||||
soNetSubmask=1
|
||||
soNetGateway=1
|
||||
soNetDNS1=1
|
||||
soNetDNS2=1
|
||||
soNetDHCP=1
|
||||
soCustomData=1
|
||||
sndShowSendDialog=1
|
||||
sndShowSuccessFailureMsg=0
|
||||
sndSendEntireLog=0
|
||||
sndSendXMLLogCopy=0
|
||||
sndSendScreenshot=1
|
||||
sndUseOnlyActiveWindow=0
|
||||
sndSendLastHTMLPage=1
|
||||
sndSendInSeparatedThread=0
|
||||
sndAddDateInFileName=0
|
||||
sndAddComputerNameInFileName=0
|
||||
edoSendErrorReportChecked=1
|
||||
edoAttachScreenshotChecked=1
|
||||
edoShowCopyToClipOption=1
|
||||
edoShowDetailsButton=1
|
||||
edoShowInDetailedMode=0
|
||||
edoShowInTopMostMode=0
|
||||
edoUseEurekaLogLookAndFeel=0
|
||||
edoShowSendErrorReportOption=1
|
||||
edoShowAttachScreenshotOption=1
|
||||
edoShowCustomButton=0
|
||||
csoShowDLLs=1
|
||||
csoShowBPLs=1
|
||||
csoShowBorlandThreads=1
|
||||
csoShowWindowsThreads=1
|
||||
csoDoNotStoreProcNames=0
|
||||
boPauseBorlandThreads=0
|
||||
boDoNotPauseMainThread=0
|
||||
boPauseWindowsThreads=0
|
||||
boUseMainModuleOptions=1
|
||||
boCopyLogInCaseOfError=1
|
||||
boSaveCompressedCopyInCaseOfError=0
|
||||
boHandleSafeCallExceptions=1
|
||||
boCallRTLExceptionEvent=0
|
||||
boCatchHandledExceptions=0
|
||||
loCatchLeaks=0
|
||||
loGroupsSonLeaks=1
|
||||
loHideBorlandLeaks=1
|
||||
loFreeAllLeaks=1
|
||||
loCatchLeaksExceptions=1
|
||||
cfoReduceFileSize=1
|
||||
cfoCheckFileCorruption=0
|
||||
Count mtInformationMsgCaption=1
|
||||
mtInformationMsgCaption0="Information."
|
||||
Count mtQuestionMsgCaption=1
|
||||
mtQuestionMsgCaption0="Question."
|
||||
Count mtErrorMsgCaption=1
|
||||
mtErrorMsgCaption0="Error."
|
||||
Count mtDialog_Caption=1
|
||||
mtDialog_Caption0="Error occurred"
|
||||
Count mtDialog_ErrorMsgCaption=2
|
||||
mtDialog_ErrorMsgCaption0="An error has occurred during program execution."
|
||||
mtDialog_ErrorMsgCaption1="Please read the following information for further details."
|
||||
Count mtDialog_GeneralCaption=1
|
||||
mtDialog_GeneralCaption0="General"
|
||||
Count mtDialog_GeneralHeader=1
|
||||
mtDialog_GeneralHeader0="General Information"
|
||||
Count mtDialog_CallStackCaption=1
|
||||
mtDialog_CallStackCaption0="Call Stack"
|
||||
Count mtDialog_CallStackHeader=1
|
||||
mtDialog_CallStackHeader0="Call Stack Information"
|
||||
Count mtDialog_ModulesCaption=1
|
||||
mtDialog_ModulesCaption0="Modules"
|
||||
Count mtDialog_ModulesHeader=1
|
||||
mtDialog_ModulesHeader0="Modules Information"
|
||||
Count mtDialog_ProcessesCaption=1
|
||||
mtDialog_ProcessesCaption0="Processes"
|
||||
Count mtDialog_ProcessesHeader=1
|
||||
mtDialog_ProcessesHeader0="Processes Information"
|
||||
Count mtDialog_AsmCaption=1
|
||||
mtDialog_AsmCaption0="Assembler"
|
||||
Count mtDialog_AsmHeader=1
|
||||
mtDialog_AsmHeader0="Assembler Information"
|
||||
Count mtDialog_CPUCaption=1
|
||||
mtDialog_CPUCaption0="CPU"
|
||||
Count mtDialog_CPUHeader=1
|
||||
mtDialog_CPUHeader0="CPU Information"
|
||||
Count mtDialog_OKButtonCaption=1
|
||||
mtDialog_OKButtonCaption0="%26OK"
|
||||
Count mtDialog_TerminateButtonCaption=1
|
||||
mtDialog_TerminateButtonCaption0="%26Terminate"
|
||||
Count mtDialog_RestartButtonCaption=1
|
||||
mtDialog_RestartButtonCaption0="%26Restart"
|
||||
Count mtDialog_DetailsButtonCaption=1
|
||||
mtDialog_DetailsButtonCaption0="%26Details"
|
||||
Count mtDialog_CustomButtonCaption=1
|
||||
mtDialog_CustomButtonCaption0="%26Help"
|
||||
Count mtDialog_SendMessage=1
|
||||
mtDialog_SendMessage0="%26Send this error via Internet"
|
||||
Count mtDialog_ScreenshotMessage=1
|
||||
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
|
||||
Count mtDialog_CopyMessage=1
|
||||
mtDialog_CopyMessage0="%26Copy to Clipboard"
|
||||
Count mtDialog_SupportMessage=1
|
||||
mtDialog_SupportMessage0="Go to the Support Page"
|
||||
Count mtMSDialog_ErrorMsgCaption=1
|
||||
mtMSDialog_ErrorMsgCaption0="The application has encountered a problem. We are sorry for the inconvenience."
|
||||
Count mtMSDialog_RestartCaption=1
|
||||
mtMSDialog_RestartCaption0="Restart application."
|
||||
Count mtMSDialog_TerminateCaption=1
|
||||
mtMSDialog_TerminateCaption0="Terminate application."
|
||||
Count mtMSDialog_PleaseCaption=1
|
||||
mtMSDialog_PleaseCaption0="Please tell us about this problem."
|
||||
Count mtMSDialog_DescriptionCaption=1
|
||||
mtMSDialog_DescriptionCaption0="We have created an error report that you can send to us. We will treat this report as confidential and anonymous."
|
||||
Count mtMSDialog_SeeDetailsCaption=1
|
||||
mtMSDialog_SeeDetailsCaption0="To see what data the error report contains,"
|
||||
Count mtMSDialog_SeeClickCaption=1
|
||||
mtMSDialog_SeeClickCaption0="click here."
|
||||
Count mtMSDialog_HowToReproduceCaption=1
|
||||
mtMSDialog_HowToReproduceCaption0="What were you doing when the problem happended (optional)?"
|
||||
Count mtMSDialog_EmailCaption=1
|
||||
mtMSDialog_EmailCaption0="Email address (optional):"
|
||||
Count mtMSDialog_SendButtonCaption=1
|
||||
mtMSDialog_SendButtonCaption0="%26Send Error Report"
|
||||
Count mtMSDialog_NoSendButtonCaption=1
|
||||
mtMSDialog_NoSendButtonCaption0="%26Don't Send"
|
||||
Count mtLog_AppHeader=1
|
||||
mtLog_AppHeader0="Application"
|
||||
Count mtLog_AppStartDate=1
|
||||
mtLog_AppStartDate0="Start Date"
|
||||
Count mtLog_AppName=1
|
||||
mtLog_AppName0="Name/Description"
|
||||
Count mtLog_AppVersionNumber=1
|
||||
mtLog_AppVersionNumber0="Version Number"
|
||||
Count mtLog_AppParameters=1
|
||||
mtLog_AppParameters0="Parameters"
|
||||
Count mtLog_AppCompilationDate=1
|
||||
mtLog_AppCompilationDate0="Compilation Date"
|
||||
Count mtLog_AppUpTime=1
|
||||
mtLog_AppUpTime0="Up Time"
|
||||
Count mtLog_ExcHeader=1
|
||||
mtLog_ExcHeader0="Exception"
|
||||
Count mtLog_ExcDate=1
|
||||
mtLog_ExcDate0="Date"
|
||||
Count mtLog_ExcAddress=1
|
||||
mtLog_ExcAddress0="Address"
|
||||
Count mtLog_ExcModuleName=1
|
||||
mtLog_ExcModuleName0="Module Name"
|
||||
Count mtLog_ExcModuleVersion=1
|
||||
mtLog_ExcModuleVersion0="Module Version"
|
||||
Count mtLog_ExcType=1
|
||||
mtLog_ExcType0="Type"
|
||||
Count mtLog_ExcMessage=1
|
||||
mtLog_ExcMessage0="Message"
|
||||
Count mtLog_ExcID=1
|
||||
mtLog_ExcID0="ID"
|
||||
Count mtLog_ExcCount=1
|
||||
mtLog_ExcCount0="Count"
|
||||
Count mtLog_ExcStatus=1
|
||||
mtLog_ExcStatus0="Status"
|
||||
Count mtLog_ExcNote=1
|
||||
mtLog_ExcNote0="Note"
|
||||
Count mtLog_UserHeader=1
|
||||
mtLog_UserHeader0="User"
|
||||
Count mtLog_UserID=1
|
||||
mtLog_UserID0="ID"
|
||||
Count mtLog_UserName=1
|
||||
mtLog_UserName0="Name"
|
||||
Count mtLog_UserEmail=1
|
||||
mtLog_UserEmail0="Email"
|
||||
Count mtLog_UserCompany=1
|
||||
mtLog_UserCompany0="Company"
|
||||
Count mtLog_UserPrivileges=1
|
||||
mtLog_UserPrivileges0="Privileges"
|
||||
Count mtLog_ActCtrlsHeader=1
|
||||
mtLog_ActCtrlsHeader0="Active Controls"
|
||||
Count mtLog_ActCtrlsFormClass=1
|
||||
mtLog_ActCtrlsFormClass0="Form Class"
|
||||
Count mtLog_ActCtrlsFormText=1
|
||||
mtLog_ActCtrlsFormText0="Form Text"
|
||||
Count mtLog_ActCtrlsControlClass=1
|
||||
mtLog_ActCtrlsControlClass0="Control Class"
|
||||
Count mtLog_ActCtrlsControlText=1
|
||||
mtLog_ActCtrlsControlText0="Control Text"
|
||||
Count mtLog_CmpHeader=1
|
||||
mtLog_CmpHeader0="Computer"
|
||||
Count mtLog_CmpName=1
|
||||
mtLog_CmpName0="Name"
|
||||
Count mtLog_CmpTotalMemory=1
|
||||
mtLog_CmpTotalMemory0="Total Memory"
|
||||
Count mtLog_CmpFreeMemory=1
|
||||
mtLog_CmpFreeMemory0="Free Memory"
|
||||
Count mtLog_CmpTotalDisk=1
|
||||
mtLog_CmpTotalDisk0="Total Disk"
|
||||
Count mtLog_CmpFreeDisk=1
|
||||
mtLog_CmpFreeDisk0="Free Disk"
|
||||
Count mtLog_CmpSystemUpTime=1
|
||||
mtLog_CmpSystemUpTime0="System Up Time"
|
||||
Count mtLog_CmpProcessor=1
|
||||
mtLog_CmpProcessor0="Processor"
|
||||
Count mtLog_CmpDisplayMode=1
|
||||
mtLog_CmpDisplayMode0="Display Mode"
|
||||
Count mtLog_CmpDisplayDPI=1
|
||||
mtLog_CmpDisplayDPI0="Display DPI"
|
||||
Count mtLog_CmpVideoCard=1
|
||||
mtLog_CmpVideoCard0="Video Card"
|
||||
Count mtLog_CmpPrinter=1
|
||||
mtLog_CmpPrinter0="Printer"
|
||||
Count mtLog_OSHeader=1
|
||||
mtLog_OSHeader0="Operating System"
|
||||
Count mtLog_OSType=1
|
||||
mtLog_OSType0="Type"
|
||||
Count mtLog_OSBuildN=1
|
||||
mtLog_OSBuildN0="Build #"
|
||||
Count mtLog_OSUpdate=1
|
||||
mtLog_OSUpdate0="Update"
|
||||
Count mtLog_OSLanguage=1
|
||||
mtLog_OSLanguage0="Language"
|
||||
Count mtLog_OSCharset=1
|
||||
mtLog_OSCharset0="Charset"
|
||||
Count mtLog_NetHeader=1
|
||||
mtLog_NetHeader0="Network"
|
||||
Count mtLog_NetIP=1
|
||||
mtLog_NetIP0="IP Address"
|
||||
Count mtLog_NetSubmask=1
|
||||
mtLog_NetSubmask0="Submask"
|
||||
Count mtLog_NetGateway=1
|
||||
mtLog_NetGateway0="Gateway"
|
||||
Count mtLog_NetDNS1=1
|
||||
mtLog_NetDNS10="DNS 1"
|
||||
Count mtLog_NetDNS2=1
|
||||
mtLog_NetDNS20="DNS 2"
|
||||
Count mtLog_NetDHCP=1
|
||||
mtLog_NetDHCP0="DHCP"
|
||||
Count mtLog_CustInfoHeader=1
|
||||
mtLog_CustInfoHeader0="Custom Information"
|
||||
Count mtCallStack_Address=1
|
||||
mtCallStack_Address0="Address"
|
||||
Count mtCallStack_Name=1
|
||||
mtCallStack_Name0="Module"
|
||||
Count mtCallStack_Unit=1
|
||||
mtCallStack_Unit0="Unit"
|
||||
Count mtCallStack_Class=1
|
||||
mtCallStack_Class0="Class"
|
||||
Count mtCallStack_Procedure=1
|
||||
mtCallStack_Procedure0="Procedure/Method"
|
||||
Count mtCallStack_Line=1
|
||||
mtCallStack_Line0="Line"
|
||||
Count mtCallStack_MainThread=1
|
||||
mtCallStack_MainThread0="Main"
|
||||
Count mtCallStack_ExceptionThread=1
|
||||
mtCallStack_ExceptionThread0="Exception Thread"
|
||||
Count mtCallStack_RunningThread=1
|
||||
mtCallStack_RunningThread0="Running Thread"
|
||||
Count mtCallStack_CallingThread=1
|
||||
mtCallStack_CallingThread0="Calling Thread"
|
||||
Count mtCallStack_ThreadID=1
|
||||
mtCallStack_ThreadID0="ID"
|
||||
Count mtCallStack_ThreadPriority=1
|
||||
mtCallStack_ThreadPriority0="Priority"
|
||||
Count mtCallStack_ThreadClass=1
|
||||
mtCallStack_ThreadClass0="Class"
|
||||
Count mtCallStack_LeakCaption=1
|
||||
mtCallStack_LeakCaption0="Memory Leak"
|
||||
Count mtCallStack_LeakData=1
|
||||
mtCallStack_LeakData0="Data"
|
||||
Count mtCallStack_LeakType=1
|
||||
mtCallStack_LeakType0="Type"
|
||||
Count mtCallStack_LeakSize=1
|
||||
mtCallStack_LeakSize0="Total size"
|
||||
Count mtCallStack_LeakCount=1
|
||||
mtCallStack_LeakCount0="Count"
|
||||
Count mtSendDialog_Caption=1
|
||||
mtSendDialog_Caption0="Send."
|
||||
Count mtSendDialog_Message=1
|
||||
mtSendDialog_Message0="Message"
|
||||
Count mtSendDialog_Resolving=1
|
||||
mtSendDialog_Resolving0="Resolving DNS..."
|
||||
Count mtSendDialog_Login=1
|
||||
mtSendDialog_Login0="Login..."
|
||||
Count mtSendDialog_Connecting=1
|
||||
mtSendDialog_Connecting0="Connecting with server..."
|
||||
Count mtSendDialog_Connected=1
|
||||
mtSendDialog_Connected0="Connected with server."
|
||||
Count mtSendDialog_Sending=1
|
||||
mtSendDialog_Sending0="Sending message..."
|
||||
Count mtSendDialog_Sent=1
|
||||
mtSendDialog_Sent0="Message sent."
|
||||
Count mtSendDialog_SelectProject=1
|
||||
mtSendDialog_SelectProject0="Select project..."
|
||||
Count mtSendDialog_Searching=1
|
||||
mtSendDialog_Searching0="Searching..."
|
||||
Count mtSendDialog_Modifying=1
|
||||
mtSendDialog_Modifying0="Modifying..."
|
||||
Count mtSendDialog_Disconnecting=1
|
||||
mtSendDialog_Disconnecting0="Disconnecting..."
|
||||
Count mtSendDialog_Disconnected=1
|
||||
mtSendDialog_Disconnected0="Disconnected."
|
||||
Count mtReproduceDialog_Caption=1
|
||||
mtReproduceDialog_Caption0="Request"
|
||||
Count mtReproduceDialog_Request=1
|
||||
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
|
||||
Count mtReproduceDialog_OKButtonCaption=1
|
||||
mtReproduceDialog_OKButtonCaption0="%26OK"
|
||||
Count mtModules_Handle=1
|
||||
mtModules_Handle0="Handle"
|
||||
Count mtModules_Name=1
|
||||
mtModules_Name0="Name"
|
||||
Count mtModules_Description=1
|
||||
mtModules_Description0="Description"
|
||||
Count mtModules_Version=1
|
||||
mtModules_Version0="Version"
|
||||
Count mtModules_Size=1
|
||||
mtModules_Size0="Size"
|
||||
Count mtModules_LastModified=1
|
||||
mtModules_LastModified0="Modified"
|
||||
Count mtModules_Path=1
|
||||
mtModules_Path0="Path"
|
||||
Count mtProcesses_ID=1
|
||||
mtProcesses_ID0="ID"
|
||||
Count mtProcesses_Name=1
|
||||
mtProcesses_Name0="Name"
|
||||
Count mtProcesses_Description=1
|
||||
mtProcesses_Description0="Description"
|
||||
Count mtProcesses_Version=1
|
||||
mtProcesses_Version0="Version"
|
||||
Count mtProcesses_Memory=1
|
||||
mtProcesses_Memory0="Memory"
|
||||
Count mtProcesses_Priority=1
|
||||
mtProcesses_Priority0="Priority"
|
||||
Count mtProcesses_Threads=1
|
||||
mtProcesses_Threads0="Threads"
|
||||
Count mtProcesses_Path=1
|
||||
mtProcesses_Path0="Path"
|
||||
Count mtCPU_Registers=1
|
||||
mtCPU_Registers0="Registers"
|
||||
Count mtCPU_Stack=1
|
||||
mtCPU_Stack0="Stack"
|
||||
Count mtCPU_MemoryDump=1
|
||||
mtCPU_MemoryDump0="Memory Dump"
|
||||
Count mtSend_SuccessMsg=1
|
||||
mtSend_SuccessMsg0="The message was sent successfully."
|
||||
Count mtSend_FailureMsg=1
|
||||
mtSend_FailureMsg0="Sorry, sending the message didn't work."
|
||||
Count mtSend_BugClosedMsg=2
|
||||
mtSend_BugClosedMsg0="These BUG is just closed."
|
||||
mtSend_BugClosedMsg1="Contact the program support to obtain an update."
|
||||
Count mtSend_UnknownErrorMsg=1
|
||||
mtSend_UnknownErrorMsg0="Unknown error."
|
||||
Count mtSend_InvalidLoginMsg=1
|
||||
mtSend_InvalidLoginMsg0="Invalid login request."
|
||||
Count mtSend_InvalidSearchMsg=1
|
||||
mtSend_InvalidSearchMsg0="Invalid search request."
|
||||
Count mtSend_InvalidSelectionMsg=1
|
||||
mtSend_InvalidSelectionMsg0="Invalid selection request."
|
||||
Count mtSend_InvalidInsertMsg=1
|
||||
mtSend_InvalidInsertMsg0="Invalid insert request."
|
||||
Count mtSend_InvalidModifyMsg=1
|
||||
mtSend_InvalidModifyMsg0="Invalid modify request."
|
||||
Count mtFileCrackedMsg=2
|
||||
mtFileCrackedMsg0="This file is cracked."
|
||||
mtFileCrackedMsg1="The application will be closed."
|
||||
Count mtException_LeakMultiFree=1
|
||||
mtException_LeakMultiFree0="Multi Free memory leak."
|
||||
Count mtException_LeakMemoryOverrun=1
|
||||
mtException_LeakMemoryOverrun0="Memory Overrun leak."
|
||||
Count mtException_AntiFreeze=1
|
||||
mtException_AntiFreeze0="The application seems to be frozen."
|
||||
Count mtInvalidEmailMsg=1
|
||||
mtInvalidEmailMsg0="Invalid email."
|
||||
TextsCollection=English
|
||||
EurekaLog Last Line -->
|
||||
40
Source/Base/Base.cfg
Normal file
40
Source/Base/Base.cfg
Normal file
@ -0,0 +1,40 @@
|
||||
-$A8
|
||||
-$B-
|
||||
-$C+
|
||||
-$D+
|
||||
-$E-
|
||||
-$F-
|
||||
-$G+
|
||||
-$H+
|
||||
-$I+
|
||||
-$J-
|
||||
-$K-
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O-
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R-
|
||||
-$S-
|
||||
-$T-
|
||||
-$U-
|
||||
-$V+
|
||||
-$W+
|
||||
-$X+
|
||||
-$YD
|
||||
-$Z1
|
||||
-cg
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-N0".\"
|
||||
-LE"..\..\Output\Debug\Cliente"
|
||||
-LN"..\Lib"
|
||||
-U"..\Lib"
|
||||
-O"..\Lib"
|
||||
-I"..\Lib"
|
||||
-R"..\Lib"
|
||||
@ -24,7 +24,6 @@ package Base;
|
||||
{$IMAGEBASE $400000}
|
||||
{$DESCRIPTION 'Libreria base de FactuGES'}
|
||||
{$IMPLICITBUILD ON}
|
||||
{$DEFINE DEBUG}
|
||||
|
||||
requires
|
||||
rtl,
|
||||
@ -58,29 +57,36 @@ requires
|
||||
JvDlgsD11R,
|
||||
JvNetD11R,
|
||||
JvPageCompsD11R,
|
||||
JSDialog100;
|
||||
JSDialog100,
|
||||
dbrtl,
|
||||
vcldb,
|
||||
dsnap,
|
||||
adortl;
|
||||
|
||||
contains
|
||||
uDataTableUtils in 'Utiles\uDataTableUtils.pas',
|
||||
uDBSelectionListUtils in 'Utiles\uDBSelectionListUtils.pas',
|
||||
uIntegerListUtils in 'Utiles\uIntegerListUtils.pas',
|
||||
uDataModuleBase in 'uDataModuleBase.pas' {dmBase: TDataModule},
|
||||
uDataModuleConexion in 'uDataModuleConexion.pas' {dmConexion: TDataModule},
|
||||
uConfigurarConexion in 'uConfigurarConexion.pas' {fConfigurarConexion: TForm},
|
||||
uDataModuleConexion in 'Conexion\uDataModuleConexion.pas' {dmConexion: TDataModule},
|
||||
uConfigurarConexion in 'Conexion\uConfigurarConexion.pas' {fConfigurarConexion: TForm},
|
||||
uSistemaFunc in 'Utiles\uSistemaFunc.pas',
|
||||
FactuGES_Intf in '..\Servicios\FactuGES_Intf.pas',
|
||||
uGridUtils in 'Utiles\uGridUtils.pas',
|
||||
uDateUtils in 'Utiles\uDateUtils.pas',
|
||||
uDataModuleConfiguracion in 'uDataModuleConfiguracion.pas' {dmConfiguracion: TDataModule},
|
||||
uViewRegistryUtils in 'ClassRegistry\uViewRegistryUtils.pas',
|
||||
uClassRegistryUtils in 'ClassRegistry\uClassRegistryUtils.pas',
|
||||
uEditorRegistryUtils in 'ClassRegistry\uEditorRegistryUtils.pas',
|
||||
uDataModuleConfiguracion in 'Configuracion\uDataModuleConfiguracion.pas' {dmConfiguracion: TDataModule},
|
||||
uViewRegistryUtils in 'Utiles\ClassRegistry\uViewRegistryUtils.pas',
|
||||
uClassRegistryUtils in 'Utiles\ClassRegistry\uClassRegistryUtils.pas',
|
||||
uEditorRegistryUtils in 'Utiles\ClassRegistry\uEditorRegistryUtils.pas',
|
||||
uDialogUtils in 'Utiles\uDialogUtils.pas',
|
||||
uNumUtils in 'Utiles\uNumUtils.pas',
|
||||
uMD5 in 'Utiles\uMD5.pas',
|
||||
uPasswordUtils in 'Utiles\uPasswordUtils.pas',
|
||||
uInfoProjectUtils in 'Utiles\uInfoProjectUtils.pas',
|
||||
uActualizacion in 'uActualizacion.pas' {fActualizacion: Form},
|
||||
uInformeRegistryUtils in 'ClassRegistry\uInformeRegistryUtils.pas';
|
||||
uActualizacion in 'Actualizacion\uActualizacion.pas' {fActualizacion: Form},
|
||||
uInformeRegistryUtils in 'Utiles\ClassRegistry\uInformeRegistryUtils.pas',
|
||||
uControllerDetallesDTO in 'Controladores\uControllerDetallesDTO.pas',
|
||||
uControllerBase in 'Controladores\uControllerBase.pas',
|
||||
uControllerDetallesBase in 'Controladores\uControllerDetallesBase.pas';
|
||||
|
||||
end.
|
||||
|
||||
@ -26,7 +26,6 @@
|
||||
<Version>7.0</Version>
|
||||
<DCC_Optimize>False</DCC_Optimize>
|
||||
<DCC_GenerateStackFrames>True</DCC_GenerateStackFrames>
|
||||
<DCC_Define>DEBUG</DCC_Define>
|
||||
<DCC_DcuOutput>.\</DCC_DcuOutput>
|
||||
<DCC_ObjOutput>.\</DCC_ObjOutput>
|
||||
<DCC_HppOutput>.\</DCC_HppOutput>
|
||||
@ -43,12 +42,6 @@
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">Libreria base de FactuGES</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\dclwebsnap100.bpl">CodeGear WebSnap Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
@ -62,38 +55,92 @@
|
||||
<DelphiCompile Include="Base.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\cxDataD10.dcp" />
|
||||
<DCCReference Include="..\cxEditorsD10.dcp" />
|
||||
<DCCReference Include="..\cxExportD10.dcp" />
|
||||
<DCCReference Include="..\cxExtEditorsD10.dcp" />
|
||||
<DCCReference Include="..\cxGridD10.dcp" />
|
||||
<DCCReference Include="..\cxIntl5D10.dcp" />
|
||||
<DCCReference Include="..\cxIntlPrintSys3D10.dcp" />
|
||||
<DCCReference Include="..\cxLibraryD10.dcp" />
|
||||
<DCCReference Include="..\cxPageControlD10.dcp" />
|
||||
<DCCReference Include="..\DataAbstract_Core_D10.dcp" />
|
||||
<DCCReference Include="..\dxPSCoreD10.dcp" />
|
||||
<DCCReference Include="..\dxThemeD10.dcp" />
|
||||
<DCCReference Include="..\GUISDK_D11.dcp" />
|
||||
<DCCReference Include="..\IndyCore.dcp" />
|
||||
<DCCReference Include="..\IndyProtocols.dcp" />
|
||||
<DCCReference Include="..\IndySystem.dcp" />
|
||||
<DCCReference Include="..\Jcl.dcp" />
|
||||
<DCCReference Include="..\JSDialog100containsuDataTableUtilsin.dcp" />
|
||||
<DCCReference Include="..\JvCoreD11R.dcp" />
|
||||
<DCCReference Include="..\JvDlgsD11R.dcp" />
|
||||
<DCCReference Include="..\JvNetD11R.dcp" />
|
||||
<DCCReference Include="..\JvPageCompsD11R.dcp" />
|
||||
<DCCReference Include="..\JvStdCtrlsD11R.dcp" />
|
||||
<DCCReference Include="..\JvSystemD11R.dcp" />
|
||||
<DCCReference Include="..\PngComponentsD10.dcp" />
|
||||
<DCCReference Include="..\PNG_D10.dcp" />
|
||||
<DCCReference Include="..\RemObjects_Core_D10.dcp" />
|
||||
<DCCReference Include="..\rtl.dcp" />
|
||||
<DCCReference Include="..\TB2k_D10.dcp" />
|
||||
<DCCReference Include="..\tbx_d10.dcp" />
|
||||
<DCCReference Include="..\vcl.dcp" />
|
||||
<DCCReference Include="..\vcljpg.dcp" />
|
||||
<DCCReference Include="..\Servicios\FactuGES_Intf.pas" />
|
||||
<DCCReference Include="Actualizacion\uActualizacion.pas">
|
||||
<Form>fActualizacion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="ClassRegistry\uClassRegistryUtils.pas" />
|
||||
<DCCReference Include="ClassRegistry\uEditorRegistryUtils.pas" />
|
||||
<DCCReference Include="ClassRegistry\uInformeRegistryUtils.pas" />
|
||||
<DCCReference Include="ClassRegistry\uViewRegistryUtils.pas" />
|
||||
<DCCReference Include="Conexion\uConfigurarConexion.pas">
|
||||
<Form>fConfigurarConexion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Conexion\uDataModuleConexion.pas">
|
||||
<Form>dmConexion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Configuracion\uDataModuleConfiguracion.pas">
|
||||
<Form>dmConfiguracion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Controladores\adortl.dcp" />
|
||||
<DCCReference Include="Controladores\cxDataD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxEditorsD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxExportD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxExtEditorsD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxGridD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxIntl5D10.dcp" />
|
||||
<DCCReference Include="Controladores\cxIntlPrintSys3D10.dcp" />
|
||||
<DCCReference Include="Controladores\cxLibraryD10.dcp" />
|
||||
<DCCReference Include="Controladores\cxPageControlD10.dcp" />
|
||||
<DCCReference Include="Controladores\DataAbstract_Core_D10.dcp" />
|
||||
<DCCReference Include="Controladores\dbrtl.dcp" />
|
||||
<DCCReference Include="Controladores\dsnap.dcp" />
|
||||
<DCCReference Include="Controladores\dxPSCoreD10.dcp" />
|
||||
<DCCReference Include="Controladores\dxThemeD10.dcp" />
|
||||
<DCCReference Include="Controladores\GUISDK_D11.dcp" />
|
||||
<DCCReference Include="Controladores\IndyCore.dcp" />
|
||||
<DCCReference Include="Controladores\IndyProtocols.dcp" />
|
||||
<DCCReference Include="Controladores\IndySystem.dcp" />
|
||||
<DCCReference Include="Controladores\Jcl.dcp" />
|
||||
<DCCReference Include="Controladores\JSDialog100.dcp" />
|
||||
<DCCReference Include="Controladores\JvCoreD11R.dcp" />
|
||||
<DCCReference Include="Controladores\JvDlgsD11R.dcp" />
|
||||
<DCCReference Include="Controladores\JvNetD11R.dcp" />
|
||||
<DCCReference Include="Controladores\JvPageCompsD11R.dcp" />
|
||||
<DCCReference Include="Controladores\JvStdCtrlsD11R.dcp" />
|
||||
<DCCReference Include="Controladores\JvSystemD11R.dcp" />
|
||||
<DCCReference Include="Controladores\PngComponentsD10.dcp" />
|
||||
<DCCReference Include="Controladores\PNG_D10.dcp" />
|
||||
<DCCReference Include="Controladores\RemObjects_Core_D10.dcp" />
|
||||
<DCCReference Include="Controladores\rtl.dcp" />
|
||||
<DCCReference Include="Controladores\TB2k_D10.dcp" />
|
||||
<DCCReference Include="Controladores\tbx_d10.dcp" />
|
||||
<DCCReference Include="Controladores\uControllerBase.pas" />
|
||||
<DCCReference Include="Controladores\uControllerDetallesBase.pas" />
|
||||
<DCCReference Include="Controladores\uControllerDetallesDTO.pas" />
|
||||
<DCCReference Include="Controladores\vcl.dcp" />
|
||||
<DCCReference Include="Controladores\vcldb.dcp" />
|
||||
<DCCReference Include="Controladores\vcljpg.dcp" />
|
||||
<DCCReference Include="uActualizacion.pas">
|
||||
<Form>fActualizacion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uConfigurarConexion.pas">
|
||||
<Form>fConfigurarConexion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uDataModuleBase.pas">
|
||||
<Form>dmBase</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uDataModuleConexion.pas">
|
||||
<Form>dmConexion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uDataModuleConfiguracion.pas">
|
||||
<Form>dmConfiguracion</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Utiles\ClassRegistry\uClassRegistryUtils.pas" />
|
||||
<DCCReference Include="Utiles\ClassRegistry\uEditorRegistryUtils.pas" />
|
||||
<DCCReference Include="Utiles\ClassRegistry\uInformeRegistryUtils.pas" />
|
||||
<DCCReference Include="Utiles\ClassRegistry\uViewRegistryUtils.pas" />
|
||||
<DCCReference Include="Utiles\uDataTableUtils.pas" />
|
||||
<DCCReference Include="Utiles\uDateUtils.pas" />
|
||||
<DCCReference Include="Utiles\uDBSelectionListUtils.pas" />
|
||||
<DCCReference Include="Utiles\uDialogUtils.pas" />
|
||||
<DCCReference Include="Utiles\uGridUtils.pas" />
|
||||
<DCCReference Include="Utiles\uInfoProjectUtils.pas" />
|
||||
<DCCReference Include="Utiles\uIntegerListUtils.pas" />
|
||||
<DCCReference Include="Utiles\uMD5.pas" />
|
||||
<DCCReference Include="Utiles\uNumUtils.pas" />
|
||||
<DCCReference Include="Utiles\uPasswordUtils.pas" />
|
||||
<DCCReference Include="Utiles\uSistemaFunc.pas" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
<!-- EurekaLog First Line
|
||||
|
||||
@ -14,10 +14,10 @@ BEGIN
|
||||
uClassRegistryUtils_eClassnotFound, "Class \"%s\" was not found in the registry."
|
||||
END
|
||||
|
||||
/* C:\Codigo Tecsitel\Source\Base\uConfigurarConexion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\uDataModuleConexion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\uDataModuleConfiguracion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Conexion\uConfigurarConexion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Conexion\uDataModuleConexion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Configuracion\uDataModuleConfiguracion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\uDataModuleBase.DFM */
|
||||
/* C:\Codigo Tecsitel\Source\Base\uActualizacion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Actualizacion\uActualizacion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Base.res */
|
||||
/* C:\Codigo Tecsitel\Source\Base\Base.drf */
|
||||
|
||||
Binary file not shown.
112
Source/Base/Conexion/uConfigurarConexion.dfm
Normal file
112
Source/Base/Conexion/uConfigurarConexion.dfm
Normal file
@ -0,0 +1,112 @@
|
||||
object fConfigurarConexion: TfConfigurarConexion
|
||||
Left = 663
|
||||
Top = 468
|
||||
ActiveControl = edtServer
|
||||
Caption = 'Configuraci'#243'n de la conexi'#243'n'
|
||||
ClientHeight = 149
|
||||
ClientWidth = 392
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
Scaled = False
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object bProbar: TButton
|
||||
Left = 8
|
||||
Top = 113
|
||||
Width = 121
|
||||
Height = 25
|
||||
Caption = '&Probar la conexi'#243'n'
|
||||
TabOrder = 1
|
||||
OnClick = bProbarClick
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 375
|
||||
Height = 97
|
||||
Caption = 'Servidor'
|
||||
TabOrder = 0
|
||||
DesignSize = (
|
||||
375
|
||||
97)
|
||||
object Label1: TLabel
|
||||
Left = 18
|
||||
Top = 28
|
||||
Width = 97
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Nombre del servidor:'
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 18
|
||||
Top = 60
|
||||
Width = 93
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Puerto de escucha:'
|
||||
end
|
||||
object edtServer: TEdit
|
||||
Left = 136
|
||||
Top = 24
|
||||
Width = 223
|
||||
Height = 21
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtPort: TEdit
|
||||
Left = 136
|
||||
Top = 56
|
||||
Width = 108
|
||||
Height = 21
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
TabOrder = 1
|
||||
Text = '8099'
|
||||
end
|
||||
end
|
||||
object bAceptar: TButton
|
||||
Left = 219
|
||||
Top = 113
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = '&Aceptar'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 2
|
||||
end
|
||||
object bCancelar: TButton
|
||||
Left = 307
|
||||
Top = 113
|
||||
Width = 75
|
||||
Height = 25
|
||||
Cancel = True
|
||||
Caption = '&Cancelar'
|
||||
ModalResult = 2
|
||||
TabOrder = 3
|
||||
end
|
||||
object HTTPChannel: TROWinInetHTTPChannel
|
||||
UserAgent = 'AdminPV'
|
||||
TargetURL = 'http://localhost:8099/BIN'
|
||||
ServerLocators = <>
|
||||
DispatchOptions = []
|
||||
Left = 120
|
||||
Top = 112
|
||||
end
|
||||
object ROBinMessage: TROBinMessage
|
||||
Left = 152
|
||||
Top = 112
|
||||
end
|
||||
object CoService: TRORemoteService
|
||||
Message = ROBinMessage
|
||||
Channel = HTTPChannel
|
||||
ServiceName = 'srvLogin'
|
||||
Left = 184
|
||||
Top = 112
|
||||
end
|
||||
end
|
||||
76
Source/Base/Conexion/uConfigurarConexion.pas
Normal file
76
Source/Base/Conexion/uConfigurarConexion.pas
Normal file
@ -0,0 +1,76 @@
|
||||
unit uConfigurarConexion;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, uROClient, uROWinInetHttpChannel, uRODynamicRequest,
|
||||
uRORemoteService, uROBinMessage;
|
||||
|
||||
type
|
||||
TfConfigurarConexion = class(TForm)
|
||||
bProbar: TButton;
|
||||
GroupBox1: TGroupBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
edtServer: TEdit;
|
||||
edtPort: TEdit;
|
||||
bAceptar: TButton;
|
||||
bCancelar: TButton;
|
||||
HTTPChannel: TROWinInetHTTPChannel;
|
||||
ROBinMessage: TROBinMessage;
|
||||
CoService: TRORemoteService;
|
||||
procedure bProbarClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
function GetTargetURL: String;
|
||||
procedure SetTargetURL(const Value: String);
|
||||
{ Private declarations }
|
||||
public
|
||||
property TargetURL : String read GetTargetURL write SetTargetURL;
|
||||
end;
|
||||
|
||||
var
|
||||
fConfigurarConexion: TfConfigurarConexion;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, JclStrings, uDataModuleConexion, uDialogUtils;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
{ TfConfigurarConexion }
|
||||
|
||||
function TfConfigurarConexion.GetTargetURL: String;
|
||||
begin
|
||||
Result := 'http://' + edtServer.Text + ':' + edtPort.Text + '/bin';
|
||||
end;
|
||||
|
||||
procedure TfConfigurarConexion.SetTargetURL(const Value: String);
|
||||
var
|
||||
s : String;
|
||||
begin
|
||||
s := StrAfter('http://', Value);
|
||||
s := StrBefore(':', s);
|
||||
edtServer.Text := s;
|
||||
|
||||
s := StrAfter(edtServer.Text + ':', Value);
|
||||
s := StrBefore('/bin', s);
|
||||
edtPort.Text := s;
|
||||
end;
|
||||
|
||||
procedure TfConfigurarConexion.bProbarClick(Sender: TObject);
|
||||
begin
|
||||
if dmConexion.ProbarConexion(TargetURL) then
|
||||
ShowInfoMessage('Conexión válida con el servidor.')
|
||||
else
|
||||
ShowErrorMessage('Error de conexión', 'No se ha podido establecer la conexión con el servidor.')
|
||||
end;
|
||||
|
||||
procedure TfConfigurarConexion.FormCreate(Sender: TObject);
|
||||
begin
|
||||
HTTPChannel.OnFailure := dmConexion.ROChannelFailure;
|
||||
end;
|
||||
|
||||
end.
|
||||
20
Source/Base/Conexion/uDataModuleConexion.dfm
Normal file
20
Source/Base/Conexion/uDataModuleConexion.dfm
Normal file
@ -0,0 +1,20 @@
|
||||
object dmConexion: TdmConexion
|
||||
OldCreateOrder = False
|
||||
Height = 177
|
||||
Width = 121
|
||||
object ROChannel: TROWinInetHTTPChannel
|
||||
OnFailure = ROChannelFailure
|
||||
OnException = ROChannelFailure
|
||||
UserAgent = 'RemObjects SDK'
|
||||
TargetURL = 'http://localhost:8099/bin'
|
||||
KeepConnection = True
|
||||
ServerLocators = <>
|
||||
DispatchOptions = []
|
||||
Left = 42
|
||||
Top = 16
|
||||
end
|
||||
object ROMessage: TROBinMessage
|
||||
Left = 42
|
||||
Top = 88
|
||||
end
|
||||
end
|
||||
150
Source/Base/Conexion/uDataModuleConexion.pas
Normal file
150
Source/Base/Conexion/uDataModuleConexion.pas
Normal file
@ -0,0 +1,150 @@
|
||||
unit uDataModuleConexion;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, uRORemoteService, uDADataTable,
|
||||
uDABINAdapter, uROClient, uROBinMessage, uROWinInetHttpChannel,
|
||||
uDADataStreamer;
|
||||
|
||||
const
|
||||
SERVER_URL = 'http://localhost:8099/bin'; // Dirección por defecto del servidor
|
||||
|
||||
type
|
||||
TdmConexion = class(TDataModule)
|
||||
ROChannel: TROWinInetHTTPChannel;
|
||||
ROMessage: TROBinMessage;
|
||||
procedure ROChannelFailure(Sender: TROTransportChannel;
|
||||
anException: Exception; var Retry: Boolean);
|
||||
private
|
||||
function GetChannel: TROWinInetHTTPChannel;
|
||||
function GetMessage: TROBinMessage;
|
||||
function GetTargetURL: String;
|
||||
procedure SetTargetURL(const Value: String);
|
||||
public
|
||||
function HayConexion : Boolean;
|
||||
function ProbarConexion(const ATargetURL : String): Boolean;
|
||||
procedure ConfigurarConexion;
|
||||
property TargetURL : String read GetTargetURL write SetTargetURL;
|
||||
property Channel: TROWinInetHTTPChannel read GetChannel;
|
||||
property Message: TROBinMessage read GetMessage;
|
||||
end;
|
||||
|
||||
var
|
||||
dmConexion: TdmConexion;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
Windows, WinInet, cxControls, uConfigurarConexion, Dialogs, Controls,
|
||||
uDataModuleBase, FactuGES_Intf;
|
||||
|
||||
const
|
||||
IE_OFFLINE_ERROR = 'Unexpected error in WinInet HTTP Channel (2)';
|
||||
|
||||
function TdmConexion.HayConexion: Boolean;
|
||||
begin
|
||||
Result := ROChannel.Connected;
|
||||
end;
|
||||
|
||||
procedure TdmConexion.ConfigurarConexion;
|
||||
begin
|
||||
with TfConfigurarConexion.Create(NIL) do
|
||||
try
|
||||
TargetURL := ROChannel.TargetURL;
|
||||
if ShowModal = mrOk then
|
||||
begin
|
||||
ROChannel.TargetURL := TargetURL;
|
||||
ROChannel.Connected := False;
|
||||
ROChannel.Connected := True;
|
||||
dmBase.SalvarConfiguracion;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TdmConexion.GetChannel: TROWinInetHTTPChannel;
|
||||
begin
|
||||
Result := ROChannel;
|
||||
end;
|
||||
|
||||
function TdmConexion.GetMessage: TROBinMessage;
|
||||
begin
|
||||
Result := ROMessage;
|
||||
end;
|
||||
|
||||
function TdmConexion.GetTargetURL: String;
|
||||
begin
|
||||
Result := ROChannel.TargetURL;
|
||||
end;
|
||||
|
||||
function TdmConexion.ProbarConexion(const ATargetURL: String): Boolean;
|
||||
var
|
||||
AHTTPChannel: TROWinInetHTTPChannel;
|
||||
AROBinMessage: TROBinMessage;
|
||||
ACoService: TRORemoteService;
|
||||
begin
|
||||
if ATargetURL = '' then
|
||||
raise Exception.Create('No se ha indicado la URL del servidor (HayConexion)');
|
||||
|
||||
AHTTPChannel := TROWinInetHTTPChannel.Create(Self);
|
||||
AROBinMessage := TROBinMessage.Create(Self);
|
||||
ACoService := TRORemoteService.Create(Self);
|
||||
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
with AHTTPChannel do
|
||||
begin
|
||||
Name := 'HTTPChannel';
|
||||
if Length(ATargetURL) > 0 then
|
||||
TargetURL := ATargetURL
|
||||
else
|
||||
TargetURL := ROChannel.TargetURL;
|
||||
end;
|
||||
|
||||
with ACoService do
|
||||
begin
|
||||
ServiceName := 'srvLogin';
|
||||
ACoService.Message := AROBinMessage;
|
||||
Channel := AHTTPChannel;
|
||||
end;
|
||||
|
||||
try
|
||||
AHTTPChannel.Connected := True;
|
||||
(ACoService as IsrvLogin).Ping;
|
||||
AHTTPChannel.Connected := False;
|
||||
Result := True;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
finally
|
||||
AHTTPChannel.Connected := False;
|
||||
FreeAndNil(AHTTPChannel);
|
||||
FreeAndNil(ACoService);
|
||||
FreeAndNil(AROBinMessage);
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmConexion.ROChannelFailure(Sender: TROTransportChannel;
|
||||
anException: Exception; var Retry: Boolean);
|
||||
begin
|
||||
if (Pos(anException.Message, IE_OFFLINE_ERROR) > 0) then
|
||||
begin
|
||||
// Preguntar al usuario si se quiere conectar
|
||||
if InternetGoOnline(PAnsiChar(ROChannel.TargetURL), GetDesktopWindow(), 0) then
|
||||
Retry := True // Si el usuario pulsa en 'Conectar' reintentar la operación
|
||||
else
|
||||
Abort; // Si el usuario pulsa en 'Seguir desconectado' parar todo
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TdmConexion.SetTargetURL(const Value: String);
|
||||
begin
|
||||
ROChannel.TargetURL := Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
27
Source/Base/Configuracion/uDataModuleConfiguracion.dfm
Normal file
27
Source/Base/Configuracion/uDataModuleConfiguracion.dfm
Normal file
@ -0,0 +1,27 @@
|
||||
object dmConfiguracion: TdmConfiguracion
|
||||
OldCreateOrder = False
|
||||
Height = 160
|
||||
Width = 220
|
||||
object ROChannel: TROWinInetHTTPChannel
|
||||
UserAgent = 'RemObjects SDK'
|
||||
TargetURL = 'http://localhost:8099/bin'
|
||||
Login.Username = '123456'
|
||||
Login.Password = 'sa'
|
||||
KeepConnection = True
|
||||
ServerLocators = <>
|
||||
DispatchOptions = []
|
||||
Left = 42
|
||||
Top = 16
|
||||
end
|
||||
object ROMessage: TROBinMessage
|
||||
Left = 42
|
||||
Top = 88
|
||||
end
|
||||
object RORemoteService: TRORemoteService
|
||||
Message = ROMessage
|
||||
Channel = ROChannel
|
||||
ServiceName = 'srvConfiguracion'
|
||||
Left = 136
|
||||
Top = 16
|
||||
end
|
||||
end
|
||||
70
Source/Base/Configuracion/uDataModuleConfiguracion.pas
Normal file
70
Source/Base/Configuracion/uDataModuleConfiguracion.pas
Normal file
@ -0,0 +1,70 @@
|
||||
unit uDataModuleConfiguracion;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, uRORemoteService, uDADataTable,
|
||||
uDABINAdapter, uROClient, uROBinMessage, uROWinInetHttpChannel, IniFiles,
|
||||
uDADataStreamer;
|
||||
|
||||
const
|
||||
SERVER_URL = 'http://localhost:8099/bin';
|
||||
|
||||
type
|
||||
TdmConfiguracion = class(TDataModule)
|
||||
ROChannel: TROWinInetHTTPChannel;
|
||||
ROMessage: TROBinMessage;
|
||||
RORemoteService: TRORemoteService;
|
||||
private
|
||||
FIniFile : TIniFile;
|
||||
public
|
||||
function DarValor(const CODIGO: String): Variant;
|
||||
procedure LeerConfiguracion;
|
||||
procedure SalvarConfiguracion;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
dmConfiguracion: TdmConfiguracion;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
Forms, FactuGES_Intf, Variants, uDataModuleConexion;
|
||||
|
||||
|
||||
{ TdmConfiguracion }
|
||||
|
||||
constructor TdmConfiguracion.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FIniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini' ) );
|
||||
end;
|
||||
|
||||
function TdmConfiguracion.DarValor(const CODIGO: String): Variant;
|
||||
begin
|
||||
Result := (RORemoteService as IsrvConfiguracion).DarValor(CODIGO);
|
||||
end;
|
||||
|
||||
destructor TdmConfiguracion.Destroy;
|
||||
begin
|
||||
FreeAndNIL(FIniFile);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TdmConfiguracion.LeerConfiguracion;
|
||||
begin
|
||||
with FIniFile do
|
||||
dmConexion.TargetURL := ReadString('Server', 'URL', SERVER_URL);
|
||||
end;
|
||||
|
||||
procedure TdmConfiguracion.SalvarConfiguracion;
|
||||
begin
|
||||
with FIniFile do
|
||||
WriteString('Server', 'URL', dmConexion.TargetURL);
|
||||
end;
|
||||
|
||||
end.
|
||||
102
Source/Base/Controladores/uControllerBase.pas
Normal file
102
Source/Base/Controladores/uControllerBase.pas
Normal file
@ -0,0 +1,102 @@
|
||||
unit uControllerBase;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, uDADataTable;
|
||||
|
||||
type
|
||||
ISujeto = interface;
|
||||
|
||||
IObservador = interface
|
||||
['{679D5CF2-D5DC-4A52-9FF3-04AD91402483}']
|
||||
procedure RecibirAviso(ASujeto: ISujeto); overload;
|
||||
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload;
|
||||
end;
|
||||
|
||||
ISujeto = interface
|
||||
['{CDB691CD-D1D6-4F2E-AA34-93B1CD0E6030}']
|
||||
procedure AddObservador(Observador: IObservador);
|
||||
procedure DeleteObservador(Observador: IObservador);
|
||||
end;
|
||||
|
||||
TObservador = class(TInterfacedObject, IObservador)
|
||||
protected
|
||||
procedure RecibirAviso(ASujeto: ISujeto); overload; virtual;
|
||||
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload; virtual; abstract;
|
||||
end;
|
||||
|
||||
TSujeto = class(TInterfacedObject, ISujeto)
|
||||
private
|
||||
fObservadores: IInterfaceList;
|
||||
protected
|
||||
procedure AvisarObservadores; overload;
|
||||
procedure AvisarObservadores(ADataTable: IDAStronglyTypedDataTable); overload;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
procedure AddObservador(Observador: IObservador);
|
||||
procedure DeleteObservador(Observador: IObservador);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
{ TSujeto }
|
||||
|
||||
procedure TSujeto.addObservador(Observador: IObservador);
|
||||
begin
|
||||
FObservadores.Add(Observador);
|
||||
end;
|
||||
|
||||
procedure TSujeto.AvisarObservadores;
|
||||
var
|
||||
i: Integer;
|
||||
AObs : IObservador;
|
||||
begin
|
||||
for i := 0 to Pred(FObservadores.Count) do
|
||||
begin
|
||||
if Supports(FObservadores[i], IObservador, AObs) then
|
||||
AObs.RecibirAviso(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSujeto.AvisarObservadores(ADataTable: IDAStronglyTypedDataTable);
|
||||
var
|
||||
i: Integer;
|
||||
AObs : IObservador;
|
||||
begin
|
||||
for i := 0 to Pred(FObservadores.Count) do
|
||||
begin
|
||||
if Supports(FObservadores[i], IObservador, AObs) then
|
||||
AObs.RecibirAviso(Self, ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TSujeto.Create;
|
||||
begin
|
||||
inherited;
|
||||
FObservadores := TInterfaceList.Create;
|
||||
end;
|
||||
|
||||
procedure TSujeto.DeleteObservador(Observador: IObservador);
|
||||
begin
|
||||
FObservadores.Remove(Observador);
|
||||
end;
|
||||
|
||||
destructor TSujeto.Destroy;
|
||||
begin
|
||||
FObservadores := NIL;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
{ TObservador }
|
||||
|
||||
procedure TObservador.RecibirAviso(ASujeto: ISujeto);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
end.
|
||||
585
Source/Base/Controladores/uControllerDetallesBase.pas
Normal file
585
Source/Base/Controladores/uControllerDetallesBase.pas
Normal file
@ -0,0 +1,585 @@
|
||||
unit uControllerDetallesBase;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes, Variants, uDACDSDataTable, uDADataTable, uControllerBase;
|
||||
|
||||
const
|
||||
CAMPO_ID = 'ID';
|
||||
CAMPO_POSICION = 'POSICION';
|
||||
CAMPO_TIPO = 'TIPO_DETALLE';
|
||||
CAMPO_CONCEPTO = 'CONCEPTO';
|
||||
CAMPO_CANTIDAD = 'CANTIDAD';
|
||||
CAMPO_IMPORTE_UNIDAD = 'IMPORTE_UNIDAD';
|
||||
CAMPO_IMPORTE_TOTAL = 'IMPORTE_TOTAL';
|
||||
|
||||
TIPO_DETALLE_CONCEPTO = 'Concepto';
|
||||
TIPO_DETALLE_TITULO = 'Titulo';
|
||||
TIPO_DETALLE_SUBTOTAL = 'Subtotal';
|
||||
TIPO_DETALLE_SALTO = 'Salto';
|
||||
|
||||
CTE_DESC_SALTO = 'SALTO DE PAGINA >>';
|
||||
|
||||
type
|
||||
TIntegerArray = array of Integer;
|
||||
|
||||
IControllerDetallesBase = interface(ISujeto)
|
||||
['{F0B0E714-EC0D-4B6B-98B1-76F72F70B735}']
|
||||
|
||||
function getTipo(ADataTable: IDAStronglyTypedDataTable; pPosicion: Integer): String;
|
||||
procedure Clear(ADataTable: IDAStronglyTypedDataTable);
|
||||
procedure Add(ADataTable: IDAStronglyTypedDataTable; TipoConcepto: Variant);
|
||||
procedure Delete(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray);
|
||||
procedure Move(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray; Posiciones: Integer);
|
||||
|
||||
// procedure Copy(SMExport: TSMExportToClipboard);
|
||||
// procedure Paste;
|
||||
|
||||
procedure ActualizarTotales(ADataTable: IDAStronglyTypedDataTable);
|
||||
function DarTotalImporteTotal(ADataTable: IDAStronglyTypedDataTable): Double;
|
||||
|
||||
function DarListaTiposDetalle: TStringList;
|
||||
end;
|
||||
|
||||
TControllerDetallesBase = class (TSujeto, IControllerDetallesBase)
|
||||
private
|
||||
fUpdateCount: Integer;
|
||||
|
||||
function CalcularTotales(Modificar: boolean; DataTable: TDADataTable): Double;
|
||||
|
||||
protected
|
||||
procedure Renumerar(DataTable: TDADataTable; LocalizaPosicion: Integer);
|
||||
function DesplazarNPosiciones(DataTable: TDADataTable; NumOrdenIni: Variant; NPosiciones: Variant): Integer;
|
||||
procedure Mover(DataTable: TDADataTable; Posicion: Integer; NumPosiciones: Integer);
|
||||
procedure BeginUpdate(ADataTable: IDAStronglyTypedDataTable);
|
||||
procedure EndUpdate(ADataTable: IDAStronglyTypedDataTable);
|
||||
|
||||
//Si en los hijos existen campos a tener en cuenta se sobreescribira este metodo
|
||||
procedure validarCampos(DataTable: TDADataTable); virtual;
|
||||
|
||||
//Si sobreescribimos este método podremos tener en cuenta otras columnas para el calculo del importe total de un concepto
|
||||
function CalcularImporteTotalConcepto(DataTable: TDADataTable): Double; virtual;
|
||||
procedure TratamientoDetalleConcepto(DataTable: TDADataTable); virtual;
|
||||
procedure CalculoDetalleConcepto(DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double); virtual;
|
||||
procedure TratamientoDetalleSalto(DataTable: TDADataTable); virtual;
|
||||
procedure CalculoDetalleSalto(DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double); virtual;
|
||||
procedure TratamientoDetalleTitulo(DataTable: TDADataTable); virtual;
|
||||
procedure CalculoDetalleTitulo(DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double); virtual;
|
||||
procedure TratamientoDetalleSubtotal(DataTable: TDADataTable); virtual;
|
||||
procedure CalculoDetalleSubtotal(DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double); virtual;
|
||||
//Si sobreescribimos este metodo es para continuar el CalcularTotales segun los tipos de concepto de los hijos
|
||||
function CalcularTotalesHijos(Modificar: boolean; DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double): Double; virtual;
|
||||
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function getTipo(ADataTable: IDAStronglyTypedDataTable; pPosicion: Integer): String;
|
||||
procedure Clear(ADataTable: IDAStronglyTypedDataTable);
|
||||
procedure Add(ADataTable: IDAStronglyTypedDataTable; TipoConcepto: Variant); virtual;
|
||||
procedure Delete(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray); virtual;
|
||||
procedure Move(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray; Posiciones: Integer); virtual;
|
||||
|
||||
// procedure Copy(SMExport: TSMExportToClipboard);
|
||||
// procedure Paste;
|
||||
|
||||
procedure ActualizarTotales(ADataTable: IDAStronglyTypedDataTable);
|
||||
function DarTotalImporteTotal(ADataTable: IDAStronglyTypedDataTable): Double;
|
||||
function DarListaTiposDetalle: TStringList; virtual;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TControllerDetallesBase }
|
||||
|
||||
uses cxControls, SysUtils, DB, uDAInterfaces;
|
||||
|
||||
procedure TControllerDetallesBase.ActualizarTotales(ADataTable: IDAStronglyTypedDataTable);
|
||||
begin
|
||||
BeginUpdate(ADataTable);
|
||||
try
|
||||
CalcularTotales(True, ADataTable.DataTable);
|
||||
finally
|
||||
EndUpdate(ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Add(ADataTable: IDAStronglyTypedDataTable; TipoConcepto: Variant);
|
||||
var
|
||||
AuxNumOrden : Integer;
|
||||
|
||||
begin
|
||||
BeginUpdate(ADataTable);
|
||||
try
|
||||
with ADataTable do
|
||||
begin
|
||||
AuxNumOrden := desplazarNPosiciones(DataTable, DataTable.FieldByName(CAMPO_POSICION).AsVariant, 1);
|
||||
|
||||
DataTable.Insert;
|
||||
DataTable.FieldByName(CAMPO_POSICION).AsInteger := AuxNumOrden;
|
||||
DataTable.FieldByName(CAMPO_TIPO).AsVariant := TipoConcepto;
|
||||
DataTable.post;
|
||||
end;
|
||||
finally
|
||||
EndUpdate(ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.BeginUpdate(ADataTable: IDAStronglyTypedDataTable);
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
Inc(fUpdateCount);
|
||||
ADataTable.DataTable.DisableControls;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.CalcularImporteTotalConcepto(DataTable: TDADataTable): Double;
|
||||
begin
|
||||
with DataTable do
|
||||
Result := FieldByName(CAMPO_CANTIDAD).asInteger * FieldByName(CAMPO_IMPORTE_UNIDAD).AsFloat;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.CalcularTotales(Modificar: boolean; DataTable: TDADataTable): Double;
|
||||
{
|
||||
funcion que recalcula todos los detalles de la tabla pasada por parametro y devuelve
|
||||
la cantidad total de los mismos
|
||||
}
|
||||
var
|
||||
AuxPosicionIni : Integer;
|
||||
AuxPosicion : Integer;
|
||||
AuxImporteAcumulado : Double;
|
||||
AuxImporteTotal : Double;
|
||||
|
||||
begin
|
||||
if (DataTable.State in dsEditModes) then
|
||||
DataTable.Post;
|
||||
|
||||
ValidarCampos(DataTable);
|
||||
|
||||
DataTable.DisableControls;
|
||||
AuxPosicionIni := DataTable.FieldByName(CAMPO_POSICION).AsInteger;
|
||||
AuxPosicion := 0;
|
||||
AuxImporteAcumulado := 0;
|
||||
AuxImporteTotal := 0;
|
||||
try
|
||||
|
||||
DataTable.First;
|
||||
while DataTable.Locate(CAMPO_POSICION, IntToStr(AuxPosicion), []) do
|
||||
begin
|
||||
//SALTOS DE LINEA
|
||||
if (DataTable.FieldByName(CAMPO_TIPO).AsString = TIPO_DETALLE_SALTO) then
|
||||
begin
|
||||
if Modificar then
|
||||
TratamientoDetalleSalto(DataTable); //Se podrá sobreescribir para que se tengan en cuenta nuevos campos en hijos
|
||||
CalculoDetalleSalto(DataTable, AuxImporteAcumulado, AuxImporteTotal); //Se podrá sobreescribir para posibles nuevos calculos de los hijos
|
||||
end
|
||||
//TITULOS
|
||||
else if (DataTable.FieldByName(CAMPO_TIPO).AsString = TIPO_DETALLE_TITULO) then
|
||||
begin
|
||||
if Modificar then
|
||||
TratamientoDetalleTitulo(DataTable); //Se podrá sobreescribir para que se tengan en cuenta nuevos campos en hijos
|
||||
CalculoDetalleTitulo(DataTable, AuxImporteAcumulado, AuxImporteTotal); //Se podrá sobreescribir para posibles nuevos calculos de los hijos
|
||||
end
|
||||
//SUBTITULOS
|
||||
else if (DataTable.FieldByName(CAMPO_TIPO).AsString = TIPO_DETALLE_SUBTOTAL) then
|
||||
begin
|
||||
if Modificar then
|
||||
TratamientoDetalleSubtotal(DataTable); //Se podrá sobreescribir para que se tengan en cuenta nuevos campos
|
||||
CalculoDetalleSubtotal(DataTable, AuxImporteAcumulado, AuxImporteTotal); //Se podrá sobreescribir para posibles nuevos calculos de los hijos
|
||||
end
|
||||
//CONCEPTOS
|
||||
else if (DataTable.FieldByName(CAMPO_TIPO).AsString = TIPO_DETALLE_CONCEPTO) then
|
||||
begin
|
||||
if Modificar then
|
||||
TratamientoDetalleConcepto(DataTable); //Se podrá sobreescribir para que se tengan en cuenta nuevos campos
|
||||
CalculoDetalleConcepto(DataTable, AuxImporteAcumulado, AuxImporteTotal); //Se podrá sobreescribir para posibles nuevos calculos de los hijos
|
||||
end
|
||||
//HIJOS
|
||||
else CalcularTotalesHijos(Modificar, DataTable, AuxImporteAcumulado, AuxImporteTotal);
|
||||
|
||||
Inc(AuxPosicion);
|
||||
DataTable.First;
|
||||
end;
|
||||
|
||||
finally
|
||||
//Dejamos el puntero en la misma posición que la que partió
|
||||
DataTable.Locate(CAMPO_POSICION, IntToStr(AuxPosicionIni), []);
|
||||
DataTable.EnableControls;
|
||||
end;
|
||||
|
||||
Result := AuxImporteTotal;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.CalcularTotalesHijos(Modificar: boolean; DataTable: TDADataTable; var ImporteAcumulado : Double; var ImporteTotal : Double): Double;
|
||||
begin
|
||||
//
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.CalculoDetalleConcepto(DataTable: TDADataTable; var ImporteAcumulado, ImporteTotal: Double);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
ImporteAcumulado := ImporteAcumulado + FieldByName(CAMPO_IMPORTE_TOTAL).AsFloat;
|
||||
ImporteTotal := ImporteTotal + FieldByName(CAMPO_IMPORTE_TOTAL).AsFloat;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.CalculoDetalleSalto(DataTable: TDADataTable; var ImporteAcumulado, ImporteTotal: Double);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
FieldByName(CAMPO_CANTIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_UNIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_TOTAL).AsVariant := Null;
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.CalculoDetalleSubtotal(DataTable: TDADataTable; var ImporteAcumulado, ImporteTotal: Double);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
FieldByName(CAMPO_IMPORTE_TOTAL).AsFloat := ImporteAcumulado;
|
||||
Post;
|
||||
end;
|
||||
ImporteAcumulado := 0;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.CalculoDetalleTitulo(DataTable: TDADataTable; var ImporteAcumulado, ImporteTotal: Double);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Clear(ADataTable: IDAStronglyTypedDataTable);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
constructor TControllerDetallesBase.Create;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.DarListaTiposDetalle: TStringList;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
Result.Values[TIPO_DETALLE_CONCEPTO] := 'Concepto';
|
||||
Result.Values[TIPO_DETALLE_TITULO] := 'Título de capítulo';
|
||||
Result.Values[TIPO_DETALLE_SUBTOTAL] := 'Final de capítulo';
|
||||
Result.Values[TIPO_DETALLE_SALTO] := 'Salto de página';
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.darTotalImporteTotal(ADataTable: IDAStronglyTypedDataTable): Double;
|
||||
begin
|
||||
Result := CalcularTotales(False, ADataTable.DataTable);
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Delete(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray);
|
||||
var
|
||||
i: integer;
|
||||
AField: TDAField;
|
||||
DeletePosicion: Integer;
|
||||
begin
|
||||
AField := ADataTable.DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (Delete)');
|
||||
|
||||
BeginUpdate(ADataTable);
|
||||
try
|
||||
with ADataTable do
|
||||
begin
|
||||
DeletePosicion := 0;
|
||||
for i := 0 to High(POSICION) do
|
||||
begin
|
||||
DataTable.First;
|
||||
DeletePosicion := POSICION[i];
|
||||
if DataTable.Locate(CAMPO_POSICION, IntToStr(DeletePosicion), []) then
|
||||
DataTable.Delete;
|
||||
end;
|
||||
Renumerar(DataTable, DeletePosicion);
|
||||
end;
|
||||
finally
|
||||
EndUpdate(ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.DesplazarNPosiciones(DataTable: TDADataTable; NumOrdenIni: Variant; NPosiciones: Variant): Integer;
|
||||
{
|
||||
Función que desplaza NPosiciones el numero de orden a partir del elemento con el
|
||||
número de orden dado. Devuelve el numero de orden del primer elemento del hueco
|
||||
generado
|
||||
}
|
||||
var
|
||||
AuxNumOrden: Integer;
|
||||
AuxNumPos: Integer;
|
||||
AField: TDAField;
|
||||
begin
|
||||
|
||||
AField := DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (desplazarNPosiciones)');
|
||||
|
||||
if VarIsNull(NPosiciones)
|
||||
then AuxNumPos := 1
|
||||
else AuxNumPos := NPosiciones;
|
||||
|
||||
if VarIsNull(NumOrdenIni)
|
||||
then AuxNumOrden := 0
|
||||
else AuxNumOrden := NumOrdenIni + 1; //Añadimos por abajo siempre
|
||||
|
||||
Result := AuxNumOrden;
|
||||
|
||||
with DataTable do
|
||||
begin
|
||||
First;
|
||||
while not EOF do
|
||||
begin
|
||||
if (FieldByName(CAMPO_POSICION).AsInteger >= AuxNumOrden) then
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
FieldByName(CAMPO_POSICION).AsInteger := FieldByName(CAMPO_POSICION).AsInteger + AuxNumPos;
|
||||
Post;
|
||||
end;
|
||||
Next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TControllerDetallesBase.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.EndUpdate(ADataTable: IDAStronglyTypedDataTable);
|
||||
begin
|
||||
Dec(fUpdateCount);
|
||||
CalcularTotales(True, ADataTable.DataTable);
|
||||
ADataTable.DataTable.EnableControls;
|
||||
|
||||
if fUpdateCount = 0 then
|
||||
AvisarObservadores(ADataTable);
|
||||
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
function TControllerDetallesBase.getTipo(ADataTable: IDAStronglyTypedDataTable; pPosicion: Integer): String;
|
||||
var
|
||||
posIni: integer;
|
||||
AField: TDAField;
|
||||
begin
|
||||
AField := ADataTable.DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (getTipo)');
|
||||
|
||||
Result := '';
|
||||
BeginUpdate(ADataTable);
|
||||
try
|
||||
with ADataTable do
|
||||
begin
|
||||
//Guardamos la posicion en la que estamos
|
||||
posIni := DataTable.FieldByName(CAMPO_POSICION).AsInteger;
|
||||
|
||||
DataTable.First;
|
||||
if DataTable.Locate(CAMPO_POSICION, IntToStr(pPosicion), []) then
|
||||
Result := DataTable.FieldByName(CAMPO_TIPO).AsString;
|
||||
|
||||
//Volvemos a posicionar el puntero donde estaba
|
||||
DataTable.First;
|
||||
if not DataTable.Locate(CAMPO_POSICION, IntToStr(posIni), []) then
|
||||
raise Exception.Create('La posición ' + IntToStr(posIni) + ' no existe (getTipo)');
|
||||
end;
|
||||
finally
|
||||
EndUpdate(ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Move(ADataTable: IDAStronglyTypedDataTable; Posicion: TIntegerArray; Posiciones: Integer);
|
||||
var
|
||||
i:Integer;
|
||||
begin
|
||||
BeginUpdate(ADataTable);
|
||||
try
|
||||
with ADataTable do
|
||||
begin
|
||||
//Empezamos desde abajo
|
||||
if Posiciones > 0 then
|
||||
for i:= High(POSICION) downto 0 do
|
||||
Mover(DataTable, POSICION[i], Posiciones)
|
||||
else
|
||||
//Empezamos desde arriba
|
||||
for i:= 0 to High(POSICION) do
|
||||
Mover(DataTable, POSICION[i], Posiciones);
|
||||
end;
|
||||
finally
|
||||
EndUpdate(ADataTable);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Mover(DataTable: TDADataTable; Posicion: Integer; NumPosiciones: Integer);
|
||||
{
|
||||
procedimiento que desplaza el número de posiciones (NumPosiciones) pasados por parametro
|
||||
a la posicion (Posicion) dada, en caso de ser negativo será hacia arriba y positivo hacia
|
||||
abajo
|
||||
}
|
||||
var
|
||||
AuxOrden : Integer;
|
||||
AuxID : Integer;
|
||||
AField: TDAField;
|
||||
begin
|
||||
AField := DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (mover)');
|
||||
|
||||
AField := DataTable.FindField(CAMPO_ID);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_ID + ' no encontrado (mover)');
|
||||
|
||||
//Buscamos el elemento con la posicion pasada por parametro
|
||||
DataTable.First;
|
||||
if not DataTable.Locate(CAMPO_POSICION, IntToStr(Posicion), []) then
|
||||
raise Exception.Create('Error, no se ha encontrado la POSICION [' + IntToStr(Posicion) + '] (mover)');
|
||||
|
||||
//Guardamos el id del elemento a cambiar de posicion y calculamos su nueva posicion
|
||||
AuxID := DataTable.FieldByName(CAMPO_ID).AsInteger;
|
||||
AuxOrden := Posicion + NumPosiciones;
|
||||
|
||||
DataTable.First;
|
||||
if DataTable.Locate(CAMPO_POSICION, IntToStr(AuxOrden), []) then
|
||||
begin
|
||||
if not DataTable.Editing then DataTable.Edit;
|
||||
DataTable.FieldByName(CAMPO_POSICION).AsInteger := DataTable.FieldByName(CAMPO_POSICION).AsInteger - NumPosiciones;
|
||||
|
||||
//Se hace dentro por si es el ultimo o el primero
|
||||
DataTable.First;
|
||||
if not DataTable.Locate(CAMPO_ID, IntToStr(AuxID), []) then
|
||||
raise Exception.Create('Error, no se ha encontrado el ID [' + IntToStr(AuxID) + '] (mover)');
|
||||
|
||||
if not DataTable.Editing then DataTable.Edit;
|
||||
DataTable.FieldByName(CAMPO_POSICION).AsInteger := AuxOrden;
|
||||
|
||||
DataTable.Post;
|
||||
end;
|
||||
|
||||
//Colocamos el puntero en la posición en la que estaba
|
||||
DataTable.First;
|
||||
DataTable.Locate(CAMPO_ID, IntToStr(AuxID), []);
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.Renumerar(DataTable: TDADataTable; LocalizaPosicion: Integer);
|
||||
{
|
||||
procedimiento que renumera todos los conceptos de la tabla dada por parametro
|
||||
}
|
||||
var
|
||||
i, j : Integer;
|
||||
AField: TDAField;
|
||||
begin
|
||||
AField := DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (renumerar)');
|
||||
|
||||
with DataTable do
|
||||
begin
|
||||
for i:=0 to RecordCount-1 do
|
||||
begin
|
||||
First;
|
||||
if not Locate(CAMPO_POSICION, IntToStr(i), []) then
|
||||
begin
|
||||
j := i;
|
||||
First;
|
||||
while not Locate(CAMPO_POSICION, IntToStr(j), []) do
|
||||
begin
|
||||
Inc(j);
|
||||
First;
|
||||
end;
|
||||
|
||||
if not Editing then Edit;
|
||||
FieldByName(CAMPO_POSICION).AsInteger := i;
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
//Posicionamos el puntero en la posición dada por parametro
|
||||
if Locate(CAMPO_POSICION, IntToStr(LocalizaPosicion), []) then
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.TratamientoDetalleConcepto(DataTable: TDADataTable);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
//Si alguno de los campos de calculo de total es nulo el total tambien será nulo
|
||||
if (VarIsNull(FieldByName(CAMPO_CANTIDAD).AsVariant)
|
||||
or VarIsNull(FieldByName(CAMPO_IMPORTE_UNIDAD).AsVariant))
|
||||
then FieldByName(CAMPO_IMPORTE_TOTAL).AsVariant := Null
|
||||
else FieldByName(CAMPO_IMPORTE_TOTAL).AsFloat := CalcularImporteTotalConcepto(DataTable);
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.TratamientoDetalleSalto(DataTable: TDADataTable);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
FieldByName(CAMPO_CONCEPTO).AsString := CTE_DESC_SALTO;
|
||||
FieldByName(CAMPO_CANTIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_UNIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_TOTAL).AsVariant := Null;
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.TratamientoDetalleSubtotal(DataTable: TDADataTable);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
if (FieldByName(CAMPO_CONCEPTO).AsString = CTE_DESC_SALTO) then
|
||||
FieldByName(CAMPO_CONCEPTO).AsVariant := Null;
|
||||
FieldByName(CAMPO_CANTIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_UNIDAD).AsVariant := Null;
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.TratamientoDetalleTitulo(DataTable: TDADataTable);
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if not Editing then Edit;
|
||||
if (FieldByName(CAMPO_CONCEPTO).AsString = CTE_DESC_SALTO) then
|
||||
FieldByName(CAMPO_CONCEPTO).AsVariant := Null;
|
||||
FieldByName(CAMPO_CANTIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_UNIDAD).AsVariant := Null;
|
||||
FieldByName(CAMPO_IMPORTE_TOTAL).AsVariant := Null;
|
||||
Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesBase.validarCampos(DataTable: TDADataTable);
|
||||
var
|
||||
AField: TDAField;
|
||||
begin
|
||||
//Validamos la existencia de todos los campos necesarios
|
||||
AField := DataTable.FindField(CAMPO_POSICION);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (validarCampos)');
|
||||
AField := DataTable.FindField(CAMPO_TIPO);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_TIPO + ' no encontrado (validarCampos)');
|
||||
AField := DataTable.FindField(CAMPO_CANTIDAD);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_CANTIDAD + ' no encontrado (validarCampos)');
|
||||
AField := DataTable.FindField(CAMPO_IMPORTE_UNIDAD);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_IMPORTE_UNIDAD + ' no encontrado (validarCampos)');
|
||||
AField := DataTable.FindField(CAMPO_IMPORTE_TOTAL);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_IMPORTE_TOTAL + ' no encontrado (validarCampos)');
|
||||
end;
|
||||
|
||||
end.
|
||||
70
Source/Base/Controladores/uControllerDetallesDTO.pas
Normal file
70
Source/Base/Controladores/uControllerDetallesDTO.pas
Normal file
@ -0,0 +1,70 @@
|
||||
unit uControllerDetallesDTO;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes, Variants, uDACDSDataTable, uDADataTable, uControllerDetallesBase;
|
||||
|
||||
const
|
||||
CAMPO_DESCUENTO = 'DESCUENTO';
|
||||
//Además del descuento tambien se añade el Precio de porte por artículo
|
||||
CAMPO_IMPORTE_PORTE = 'IMPORTE_PORTE';
|
||||
|
||||
type
|
||||
IControllerDetallesDTO = interface(IControllerDetallesBase)
|
||||
['{F6C5D9E4-4D3D-404F-9B6A-58D4A24B01C6}']
|
||||
end;
|
||||
|
||||
TControllerDetallesDTO = class (TControllerDetallesBase, IControllerDetallesDTO)
|
||||
protected
|
||||
//Si en los hijos existen campos a tener en cuenta se sobreescribira este metodo
|
||||
procedure ValidarCampos(DataTable: TDADataTable); override;
|
||||
|
||||
//Si sobreescribimos este método podremos tener en cuenta otras columnas para el calculo del importe total de un concepto
|
||||
function CalcularImporteTotalConcepto(DataTable: TDADataTable): Double; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TControllerDetallesBase }
|
||||
|
||||
uses SysUtils, uDAInterfaces;
|
||||
|
||||
function TControllerDetallesDTO.CalcularImporteTotalConcepto(DataTable: TDADataTable): Double;
|
||||
var
|
||||
ImporteTotal : Double;
|
||||
begin
|
||||
with DataTable do
|
||||
begin
|
||||
if (VarIsNull(FieldByName(CAMPO_DESCUENTO).AsVariant)) then
|
||||
ImporteTotal := FieldByName(CAMPO_CANTIDAD).asInteger * FieldByName(CAMPO_IMPORTE_UNIDAD).AsFloat
|
||||
else
|
||||
ImporteTotal := FieldByName(CAMPO_CANTIDAD).asInteger * (FieldByName(CAMPO_IMPORTE_UNIDAD).AsFloat - (FieldByName(CAMPO_IMPORTE_UNIDAD).AsFloat * (FieldByName(CAMPO_DESCUENTO).AsFloat/100)));
|
||||
|
||||
if (VarIsNull(FieldByName(CAMPO_IMPORTE_PORTE).AsVariant)) then
|
||||
ImporteTotal := ImporteTotal
|
||||
else
|
||||
ImporteTotal := ImporteTotal + (FieldByName(CAMPO_CANTIDAD).asInteger * FieldByName(CAMPO_IMPORTE_PORTE).AsFloat);
|
||||
end;
|
||||
|
||||
Result := ImporteTotal;
|
||||
end;
|
||||
|
||||
procedure TControllerDetallesDTO.validarCampos(DataTable: TDADataTable);
|
||||
var
|
||||
AField: TDAField;
|
||||
begin
|
||||
inherited;
|
||||
//Validamos la existencia de todos los campos necesarios
|
||||
|
||||
AField := DataTable.FindField(CAMPO_DESCUENTO);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_DESCUENTO + ' no encontrado (validarCampos)');
|
||||
|
||||
|
||||
AField := DataTable.FindField(CAMPO_IMPORTE_PORTE);
|
||||
if not Assigned(AField) then
|
||||
raise Exception.Create('Campo ' + CAMPO_IMPORTE_PORTE + ' no encontrado (validarCampos)');
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -0,0 +1,28 @@
|
||||
unit uIEditorDatosBancarioEmpresa;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uBizEmpresasDatosBancarios, uDatosBancariosEmpresaController;
|
||||
|
||||
type
|
||||
IEditorDatosBancariosEmpresa = interface
|
||||
['{486525AD-953D-453D-AF70-2FBBF39B5188}']
|
||||
|
||||
function GetController : IDatosBancariosEmpresaController;
|
||||
procedure SetController (const Value : IDatosBancariosEmpresaController);
|
||||
property Controller : IDatosBancariosEmpresaController read GetController
|
||||
write SetController;
|
||||
|
||||
function GetDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
procedure SetDatosBancarios(const Value: IBizEmpresasDatosBancarios);
|
||||
property DatosBancarios: IBizEmpresasDatosBancarios read GetDatosBancarios write SetDatosBancarios;
|
||||
|
||||
function ShowModal : Integer;
|
||||
procedure Release;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
23
Source/Base/Empresas/Controller/View/uIEditorEmpresa.pas
Normal file
23
Source/Base/Empresas/Controller/View/uIEditorEmpresa.pas
Normal file
@ -0,0 +1,23 @@
|
||||
unit uIEditorEmpresa;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uEditorDBItem, uBizEmpresas, uEmpresasController;
|
||||
|
||||
type
|
||||
IEditorEmpresa = interface(IEditorDBItem)
|
||||
['{88FA3FF3-ACDC-4BCC-ADCE-6BA890E55220}']
|
||||
function GetController : IEmpresasController;
|
||||
procedure SetController (const Value : IEmpresasController);
|
||||
property Controller : IEmpresasController read GetController
|
||||
write SetController;
|
||||
|
||||
function GetEmpresa: IBizEmpresa;
|
||||
procedure SetEmpresa(const Value: IBizEmpresa);
|
||||
property Empresa: IBizEmpresa read GetEmpresa write SetEmpresa;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
24
Source/Base/Empresas/Controller/View/uIEditorEmpresas.pas
Normal file
24
Source/Base/Empresas/Controller/View/uIEditorEmpresas.pas
Normal file
@ -0,0 +1,24 @@
|
||||
unit uIEditorEmpresas;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uEditorGridBase, uBizEmpresas, uEmpresasController;
|
||||
|
||||
type
|
||||
IEditorEmpresas = interface(IEditorGridBase)
|
||||
['{F4E5DE2F-C08A-47DA-827B-78BD31861BD0}']
|
||||
function GetEmpresas: IBizEmpresa;
|
||||
procedure SetEmpresas(const Value: IBizEmpresa);
|
||||
property Empresas: IBizEmpresa read GetEmpresas write SetEmpresas;
|
||||
|
||||
function GetController : IEmpresasController;
|
||||
procedure SetController (const Value : IEmpresasController);
|
||||
property Controller : IEmpresasController read GetController
|
||||
write SetController;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@ -0,0 +1,71 @@
|
||||
unit uDatosBancariosEmpresaController;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Forms, Classes, Controls, Contnrs, SysUtils, uDADataTable,
|
||||
uBizEmpresas, uBizEmpresasDatosBancarios, uIDataModuleEmpresas;
|
||||
|
||||
type
|
||||
IDatosBancariosEmpresaController = interface
|
||||
['{E9B0313E-7B16-420A-B47E-20E42E96BAC6}']
|
||||
procedure Ver(ADatosBancarios : IBizEmpresasDatosBancarios);
|
||||
end;
|
||||
|
||||
TDatosBancariosEmpresaController = class(TInterfacedObject, IDatosBancariosEmpresaController)
|
||||
private
|
||||
FDataModule : IDataModuleEmpresas;
|
||||
public
|
||||
procedure Ver(ADatosBancarios : IBizEmpresasDatosBancarios);
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDatosBancariosEmpresaController }
|
||||
|
||||
uses
|
||||
uDataModuleEmpresas, schEmpresasClient_Intf, uIEditorDatosBancarioEmpresa,
|
||||
uEditorRegistryUtils, cxControls;
|
||||
|
||||
constructor TDatosBancariosEmpresaController.Create;
|
||||
begin
|
||||
inherited;
|
||||
FDataModule := TDataModuleEmpresas.Create(Nil);
|
||||
end;
|
||||
|
||||
destructor TDatosBancariosEmpresaController.Destroy;
|
||||
begin
|
||||
FDataModule := Nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDatosBancariosEmpresaController.Ver(
|
||||
ADatosBancarios : IBizEmpresasDatosBancarios);
|
||||
var
|
||||
AEditor : IEditorDatosBancariosEmpresa;
|
||||
begin
|
||||
AEditor := NIL;
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
CreateEditor('EditorDatosBancariosEmpresa', IEditorDatosBancariosEmpresa, AEditor);
|
||||
with AEditor do
|
||||
begin
|
||||
DatosBancarios := ADatosBancarios;
|
||||
Controller := Self;
|
||||
end;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
if Assigned(AEditor) then
|
||||
try
|
||||
AEditor.ShowModal;
|
||||
AEditor.Release;
|
||||
finally
|
||||
AEditor := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
242
Source/Base/Empresas/Controller/uEmpresasController.pas
Normal file
242
Source/Base/Empresas/Controller/uEmpresasController.pas
Normal file
@ -0,0 +1,242 @@
|
||||
unit uEmpresasController;
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
Windows, Forms, Classes, Controls, Contnrs, SysUtils,
|
||||
uBizEmpresas, uIDataModuleEmpresas, uDADataTable;
|
||||
|
||||
type
|
||||
IEmpresasController = interface
|
||||
['{2F0AB21C-4F19-446E-87C4-B9C1038850FC}']
|
||||
function Buscar(const ID: Integer): IBizEmpresa;
|
||||
function BuscarTodos: IBizEmpresa;
|
||||
procedure Ver(AEmpresa : IBizEmpresa);
|
||||
procedure VerTodos(AEmpresas: IBizEmpresa);
|
||||
function Nuevo : IBizEmpresa;
|
||||
procedure Anadir(AEmpresa : IBizEmpresa);
|
||||
function Eliminar(const ID : Integer): Boolean; overload;
|
||||
function Eliminar(AEmpresa : IBizEmpresa): Boolean; overload;
|
||||
function Guardar(AEmpresa : IBizEmpresa): Boolean;
|
||||
procedure DescartarCambios(AEmpresa : IBizEmpresa);
|
||||
function Existe(const ID: Integer) : Boolean;
|
||||
function ToStringList(AEmpresa : IBizEmpresa) : TStringList;
|
||||
end;
|
||||
|
||||
TEmpresasController = class(TInterfacedObject, IEmpresasController)
|
||||
protected
|
||||
FDataModule : IDataModuleEmpresas;
|
||||
function ValidarEmpresa(AEmpresa : IBizEmpresa): Boolean; virtual;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
function Eliminar(const ID : Integer): Boolean; overload;
|
||||
function Eliminar(AEmpresa : IBizEmpresa): Boolean; overload;
|
||||
function Guardar(AEmpresa : IBizEmpresa): Boolean;
|
||||
procedure DescartarCambios(AEmpresa : IBizEmpresa); virtual;
|
||||
function Existe(const ID: Integer) : Boolean; virtual;
|
||||
procedure Anadir(AEmpresa : IBizEmpresa); virtual;
|
||||
|
||||
function Buscar(const ID: Integer): IBizEmpresa; virtual;
|
||||
function BuscarTodos: IBizEmpresa; virtual;
|
||||
function Nuevo : IBizEmpresa; virtual;
|
||||
procedure Ver(AEmpresa : IBizEmpresa); virtual;
|
||||
procedure VerTodos(AEmpresas: IBizEmpresa); virtual;
|
||||
function ToStringList(AEmpresa : IBizEmpresa) : TStringList; virtual;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uEditorRegistryUtils, cxControls, DB,
|
||||
uDataModuleEmpresas, uIEditorEmpresa;
|
||||
|
||||
{ TEmpresasController }
|
||||
|
||||
procedure TEmpresasController.Anadir(AEmpresa: IBizEmpresa);
|
||||
begin
|
||||
AEmpresa.Insert;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Buscar(const ID: Integer): IBizEmpresa;
|
||||
begin
|
||||
Result := FDataModule.GetItem(ID)
|
||||
end;
|
||||
|
||||
function TEmpresasController.BuscarTodos: IBizEmpresa;
|
||||
begin
|
||||
Result := FDataModule.GetItems;
|
||||
end;
|
||||
|
||||
constructor TEmpresasController.Create;
|
||||
begin
|
||||
FDataModule := TDataModuleEmpresas.Create(Nil);
|
||||
end;
|
||||
|
||||
procedure TEmpresasController.DescartarCambios(AEmpresa: IBizEmpresa);
|
||||
begin
|
||||
if not Assigned(AEmpresa) then
|
||||
raise Exception.Create ('Empresa no asignada');
|
||||
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
if (AEmpresa.State in dsEditModes) then
|
||||
AEmpresa.Cancel;
|
||||
|
||||
AEmpresa.DataTable.CancelUpdates;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TEmpresasController.Destroy;
|
||||
begin
|
||||
FDataModule := NIL;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Eliminar(AEmpresa: IBizEmpresa): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not Assigned(AEmpresa) then
|
||||
raise Exception.Create ('Empresa no asignada');
|
||||
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
if (AEmpresa.State in dsEditModes) then
|
||||
AEmpresa.Cancel;
|
||||
|
||||
AEmpresa.Delete;
|
||||
AEmpresa.DataTable.ApplyUpdates;
|
||||
|
||||
Result := True;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Eliminar(const ID: Integer): Boolean;
|
||||
var
|
||||
AEmpresa : IBizEmpresa;
|
||||
begin
|
||||
AEmpresa := Buscar(ID);
|
||||
|
||||
if not Assigned(AEmpresa) then
|
||||
raise Exception.Create(Format('No se ha encontrado la empresa con ID = %d', [ID]));
|
||||
|
||||
Result := Eliminar(AEmpresa);
|
||||
AEmpresa := NIL;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Existe(const ID: Integer): Boolean;
|
||||
var
|
||||
AEmpresa : IBizEmpresa;
|
||||
begin
|
||||
try
|
||||
AEmpresa := Buscar(ID);
|
||||
Result := Assigned(AEmpresa) and (AEmpresa.ID = ID);
|
||||
finally
|
||||
AEmpresa := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Guardar(AEmpresa: IBizEmpresa): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if ValidarEmpresa(AEmpresa) then
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
AEmpresa.DataTable.ApplyUpdates;
|
||||
Result := True;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEmpresasController.Nuevo: IBizEmpresa;
|
||||
begin
|
||||
Result := FDataModule.NewItem;
|
||||
end;
|
||||
|
||||
function TEmpresasController.ToStringList(AEmpresa: IBizEmpresa): TStringList;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
with Result do
|
||||
begin
|
||||
AEmpresa.DataTable.Active := True;
|
||||
AEmpresa.First;
|
||||
while not AEmpresa.EOF do
|
||||
begin
|
||||
Add(AEmpresa.NOMBRE);
|
||||
AEmpresa.Next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEmpresasController.ValidarEmpresa(AEmpresa: IBizEmpresa): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not Assigned(AEmpresa) then
|
||||
raise Exception.Create ('Empresa no asignada');
|
||||
|
||||
if (AEmpresa.DataTable.State in dsEditModes) then
|
||||
AEmpresa.DataTable.Post;
|
||||
|
||||
if Length(AEmpresa.NOMBRE) = 0 then
|
||||
raise Exception.Create('Debe indicar al menos el nombre de la empresa.');
|
||||
|
||||
// Asegurarse de valores en campos "automáticos"
|
||||
{ AEmpresa.Edit;
|
||||
AEmpresa.USUARIO := dmUsuarios.LoginInfo.Usuario;
|
||||
AEmpresa.Post;}
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TEmpresasController.Ver(AEmpresa: IBizEmpresa);
|
||||
var
|
||||
AEditor : IEditorEmpresa;
|
||||
begin
|
||||
AEditor := NIL;
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
CreateEditor('EditorEmpresa', IEditorEmpresa, AEditor);
|
||||
with AEditor do
|
||||
begin
|
||||
Empresa := AEmpresa;
|
||||
Controller := Self;
|
||||
end;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
if Assigned(AEditor) then
|
||||
try
|
||||
AEditor.ShowModal;
|
||||
AEditor.Release;
|
||||
finally
|
||||
AEditor := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEmpresasController.VerTodos(AEmpresas: IBizEmpresa);
|
||||
{var
|
||||
AEditor : IEditorClientes;}
|
||||
begin
|
||||
{ CreateEditor('EditorEmpresas', IEditorClientes, AEditor);
|
||||
with AEditor do
|
||||
begin
|
||||
Contactos := AContactos;
|
||||
Controller := Self;
|
||||
ShowEmbedded;
|
||||
end;}
|
||||
end;
|
||||
|
||||
end.
|
||||
292
Source/Base/Empresas/Data/uDataModuleEmpresas.dfm
Normal file
292
Source/Base/Empresas/Data/uDataModuleEmpresas.dfm
Normal file
@ -0,0 +1,292 @@
|
||||
object DataModuleEmpresas: TDataModuleEmpresas
|
||||
OldCreateOrder = True
|
||||
OnCreate = DAClientDataModuleCreate
|
||||
Height = 267
|
||||
Width = 402
|
||||
object RORemoteService: TRORemoteService
|
||||
Message = dmConexion.ROMessage
|
||||
Channel = dmConexion.ROChannel
|
||||
ServiceName = 'srvEmpresas'
|
||||
Left = 48
|
||||
Top = 24
|
||||
end
|
||||
object rda_Empresas: TDARemoteDataAdapter
|
||||
GetSchemaCall.RemoteService = RORemoteService
|
||||
GetDataCall.RemoteService = RORemoteService
|
||||
UpdateDataCall.RemoteService = RORemoteService
|
||||
GetScriptsCall.RemoteService = RORemoteService
|
||||
RemoteService = RORemoteService
|
||||
DataStreamer = Bin2DataStreamer
|
||||
Left = 176
|
||||
Top = 24
|
||||
end
|
||||
object Bin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 48
|
||||
Top = 96
|
||||
end
|
||||
object tbl_Empresas: TDAMemDataTable
|
||||
RemoteUpdatesOptions = []
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_ID'
|
||||
LogChanges = False
|
||||
Required = True
|
||||
ReadOnly = True
|
||||
ServerAutoRefresh = True
|
||||
DictionaryEntry = 'Empresas_ID'
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'NIF_CIF'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'CIF'
|
||||
DictionaryEntry = 'Empresas_NIF_CIF'
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Nombre'
|
||||
DictionaryEntry = 'Empresas_NOMBRE'
|
||||
end
|
||||
item
|
||||
Name = 'RAZON_SOCIAL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Raz'#243'n Social'
|
||||
DictionaryEntry = 'Empresas_RAZON_SOCIAL'
|
||||
end
|
||||
item
|
||||
Name = 'CALLE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Calle'
|
||||
DictionaryEntry = 'Empresas_CALLE'
|
||||
end
|
||||
item
|
||||
Name = 'POBLACION'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Poblaci'#243'n'
|
||||
DictionaryEntry = 'Empresas_POBLACION'
|
||||
end
|
||||
item
|
||||
Name = 'PROVINCIA'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Provincia'
|
||||
DictionaryEntry = 'Empresas_PROVINCIA'
|
||||
end
|
||||
item
|
||||
Name = 'CODIGO_POSTAL'
|
||||
DataType = datString
|
||||
Size = 10
|
||||
DisplayLabel = 'C'#243'd. postal'
|
||||
DictionaryEntry = 'Empresas_CODIGO_POSTAL'
|
||||
end
|
||||
item
|
||||
Name = 'TELEFONO_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Tel'#233'fono 1'
|
||||
DictionaryEntry = 'Empresas_TELEFONO_1'
|
||||
end
|
||||
item
|
||||
Name = 'TELEFONO_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Tel'#233'fono 2'
|
||||
DictionaryEntry = 'Empresas_TELEFONO_2'
|
||||
end
|
||||
item
|
||||
Name = 'MOVIL_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'M'#243'vil 1'
|
||||
DictionaryEntry = 'Empresas_MOVIL_1'
|
||||
end
|
||||
item
|
||||
Name = 'MOVIL_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'M'#243'vil 2'
|
||||
DictionaryEntry = 'Empresas_MOVIL_2'
|
||||
end
|
||||
item
|
||||
Name = 'FAX'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Fax'
|
||||
DictionaryEntry = 'Empresas_FAX'
|
||||
end
|
||||
item
|
||||
Name = 'EMAIL_1'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'E-mail 1'
|
||||
DictionaryEntry = 'Empresas_EMAIL_1'
|
||||
end
|
||||
item
|
||||
Name = 'EMAIL_2'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'E-mail 2'
|
||||
DictionaryEntry = 'Empresas_EMAIL_2'
|
||||
end
|
||||
item
|
||||
Name = 'PAGINA_WEB'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'P'#225'gina web'
|
||||
DictionaryEntry = 'Empresas_PAGINA_WEB'
|
||||
end
|
||||
item
|
||||
Name = 'NOTAS'
|
||||
DataType = datMemo
|
||||
DisplayLabel = 'Notas'
|
||||
DictionaryEntry = 'Empresas_NOTAS'
|
||||
end
|
||||
item
|
||||
Name = 'FECHA_ALTA'
|
||||
DataType = datDateTime
|
||||
DisplayLabel = 'Empresas_FECHA_ALTA'
|
||||
DictionaryEntry = 'Empresas_FECHA_ALTA'
|
||||
end
|
||||
item
|
||||
Name = 'FECHA_MODIFICACION'
|
||||
DataType = datDateTime
|
||||
DisplayLabel = 'Empresas_FECHA_MODIFICACION'
|
||||
DictionaryEntry = 'Empresas_FECHA_MODIFICACION'
|
||||
end
|
||||
item
|
||||
Name = 'USUARIO'
|
||||
DataType = datString
|
||||
Size = 20
|
||||
DisplayLabel = 'Empresas_USUARIO'
|
||||
DictionaryEntry = 'Empresas_USUARIO'
|
||||
end
|
||||
item
|
||||
Name = 'LOGOTIPO'
|
||||
DataType = datBlob
|
||||
BlobType = dabtBlob
|
||||
DisplayLabel = 'Logotipo'
|
||||
DictionaryEntry = 'Empresas_LOGOTIPO'
|
||||
end
|
||||
item
|
||||
Name = 'REGISTRO_MERCANTIL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Registro mercantil'
|
||||
DictionaryEntry = 'Empresas_REGISTRO_MERCANTIL'
|
||||
end
|
||||
item
|
||||
Name = 'IVA'
|
||||
DataType = datFloat
|
||||
DictionaryEntry = 'Empresas_IVA'
|
||||
end>
|
||||
Params = <>
|
||||
StreamingOptions = [soDisableEventsWhileStreaming]
|
||||
RemoteDataAdapter = rda_Empresas
|
||||
DetailOptions = [dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch]
|
||||
MasterOptions = [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]
|
||||
LogicalName = 'Empresas'
|
||||
Left = 176
|
||||
Top = 96
|
||||
end
|
||||
object ds_Empresas: TDADataSource
|
||||
DataSet = tbl_Empresas.Dataset
|
||||
DataTable = tbl_Empresas
|
||||
Left = 176
|
||||
Top = 168
|
||||
end
|
||||
object tbl_EmpresasDatosBanco: TDAMemDataTable
|
||||
RemoteUpdatesOptions = []
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_DATOS_BANCO_ID'
|
||||
LogChanges = False
|
||||
Required = True
|
||||
ReadOnly = True
|
||||
ServerAutoRefresh = True
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ID'
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'ID_EMPRESA'
|
||||
DataType = datInteger
|
||||
DisplayLabel = 'EmpresasDatosBanco_ID_EMPRESA'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ID_EMPRESA'
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Nombre del banco'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_NOMBRE'
|
||||
end
|
||||
item
|
||||
Name = 'ENTIDAD'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Entidad'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ENTIDAD'
|
||||
end
|
||||
item
|
||||
Name = 'SUCURSAL'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Sucursal'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUCURSAL'
|
||||
end
|
||||
item
|
||||
Name = 'DC'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'EmpresasDatosBanco_DC'
|
||||
end
|
||||
item
|
||||
Name = 'CUENTA'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Cuenta'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_CUENTA'
|
||||
end
|
||||
item
|
||||
Name = 'SUFIJO_N19'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DisplayLabel = 'Sufijo 19'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUFIJO_N19'
|
||||
end
|
||||
item
|
||||
Name = 'SUFIJO_N58'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DisplayLabel = 'Sufijo 58'
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUFIJO_N58'
|
||||
end>
|
||||
Params = <>
|
||||
MasterMappingMode = mmWhere
|
||||
StreamingOptions = [soDisableEventsWhileStreaming]
|
||||
RemoteDataAdapter = rda_Empresas
|
||||
MasterSource = ds_Empresas
|
||||
MasterFields = 'ID'
|
||||
DetailFields = 'ID_EMPRESA'
|
||||
DetailOptions = [dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch]
|
||||
MasterOptions = [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]
|
||||
LogicalName = 'EmpresasDatosBanco'
|
||||
Left = 288
|
||||
Top = 96
|
||||
end
|
||||
object ds_EmpresasDatosBanco: TDADataSource
|
||||
DataSet = tbl_EmpresasDatosBanco.Dataset
|
||||
DataTable = tbl_EmpresasDatosBanco
|
||||
Left = 288
|
||||
Top = 168
|
||||
end
|
||||
end
|
||||
149
Source/Base/Empresas/Data/uDataModuleEmpresas.pas
Normal file
149
Source/Base/Empresas/Data/uDataModuleEmpresas.pas
Normal file
@ -0,0 +1,149 @@
|
||||
unit uDataModuleEmpresas;
|
||||
|
||||
interface
|
||||
|
||||
uses {vcl:} SysUtils, Classes, DB, DBClient,
|
||||
{RemObjects:} uDADataTable, uDAScriptingProvider,
|
||||
uDACDSDataTable, uDABINAdapter, uRORemoteService,
|
||||
uROClient, uROBinMessage, uROWinInetHttpChannel, uDADesigntimeCall,
|
||||
uIDataModuleEmpresas, uBizEmpresas, uBizEmpresasDatosBancarios,
|
||||
uDARemoteDataAdapter, uDADataStreamer, uRODynamicRequest, uDAInterfaces,
|
||||
uDAMemDataTable, uDABin2DataStreamer, uIntegerListUtils;
|
||||
|
||||
type
|
||||
TDataModuleEmpresas = class(TDataModule, IDataModuleEmpresas)
|
||||
RORemoteService: TRORemoteService;
|
||||
rda_Empresas: TDARemoteDataAdapter;
|
||||
Bin2DataStreamer: TDABin2DataStreamer;
|
||||
tbl_Empresas: TDAMemDataTable;
|
||||
ds_Empresas: TDADataSource;
|
||||
tbl_EmpresasDatosBanco: TDAMemDataTable;
|
||||
ds_EmpresasDatosBanco: TDADataSource;
|
||||
procedure DAClientDataModuleCreate(Sender: TObject);
|
||||
private
|
||||
FEmpresaActual: IBizEmpresa;
|
||||
|
||||
function _GetDatosBancarios : IBizEmpresasDatosBancarios;
|
||||
|
||||
{ function GetEmpresas: TIntegerList;
|
||||
|
||||
procedure SetEmpresaActual(const Value: IBizEmpresa);
|
||||
function GetIDEmpresaActual: Integer;
|
||||
procedure SetIDEmpresaActual(const Value: Integer);}
|
||||
public
|
||||
function GetItem(const ID : Integer) : IBizEmpresa;
|
||||
function NewItem : IBizEmpresa;
|
||||
function GetItems : IBizEmpresa;
|
||||
|
||||
{ property IDEmpresaActual : Integer read GetIDEmpresaActual write SetIDEmpresaActual;
|
||||
property EmpresaActual : IBizEmpresa read FEmpresaActual write SetEmpresaActual;
|
||||
property Empresas : TIntegerList read GetEmpresas;}
|
||||
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.DFM}
|
||||
|
||||
uses
|
||||
uDataModuleConexion, uDataTableUtils,
|
||||
FactuGES_Intf, schEmpresasClient_Intf, cxControls;
|
||||
|
||||
procedure TDataModuleEmpresas.DAClientDataModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FEmpresaActual := nil;
|
||||
RORemoteService.Channel := dmConexion.Channel;
|
||||
RORemoteService.Message := dmConexion.Message;
|
||||
end;
|
||||
|
||||
function TDataModuleEmpresas.GetItem(const ID: Integer): IBizEmpresa;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
Result := Self.GetItems;
|
||||
|
||||
with Result.DataTable.DynamicWhere do
|
||||
begin
|
||||
Clear;
|
||||
// (ID = :ID)
|
||||
Expression := NewBinaryExpression(NewField('', fld_EmpresasID),
|
||||
NewConstant(ID, datInteger), dboEqual);
|
||||
end;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataModuleEmpresas.GetItems: IBizEmpresa;
|
||||
var
|
||||
AEmpresa : TDAMemDataTable;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
AEmpresa := CloneDataTable(tbl_Empresas);
|
||||
AEmpresa.BusinessRulesID := BIZ_CLIENT_EMPRESA;
|
||||
|
||||
with TBizEmpresa(AEmpresa.BusinessEventsObj) do
|
||||
begin
|
||||
DatosBancarios := _GetDatosBancarios;
|
||||
end;
|
||||
|
||||
Result := (AEmpresa as IBizEmpresa);
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataModuleEmpresas.NewItem: IBizEmpresa;
|
||||
begin
|
||||
Result := GetItem(ID_NULO)
|
||||
end;
|
||||
|
||||
{procedure TDataModuleEmpresas.SetEmpresaActual(const Value: IBizEmpresa);
|
||||
begin
|
||||
FEmpresaActual := Value;
|
||||
FEmpresaActual.DataTable.Active := True;
|
||||
end;
|
||||
|
||||
procedure TDataModuleEmpresas.SetIDEmpresaActual(const Value: Integer);
|
||||
var
|
||||
AEmpresasController : IEmpresasController;
|
||||
AEmpresa : IBizEmpresa;
|
||||
begin
|
||||
AEmpresasController := TEmpresasController.Create;
|
||||
AEmpresa := AEmpresasController.Buscar(Value);
|
||||
AEmpresa.DataTable.Active := True;
|
||||
|
||||
if not AEmpresa.IsEmpty then
|
||||
begin
|
||||
FEmpresaActual := AEmpresa;
|
||||
FEmpresaActual.DataTable.Active := True;
|
||||
end
|
||||
else
|
||||
FEmpresaActual := NIL;
|
||||
end;}
|
||||
|
||||
function TDataModuleEmpresas._GetDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
var
|
||||
ADatosBancarios : TDAMemDataTable;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
ADatosBancarios := CloneDataTable(tbl_EmpresasDatosBanco);
|
||||
with ADatosBancarios do
|
||||
begin
|
||||
BusinessRulesID := BIZ_CLIENT_EMPRESAS_DATOS_BANCARIOS;
|
||||
DetailOptions := DetailOptions -
|
||||
[dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates];
|
||||
end;
|
||||
Result := (ADatosBancarios as IBizEmpresasDatosBancarios);
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
19
Source/Base/Empresas/Model/Data/uIDataModuleEmpresas.pas
Normal file
19
Source/Base/Empresas/Model/Data/uIDataModuleEmpresas.pas
Normal file
@ -0,0 +1,19 @@
|
||||
unit uIDataModuleEmpresas;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
uBizEmpresas;
|
||||
|
||||
type
|
||||
IDataModuleEmpresas = interface
|
||||
['{681FD37D-8C67-47F1-8286-2B6EFE95CE7D}']
|
||||
function GetItem(const ID : Integer) : IBizEmpresa;
|
||||
function NewItem : IBizEmpresa;
|
||||
function GetItems : IBizEmpresa;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
1243
Source/Base/Empresas/Model/schEmpresasClient_Intf.pas
Normal file
1243
Source/Base/Empresas/Model/schEmpresasClient_Intf.pas
Normal file
File diff suppressed because it is too large
Load Diff
1490
Source/Base/Empresas/Model/schEmpresasServer_Intf.pas
Normal file
1490
Source/Base/Empresas/Model/schEmpresasServer_Intf.pas
Normal file
File diff suppressed because it is too large
Load Diff
99
Source/Base/Empresas/Model/uBizEmpresas.pas
Normal file
99
Source/Base/Empresas/Model/uBizEmpresas.pas
Normal file
@ -0,0 +1,99 @@
|
||||
unit uBizEmpresas;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uDAInterfaces, uDADataTable, schEmpresasClient_Intf,
|
||||
uBizEmpresasDatosBancarios;
|
||||
|
||||
const
|
||||
BIZ_CLIENT_EMPRESA = 'Client.Empresa';
|
||||
|
||||
type
|
||||
IBizEmpresa = interface (IEmpresas)
|
||||
['{1DB69F36-969C-4078-B862-6D697670BCFD}']
|
||||
procedure SetDatosBancarios(AValue : IBizEmpresasDatosBancarios);
|
||||
function GetDatosBancarios : IBizEmpresasDatosBancarios;
|
||||
property DatosBancarios : IBizEmpresasDatosBancarios read GetDatosBancarios
|
||||
write SetDatosBancarios;
|
||||
|
||||
function EsNuevo : Boolean;
|
||||
end;
|
||||
|
||||
TBizEmpresa = class(TEmpresasDataTableRules, IBizEmpresa)
|
||||
protected
|
||||
FDatosBancarios : IBizEmpresasDatosBancarios;
|
||||
FDatosBancariosLink : TDADataSource;
|
||||
|
||||
procedure OnNewRecord(Sender: TDADataTable); override;
|
||||
|
||||
procedure SetDatosBancarios(AValue : IBizEmpresasDatosBancarios);
|
||||
function GetDatosBancarios : IBizEmpresasDatosBancarios;
|
||||
public
|
||||
function EsNuevo : Boolean;
|
||||
procedure IniciarValoresEmpresaNueva;
|
||||
|
||||
constructor Create(aDataTable: TDADataTable); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
property DatosBancarios : IBizEmpresasDatosBancarios read GetDatosBancarios
|
||||
write SetDatosBancarios;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uDataTableUtils, Classes, DateUtils, SysUtils;
|
||||
|
||||
{ TBizEmpresa }
|
||||
|
||||
|
||||
constructor TBizEmpresa.Create(aDataTable: TDADataTable);
|
||||
begin
|
||||
inherited;
|
||||
FDatosBancariosLink := TDADataSource.Create(NIL);
|
||||
FDatosBancariosLink.DataTable := aDataTable;
|
||||
end;
|
||||
|
||||
destructor TBizEmpresa.Destroy;
|
||||
begin
|
||||
FDatosBancarios := NIL;
|
||||
FDatosBancariosLink.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TBizEmpresa.EsNuevo: Boolean;
|
||||
begin
|
||||
Result := (ID < 0);
|
||||
end;
|
||||
|
||||
function TBizEmpresa.GetDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
begin
|
||||
Result := FDatosBancarios;
|
||||
end;
|
||||
|
||||
procedure TBizEmpresa.IniciarValoresEmpresaNueva;
|
||||
begin
|
||||
// USUARIO := dmUsuarios.LoginInfo.Usuario;
|
||||
end;
|
||||
|
||||
procedure TBizEmpresa.OnNewRecord(Sender: TDADataTable);
|
||||
begin
|
||||
inherited;
|
||||
IniciarValoresEmpresaNueva;
|
||||
end;
|
||||
|
||||
procedure TBizEmpresa.SetDatosBancarios(AValue: IBizEmpresasDatosBancarios);
|
||||
begin
|
||||
FDatosBancarios := AValue;
|
||||
EnlazarMaestroDetalle(FDatosBancariosLink, FDatosBancarios);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterDataTableRules(BIZ_CLIENT_EMPRESA, TBizEmpresa);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
|
||||
51
Source/Base/Empresas/Model/uBizEmpresasDatosBancarios.pas
Normal file
51
Source/Base/Empresas/Model/uBizEmpresasDatosBancarios.pas
Normal file
@ -0,0 +1,51 @@
|
||||
unit uBizEmpresasDatosBancarios;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uDAInterfaces, uDADataTable,
|
||||
schEmpresasClient_Intf;
|
||||
|
||||
const
|
||||
BIZ_CLIENT_EMPRESAS_DATOS_BANCARIOS = 'Client.EmpresasDatosBancarios';
|
||||
|
||||
type
|
||||
IBizEmpresasDatosBancarios = interface(IEmpresasDatosBanco)
|
||||
['{CF695D8D-B9C0-406F-A3EA-B251E35A7E19}']
|
||||
function EsNuevo : Boolean;
|
||||
end;
|
||||
|
||||
TBizEmpresasDatosBancarios = class(TEmpresasDatosBancoDataTableRules, IBizEmpresasDatosBancarios)
|
||||
protected
|
||||
procedure BeforeInsert(Sender: TDADataTable); override;
|
||||
public
|
||||
function EsNuevo : Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Dialogs,uDataTableUtils, DB;
|
||||
|
||||
{ TBizDatosBancarios }
|
||||
|
||||
procedure TBizEmpresasDatosBancarios.BeforeInsert(Sender: TDADataTable);
|
||||
var
|
||||
AMasterTable : TDADataTable;
|
||||
begin
|
||||
inherited;
|
||||
AMasterTable := DataTable.GetMasterDataTable;
|
||||
if Assigned(AMasterTable) and (AMasterTable.State = dsInsert) then
|
||||
AMasterTable.Post;
|
||||
end;
|
||||
|
||||
function TBizEmpresasDatosBancarios.EsNuevo: Boolean;
|
||||
begin
|
||||
Result := (ID < 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterDataTableRules(BIZ_CLIENT_EMPRESAS_DATOS_BANCARIOS, TBizEmpresasDatosBancarios);
|
||||
|
||||
|
||||
end.
|
||||
633
Source/Base/Empresas/Servidor/srvEmpresas_Impl.dfm
Normal file
633
Source/Base/Empresas/Servidor/srvEmpresas_Impl.dfm
Normal file
@ -0,0 +1,633 @@
|
||||
object srvEmpresas: TsrvEmpresas
|
||||
OldCreateOrder = True
|
||||
OnCreate = DARemoteServiceCreate
|
||||
RequiresSession = True
|
||||
ConnectionName = 'IBX'
|
||||
ServiceSchema = schEmpresas
|
||||
ServiceDataStreamer = DABin2DataStreamer
|
||||
ExportedDataTables = <>
|
||||
BeforeAcquireConnection = DataAbstractServiceBeforeAcquireConnection
|
||||
BeforeGetDatasetData = DataAbstractServiceBeforeGetDatasetData
|
||||
Height = 166
|
||||
Width = 351
|
||||
object schEmpresas: TDASchema
|
||||
ConnectionManager = dmServer.ConnectionManager
|
||||
DataDictionary = DataDictionary
|
||||
Diagrams = Diagrams
|
||||
Datasets = <
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
Default = True
|
||||
TargetTable = 'EMPRESAS'
|
||||
Name = 'IBX'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID'
|
||||
TableField = 'ID'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NIF_CIF'
|
||||
TableField = 'NIF_CIF'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOMBRE'
|
||||
TableField = 'NOMBRE'
|
||||
end
|
||||
item
|
||||
DatasetField = 'RAZON_SOCIAL'
|
||||
TableField = 'RAZON_SOCIAL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CALLE'
|
||||
TableField = 'CALLE'
|
||||
end
|
||||
item
|
||||
DatasetField = 'POBLACION'
|
||||
TableField = 'POBLACION'
|
||||
end
|
||||
item
|
||||
DatasetField = 'PROVINCIA'
|
||||
TableField = 'PROVINCIA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CODIGO_POSTAL'
|
||||
TableField = 'CODIGO_POSTAL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'TELEFONO_1'
|
||||
TableField = 'TELEFONO_1'
|
||||
end
|
||||
item
|
||||
DatasetField = 'TELEFONO_2'
|
||||
TableField = 'TELEFONO_2'
|
||||
end
|
||||
item
|
||||
DatasetField = 'MOVIL_1'
|
||||
TableField = 'MOVIL_1'
|
||||
end
|
||||
item
|
||||
DatasetField = 'MOVIL_2'
|
||||
TableField = 'MOVIL_2'
|
||||
end
|
||||
item
|
||||
DatasetField = 'FAX'
|
||||
TableField = 'FAX'
|
||||
end
|
||||
item
|
||||
DatasetField = 'EMAIL_1'
|
||||
TableField = 'EMAIL_1'
|
||||
end
|
||||
item
|
||||
DatasetField = 'EMAIL_2'
|
||||
TableField = 'EMAIL_2'
|
||||
end
|
||||
item
|
||||
DatasetField = 'PAGINA_WEB'
|
||||
TableField = 'PAGINA_WEB'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOTAS'
|
||||
TableField = 'NOTAS'
|
||||
end
|
||||
item
|
||||
DatasetField = 'FECHA_ALTA'
|
||||
TableField = 'FECHA_ALTA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'FECHA_MODIFICACION'
|
||||
TableField = 'FECHA_MODIFICACION'
|
||||
end
|
||||
item
|
||||
DatasetField = 'USUARIO'
|
||||
TableField = 'USUARIO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'LOGOTIPO'
|
||||
TableField = 'LOGOTIPO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'REGISTRO_MERCANTIL'
|
||||
TableField = 'REGISTRO_MERCANTIL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'IVA'
|
||||
TableField = 'IVA'
|
||||
end>
|
||||
end>
|
||||
Name = 'Empresas'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_ID'
|
||||
ServerAutoRefresh = True
|
||||
DictionaryEntry = 'Empresas_ID'
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'NIF_CIF'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'Empresas_NIF_CIF'
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_NOMBRE'
|
||||
end
|
||||
item
|
||||
Name = 'RAZON_SOCIAL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_RAZON_SOCIAL'
|
||||
end
|
||||
item
|
||||
Name = 'CALLE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_CALLE'
|
||||
end
|
||||
item
|
||||
Name = 'POBLACION'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_POBLACION'
|
||||
end
|
||||
item
|
||||
Name = 'PROVINCIA'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_PROVINCIA'
|
||||
end
|
||||
item
|
||||
Name = 'CODIGO_POSTAL'
|
||||
DataType = datString
|
||||
Size = 10
|
||||
DictionaryEntry = 'Empresas_CODIGO_POSTAL'
|
||||
end
|
||||
item
|
||||
Name = 'TELEFONO_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DictionaryEntry = 'Empresas_TELEFONO_1'
|
||||
end
|
||||
item
|
||||
Name = 'TELEFONO_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DictionaryEntry = 'Empresas_TELEFONO_2'
|
||||
end
|
||||
item
|
||||
Name = 'MOVIL_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DictionaryEntry = 'Empresas_MOVIL_1'
|
||||
end
|
||||
item
|
||||
Name = 'MOVIL_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DictionaryEntry = 'Empresas_MOVIL_2'
|
||||
end
|
||||
item
|
||||
Name = 'FAX'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DictionaryEntry = 'Empresas_FAX'
|
||||
end
|
||||
item
|
||||
Name = 'EMAIL_1'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_EMAIL_1'
|
||||
end
|
||||
item
|
||||
Name = 'EMAIL_2'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_EMAIL_2'
|
||||
end
|
||||
item
|
||||
Name = 'PAGINA_WEB'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_PAGINA_WEB'
|
||||
end
|
||||
item
|
||||
Name = 'NOTAS'
|
||||
DataType = datMemo
|
||||
DictionaryEntry = 'Empresas_NOTAS'
|
||||
end
|
||||
item
|
||||
Name = 'FECHA_ALTA'
|
||||
DataType = datDateTime
|
||||
DictionaryEntry = 'Empresas_FECHA_ALTA'
|
||||
end
|
||||
item
|
||||
Name = 'FECHA_MODIFICACION'
|
||||
DataType = datDateTime
|
||||
DictionaryEntry = 'Empresas_FECHA_MODIFICACION'
|
||||
end
|
||||
item
|
||||
Name = 'USUARIO'
|
||||
DataType = datString
|
||||
Size = 20
|
||||
DictionaryEntry = 'Empresas_USUARIO'
|
||||
end
|
||||
item
|
||||
Name = 'LOGOTIPO'
|
||||
DataType = datBlob
|
||||
BlobType = dabtBlob
|
||||
DictionaryEntry = 'Empresas_LOGOTIPO'
|
||||
end
|
||||
item
|
||||
Name = 'REGISTRO_MERCANTIL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'Empresas_REGISTRO_MERCANTIL'
|
||||
end
|
||||
item
|
||||
Name = 'IVA'
|
||||
DataType = datFloat
|
||||
DictionaryEntry = 'Empresas_IVA'
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
Default = True
|
||||
TargetTable = 'EMPRESAS_DATOS_BANCO'
|
||||
Name = 'IBX'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID'
|
||||
TableField = 'ID'
|
||||
end
|
||||
item
|
||||
DatasetField = 'ID_EMPRESA'
|
||||
TableField = 'ID_EMPRESA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOMBRE'
|
||||
TableField = 'NOMBRE'
|
||||
end
|
||||
item
|
||||
DatasetField = 'ENTIDAD'
|
||||
TableField = 'ENTIDAD'
|
||||
end
|
||||
item
|
||||
DatasetField = 'SUCURSAL'
|
||||
TableField = 'SUCURSAL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'DC'
|
||||
TableField = 'DC'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CUENTA'
|
||||
TableField = 'CUENTA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'SUFIJO_N19'
|
||||
TableField = 'SUFIJO_N19'
|
||||
end
|
||||
item
|
||||
DatasetField = 'SUFIJO_N58'
|
||||
TableField = 'SUFIJO_N58'
|
||||
end>
|
||||
end>
|
||||
Name = 'EmpresasDatosBanco'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_DATOS_BANCO_ID'
|
||||
ServerAutoRefresh = True
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ID'
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'ID_EMPRESA'
|
||||
DataType = datInteger
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ID_EMPRESA'
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DictionaryEntry = 'EmpresasDatosBanco_NOMBRE'
|
||||
end
|
||||
item
|
||||
Name = 'ENTIDAD'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'EmpresasDatosBanco_ENTIDAD'
|
||||
end
|
||||
item
|
||||
Name = 'SUCURSAL'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUCURSAL'
|
||||
end
|
||||
item
|
||||
Name = 'DC'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'EmpresasDatosBanco_DC'
|
||||
end
|
||||
item
|
||||
Name = 'CUENTA'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DictionaryEntry = 'EmpresasDatosBanco_CUENTA'
|
||||
end
|
||||
item
|
||||
Name = 'SUFIJO_N19'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUFIJO_N19'
|
||||
end
|
||||
item
|
||||
Name = 'SUFIJO_N58'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DictionaryEntry = 'EmpresasDatosBanco_SUFIJO_N58'
|
||||
end>
|
||||
end>
|
||||
JoinDataTables = <>
|
||||
UnionDataTables = <>
|
||||
Commands = <>
|
||||
RelationShips = <
|
||||
item
|
||||
Name = 'FK_EmpresasDatosBanco_Empresas'
|
||||
MasterDatasetName = 'Empresas'
|
||||
MasterFields = 'ID'
|
||||
DetailDatasetName = 'EmpresasDatosBanco'
|
||||
DetailFields = 'ID_EMPRESA'
|
||||
RelationshipType = rtForeignKey
|
||||
end>
|
||||
UpdateRules = <
|
||||
item
|
||||
Name = 'Insert Empresas'
|
||||
DoUpdate = False
|
||||
DoDelete = False
|
||||
DatasetName = 'Empresas'
|
||||
FailureBehavior = fbRaiseException
|
||||
end
|
||||
item
|
||||
Name = 'Insert EmpresasDatosBanco'
|
||||
DoUpdate = False
|
||||
DoDelete = False
|
||||
DatasetName = 'EmpresasDatosBanco'
|
||||
FailureBehavior = fbRaiseException
|
||||
end
|
||||
item
|
||||
Name = 'Update Empresas'
|
||||
DoInsert = False
|
||||
DoDelete = False
|
||||
DatasetName = 'Empresas'
|
||||
FailureBehavior = fbRaiseException
|
||||
end
|
||||
item
|
||||
Name = 'Update EmpresasDatosBanco'
|
||||
DoInsert = False
|
||||
DoDelete = False
|
||||
DatasetName = 'EmpresasDatosBanco'
|
||||
FailureBehavior = fbRaiseException
|
||||
end
|
||||
item
|
||||
Name = 'Delete EmpresasDatosBanco'
|
||||
DoUpdate = False
|
||||
DoInsert = False
|
||||
DatasetName = 'EmpresasDatosBanco'
|
||||
FailureBehavior = fbRaiseException
|
||||
end
|
||||
item
|
||||
Name = 'Delete Empresas'
|
||||
DoUpdate = False
|
||||
DoInsert = False
|
||||
DatasetName = 'Empresas'
|
||||
FailureBehavior = fbRaiseException
|
||||
end>
|
||||
Version = 0
|
||||
Left = 46
|
||||
Top = 22
|
||||
end
|
||||
object DataDictionary: TDADataDictionary
|
||||
Fields = <
|
||||
item
|
||||
Name = 'Empresas_NIF_CIF'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'CIF'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Nombre'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_RAZON_SOCIAL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Raz'#243'n Social'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_CALLE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Calle'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_POBLACION'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Poblaci'#243'n'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_PROVINCIA'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Provincia'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_CODIGO_POSTAL'
|
||||
DataType = datString
|
||||
Size = 10
|
||||
DisplayLabel = 'C'#243'd. postal'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_TELEFONO_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Tel'#233'fono 1'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_TELEFONO_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Tel'#233'fono 2'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_MOVIL_1'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'M'#243'vil 1'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_MOVIL_2'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'M'#243'vil 2'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_FAX'
|
||||
DataType = datString
|
||||
Size = 25
|
||||
DisplayLabel = 'Fax'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_EMAIL_1'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'E-mail 1'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_EMAIL_2'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'E-mail 2'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_PAGINA_WEB'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'P'#225'gina web'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_NOTAS'
|
||||
DataType = datMemo
|
||||
DisplayLabel = 'Notas'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_FECHA_ALTA'
|
||||
DataType = datDateTime
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_FECHA_MODIFICACION'
|
||||
DataType = datDateTime
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_USUARIO'
|
||||
DataType = datString
|
||||
Size = 20
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_LOGOTIPO'
|
||||
DataType = datBlob
|
||||
BlobType = dabtBlob
|
||||
DisplayLabel = 'Logotipo'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_REGISTRO_MERCANTIL'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Registro mercantil'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_IVA'
|
||||
DataType = datFloat
|
||||
DisplayLabel = 'IVA'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_ID_EMPRESA'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_NOMBRE'
|
||||
DataType = datString
|
||||
Size = 255
|
||||
DisplayLabel = 'Nombre del banco'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_ENTIDAD'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Entidad'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_SUCURSAL'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Sucursal'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_DC'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'DC'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_CUENTA'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
DisplayLabel = 'Cuenta'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_SUFIJO_N19'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DisplayLabel = 'Sufijo 19'
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_SUFIJO_N58'
|
||||
DataType = datString
|
||||
Size = 3
|
||||
DisplayLabel = 'Sufijo 58'
|
||||
end
|
||||
item
|
||||
Name = 'Empresas_ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_ID'
|
||||
LogChanges = False
|
||||
Required = True
|
||||
DisplayLabel = 'ID'
|
||||
ReadOnly = True
|
||||
ServerAutoRefresh = True
|
||||
end
|
||||
item
|
||||
Name = 'EmpresasDatosBanco_ID'
|
||||
DataType = datAutoInc
|
||||
GeneratorName = 'GEN_EMPRESAS_DATOS_BANCO_ID'
|
||||
LogChanges = False
|
||||
Required = True
|
||||
DisplayLabel = 'ID'
|
||||
ReadOnly = True
|
||||
ServerAutoRefresh = True
|
||||
end>
|
||||
Left = 158
|
||||
Top = 22
|
||||
end
|
||||
object Diagrams: TDADiagrams
|
||||
Left = 158
|
||||
Top = 90
|
||||
DiagramData =
|
||||
'<Diagrams>'#13#10' <Diagram Name="New Diagram" Left="200" Top="200" W' +
|
||||
'idth="400" Height="300">'#13#10' <Entity Name="EmpresasDatosBanco" ' +
|
||||
'Left="311,00" Top="2,00" />'#13#10' <Entity Name="Empresas" Left="0' +
|
||||
',00" Top="0,00" />'#13#10' </Diagram>'#13#10'</Diagrams>'#13#10
|
||||
end
|
||||
object DABin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 48
|
||||
Top = 88
|
||||
end
|
||||
end
|
||||
81
Source/Base/Empresas/Servidor/srvEmpresas_Impl.pas
Normal file
81
Source/Base/Empresas/Servidor/srvEmpresas_Impl.pas
Normal file
@ -0,0 +1,81 @@
|
||||
unit srvEmpresas_Impl;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ This is where you are supposed to code the implementation of your objects. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, SysUtils,
|
||||
{RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
||||
{Ancestor Implementation:} DataAbstractService_Impl,
|
||||
{Used RODLs:} DataAbstract4_Intf,
|
||||
{Generated:} FactuGES_Intf, uDAScriptingProvider, uDABusinessProcessor,
|
||||
uDABin2DataStreamer, uDADataStreamer, uDAClasses, uDAInterfaces;
|
||||
|
||||
type
|
||||
{ TsrvEmpresas }
|
||||
TsrvEmpresas = class(TDataAbstractService, IsrvEmpresas)
|
||||
Diagrams: TDADiagrams;
|
||||
DABin2DataStreamer: TDABin2DataStreamer;
|
||||
schEmpresas: TDASchema;
|
||||
DataDictionary: TDADataDictionary;
|
||||
procedure DARemoteServiceCreate(Sender: TObject);
|
||||
procedure DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
|
||||
var aConnectionName: string);
|
||||
procedure DataAbstractServiceBeforeGetDatasetData(aSender: TObject;
|
||||
const aDataset: IDADataset; const aIncludeSchema: Boolean;
|
||||
const aMaxRecords: Integer);
|
||||
private
|
||||
protected
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
uses
|
||||
{Generated:} FactuGES_Invk, uDataModuleServer, uRORemoteDataModule,
|
||||
uDatabaseUtils, Dialogs, Variants, uROStreamSerializer, uROBinaryHelpers,
|
||||
uSesionesUtils, schEmpresasClient_Intf, uUsersManager,
|
||||
uRestriccionesUsuarioUtils;
|
||||
|
||||
procedure Create_srvEmpresas(out anInstance : IUnknown);
|
||||
begin
|
||||
anInstance := TsrvEmpresas.Create(NIL);
|
||||
end;
|
||||
|
||||
{ srvEmpresas }
|
||||
procedure TsrvEmpresas.DARemoteServiceCreate(Sender: TObject);
|
||||
begin
|
||||
SessionManager := dmServer.SessionManager;
|
||||
end;
|
||||
|
||||
procedure TsrvEmpresas.DataAbstractServiceBeforeAcquireConnection(
|
||||
aSender: TObject; var aConnectionName: string);
|
||||
begin
|
||||
ConnectionName := dmServer.ConnectionName;
|
||||
end;
|
||||
|
||||
procedure TsrvEmpresas.DataAbstractServiceBeforeGetDatasetData(aSender: TObject;
|
||||
const aDataset: IDADataset; const aIncludeSchema: Boolean;
|
||||
const aMaxRecords: Integer);
|
||||
begin
|
||||
Exit;
|
||||
if (aDataset.Name <> nme_EmpresasDatosBanco) then
|
||||
begin
|
||||
{ Aquí se asegura que el usuario sólo accede a las empresas a
|
||||
las que tiene permiso para acceder filtrando DataSet por ID_EMPRESA. }
|
||||
FiltrarAccesoUsuario(Session, Connection, ServiceSchema, aDataset, fld_EmpresasID);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TROClassFactory.Create('srvEmpresas', Create_srvEmpresas, TsrvEmpresas_Invoker);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
496
Source/Base/Empresas/Test/Empresas_Tests.bdsproj
Normal file
496
Source/Base/Empresas/Test/Empresas_Tests.bdsproj
Normal file
@ -0,0 +1,496 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<BorlandProject>
|
||||
<PersonalityInfo>
|
||||
<Option>
|
||||
<Option Name="Personality">Delphi.Personality</Option>
|
||||
<Option Name="ProjectType"></Option>
|
||||
<Option Name="Version">1.0</Option>
|
||||
<Option Name="GUID">{A12ECF04-330A-4A69-9080-E0E6821E2FC3}</Option>
|
||||
</Option>
|
||||
</PersonalityInfo>
|
||||
<Delphi.Personality>
|
||||
<Source>
|
||||
<Source Name="MainSource">Empresas_Tests.dpr</Source>
|
||||
</Source>
|
||||
<FileVersion>
|
||||
<FileVersion Name="Version">7.0</FileVersion>
|
||||
</FileVersion>
|
||||
<Compiler>
|
||||
<Compiler Name="A">8</Compiler>
|
||||
<Compiler Name="B">0</Compiler>
|
||||
<Compiler Name="C">1</Compiler>
|
||||
<Compiler Name="D">1</Compiler>
|
||||
<Compiler Name="E">0</Compiler>
|
||||
<Compiler Name="F">0</Compiler>
|
||||
<Compiler Name="G">1</Compiler>
|
||||
<Compiler Name="H">1</Compiler>
|
||||
<Compiler Name="I">1</Compiler>
|
||||
<Compiler Name="J">0</Compiler>
|
||||
<Compiler Name="K">0</Compiler>
|
||||
<Compiler Name="L">1</Compiler>
|
||||
<Compiler Name="M">0</Compiler>
|
||||
<Compiler Name="N">1</Compiler>
|
||||
<Compiler Name="O">1</Compiler>
|
||||
<Compiler Name="P">1</Compiler>
|
||||
<Compiler Name="Q">0</Compiler>
|
||||
<Compiler Name="R">0</Compiler>
|
||||
<Compiler Name="S">0</Compiler>
|
||||
<Compiler Name="T">0</Compiler>
|
||||
<Compiler Name="U">0</Compiler>
|
||||
<Compiler Name="V">1</Compiler>
|
||||
<Compiler Name="W">0</Compiler>
|
||||
<Compiler Name="X">1</Compiler>
|
||||
<Compiler Name="Y">1</Compiler>
|
||||
<Compiler Name="Z">1</Compiler>
|
||||
<Compiler Name="ShowHints">True</Compiler>
|
||||
<Compiler Name="ShowWarnings">True</Compiler>
|
||||
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
|
||||
<Compiler Name="NamespacePrefix"></Compiler>
|
||||
<Compiler Name="GenerateDocumentation">False</Compiler>
|
||||
<Compiler Name="DefaultNamespace"></Compiler>
|
||||
<Compiler Name="SymbolDeprecated">True</Compiler>
|
||||
<Compiler Name="SymbolLibrary">True</Compiler>
|
||||
<Compiler Name="SymbolPlatform">True</Compiler>
|
||||
<Compiler Name="SymbolExperimental">True</Compiler>
|
||||
<Compiler Name="UnitLibrary">True</Compiler>
|
||||
<Compiler Name="UnitPlatform">True</Compiler>
|
||||
<Compiler Name="UnitDeprecated">True</Compiler>
|
||||
<Compiler Name="UnitExperimental">True</Compiler>
|
||||
<Compiler Name="HResultCompat">True</Compiler>
|
||||
<Compiler Name="HidingMember">True</Compiler>
|
||||
<Compiler Name="HiddenVirtual">True</Compiler>
|
||||
<Compiler Name="Garbage">True</Compiler>
|
||||
<Compiler Name="BoundsError">True</Compiler>
|
||||
<Compiler Name="ZeroNilCompat">True</Compiler>
|
||||
<Compiler Name="StringConstTruncated">True</Compiler>
|
||||
<Compiler Name="ForLoopVarVarPar">True</Compiler>
|
||||
<Compiler Name="TypedConstVarPar">True</Compiler>
|
||||
<Compiler Name="AsgToTypedConst">True</Compiler>
|
||||
<Compiler Name="CaseLabelRange">True</Compiler>
|
||||
<Compiler Name="ForVariable">True</Compiler>
|
||||
<Compiler Name="ConstructingAbstract">True</Compiler>
|
||||
<Compiler Name="ComparisonFalse">True</Compiler>
|
||||
<Compiler Name="ComparisonTrue">True</Compiler>
|
||||
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
|
||||
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
|
||||
<Compiler Name="UnsupportedConstruct">True</Compiler>
|
||||
<Compiler Name="FileOpen">True</Compiler>
|
||||
<Compiler Name="FileOpenUnitSrc">True</Compiler>
|
||||
<Compiler Name="BadGlobalSymbol">True</Compiler>
|
||||
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
|
||||
<Compiler Name="InvalidDirective">True</Compiler>
|
||||
<Compiler Name="PackageNoLink">True</Compiler>
|
||||
<Compiler Name="PackageThreadVar">True</Compiler>
|
||||
<Compiler Name="ImplicitImport">True</Compiler>
|
||||
<Compiler Name="HPPEMITIgnored">True</Compiler>
|
||||
<Compiler Name="NoRetVal">True</Compiler>
|
||||
<Compiler Name="UseBeforeDef">True</Compiler>
|
||||
<Compiler Name="ForLoopVarUndef">True</Compiler>
|
||||
<Compiler Name="UnitNameMismatch">True</Compiler>
|
||||
<Compiler Name="NoCFGFileFound">True</Compiler>
|
||||
<Compiler Name="ImplicitVariants">True</Compiler>
|
||||
<Compiler Name="UnicodeToLocale">True</Compiler>
|
||||
<Compiler Name="LocaleToUnicode">True</Compiler>
|
||||
<Compiler Name="ImagebaseMultiple">True</Compiler>
|
||||
<Compiler Name="SuspiciousTypecast">True</Compiler>
|
||||
<Compiler Name="PrivatePropAccessor">True</Compiler>
|
||||
<Compiler Name="UnsafeType">False</Compiler>
|
||||
<Compiler Name="UnsafeCode">False</Compiler>
|
||||
<Compiler Name="UnsafeCast">False</Compiler>
|
||||
<Compiler Name="OptionTruncated">True</Compiler>
|
||||
<Compiler Name="WideCharReduced">True</Compiler>
|
||||
<Compiler Name="DuplicatesIgnored">True</Compiler>
|
||||
<Compiler Name="UnitInitSeq">True</Compiler>
|
||||
<Compiler Name="LocalPInvoke">True</Compiler>
|
||||
<Compiler Name="MessageDirective">True</Compiler>
|
||||
<Compiler Name="CodePage"></Compiler>
|
||||
</Compiler>
|
||||
<Linker>
|
||||
<Linker Name="MapFile">3</Linker>
|
||||
<Linker Name="OutputObjs">0</Linker>
|
||||
<Linker Name="GenerateHpps">False</Linker>
|
||||
<Linker Name="ConsoleApp">1</Linker>
|
||||
<Linker Name="DebugInfo">False</Linker>
|
||||
<Linker Name="RemoteSymbols">False</Linker>
|
||||
<Linker Name="GenerateDRC">False</Linker>
|
||||
<Linker Name="MinStackSize">16384</Linker>
|
||||
<Linker Name="MaxStackSize">1048576</Linker>
|
||||
<Linker Name="ImageBase">4194304</Linker>
|
||||
<Linker Name="ExeDescription"></Linker>
|
||||
</Linker>
|
||||
<Directories>
|
||||
<Directories Name="OutputDir">..\..\..\..\Output\Debug\Cliente</Directories>
|
||||
<Directories Name="UnitOutputDir">.\</Directories>
|
||||
<Directories Name="PackageDLLOutputDir"></Directories>
|
||||
<Directories Name="PackageDCPOutputDir">..\..\Lib</Directories>
|
||||
<Directories Name="SearchPath">..\..\..\Lib;..\..\Lib</Directories>
|
||||
<Directories Name="Packages">DataAbstract_D10;Base;GUIBase;Empresas_model;Empresas_controller</Directories>
|
||||
<Directories Name="Conditionals">_CONSOLE_TESTRUNNER;EUREKALOG;EUREKALOG_VER5</Directories>
|
||||
<Directories Name="DebugSourceDirs"></Directories>
|
||||
<Directories Name="UsePackages">True</Directories>
|
||||
</Directories>
|
||||
<Parameters>
|
||||
<Parameters Name="RunParams"></Parameters>
|
||||
<Parameters Name="HostApplication"></Parameters>
|
||||
<Parameters Name="Launcher"></Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="DebugCWD"></Parameters>
|
||||
<Parameters Name="Debug Symbols Search Path"></Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<Language>
|
||||
<Language Name="ActiveLang"></Language>
|
||||
<Language Name="ProjectLang">$00000000</Language>
|
||||
<Language Name="RootDir"></Language>
|
||||
</Language>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">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">Empresas (Test)</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>
|
||||
</Delphi.Personality>
|
||||
<UnitTesting>
|
||||
<TestFramework>DUnit / Delphi Win32</TestFramework>
|
||||
<TestRunner>GUI</TestRunner>
|
||||
</UnitTesting>
|
||||
<!-- EurekaLog First Line
|
||||
[Exception Log]
|
||||
EurekaLog Version=519
|
||||
Activate=1
|
||||
Activate Handle=1
|
||||
Save Log File=1
|
||||
Foreground Tab=0
|
||||
Freeze Activate=0
|
||||
Freeze Timeout=0
|
||||
Freeze Message=The application seems to be frozen.
|
||||
SMTP From=eurekalog@email.com
|
||||
SMTP Host=
|
||||
SMTP Port=25
|
||||
SMTP UserID=
|
||||
SMTP Password=
|
||||
Append to Log=0
|
||||
Show TerminateBtn=1
|
||||
TerminateBtn Operation=1
|
||||
Errors Number=32
|
||||
Errors Terminate=3
|
||||
Email Address=
|
||||
Email Object=
|
||||
Email Send Options=0
|
||||
Output Path=
|
||||
Encrypt Password=
|
||||
AutoCloseDialogSecs=0
|
||||
WebSendMode=0
|
||||
SupportULR=
|
||||
HTMLLayout Count=15
|
||||
HTMLLine0="%3Chtml%3E"
|
||||
HTMLLine1=" %3Chead%3E"
|
||||
HTMLLine2=" %3C/head%3E"
|
||||
HTMLLine3=" %3Cbody TopMargin=10 LeftMargin=10%3E"
|
||||
HTMLLine4=" %3Ctable width="100%%" border="0"%3E"
|
||||
HTMLLine5=" %3Ctr%3E"
|
||||
HTMLLine6=" %3Ctd nowrap%3E"
|
||||
HTMLLine7=" %3Cfont face="Lucida Console, Courier" size="2"%3E"
|
||||
HTMLLine8=" %3C%%HTML_TAG%%%3E"
|
||||
HTMLLine9=" %3C/font%3E"
|
||||
HTMLLine10=" %3C/td%3E"
|
||||
HTMLLine11=" %3C/tr%3E"
|
||||
HTMLLine12=" %3C/table%3E"
|
||||
HTMLLine13=" %3C/body%3E"
|
||||
HTMLLine14="%3C/html%3E"
|
||||
AutoCrashOperation=1
|
||||
AutoCrashNumber=10
|
||||
AutoCrashMinutes=1
|
||||
WebURL=
|
||||
WebUserID=
|
||||
WebPassword=
|
||||
WebPort=0
|
||||
AttachedFiles=
|
||||
Count=0
|
||||
EMail Message Line Count=0
|
||||
loNoDuplicateErrors=0
|
||||
loAppendReproduceText=0
|
||||
loDeleteLogAtVersionChange=0
|
||||
loAddComputerNameInLogFileName=0
|
||||
loSaveModulesSection=1
|
||||
loSaveCPUSection=1
|
||||
soAppStartDate=1
|
||||
soAppName=1
|
||||
soAppVersionNumber=1
|
||||
soAppParameters=1
|
||||
soAppCompilationDate=1
|
||||
soExcDate=1
|
||||
soExcAddress=1
|
||||
soExcModule=1
|
||||
soExcType=1
|
||||
soExcMessage=1
|
||||
soActCtlsFormClass=1
|
||||
soActCtlsFormText=1
|
||||
soActCtlsControlClass=1
|
||||
soActCtlsControlText=1
|
||||
soCmpName=1
|
||||
soCmpUser=1
|
||||
soCmpTotalMemory=1
|
||||
soCmpFreeMemory=1
|
||||
soCmpTotalDisk=1
|
||||
soCmpFreeDisk=1
|
||||
soCmpSysUpTime=1
|
||||
soCmpProcessor=1
|
||||
soCmpDisplayMode=1
|
||||
soOSType=1
|
||||
soOSBuildN=1
|
||||
soOSUpdate=1
|
||||
soOSLanguage=1
|
||||
soNetIP=1
|
||||
soNetSubmask=1
|
||||
soNetGateway=1
|
||||
soNetDNS1=1
|
||||
soNetDNS2=1
|
||||
soNetDHCP=1
|
||||
sndShowSendDialog=1
|
||||
sndShowSuccessFailureMsg=0
|
||||
sndSendEntireLog=0
|
||||
sndSendXMLLogCopy=0
|
||||
sndSendScreenshot=0
|
||||
sndUseOnlyActiveWindow=0
|
||||
sndSendLastHTMLPage=1
|
||||
sndSendInSeparatedThread=0
|
||||
sndAddDateInFileName=0
|
||||
sndCompressAllFiles=0
|
||||
edoShowExceptionDialog=1
|
||||
edoSendEmailChecked=1
|
||||
edoAttachScreenshotChecked=1
|
||||
edoShowCopyToClipOption=1
|
||||
edoShowDetailsButton=1
|
||||
edoShowInDetailedMode=0
|
||||
edoShowInTopMostMode=0
|
||||
edoUseEurekaLogLookAndFeel=1
|
||||
csoShowDLLs=1
|
||||
csoShowBPLs=1
|
||||
csoShowBorlandThreads=1
|
||||
csoShowWindowsThreads=1
|
||||
csoShowProcedureOffset=0
|
||||
boActivateCrashDetection=0
|
||||
boPauseBorlandThreads=0
|
||||
boDoNotPauseMainThread=0
|
||||
boPauseWindowsThreads=0
|
||||
boUseMainModuleOptions=1
|
||||
boCopyLogInCaseOfError=1
|
||||
boSaveCompressedCopyInCaseOfError=0
|
||||
Count mtInformationMsgCaption=1
|
||||
mtInformationMsgCaption0="Information."
|
||||
Count mtQuestionMsgCaption=1
|
||||
mtQuestionMsgCaption0="Question."
|
||||
Count mtDialog_Caption=1
|
||||
mtDialog_Caption0="Error."
|
||||
Count mtDialog_ErrorMsgCaption=2
|
||||
mtDialog_ErrorMsgCaption0="An error has occurred during program execution."
|
||||
mtDialog_ErrorMsgCaption1="Please read the following information for further details."
|
||||
Count mtDialog_GeneralCaption=1
|
||||
mtDialog_GeneralCaption0="General"
|
||||
Count mtDialog_GeneralHeader=1
|
||||
mtDialog_GeneralHeader0="General Information"
|
||||
Count mtDialog_CallStackCaption=1
|
||||
mtDialog_CallStackCaption0="Call Stack"
|
||||
Count mtDialog_CallStackHeader=1
|
||||
mtDialog_CallStackHeader0="Call Stack Information"
|
||||
Count mtDialog_ModulesCaption=1
|
||||
mtDialog_ModulesCaption0="Modules"
|
||||
Count mtDialog_ModulesHeader=1
|
||||
mtDialog_ModulesHeader0="Modules Information"
|
||||
Count mtDialog_CPUCaption=1
|
||||
mtDialog_CPUCaption0="CPU"
|
||||
Count mtDialog_CPUHeader=1
|
||||
mtDialog_CPUHeader0="CPU Information"
|
||||
Count mtDialog_CustomDataCaption=1
|
||||
mtDialog_CustomDataCaption0="Other"
|
||||
Count mtDialog_CustomDataHeader=1
|
||||
mtDialog_CustomDataHeader0="Other Information"
|
||||
Count mtDialog_OKButtonCaption=1
|
||||
mtDialog_OKButtonCaption0="%26OK"
|
||||
Count mtDialog_TerminateButtonCaption=1
|
||||
mtDialog_TerminateButtonCaption0="%26Terminate"
|
||||
Count mtDialog_RestartButtonCaption=1
|
||||
mtDialog_RestartButtonCaption0="%26Restart"
|
||||
Count mtDialog_DetailsButtonCaption=1
|
||||
mtDialog_DetailsButtonCaption0="%26Details"
|
||||
Count mtDialog_SendMessage=1
|
||||
mtDialog_SendMessage0="%26Send this error via Internet"
|
||||
Count mtDialog_ScreenshotMessage=1
|
||||
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
|
||||
Count mtDialog_CopyMessage=1
|
||||
mtDialog_CopyMessage0="%26Copy to Clipboard"
|
||||
Count mtDialog_SupportMessage=1
|
||||
mtDialog_SupportMessage0="Go to the Support Page"
|
||||
Count mtLog_AppHeader=1
|
||||
mtLog_AppHeader0="Application"
|
||||
Count mtLog_AppStartDate=1
|
||||
mtLog_AppStartDate0="Start Date"
|
||||
Count mtLog_AppName=1
|
||||
mtLog_AppName0="Name/Description"
|
||||
Count mtLog_AppVersionNumber=1
|
||||
mtLog_AppVersionNumber0="Version Number"
|
||||
Count mtLog_AppParameters=1
|
||||
mtLog_AppParameters0="Parameters"
|
||||
Count mtLog_AppCompilationDate=1
|
||||
mtLog_AppCompilationDate0="Compilation Date"
|
||||
Count mtLog_ExcHeader=1
|
||||
mtLog_ExcHeader0="Exception"
|
||||
Count mtLog_ExcDate=1
|
||||
mtLog_ExcDate0="Date"
|
||||
Count mtLog_ExcAddress=1
|
||||
mtLog_ExcAddress0="Address"
|
||||
Count mtLog_ExcModule=1
|
||||
mtLog_ExcModule0="Module"
|
||||
Count mtLog_ExcType=1
|
||||
mtLog_ExcType0="Type"
|
||||
Count mtLog_ExcMessage=1
|
||||
mtLog_ExcMessage0="Message"
|
||||
Count mtLog_ActCtrlsHeader=1
|
||||
mtLog_ActCtrlsHeader0="Active Controls"
|
||||
Count mtLog_ActCtrlsFormClass=1
|
||||
mtLog_ActCtrlsFormClass0="Form Class"
|
||||
Count mtLog_ActCtrlsFormText=1
|
||||
mtLog_ActCtrlsFormText0="Form Text"
|
||||
Count mtLog_ActCtrlsControlClass=1
|
||||
mtLog_ActCtrlsControlClass0="Control Class"
|
||||
Count mtLog_ActCtrlsControlText=1
|
||||
mtLog_ActCtrlsControlText0="Control Text"
|
||||
Count mtLog_CmpHeader=1
|
||||
mtLog_CmpHeader0="Computer"
|
||||
Count mtLog_CmpName=1
|
||||
mtLog_CmpName0="Name"
|
||||
Count mtLog_CmpUser=1
|
||||
mtLog_CmpUser0="User"
|
||||
Count mtLog_CmpTotalMemory=1
|
||||
mtLog_CmpTotalMemory0="Total Memory"
|
||||
Count mtLog_CmpFreeMemory=1
|
||||
mtLog_CmpFreeMemory0="Free Memory"
|
||||
Count mtLog_CmpTotalDisk=1
|
||||
mtLog_CmpTotalDisk0="Total Disk"
|
||||
Count mtLog_CmpFreeDisk=1
|
||||
mtLog_CmpFreeDisk0="Free Disk"
|
||||
Count mtLog_CmpSystemUpTime=1
|
||||
mtLog_CmpSystemUpTime0="System Up Time"
|
||||
Count mtLog_CmpProcessor=1
|
||||
mtLog_CmpProcessor0="Processor"
|
||||
Count mtLog_CmpDisplayMode=1
|
||||
mtLog_CmpDisplayMode0="Display Mode"
|
||||
Count mtLog_OSHeader=1
|
||||
mtLog_OSHeader0="Operating System"
|
||||
Count mtLog_OSType=1
|
||||
mtLog_OSType0="Type"
|
||||
Count mtLog_OSBuildN=1
|
||||
mtLog_OSBuildN0="Build #"
|
||||
Count mtLog_OSUpdate=1
|
||||
mtLog_OSUpdate0="Update"
|
||||
Count mtLog_OSLanguage=1
|
||||
mtLog_OSLanguage0="Language"
|
||||
Count mtLog_NetHeader=1
|
||||
mtLog_NetHeader0="Network"
|
||||
Count mtLog_NetIP=1
|
||||
mtLog_NetIP0="IP Address"
|
||||
Count mtLog_NetSubmask=1
|
||||
mtLog_NetSubmask0="Submask"
|
||||
Count mtLog_NetGateway=1
|
||||
mtLog_NetGateway0="Gateway"
|
||||
Count mtLog_NetDNS1=1
|
||||
mtLog_NetDNS10="DNS 1"
|
||||
Count mtLog_NetDNS2=1
|
||||
mtLog_NetDNS20="DNS 2"
|
||||
Count mtLog_NetDHCP=1
|
||||
mtLog_NetDHCP0="DHCP"
|
||||
Count mtLog_CustInfoHeader=1
|
||||
mtLog_CustInfoHeader0="Custom Information"
|
||||
Count mtCallStack_Address=1
|
||||
mtCallStack_Address0="Address"
|
||||
Count mtCallStack_Name=1
|
||||
mtCallStack_Name0="Module"
|
||||
Count mtCallStack_Unit=1
|
||||
mtCallStack_Unit0="Unit"
|
||||
Count mtCallStack_Class=1
|
||||
mtCallStack_Class0="Class"
|
||||
Count mtCallStack_Procedure=1
|
||||
mtCallStack_Procedure0="Procedure/Method"
|
||||
Count mtCallStack_Line=1
|
||||
mtCallStack_Line0="Line"
|
||||
Count mtCallStack_MainThread=1
|
||||
mtCallStack_MainThread0="Main"
|
||||
Count mtCallStack_ExceptionThread=1
|
||||
mtCallStack_ExceptionThread0="Exception Thread"
|
||||
Count mtCallStack_RunningThread=1
|
||||
mtCallStack_RunningThread0="Running Thread"
|
||||
Count mtCallStack_CallingThread=1
|
||||
mtCallStack_CallingThread0="Calling Thread"
|
||||
Count mtCallStack_ThreadID=1
|
||||
mtCallStack_ThreadID0="ID"
|
||||
Count mtCallStack_ThreadPriority=1
|
||||
mtCallStack_ThreadPriority0="Priority"
|
||||
Count mtCallStack_ThreadClass=1
|
||||
mtCallStack_ThreadClass0="Class"
|
||||
Count mtSendDialog_Caption=1
|
||||
mtSendDialog_Caption0="Send."
|
||||
Count mtSendDialog_Message=1
|
||||
mtSendDialog_Message0="Message"
|
||||
Count mtSendDialog_Resolving=1
|
||||
mtSendDialog_Resolving0="Resolving DNS..."
|
||||
Count mtSendDialog_Connecting=1
|
||||
mtSendDialog_Connecting0="Connecting with server..."
|
||||
Count mtSendDialog_Connected=1
|
||||
mtSendDialog_Connected0="Connected with server."
|
||||
Count mtSendDialog_Sending=1
|
||||
mtSendDialog_Sending0="Sending message..."
|
||||
Count mtReproduceDialog_Caption=1
|
||||
mtReproduceDialog_Caption0="Request"
|
||||
Count mtReproduceDialog_Request=1
|
||||
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
|
||||
Count mtReproduceDialog_OKButtonCaption=1
|
||||
mtReproduceDialog_OKButtonCaption0="%26OK"
|
||||
Count mtModules_Handle=1
|
||||
mtModules_Handle0="Handle"
|
||||
Count mtModules_Name=1
|
||||
mtModules_Name0="Name"
|
||||
Count mtModules_Description=1
|
||||
mtModules_Description0="Description"
|
||||
Count mtModules_Version=1
|
||||
mtModules_Version0="Version"
|
||||
Count mtModules_Size=1
|
||||
mtModules_Size0="Size"
|
||||
Count mtModules_LastModified=1
|
||||
mtModules_LastModified0="Modified"
|
||||
Count mtModules_Path=1
|
||||
mtModules_Path0="Path"
|
||||
Count mtCPU_Registers=1
|
||||
mtCPU_Registers0="Registers"
|
||||
Count mtCPU_Stack=1
|
||||
mtCPU_Stack0="Stack"
|
||||
Count mtCPU_MemoryDump=1
|
||||
mtCPU_MemoryDump0="Memory Dump"
|
||||
Count mtSend_SuccessMsg=1
|
||||
mtSend_SuccessMsg0="The message was sent successfully."
|
||||
Count mtSend_FailureMsg=1
|
||||
mtSend_FailureMsg0="Sorry, sending the message didn't work."
|
||||
EurekaLog Last Line -->
|
||||
</BorlandProject>
|
||||
39
Source/Base/Empresas/Test/Empresas_Tests.dpr
Normal file
39
Source/Base/Empresas/Test/Empresas_Tests.dpr
Normal file
@ -0,0 +1,39 @@
|
||||
program Empresas_Tests;
|
||||
{
|
||||
|
||||
Delphi DUnit Test Project
|
||||
-------------------------
|
||||
This project contains the DUnit test framework and the GUI/Console test runners.
|
||||
Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
|
||||
to use the console test runner. Otherwise the GUI test runner will be used by
|
||||
default.
|
||||
|
||||
}
|
||||
|
||||
{$IFDEF CONSOLE_TESTRUNNER}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
|
||||
uses
|
||||
ExceptionLog,
|
||||
Forms,
|
||||
TestFramework,
|
||||
GUITestRunner,
|
||||
TextTestRunner,
|
||||
uEmpresasController_Test in 'uEmpresasController_Test.pas',
|
||||
uHostMainForm in 'uHostMainForm.pas' {HostMainForm};
|
||||
|
||||
{$R *.RES}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(THostMainForm, HostMainForm);
|
||||
Application.Run;
|
||||
Application.Terminate;
|
||||
|
||||
{if IsConsole then
|
||||
TextTestRunner.RunRegisteredTests
|
||||
else
|
||||
GUITestRunner.RunRegisteredTests;}
|
||||
end.
|
||||
|
||||
14
Source/Base/Empresas/Test/Empresas_Tests.drc
Normal file
14
Source/Base/Empresas/Test/Empresas_Tests.drc
Normal file
@ -0,0 +1,14 @@
|
||||
/* VER180
|
||||
Generated by the Borland Delphi Pascal Compiler
|
||||
because -GD or --drc was supplied to the compiler.
|
||||
|
||||
This file contains compiler-generated resources that
|
||||
were bound to the executable.
|
||||
If this file is empty, then no compiler-generated
|
||||
resources were bound to the produced executable.
|
||||
*/
|
||||
|
||||
STRINGTABLE
|
||||
BEGIN
|
||||
END
|
||||
|
||||
BIN
Source/Base/Empresas/Test/Empresas_Tests.res
Normal file
BIN
Source/Base/Empresas/Test/Empresas_Tests.res
Normal file
Binary file not shown.
178
Source/Base/Empresas/Test/uEmpresasController_Test.pas
Normal file
178
Source/Base/Empresas/Test/uEmpresasController_Test.pas
Normal file
@ -0,0 +1,178 @@
|
||||
unit uEmpresasController_Test;
|
||||
{
|
||||
|
||||
Delphi DUnit Test Case
|
||||
----------------------
|
||||
This unit contains a skeleton test case class generated by the Test Case Wizard.
|
||||
Modify the generated code to correctly setup and call the methods from the unit
|
||||
being tested.
|
||||
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TestFramework, Classes, uEmpresasController, Contnrs, SysUtils, uIDataModuleEmpresas,
|
||||
Forms, Windows, Controls, uBizEmpresas;
|
||||
type
|
||||
// Test methods for class TEmpresasController
|
||||
|
||||
TestTEmpresasController = class(TTestCase)
|
||||
strict private
|
||||
FEmpresasController: TEmpresasController;
|
||||
public
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
published
|
||||
procedure TestEliminar;
|
||||
procedure TestEliminar1;
|
||||
procedure TestGuardar;
|
||||
procedure TestDescartarCambios;
|
||||
procedure TestExiste;
|
||||
procedure TestAnadir;
|
||||
procedure TestBuscar;
|
||||
procedure TestBuscarTodos;
|
||||
procedure TestNuevo;
|
||||
procedure TestVer;
|
||||
procedure TestVerTodos;
|
||||
procedure TestToStringList;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TestTEmpresasController.SetUp;
|
||||
begin
|
||||
FEmpresasController := TEmpresasController.Create;
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TearDown;
|
||||
begin
|
||||
FEmpresasController.Free;
|
||||
FEmpresasController := nil;
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestEliminar;
|
||||
var
|
||||
ID: Integer;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.Eliminar(ID);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestEliminar1;
|
||||
var
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.Eliminar(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestGuardar;
|
||||
var
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.Guardar(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestDescartarCambios;
|
||||
var
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.DescartarCambios(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestExiste;
|
||||
var
|
||||
ReturnValue: Boolean;
|
||||
ID: Integer;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
ReturnValue := FEmpresasController.Existe(ID);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestAnadir;
|
||||
var
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.Anadir(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestBuscar;
|
||||
var
|
||||
ReturnValue: IBizEmpresa;
|
||||
ID: Integer;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
ReturnValue := FEmpresasController.Buscar(ID);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestBuscarTodos;
|
||||
var
|
||||
ReturnValue: IBizEmpresa;
|
||||
begin
|
||||
ReturnValue := FEmpresasController.BuscarTodos;
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestNuevo;
|
||||
var
|
||||
ReturnValue: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
ReturnValue := FEmpresasController.Nuevo;
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestVer;
|
||||
var
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.Ver(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestVerTodos;
|
||||
var
|
||||
AEmpresas: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
FEmpresasController.VerTodos(AEmpresas);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
procedure TestTEmpresasController.TestToStringList;
|
||||
var
|
||||
ReturnValue: TStringList;
|
||||
AEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Check(False);
|
||||
// TODO: Setup method call parameters
|
||||
ReturnValue := FEmpresasController.ToStringList(AEmpresa);
|
||||
// TODO: Validate method results
|
||||
end;
|
||||
|
||||
initialization
|
||||
// Register any test cases with the test runner
|
||||
RegisterTest(TestTEmpresasController.Suite);
|
||||
end.
|
||||
|
||||
28
Source/Base/Empresas/Test/uHostMainForm.dfm
Normal file
28
Source/Base/Empresas/Test/uHostMainForm.dfm
Normal file
@ -0,0 +1,28 @@
|
||||
object HostMainForm: THostMainForm
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'HostMainForm'
|
||||
ClientHeight = 598
|
||||
ClientWidth = 690
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
OnCloseQuery = FormCloseQuery
|
||||
OnShow = FormShow
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 690
|
||||
Height = 598
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
116
Source/Base/Empresas/Test/uHostMainForm.pas
Normal file
116
Source/Base/Empresas/Test/uHostMainForm.pas
Normal file
@ -0,0 +1,116 @@
|
||||
unit uHostMainForm;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, uGUIBase, ExtCtrls, uCustomEditor, cxControls;
|
||||
|
||||
type
|
||||
THostMainForm = class(TForm, IHostForm)
|
||||
Panel1: TPanel;
|
||||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
procedure FormShow(Sender: TObject);
|
||||
protected
|
||||
FContenido : TCustomEditor;
|
||||
function GetWorkPanel: TWinControl;
|
||||
procedure OnWorkPanelChanged(AEditor : ICustomEditor);
|
||||
procedure ShowEmbedded(AEditor : ICustomEditor);
|
||||
procedure ReleaseEmbedded;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property WorkPanel: TWinControl read GetWorkPanel;
|
||||
end;
|
||||
|
||||
var
|
||||
HostMainForm: THostMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
TestFramework, GUITestRunner, TextTestRunner;
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
constructor THostMainForm.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FContenido := NIL;
|
||||
end;
|
||||
|
||||
destructor THostMainForm.Destroy;
|
||||
begin
|
||||
ReleaseEmbedded;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THostMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
begin
|
||||
CanClose := True;
|
||||
if Assigned(FContenido) then
|
||||
CanClose := FContenido.CloseQuery;
|
||||
end;
|
||||
|
||||
procedure THostMainForm.FormShow(Sender: TObject);
|
||||
begin
|
||||
if IsConsole then
|
||||
TextTestRunner.RunRegisteredTests
|
||||
else
|
||||
GUITestRunner.RunRegisteredTestsModeless;
|
||||
Self.SendToBack;
|
||||
end;
|
||||
|
||||
function THostMainForm.GetWorkPanel: TWinControl;
|
||||
begin
|
||||
Result := Panel1;
|
||||
end;
|
||||
|
||||
procedure THostMainForm.OnWorkPanelChanged(AEditor: ICustomEditor);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure THostMainForm.ReleaseEmbedded;
|
||||
begin
|
||||
if Assigned(FContenido) then
|
||||
FContenido.Release;
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
procedure THostMainForm.ShowEmbedded(AEditor: ICustomEditor);
|
||||
begin
|
||||
if Assigned(FContenido) then
|
||||
if not FContenido.CloseQuery then
|
||||
begin
|
||||
AEditor.Release;
|
||||
AEditor := NIL;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ShowHourglassCursor;
|
||||
LockWindowUpdate(Handle);
|
||||
try
|
||||
FContenido := AEditor.GetInstance as TCustomEditor;
|
||||
with (FContenido) do
|
||||
begin
|
||||
Visible := False;
|
||||
BorderIcons := [];
|
||||
BorderStyle := bsNone;
|
||||
Parent := WorkPanel;
|
||||
FContenido.Show;
|
||||
Align := alClient;
|
||||
FContenido.SetFocus;
|
||||
end;
|
||||
finally
|
||||
Application.ProcessMessages;
|
||||
LockWindowUpdate(0);
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
OnWorkPanelChanged(FContenido);
|
||||
end;
|
||||
|
||||
end.
|
||||
181
Source/Base/Empresas/Views/uEditorDatosBancariosEmpresa.dfm
Normal file
181
Source/Base/Empresas/Views/uEditorDatosBancariosEmpresa.dfm
Normal file
@ -0,0 +1,181 @@
|
||||
object fEditorDatosBancariosEmpresa: TfEditorDatosBancariosEmpresa
|
||||
Left = 227
|
||||
Top = 108
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Cambio de datos bancarios'
|
||||
ClientHeight = 292
|
||||
ClientWidth = 433
|
||||
Color = clBtnFace
|
||||
ParentFont = True
|
||||
OldCreateOrder = True
|
||||
Position = poOwnerFormCenter
|
||||
DesignSize = (
|
||||
433
|
||||
292)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object OKBtn: TButton
|
||||
Left = 350
|
||||
Top = 7
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = '&Guardar'
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
object CancelBtn: TButton
|
||||
Left = 350
|
||||
Top = 38
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akTop, akRight]
|
||||
Cancel = True
|
||||
Caption = '&Cancelar'
|
||||
ModalResult = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 329
|
||||
Height = 176
|
||||
Caption = 'Datos bancarios'
|
||||
TabOrder = 2
|
||||
object Label5: TLabel
|
||||
Left = 12
|
||||
Top = 31
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'Banco:'
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 12
|
||||
Top = 67
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'C'#243'd. entidad:'
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 12
|
||||
Top = 94
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'C'#243'd. sucursal:'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 12
|
||||
Top = 120
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'DC:'
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 11
|
||||
Top = 146
|
||||
Width = 78
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'Cuenta:'
|
||||
end
|
||||
object eNombre: TDBEdit
|
||||
Left = 95
|
||||
Top = 28
|
||||
Width = 223
|
||||
Height = 21
|
||||
Color = clInfoBk
|
||||
DataField = 'NOMBRE'
|
||||
DataSource = dsDatosBancarios
|
||||
TabOrder = 0
|
||||
end
|
||||
object eCodEntidad: TDBEdit
|
||||
Left = 95
|
||||
Top = 64
|
||||
Width = 74
|
||||
Height = 21
|
||||
DataField = 'ENTIDAD'
|
||||
DataSource = dsDatosBancarios
|
||||
TabOrder = 1
|
||||
end
|
||||
object eCodSucursal: TDBEdit
|
||||
Left = 95
|
||||
Top = 90
|
||||
Width = 74
|
||||
Height = 21
|
||||
DataField = 'SUCURSAL'
|
||||
DataSource = dsDatosBancarios
|
||||
TabOrder = 2
|
||||
end
|
||||
object eDC: TDBEdit
|
||||
Left = 95
|
||||
Top = 116
|
||||
Width = 74
|
||||
Height = 21
|
||||
DataField = 'DC'
|
||||
DataSource = dsDatosBancarios
|
||||
MaxLength = 2
|
||||
TabOrder = 3
|
||||
end
|
||||
object eCuenta: TDBEdit
|
||||
Left = 95
|
||||
Top = 142
|
||||
Width = 223
|
||||
Height = 21
|
||||
DataField = 'CUENTA'
|
||||
DataSource = dsDatosBancarios
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 8
|
||||
Top = 190
|
||||
Width = 329
|
||||
Height = 83
|
||||
Caption = 'Sufijos para normas CSB'
|
||||
TabOrder = 3
|
||||
object Label7: TLabel
|
||||
Left = 12
|
||||
Top = 28
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'Norma 19:'
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 12
|
||||
Top = 55
|
||||
Width = 77
|
||||
Height = 13
|
||||
AutoSize = False
|
||||
Caption = 'Norma 58:'
|
||||
end
|
||||
object eNorma19: TDBEdit
|
||||
Left = 95
|
||||
Top = 24
|
||||
Width = 74
|
||||
Height = 21
|
||||
DataField = 'SUFIJO_N19'
|
||||
DataSource = dsDatosBancarios
|
||||
MaxLength = 3
|
||||
TabOrder = 0
|
||||
end
|
||||
object eNorma58: TDBEdit
|
||||
Left = 95
|
||||
Top = 51
|
||||
Width = 74
|
||||
Height = 21
|
||||
DataField = 'SUFIJO_N58'
|
||||
DataSource = dsDatosBancarios
|
||||
MaxLength = 3
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object dsDatosBancarios: TDADataSource
|
||||
Left = 352
|
||||
Top = 72
|
||||
end
|
||||
end
|
||||
97
Source/Base/Empresas/Views/uEditorDatosBancariosEmpresa.pas
Normal file
97
Source/Base/Empresas/Views/uEditorDatosBancariosEmpresa.pas
Normal file
@ -0,0 +1,97 @@
|
||||
unit uEditorDatosBancariosEmpresa;
|
||||
|
||||
interface
|
||||
|
||||
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
|
||||
Buttons, ExtCtrls, Mask, DBCtrls, DB, uDADataTable, PngSpeedButton,
|
||||
cxControls, cxContainer, cxEdit, cxTextEdit, cxHyperLinkEdit, cxDBEdit,
|
||||
uIEditorDatosBancarioEmpresa, uDatosBancariosEmpresaController, uBizEmpresasDatosBancarios,
|
||||
cxCurrencyEdit;
|
||||
|
||||
type
|
||||
TfEditorDatosBancariosEmpresa = class(TForm, IEditorDatosBancariosEmpresa)
|
||||
OKBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
dsDatosBancarios: TDADataSource;
|
||||
GroupBox1: TGroupBox;
|
||||
Label5: TLabel;
|
||||
eNombre: TDBEdit;
|
||||
Label2: TLabel;
|
||||
eCodEntidad: TDBEdit;
|
||||
Label3: TLabel;
|
||||
eCodSucursal: TDBEdit;
|
||||
Label4: TLabel;
|
||||
eDC: TDBEdit;
|
||||
Label6: TLabel;
|
||||
eCuenta: TDBEdit;
|
||||
GroupBox2: TGroupBox;
|
||||
Label7: TLabel;
|
||||
eNorma19: TDBEdit;
|
||||
Label1: TLabel;
|
||||
eNorma58: TDBEdit;
|
||||
protected
|
||||
FController : IDatosBancariosEmpresaController;
|
||||
FDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
|
||||
function GetController : IDatosBancariosEmpresaController;
|
||||
procedure SetController (const Value : IDatosBancariosEmpresaController);
|
||||
|
||||
function GetDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
procedure SetDatosBancarios(const Value: IBizEmpresasDatosBancarios);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property DatosBancarios: IBizEmpresasDatosBancarios read GetDatosBancarios write SetDatosBancarios;
|
||||
property Controller : IDatosBancariosEmpresaController read GetController
|
||||
write SetController;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Variants;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
{ TfEditorDireccion }
|
||||
|
||||
constructor TfEditorDatosBancariosEmpresa.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FController := NIL;
|
||||
end;
|
||||
|
||||
destructor TfEditorDatosBancariosEmpresa.Destroy;
|
||||
begin
|
||||
FController := NIL;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TfEditorDatosBancariosEmpresa.GetController: IDatosBancariosEmpresaController;
|
||||
begin
|
||||
Result := FController;
|
||||
end;
|
||||
|
||||
function TfEditorDatosBancariosEmpresa.GetDatosBancarios: IBizEmpresasDatosBancarios;
|
||||
begin
|
||||
Result := FDatosBancarios;
|
||||
end;
|
||||
|
||||
procedure TfEditorDatosBancariosEmpresa.SetController(
|
||||
const Value: IDatosBancariosEmpresaController);
|
||||
begin
|
||||
FController := Value;
|
||||
end;
|
||||
|
||||
procedure TfEditorDatosBancariosEmpresa.SetDatosBancarios(
|
||||
const Value: IBizEmpresasDatosBancarios);
|
||||
begin
|
||||
FDatosBancarios := Value;
|
||||
if Assigned(FDatosBancarios) then
|
||||
dsDatosBancarios.DataTable := FDatosBancarios.DataTable
|
||||
else
|
||||
dsDatosBancarios.DataTable := NIL;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
336
Source/Base/Empresas/Views/uEditorEmpresa.dfm
Normal file
336
Source/Base/Empresas/Views/uEditorEmpresa.dfm
Normal file
@ -0,0 +1,336 @@
|
||||
inherited fEditorEmpresa: TfEditorEmpresa
|
||||
Left = 575
|
||||
Top = 291
|
||||
HorzScrollBar.Visible = False
|
||||
VertScrollBar.Visible = False
|
||||
Caption = 'Ficha de empresa'
|
||||
ClientHeight = 554
|
||||
ClientWidth = 674
|
||||
Scaled = False
|
||||
ExplicitWidth = 682
|
||||
ExplicitHeight = 588
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
inherited JvNavPanelHeader: TJvNavPanelHeader
|
||||
Width = 674
|
||||
Caption = 'Empresa'
|
||||
ExplicitWidth = 660
|
||||
inherited Image1: TImage
|
||||
Left = 647
|
||||
ExplicitLeft = 607
|
||||
end
|
||||
end
|
||||
inherited TBXDock: TTBXDock
|
||||
Width = 674
|
||||
ExplicitWidth = 660
|
||||
inherited tbxMain: TTBXToolbar
|
||||
ExplicitWidth = 324
|
||||
inherited TBXItem2: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem5: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem23: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem3: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
inherited tbxMenu: TTBXToolbar
|
||||
DockPos = 0
|
||||
ExplicitWidth = 674
|
||||
inherited TBXSubmenuItem4: TTBXSubmenuItem
|
||||
inherited TBXItem8: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXSeparatorItem5: TTBXSeparatorItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem10: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem21: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem22: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem9: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
inherited TBXSubmenuItem1: TTBXSubmenuItem
|
||||
inherited TBXItem32: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXItem31: TTBXItem
|
||||
Visible = False
|
||||
end
|
||||
inherited TBXSeparatorItem13: TTBXSeparatorItem
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
inherited pgPaginas: TPageControl
|
||||
Width = 674
|
||||
Height = 459
|
||||
ExplicitWidth = 660
|
||||
ExplicitHeight = 451
|
||||
inherited pagGeneral: TTabSheet
|
||||
ExplicitLeft = 4
|
||||
ExplicitTop = 24
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 423
|
||||
inline frViewEmpresa1: TfrViewEmpresa
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 666
|
||||
Height = 431
|
||||
Align = alClient
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
ReadOnly = False
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 423
|
||||
inherited dxLayoutControl1: TdxLayoutControl
|
||||
Width = 666
|
||||
Height = 431
|
||||
LookAndFeel = dxLayoutOfficeLookAndFeel1
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 423
|
||||
inherited PngSpeedButton1: TPngSpeedButton
|
||||
Left = 621
|
||||
Top = 295
|
||||
ExplicitLeft = 621
|
||||
ExplicitTop = 295
|
||||
end
|
||||
inherited PngSpeedButton2: TPngSpeedButton
|
||||
Left = 621
|
||||
Top = 267
|
||||
ExplicitLeft = 621
|
||||
ExplicitTop = 267
|
||||
end
|
||||
inherited eCalle: TcxDBTextEdit
|
||||
Top = 189
|
||||
ExplicitTop = 189
|
||||
ExplicitWidth = 84
|
||||
Width = 84
|
||||
end
|
||||
inherited eProvincia: TcxDBTextEdit
|
||||
Top = 243
|
||||
ExplicitTop = 243
|
||||
ExplicitWidth = 60
|
||||
Width = 60
|
||||
end
|
||||
inherited ePoblacion: TcxDBTextEdit
|
||||
Top = 216
|
||||
ExplicitTop = 216
|
||||
ExplicitWidth = 100
|
||||
Width = 100
|
||||
end
|
||||
inherited eCodigoPostal: TcxDBTextEdit
|
||||
Left = 289
|
||||
Top = 216
|
||||
ExplicitLeft = 289
|
||||
ExplicitTop = 216
|
||||
end
|
||||
inherited ePaginaWeb: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 216
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 216
|
||||
ExplicitWidth = 165
|
||||
Width = 165
|
||||
end
|
||||
inherited eMailParticular: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 189
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 189
|
||||
ExplicitWidth = 165
|
||||
Width = 165
|
||||
end
|
||||
inherited eMailTrabajo: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 162
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 162
|
||||
ExplicitWidth = 129
|
||||
Width = 129
|
||||
end
|
||||
inherited cxDBMemo1: TcxDBMemo
|
||||
Top = 294
|
||||
ExplicitTop = 294
|
||||
ExplicitWidth = 107
|
||||
ExplicitHeight = 234
|
||||
Height = 234
|
||||
Width = 107
|
||||
end
|
||||
inherited eTlfParticular: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 57
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 57
|
||||
ExplicitWidth = 91
|
||||
Width = 91
|
||||
end
|
||||
inherited eTlfTrabajo: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 30
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 30
|
||||
ExplicitWidth = 127
|
||||
Width = 127
|
||||
end
|
||||
inherited eTlfMovil: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 84
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 84
|
||||
ExplicitWidth = 155
|
||||
Width = 155
|
||||
end
|
||||
inherited eFax: TcxDBTextEdit
|
||||
Left = 477
|
||||
Top = 111
|
||||
ExplicitLeft = 477
|
||||
ExplicitTop = 111
|
||||
ExplicitWidth = 121
|
||||
Width = 121
|
||||
end
|
||||
inherited eNombre: TcxDBTextEdit
|
||||
Top = 30
|
||||
ExplicitTop = 30
|
||||
ExplicitWidth = 108
|
||||
Width = 108
|
||||
end
|
||||
inherited eNIFCIF: TcxDBTextEdit
|
||||
Top = 57
|
||||
ExplicitTop = 57
|
||||
ExplicitWidth = 108
|
||||
Width = 108
|
||||
end
|
||||
inherited memRegistroMercantil: TcxDBMemo
|
||||
Top = 84
|
||||
ExplicitTop = 84
|
||||
ExplicitWidth = 76
|
||||
Width = 76
|
||||
end
|
||||
inherited cxDBSpinEdit1: TcxDBSpinEdit
|
||||
Top = 138
|
||||
ExplicitTop = 138
|
||||
end
|
||||
inherited cxDBImage1: TcxDBImage
|
||||
Left = 382
|
||||
Top = 267
|
||||
ExplicitLeft = 382
|
||||
ExplicitTop = 267
|
||||
ExplicitWidth = 140
|
||||
ExplicitHeight = 100
|
||||
Height = 100
|
||||
Width = 140
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet1: TTabSheet
|
||||
Caption = 'Datos bancarios'
|
||||
ImageIndex = 1
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 423
|
||||
inline frViewDatosBancarios1: TfrViewDatosBancarios
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 666
|
||||
Height = 431
|
||||
Align = alClient
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
ReadOnly = False
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 423
|
||||
inherited cxGrid: TcxGrid
|
||||
Width = 666
|
||||
Height = 406
|
||||
ExplicitWidth = 652
|
||||
ExplicitHeight = 398
|
||||
end
|
||||
inherited ToolBar1: TToolBar
|
||||
Width = 666
|
||||
ExplicitWidth = 666
|
||||
inherited ToolButton1: TToolButton
|
||||
ExplicitWidth = 62
|
||||
end
|
||||
inherited ToolButton4: TToolButton
|
||||
ExplicitWidth = 74
|
||||
end
|
||||
inherited ToolButton2: TToolButton
|
||||
ExplicitWidth = 67
|
||||
end
|
||||
inherited ToolButton7: TToolButton
|
||||
ExplicitWidth = 117
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
inherited StatusBar: TJvStatusBar
|
||||
Top = 535
|
||||
Width = 674
|
||||
Panels = <
|
||||
item
|
||||
Width = 200
|
||||
end>
|
||||
ExplicitTop = 527
|
||||
ExplicitWidth = 660
|
||||
end
|
||||
inherited EditorActionList: TActionList
|
||||
Top = 128
|
||||
end
|
||||
inherited SmallImages: TPngImageList
|
||||
Left = 403
|
||||
Top = 176
|
||||
end
|
||||
inherited dsDataTable: TDADataSource [6]
|
||||
Left = 168
|
||||
Top = 120
|
||||
end
|
||||
inherited LargeImages: TPngImageList [7]
|
||||
Left = 435
|
||||
Top = 176
|
||||
end
|
||||
inherited JvFormStorage: TJvFormStorage [8]
|
||||
Left = 408
|
||||
Top = 208
|
||||
end
|
||||
inherited JvAppRegistryStorage: TJvAppRegistryStorage
|
||||
Left = 440
|
||||
Top = 208
|
||||
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
|
||||
183
Source/Base/Empresas/Views/uEditorEmpresa.pas
Normal file
183
Source/Base/Empresas/Views/uEditorEmpresa.pas
Normal file
@ -0,0 +1,183 @@
|
||||
unit uEditorEmpresa;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, uEditorDBItem, ToolWin, ComCtrls, JvExControls, JvComponent,
|
||||
uBizEmpresas, JvNavigationPane, ActnList,
|
||||
uEditorBase, StdActns, TB2Dock, TB2Toolbar, TBX, ImgList, PngImageList,
|
||||
TB2Item, uEditorItem, DB, uDADataTable, uEditorDBBase, JvFormAutoSize,
|
||||
uDAScriptingProvider, uDACDSDataTable, StdCtrls, pngimage, ExtCtrls,
|
||||
TBXDkPanels, JvButton, AppEvnts, uCustomView, uViewBase,
|
||||
JvAppStorage, JvAppRegistryStorage, JvFormPlacement, JvComponentBase,
|
||||
uViewEmpresa, uIEditorEmpresa, uEmpresasController, dxLayoutLookAndFeels,
|
||||
JvExComCtrls, JvStatusBar, uViewDetallesGenerico, uViewDatosBancarios;
|
||||
|
||||
type
|
||||
TfEditorEmpresa = class(TfEditorDBItem, IEditorEmpresa)
|
||||
frViewEmpresa1: TfrViewEmpresa;
|
||||
dxLayoutLookAndFeelList1: TdxLayoutLookAndFeelList;
|
||||
dxLayoutOfficeLookAndFeel1: TdxLayoutOfficeLookAndFeel;
|
||||
TabSheet1: TTabSheet;
|
||||
frViewDatosBancarios1: TfrViewDatosBancarios;
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure actRefrescarUpdate(Sender: TObject);
|
||||
procedure dsDataTableDataChange(Sender: TObject; Field: TField);
|
||||
private
|
||||
FController : IEmpresasController;
|
||||
FEmpresa: IBizEmpresa;
|
||||
FViewEmpresa : IViewEmpresa;
|
||||
protected
|
||||
function GetEmpresa: IBizEmpresa; virtual;
|
||||
procedure SetEmpresa(const Value: IBizEmpresa); virtual;
|
||||
|
||||
function GetViewEmpresa: IViewEmpresa;
|
||||
procedure SetViewEmpresa(const Value: IViewEmpresa);
|
||||
procedure GuardarInterno; override;
|
||||
procedure EliminarInterno; override;
|
||||
property ViewEmpresa: IViewEmpresa read GetViewEmpresa write
|
||||
SetViewEmpresa;
|
||||
function GetController : IEmpresasController; virtual;
|
||||
procedure SetController (const Value : IEmpresasController); virtual;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure PonerTitulos(const ATitulo: string = ''); override;
|
||||
property Controller : IEmpresasController read GetController
|
||||
write SetController;
|
||||
property Empresa: IBizEmpresa read GetEmpresa write SetEmpresa;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
uCustomEditor, uDataModuleEmpresas, uDataModuleBase;
|
||||
|
||||
{
|
||||
******************************* TfEditorEmpresa *******************************
|
||||
}
|
||||
function TfEditorEmpresa.GetEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Result := FEmpresa;
|
||||
end;
|
||||
|
||||
function TfEditorEmpresa.GetController: IEmpresasController;
|
||||
begin
|
||||
Result := FController;
|
||||
end;
|
||||
|
||||
function TfEditorEmpresa.GetViewEmpresa: IViewEmpresa;
|
||||
begin
|
||||
Result := FViewEmpresa;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.GuardarInterno;
|
||||
begin
|
||||
inherited;
|
||||
FController.Guardar(FEmpresa);
|
||||
Modified := False;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.PonerTitulos(const ATitulo: string);
|
||||
var
|
||||
FTitulo : String;
|
||||
begin
|
||||
if (ATitulo = '') and Assigned(FEmpresa) then
|
||||
begin
|
||||
if Length(FEmpresa.Nombre) = 0 then
|
||||
FTitulo := 'Nueva empresa'
|
||||
else
|
||||
FTitulo := 'Empresa' + ' - ' + FEmpresa.Nombre
|
||||
end;
|
||||
|
||||
inherited PonerTitulos(FTitulo);
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.SetEmpresa(const Value: IBizEmpresa);
|
||||
begin
|
||||
FEmpresa := Value;
|
||||
dsDataTable.DataTable := FEmpresa.DataTable;
|
||||
|
||||
if Assigned(FViewEmpresa) and Assigned(Empresa) then
|
||||
begin
|
||||
FViewEmpresa.Empresa := FEmpresa;
|
||||
frViewDatosBancarios1.dsDetalles.DataTable := FEmpresa.DatosBancarios.DataTable
|
||||
end
|
||||
else begin
|
||||
FViewEmpresa.Empresa := NIL;
|
||||
frViewDatosBancarios1.dsDetalles.DataTable := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.SetController(const Value: IEmpresasController);
|
||||
begin
|
||||
FController := Value;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.SetViewEmpresa(const Value: IViewEmpresa);
|
||||
begin
|
||||
FViewEmpresa := Value;
|
||||
|
||||
if Assigned(FViewEmpresa) and Assigned(Empresa) then
|
||||
FViewEmpresa.Empresa := Empresa;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.FormShow(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
if not Assigned(FViewEmpresa) then
|
||||
raise Exception.Create('No hay ninguna vista asignada');
|
||||
|
||||
if not Assigned(Empresa) then
|
||||
raise Exception.Create('No hay ningún Empresa asignado');
|
||||
|
||||
Empresa.DataTable.Active := True;
|
||||
// FViewEmpresa.ShowEmbedded(pagGeneral);
|
||||
FViewEmpresa.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.actRefrescarUpdate(Sender: TObject);
|
||||
begin
|
||||
if Assigned(dsDataTable.DataTable) then
|
||||
(Sender as TAction).Enabled := (not dsDataTable.DataTable.Fetching) or
|
||||
(not dsDataTable.DataTable.Opening) or
|
||||
(not dsDataTable.DataTable.Closing) or
|
||||
(not FEmpresa.EsNuevo)
|
||||
else
|
||||
(Sender as TAction).Enabled := False;
|
||||
end;
|
||||
|
||||
constructor TfEditorEmpresa.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FViewEmpresa := frViewEmpresa1;
|
||||
end;
|
||||
|
||||
destructor TfEditorEmpresa.Destroy;
|
||||
begin
|
||||
FViewEmpresa := NIL;
|
||||
FEmpresa := NIL;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.dsDataTableDataChange(Sender: TObject; Field: TField);
|
||||
begin
|
||||
inherited;
|
||||
if Assigned(FEmpresa) and (not (FEmpresa.DataTable.Fetching) or
|
||||
not (FEmpresa.DataTable.Opening) or not (FEmpresa.DataTable.Closing)) then
|
||||
PonerTitulos;
|
||||
end;
|
||||
|
||||
procedure TfEditorEmpresa.EliminarInterno;
|
||||
begin
|
||||
inherited;
|
||||
FController.Eliminar(FEmpresa);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
25
Source/Base/Empresas/Views/uEmpresasViewRegister.pas
Normal file
25
Source/Base/Empresas/Views/uEmpresasViewRegister.pas
Normal file
@ -0,0 +1,25 @@
|
||||
unit uEmpresasViewRegister;
|
||||
|
||||
interface
|
||||
|
||||
procedure RegisterViews;
|
||||
procedure UnregisterViews;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uEditorRegistryUtils, uEditorEmpresa, uEditorDatosBancariosEmpresa;
|
||||
|
||||
procedure RegisterViews;
|
||||
begin
|
||||
EditorRegistry.RegisterClass(TfEditorEmpresa, 'EditorEmpresa');
|
||||
EditorRegistry.RegisterClass(TfEditorDatosBancariosEmpresa, 'EditorDatosBancariosEmpresa');
|
||||
end;
|
||||
|
||||
procedure UnregisterViews;
|
||||
begin
|
||||
EditorRegistry.UnRegisterClass(TfEditorEmpresa);
|
||||
EditorRegistry.UnRegisterClass(TfEditorDatosBancariosEmpresa);
|
||||
end;
|
||||
|
||||
end.
|
||||
52
Source/Base/Empresas/Views/uViewDatosBancarios.dfm
Normal file
52
Source/Base/Empresas/Views/uViewDatosBancarios.dfm
Normal file
@ -0,0 +1,52 @@
|
||||
inherited frViewDatosBancarios: TfrViewDatosBancarios
|
||||
Width = 583
|
||||
Height = 464
|
||||
ExplicitWidth = 583
|
||||
ExplicitHeight = 464
|
||||
inherited cxGrid: TcxGrid
|
||||
Width = 583
|
||||
Height = 439
|
||||
ExplicitWidth = 583
|
||||
ExplicitHeight = 439
|
||||
inherited cxGridView: TcxGridDBTableView
|
||||
OnDblClick = cxGridViewDblClick
|
||||
OptionsData.Appending = False
|
||||
OptionsData.Deleting = False
|
||||
OptionsData.DeletingConfirmation = False
|
||||
OptionsData.Editing = False
|
||||
OptionsData.Inserting = False
|
||||
object cxGridViewNOMBRE: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'NOMBRE'
|
||||
Width = 191
|
||||
end
|
||||
object cxGridViewENTIDAD: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'ENTIDAD'
|
||||
Width = 48
|
||||
end
|
||||
object cxGridViewSUCURSAL: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'SUCURSAL'
|
||||
Width = 48
|
||||
end
|
||||
object cxGridViewDC: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'DC'
|
||||
Width = 29
|
||||
end
|
||||
object cxGridViewCUENTA: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'CUENTA'
|
||||
Width = 141
|
||||
end
|
||||
object cxGridViewSUFIJO_N19: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'SUFIJO_N19'
|
||||
Width = 55
|
||||
end
|
||||
object cxGridViewSUFIJO_N58: TcxGridDBColumn
|
||||
DataBinding.FieldName = 'SUFIJO_N58'
|
||||
Width = 57
|
||||
end
|
||||
end
|
||||
end
|
||||
inherited ToolBar1: TToolBar
|
||||
Width = 583
|
||||
ExplicitWidth = 583
|
||||
end
|
||||
end
|
||||
67
Source/Base/Empresas/Views/uViewDatosBancarios.pas
Normal file
67
Source/Base/Empresas/Views/uViewDatosBancarios.pas
Normal file
@ -0,0 +1,67 @@
|
||||
unit uViewDatosBancarios;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, uViewBase, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
|
||||
cxDataStorage, cxEdit, DB, cxDBData, cxTextEdit, cxGridLevel,
|
||||
cxGridCustomTableView, cxGridTableView, cxGridBandedTableView,
|
||||
cxGridDBBandedTableView, cxClasses, cxControls, cxGridCustomView, cxGrid,
|
||||
uDADataTable, Grids, DBGrids, ActnList, ImgList, PngImageList, ComCtrls,
|
||||
ToolWin, cxGridDBTableView, uViewDetallesGenerico, cxCurrencyEdit;
|
||||
|
||||
type
|
||||
TfrViewDatosBancarios = class(TfrViewDetallesGenerico)
|
||||
cxGridViewNOMBRE: TcxGridDBColumn;
|
||||
cxGridViewENTIDAD: TcxGridDBColumn;
|
||||
cxGridViewSUCURSAL: TcxGridDBColumn;
|
||||
cxGridViewDC: TcxGridDBColumn;
|
||||
cxGridViewCUENTA: TcxGridDBColumn;
|
||||
cxGridViewSUFIJO_N19: TcxGridDBColumn;
|
||||
cxGridViewSUFIJO_N58: TcxGridDBColumn;
|
||||
procedure cxGridViewDblClick(Sender: TObject);
|
||||
protected
|
||||
procedure AnadirInterno; override;
|
||||
procedure ModificarInterno; override;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
uDatosBancariosEmpresaController, uBizEmpresasDatosBancarios,
|
||||
uDataModuleEmpresas;
|
||||
|
||||
procedure TfrViewDatosBancarios.AnadirInterno;
|
||||
begin
|
||||
inherited;
|
||||
try
|
||||
with TDatosBancariosEmpresaController.Create do
|
||||
Ver((dsDetalles.DataTable) as IBizEmpresasDatosBancarios);
|
||||
finally
|
||||
if (dsDetalles.DataTable.State in dsEditModes) then
|
||||
dsDetalles.DataTable.Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrViewDatosBancarios.cxGridViewDblClick(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
actModificar.Execute;
|
||||
end;
|
||||
|
||||
procedure TfrViewDatosBancarios.ModificarInterno;
|
||||
begin
|
||||
inherited;
|
||||
with TDatosBancariosEmpresaController.Create do
|
||||
Ver((dsDetalles.DataTable) as IBizEmpresasDatosBancarios);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
595
Source/Base/Empresas/Views/uViewEmpresa.dfm
Normal file
595
Source/Base/Empresas/Views/uViewEmpresa.dfm
Normal file
@ -0,0 +1,595 @@
|
||||
inherited frViewEmpresa: TfrViewEmpresa
|
||||
Width = 590
|
||||
Height = 385
|
||||
ExplicitWidth = 590
|
||||
ExplicitHeight = 385
|
||||
object dxLayoutControl1: TdxLayoutControl
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 590
|
||||
Height = 385
|
||||
Align = alClient
|
||||
ParentBackground = True
|
||||
TabOrder = 0
|
||||
AutoContentSizes = [acsWidth, acsHeight]
|
||||
object PngSpeedButton1: TPngSpeedButton
|
||||
Left = 545
|
||||
Top = 305
|
||||
Width = 23
|
||||
Height = 22
|
||||
Action = actEliminar
|
||||
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
|
||||
end
|
||||
object PngSpeedButton2: TPngSpeedButton
|
||||
Left = 545
|
||||
Top = 277
|
||||
Width = 23
|
||||
Height = 22
|
||||
Action = actAnadir
|
||||
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
|
||||
end
|
||||
object eCalle: TcxDBTextEdit
|
||||
Left = 117
|
||||
Top = 193
|
||||
DataBinding.DataField = 'CALLE'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 84
|
||||
end
|
||||
object eProvincia: TcxDBTextEdit
|
||||
Left = 117
|
||||
Top = 247
|
||||
DataBinding.DataField = 'PROVINCIA'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 7
|
||||
Width = 60
|
||||
end
|
||||
object ePoblacion: TcxDBTextEdit
|
||||
Left = 117
|
||||
Top = 220
|
||||
DataBinding.DataField = 'POBLACION'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 100
|
||||
end
|
||||
object eCodigoPostal: TcxDBTextEdit
|
||||
Left = 246
|
||||
Top = 220
|
||||
DataBinding.DataField = 'CODIGO_POSTAL'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 6
|
||||
Width = 65
|
||||
end
|
||||
object ePaginaWeb: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 220
|
||||
DataBinding.DataField = 'PAGINA_WEB'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 15
|
||||
Width = 165
|
||||
end
|
||||
object eMailParticular: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 193
|
||||
DataBinding.DataField = 'EMAIL_2'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 14
|
||||
Width = 165
|
||||
end
|
||||
object eMailTrabajo: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 166
|
||||
DataBinding.DataField = 'EMAIL_1'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 13
|
||||
Width = 129
|
||||
end
|
||||
object cxDBMemo1: TcxDBMemo
|
||||
Left = 22
|
||||
Top = 304
|
||||
DataBinding.DataField = 'NOTAS'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 8
|
||||
Height = 234
|
||||
Width = 107
|
||||
end
|
||||
object eTlfParticular: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 55
|
||||
DataBinding.DataField = 'TELEFONO_2'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 10
|
||||
Width = 91
|
||||
end
|
||||
object eTlfTrabajo: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 28
|
||||
DataBinding.DataField = 'TELEFONO_1'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 9
|
||||
Width = 127
|
||||
end
|
||||
object eTlfMovil: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 82
|
||||
DataBinding.DataField = 'MOVIL_1'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 11
|
||||
Width = 155
|
||||
end
|
||||
object eFax: TcxDBTextEdit
|
||||
Left = 436
|
||||
Top = 109
|
||||
DataBinding.DataField = 'FAX'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
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 = 12
|
||||
Width = 121
|
||||
end
|
||||
object eNombre: TcxDBTextEdit
|
||||
Left = 117
|
||||
Top = 28
|
||||
DataBinding.DataField = 'NOMBRE'
|
||||
DataBinding.DataSource = DADataSource
|
||||
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 = 0
|
||||
Width = 108
|
||||
end
|
||||
object eNIFCIF: TcxDBTextEdit
|
||||
Left = 117
|
||||
Top = 55
|
||||
DataBinding.DataField = 'NIF_CIF'
|
||||
DataBinding.DataSource = DADataSource
|
||||
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 = 1
|
||||
Width = 108
|
||||
end
|
||||
object memRegistroMercantil: TcxDBMemo
|
||||
Left = 117
|
||||
Top = 82
|
||||
DataBinding.DataField = 'REGISTRO_MERCANTIL'
|
||||
DataBinding.DataSource = DADataSource
|
||||
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
|
||||
Height = 48
|
||||
Width = 76
|
||||
end
|
||||
object cxDBSpinEdit1: TcxDBSpinEdit
|
||||
Left = 117
|
||||
Top = 136
|
||||
DataBinding.DataField = 'IVA'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
Style.HotTrack = False
|
||||
Style.LookAndFeel.Kind = lfStandard
|
||||
Style.LookAndFeel.NativeStyle = True
|
||||
Style.ButtonStyle = bts3D
|
||||
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 = 60
|
||||
end
|
||||
object cxDBImage1: TcxDBImage
|
||||
Left = 341
|
||||
Top = 277
|
||||
DataBinding.DataField = 'LOGOTIPO'
|
||||
DataBinding.DataSource = DADataSource
|
||||
Properties.Stretch = True
|
||||
Style.BorderColor = clWindowFrame
|
||||
Style.BorderStyle = ebs3D
|
||||
Style.HotTrack = False
|
||||
Style.LookAndFeel.NativeStyle = True
|
||||
StyleDisabled.LookAndFeel.NativeStyle = True
|
||||
StyleFocused.LookAndFeel.NativeStyle = True
|
||||
StyleHot.LookAndFeel.NativeStyle = True
|
||||
TabOrder = 16
|
||||
Height = 100
|
||||
Width = 140
|
||||
end
|
||||
object dxLayoutControl1Group_Root: TdxLayoutGroup
|
||||
ShowCaption = False
|
||||
Hidden = True
|
||||
LayoutDirection = ldHorizontal
|
||||
ShowBorder = False
|
||||
object dxLayoutControl1Group4: TdxLayoutGroup
|
||||
AutoAligns = [aaVertical]
|
||||
AlignHorz = ahClient
|
||||
ShowCaption = False
|
||||
Hidden = True
|
||||
ShowBorder = False
|
||||
object dxLayoutControl1Group1: TdxLayoutGroup
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
AlignVert = avClient
|
||||
Caption = 'Datos generales'
|
||||
object dxLayoutControl1Item13: TdxLayoutItem
|
||||
Caption = 'Nombre:'
|
||||
Control = eNombre
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item14: TdxLayoutItem
|
||||
Caption = 'CIF:'
|
||||
Control = eNIFCIF
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item15: TdxLayoutItem
|
||||
Caption = 'Registro mercantil:'
|
||||
CaptionOptions.AlignVert = tavTop
|
||||
Control = memRegistroMercantil
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item16: TdxLayoutItem
|
||||
AutoAligns = [aaVertical]
|
||||
Caption = 'IVA por defecto:'
|
||||
Control = cxDBSpinEdit1
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group3: TdxLayoutGroup
|
||||
AutoAligns = [aaHorizontal]
|
||||
Caption = 'Direcci'#243'n'
|
||||
object dxLayoutControl1Item1: TdxLayoutItem
|
||||
Caption = 'Calle:'
|
||||
Control = eCalle
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Group8: TdxLayoutGroup
|
||||
ShowCaption = False
|
||||
Hidden = True
|
||||
LayoutDirection = ldHorizontal
|
||||
ShowBorder = False
|
||||
object dxLayoutControl1Item3: TdxLayoutItem
|
||||
AutoAligns = [aaVertical]
|
||||
AlignHorz = ahClient
|
||||
Caption = 'Poblaci'#243'n:'
|
||||
Control = ePoblacion
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item4: TdxLayoutItem
|
||||
Caption = 'C'#243'd. postal:'
|
||||
Control = eCodigoPostal
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Item2: TdxLayoutItem
|
||||
Caption = 'Provincia:'
|
||||
Control = eProvincia
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group7: TdxLayoutGroup
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
AlignVert = avClient
|
||||
Caption = 'Observaciones'
|
||||
object dxLayoutControl1Item8: TdxLayoutItem
|
||||
AutoAligns = [aaHorizontal]
|
||||
AlignVert = avClient
|
||||
Caption = 'cxDBMemo1'
|
||||
ShowCaption = False
|
||||
Control = cxDBMemo1
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group6: TdxLayoutGroup
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
AlignVert = avClient
|
||||
ShowCaption = False
|
||||
Hidden = True
|
||||
ShowBorder = False
|
||||
object dxLayoutControl1Group2: TdxLayoutGroup
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
Caption = 'Tel'#233'fonos'
|
||||
object dxLayoutControl1Item10: TdxLayoutItem
|
||||
Caption = 'Tlf. trabajo:'
|
||||
Control = eTlfTrabajo
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item9: TdxLayoutItem
|
||||
Caption = 'Tlf. particular:'
|
||||
Control = eTlfParticular
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item11: TdxLayoutItem
|
||||
Caption = 'M'#243'vil:'
|
||||
Control = eTlfMovil
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item12: TdxLayoutItem
|
||||
Caption = 'Fax:'
|
||||
Control = eFax
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group5: TdxLayoutGroup
|
||||
Caption = 'Correo electr'#243'nico e internet'
|
||||
object dxLayoutControl1Item7: TdxLayoutItem
|
||||
Caption = 'Correo de trabajo:'
|
||||
Control = eMailTrabajo
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item6: TdxLayoutItem
|
||||
Caption = 'Correo particular:'
|
||||
Control = eMailParticular
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item5: TdxLayoutItem
|
||||
Caption = 'P'#225'gina web:'
|
||||
Control = ePaginaWeb
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group10: TdxLayoutGroup
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
AlignVert = avClient
|
||||
Caption = 'Logotipo'
|
||||
LayoutDirection = ldHorizontal
|
||||
object dxLayoutControl1Item17: TdxLayoutItem
|
||||
AutoAligns = []
|
||||
AlignHorz = ahClient
|
||||
AlignVert = avClient
|
||||
Caption = 'cxDBImage1'
|
||||
ShowCaption = False
|
||||
Control = cxDBImage1
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Group12: TdxLayoutGroup
|
||||
ShowCaption = False
|
||||
Hidden = True
|
||||
ShowBorder = False
|
||||
object dxLayoutControl1Item20: TdxLayoutItem
|
||||
AutoAligns = [aaVertical]
|
||||
AlignHorz = ahRight
|
||||
Caption = 'PngSpeedButton2'
|
||||
ShowCaption = False
|
||||
Control = PngSpeedButton2
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
object dxLayoutControl1Item19: TdxLayoutItem
|
||||
AutoAligns = [aaVertical]
|
||||
AlignHorz = ahRight
|
||||
Caption = 'PngSpeedButton1'
|
||||
ShowCaption = False
|
||||
Control = PngSpeedButton1
|
||||
ControlOptions.ShowBorder = False
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object dxLayoutControl1Group9: TdxLayoutGroup
|
||||
end
|
||||
object dxLayoutControl1Group11: TdxLayoutGroup
|
||||
end
|
||||
end
|
||||
object DADataSource: TDADataSource
|
||||
Left = 16
|
||||
Top = 56
|
||||
end
|
||||
object ActionList1: TActionList
|
||||
Images = SmallImages
|
||||
Left = 448
|
||||
Top = 256
|
||||
object actAnadir: TAction
|
||||
ImageIndex = 0
|
||||
OnExecute = actAnadirExecute
|
||||
OnUpdate = actAnadirUpdate
|
||||
end
|
||||
object actEliminar: TAction
|
||||
ImageIndex = 1
|
||||
OnExecute = actEliminarExecute
|
||||
OnUpdate = actEliminarUpdate
|
||||
end
|
||||
end
|
||||
object SmallImages: TPngImageList
|
||||
PngImages = <
|
||||
item
|
||||
PngImage.Data = {
|
||||
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
|
||||
610000000970485973000017120000171201679FD252000000D04944415478DA
|
||||
6364C0062630FCC72A5EC0C0882EC488CB80191909706EDDBA750CAF767D6260
|
||||
5830240DF8F9FB3743EBE6CD780CC011602003409A7F0071EF8E1D10030C30D5
|
||||
31A23B1706609AB1E23F7FC0F4FA2967B01B408CE6A3B76E815D856100319ABF
|
||||
FFFAC570EEC103540340218D0C92EDECE01AD79E398335ACE106305CC0942CAC
|
||||
77871BB0F5E2454820620138A331D3CB09EEECBD57AF929E0E629DADC106FCF9
|
||||
F70F1E602419106A67C6F01DE40260805D7AFC9874037C2C0D194EDDBD8B1260
|
||||
241900A6D103178B01000648ED7B1FCA93F30000000049454E44AE426082}
|
||||
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 = 419
|
||||
Top = 256
|
||||
Bitmap = {}
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
Left = 384
|
||||
Top = 256
|
||||
end
|
||||
end
|
||||
179
Source/Base/Empresas/Views/uViewEmpresa.pas
Normal file
179
Source/Base/Empresas/Views/uViewEmpresa.pas
Normal file
@ -0,0 +1,179 @@
|
||||
unit uViewEmpresa;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, uViewBase, ExtCtrls, StdCtrls, Buttons, DB, uDADataTable,
|
||||
DBCtrls, Grids, DBGrids, uBizEmpresas, Mask, ComCtrls, uCustomView,
|
||||
JvComponent, JvFormAutoSize, cxControls, cxContainer, cxEdit, cxTextEdit,
|
||||
cxDBEdit, dxLayoutControl, dxLayoutLookAndFeels, cxMemo, cxMaskEdit,
|
||||
cxSpinEdit, cxImage, JvExControls, JvBitmapButton, ActnList, ImgList,
|
||||
PngImageList, TB2Item, TBX, TB2Dock, TB2Toolbar, PngSpeedButton;
|
||||
|
||||
type
|
||||
IViewEmpresa = interface(IViewBase)
|
||||
['{876DCEBD-9E92-491A-84CE-498B1A84B525}']
|
||||
function GetEmpresa: IBizEmpresa;
|
||||
procedure SetEmpresa(const Value: IBizEmpresa);
|
||||
property Empresa: IBizEmpresa read GetEmpresa write SetEmpresa;
|
||||
end;
|
||||
|
||||
TfrViewEmpresa = class(TfrViewBase, IViewEmpresa)
|
||||
DADataSource: TDADataSource;
|
||||
dxLayoutControl1Group_Root: TdxLayoutGroup;
|
||||
dxLayoutControl1: TdxLayoutControl;
|
||||
dxLayoutControl1Group1: TdxLayoutGroup;
|
||||
dxLayoutControl1Group2: TdxLayoutGroup;
|
||||
dxLayoutControl1Group3: TdxLayoutGroup;
|
||||
dxLayoutControl1Group4: TdxLayoutGroup;
|
||||
dxLayoutControl1Group5: TdxLayoutGroup;
|
||||
dxLayoutControl1Group6: TdxLayoutGroup;
|
||||
dxLayoutControl1Group7: TdxLayoutGroup;
|
||||
dxLayoutControl1Item1: TdxLayoutItem;
|
||||
eCalle: TcxDBTextEdit;
|
||||
dxLayoutControl1Item2: TdxLayoutItem;
|
||||
eProvincia: TcxDBTextEdit;
|
||||
dxLayoutControl1Item3: TdxLayoutItem;
|
||||
ePoblacion: TcxDBTextEdit;
|
||||
dxLayoutControl1Item4: TdxLayoutItem;
|
||||
eCodigoPostal: TcxDBTextEdit;
|
||||
dxLayoutControl1Item5: TdxLayoutItem;
|
||||
ePaginaWeb: TcxDBTextEdit;
|
||||
dxLayoutControl1Item6: TdxLayoutItem;
|
||||
eMailParticular: TcxDBTextEdit;
|
||||
dxLayoutControl1Item7: TdxLayoutItem;
|
||||
eMailTrabajo: TcxDBTextEdit;
|
||||
cxDBMemo1: TcxDBMemo;
|
||||
dxLayoutControl1Item8: TdxLayoutItem;
|
||||
dxLayoutControl1Item9: TdxLayoutItem;
|
||||
eTlfParticular: TcxDBTextEdit;
|
||||
dxLayoutControl1Item10: TdxLayoutItem;
|
||||
eTlfTrabajo: TcxDBTextEdit;
|
||||
dxLayoutControl1Item11: TdxLayoutItem;
|
||||
eTlfMovil: TcxDBTextEdit;
|
||||
dxLayoutControl1Item12: TdxLayoutItem;
|
||||
eFax: TcxDBTextEdit;
|
||||
dxLayoutControl1Item13: TdxLayoutItem;
|
||||
eNombre: TcxDBTextEdit;
|
||||
dxLayoutControl1Item14: TdxLayoutItem;
|
||||
eNIFCIF: TcxDBTextEdit;
|
||||
dxLayoutControl1Item15: TdxLayoutItem;
|
||||
memRegistroMercantil: TcxDBMemo;
|
||||
dxLayoutControl1Group10: TdxLayoutGroup;
|
||||
dxLayoutControl1Group9: TdxLayoutGroup;
|
||||
dxLayoutControl1Group11: TdxLayoutGroup;
|
||||
dxLayoutControl1Group8: TdxLayoutGroup;
|
||||
cxDBSpinEdit1: TcxDBSpinEdit;
|
||||
dxLayoutControl1Item16: TdxLayoutItem;
|
||||
ActionList1: TActionList;
|
||||
actAnadir: TAction;
|
||||
actEliminar: TAction;
|
||||
SmallImages: TPngImageList;
|
||||
OpenDialog1: TOpenDialog;
|
||||
cxDBImage1: TcxDBImage;
|
||||
dxLayoutControl1Item17: TdxLayoutItem;
|
||||
PngSpeedButton1: TPngSpeedButton;
|
||||
dxLayoutControl1Item19: TdxLayoutItem;
|
||||
PngSpeedButton2: TPngSpeedButton;
|
||||
dxLayoutControl1Item20: TdxLayoutItem;
|
||||
dxLayoutControl1Group12: TdxLayoutGroup;
|
||||
procedure actAnadirExecute(Sender: TObject);
|
||||
procedure actEliminarExecute(Sender: TObject);
|
||||
procedure actEliminarUpdate(Sender: TObject);
|
||||
procedure actAnadirUpdate(Sender: TObject);
|
||||
private
|
||||
FEmpresa: IBizEmpresa;
|
||||
protected
|
||||
function GetEmpresa: IBizEmpresa;
|
||||
procedure SetEmpresa(const Value: IBizEmpresa);
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.dfm}
|
||||
|
||||
uses uROClasses, uROTypes;
|
||||
|
||||
{ TfrViewEmpresas }
|
||||
|
||||
{
|
||||
******************************* TfrViewEmpresa ********************************
|
||||
}
|
||||
procedure TfrViewEmpresa.actAnadirExecute(Sender: TObject);
|
||||
{var
|
||||
StdStream: TMemoryStream;
|
||||
StreamRO: IROStream;
|
||||
}
|
||||
begin
|
||||
inherited;
|
||||
cxDBImage1.LoadFromFile;
|
||||
|
||||
{if not OpenDialog1.Execute then
|
||||
Exit;
|
||||
try
|
||||
StdStream := TMemoryStream.Create;
|
||||
StdStream.LoadFromFile(OpenDialog1.FileName);
|
||||
StreamRO := NewROStream(StdStream,False);
|
||||
DADataSource.DataTable.Edit;
|
||||
// DADataSource.DataTable.FieldByName('LOGOTIPO').Clear;
|
||||
DADataSource.DataTable.FieldByName('LOGOTIPO').LoadFromStream(StreamRO);
|
||||
|
||||
DADataSource.DataTable.Post;
|
||||
finally
|
||||
StdStream.Free;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TfrViewEmpresa.actAnadirUpdate(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
// (Sender as TAction).Enabled := cxDBImage1.Picture.Graphic.Empty;
|
||||
end;
|
||||
|
||||
procedure TfrViewEmpresa.actEliminarExecute(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
cxDBImage1.Clear;
|
||||
|
||||
{ DADataSource.DataTable.Edit;
|
||||
DADataSource.DataTable.FieldByName('LOGOTIPO').AsVariant := Null;
|
||||
DADataSource.DataTable.Post;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TfrViewEmpresa.actEliminarUpdate(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
// (Sender as TAction).Enabled := not cxDBImage1.Picture.Graphic.Empty;
|
||||
end;
|
||||
|
||||
constructor TfrViewEmpresa.Create(AOwner : TComponent);
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TfrViewEmpresa.GetEmpresa: IBizEmpresa;
|
||||
begin
|
||||
Result := FEmpresa;
|
||||
end;
|
||||
|
||||
procedure TfrViewEmpresa.SetEmpresa(const Value: IBizEmpresa);
|
||||
begin
|
||||
FEmpresa := Value;
|
||||
if Assigned(FEmpresa) then
|
||||
DADataSource.DataTable := FEmpresa.DataTable
|
||||
else
|
||||
DADataSource.DataTable := NIL;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterClass(TfrViewEmpresa);
|
||||
|
||||
finalization
|
||||
UnRegisterClass(TfrViewEmpresa);
|
||||
|
||||
end.
|
||||
|
||||
313
Source/Base/Usuarios/Controller/uUsuariosController.pas
Normal file
313
Source/Base/Usuarios/Controller/uUsuariosController.pas
Normal file
@ -0,0 +1,313 @@
|
||||
unit uUsuariosController;
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
Classes, SysUtils, uDADataTable, uControllerBase,
|
||||
uIDataModuleUsuarios, uDataModuleUsuarios, UCBase;
|
||||
|
||||
type
|
||||
IUsuariosController = interface(IObservador)
|
||||
['{DD963EEC-5880-4DE7-AF55-B5080B538D84}']
|
||||
|
||||
{procedure Logoff;
|
||||
procedure Execute;
|
||||
procedure StartLogin;
|
||||
procedure ShowUserManager;
|
||||
procedure ShowProfileManager;
|
||||
procedure ShowLogManager;
|
||||
procedure ShowChangePassword;
|
||||
procedure ChangeUser(IDUser: Integer; Login, Name, Mail: String; Profile,UserExpired,UserDaysSun: Integer; PrivUser: Boolean);
|
||||
procedure ChangePassword(IDUser: Integer; NewPassword: String);
|
||||
procedure AddRight(idUser: Integer; ItemRight: TObject; FullPath: Boolean = True); overload;
|
||||
procedure AddRight(idUser: Integer; ItemRight: String); overload;
|
||||
procedure AddRightEX(idUser: Integer; Module, FormName, ObjName: String);
|
||||
function VerificaLogin(User, Password: String): Boolean;
|
||||
function GetLocalUserName: String;
|
||||
function GetLocalComputerName: String;
|
||||
function AddUser(Login, Password, Name, Mail: String; Profile , UserExpired , DaysExpired : Integer; PrivUser: Boolean): Integer;
|
||||
function ExisteUsuario(Login: String): Boolean;
|
||||
property CurrentUser: TUCCurrentUser read FCurrentUser write FCurrentUser;
|
||||
property CurrentEmpresa : TEmpresaDef read FEmpresaAtual write FEmpresaAtual;
|
||||
property UserSettings: TUCUserSettings read FUserSettings write SetUserSettings;}
|
||||
|
||||
{ function BuscarTodos: IBizFormaPago;
|
||||
function Buscar(ID: Integer): IBizFormaPago;
|
||||
procedure VerTodos(AUsuarios: IBizFormaPago);
|
||||
procedure Ver(AFormaPago: IBizFormaPago);
|
||||
procedure Anadir(AFormaPago : IBizFormaPago);
|
||||
function Eliminar(AFormaPago : IBizFormaPago): Boolean;
|
||||
function Guardar(AFormaPago : IBizFormaPago): Boolean;
|
||||
procedure DescartarCambios(AFormaPago : IBizFormaPago);
|
||||
function Localizar(AUsuarios: IBizFormaPago; ADescripcion:String): Boolean;
|
||||
function DarListaUsuarios: TStringList;}
|
||||
end;
|
||||
|
||||
TUsuariosController = class(TObservador, IUsuariosController)
|
||||
protected
|
||||
FDataModule : IDataModuleUsuarios;
|
||||
FUserControl: TUserControl;
|
||||
|
||||
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); override;
|
||||
function CreateEditor(const AName : String; const IID: TGUID; out Intf): Boolean;
|
||||
|
||||
// function ValidarFormaPago(AFormaPago: IBizFormaPago): Boolean;
|
||||
procedure AsignarDataModule;
|
||||
procedure InicializarUserControl;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
{ function Eliminar(AFormaPago : IBizFormaPago): Boolean;
|
||||
function Guardar(AFormaPago : IBizFormaPago): Boolean; virtual;
|
||||
procedure DescartarCambios(AFormaPago : IBizFormaPago); virtual;
|
||||
procedure Anadir(AFormaPago : IBizFormaPago);
|
||||
function BuscarTodos: IBizFormaPago;
|
||||
function Buscar(ID: Integer): IBizFormaPago;
|
||||
procedure VerTodos(AUsuarios: IBizFormaPago);
|
||||
procedure Ver(AFormaPago: IBizFormaPago);
|
||||
function Localizar(AUsuarios: IBizFormaPago; ADescripcion:String): Boolean;
|
||||
function DarListaUsuarios: TStringList;}
|
||||
|
||||
published
|
||||
property UserControl : TUserControl read FUserControl;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cxControls, DB, uEditorRegistryUtils, schUsuariosClient_Intf,
|
||||
uDAInterfaces, uDataTableUtils, uDialogUtils,
|
||||
uDateUtils, uROTypes, DateUtils, Controls, Windows;
|
||||
|
||||
{ TUsuariosController }
|
||||
|
||||
{procedure TUsuariosController.Anadir(AFormaPago: IBizFormaPago);
|
||||
begin
|
||||
AFormaPago.Insert;
|
||||
end;}
|
||||
|
||||
procedure TUsuariosController.AsignarDataModule;
|
||||
begin
|
||||
FDataModule := TDataModuleUsuarios.Create(Nil);
|
||||
end;
|
||||
|
||||
{function TUsuariosController.Buscar(ID: Integer): IBizFormaPago;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
Result := BuscarTodos;
|
||||
with Result.DataTable.Where do
|
||||
begin
|
||||
if NotEmpty then
|
||||
AddOperator(opAND);
|
||||
OpenBraket;
|
||||
AddText(fld_UsuariosID + ' = ' + IntToStr(ID));
|
||||
CloseBraket;
|
||||
end;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUsuariosController.BuscarTodos: IBizFormaPago;
|
||||
begin
|
||||
Result := FDataModule.GetItems;
|
||||
end;}
|
||||
|
||||
constructor TUsuariosController.Create;
|
||||
begin
|
||||
AsignarDataModule;
|
||||
FUserControl := TUserControl.Create(nil);
|
||||
InicializarUserControl;
|
||||
end;
|
||||
|
||||
function TUsuariosController.CreateEditor(const AName: String; const IID: TGUID; out Intf): Boolean;
|
||||
begin
|
||||
Result := Supports(EditorRegistry.CreateEditor(AName), IID, Intf);
|
||||
end;
|
||||
|
||||
{
|
||||
function TUsuariosController.DarListaUsuarios: TStringList;
|
||||
var
|
||||
AUsuarios: IBizFormaPago;
|
||||
begin
|
||||
AUsuarios := BuscarTodos;
|
||||
AUsuarios.DataTable.Active := True;
|
||||
Result := TStringList.Create;
|
||||
try
|
||||
with Result do
|
||||
begin
|
||||
AUsuarios.DataTable.First;
|
||||
while not AUsuarios.DataTable.EOF do
|
||||
begin
|
||||
Add(AUsuarios.DESCRIPCION);
|
||||
AUsuarios.DataTable.Next;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
AUsuarios := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUsuariosController.DescartarCambios(AFormaPago: IBizFormaPago);
|
||||
begin
|
||||
if not Assigned(AFormaPago) then
|
||||
raise Exception.Create ('Forma de pago no asignada');
|
||||
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
if (AFormaPago.State in dsEditModes) then
|
||||
AFormaPago.Cancel;
|
||||
|
||||
AFormaPago.DataTable.CancelUpdates;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
destructor TUsuariosController.Destroy;
|
||||
begin
|
||||
FreeANDNIL(FUserControl);
|
||||
FDataModule := NIL;
|
||||
inherited;
|
||||
end;
|
||||
procedure TUsuariosController.InicializarUserControl;
|
||||
begin
|
||||
FDataModule.InicializarCamposUserControl(FUserControl);
|
||||
with FUserControl do
|
||||
begin
|
||||
Criptografia := cMD5;
|
||||
AutoStart := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
function TUsuariosController.ValidarFormaPago(AFormaPago: IBizFormaPago): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not Assigned(AFormaPago) then
|
||||
raise Exception.Create ('Forma de pago no asignada');
|
||||
|
||||
if (AFormaPago.DataTable.State in dsEditModes) then
|
||||
AFormaPago.DataTable.Post;
|
||||
|
||||
if Length(AFormaPago.REFERENCIA) = 0 then
|
||||
raise Exception.Create('Debe indicar una referencia para esta forma de pago.');
|
||||
|
||||
if Length(AFormaPago.DESCRIPCION) = 0 then
|
||||
raise Exception.Create('Debe indicar una descripción para esta forma de pago.');
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TUsuariosController.Ver(AFormaPago: IBizFormaPago);
|
||||
var
|
||||
AEditor : IEditorFormaPago;
|
||||
begin
|
||||
AEditor := NIL;
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
CreateEditor('EditorFormaPago', IEditorFormaPago, AEditor);
|
||||
with AEditor do
|
||||
FormaPago := AFormaPago;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
if Assigned(AEditor) then
|
||||
try
|
||||
AEditor.ShowModal;
|
||||
AEditor.Release;
|
||||
finally
|
||||
AEditor := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUsuariosController.VerTodos(AUsuarios: IBizFormaPago);
|
||||
var
|
||||
AEditor : IEditorUsuarios;
|
||||
begin
|
||||
AEditor := NIL;
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
CreateEditor('EditorUsuarios', IEditorUsuarios, AEditor);
|
||||
with AEditor do
|
||||
Usuarios := AUsuarios;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
if Assigned(AEditor) then
|
||||
try
|
||||
AEditor.ShowModal;
|
||||
AEditor.Release;
|
||||
finally
|
||||
AEditor := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUsuariosController.Eliminar(AFormaPago: IBizFormaPago): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not Assigned(AFormaPago) then
|
||||
raise Exception.Create ('Forma de pago no asignada');
|
||||
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
if (AFormaPago.State in dsEditModes) then
|
||||
AFormaPago.Cancel;
|
||||
|
||||
AFormaPago.Delete;
|
||||
AFormaPago.DataTable.ApplyUpdates;
|
||||
HideHourglassCursor;
|
||||
Result := True;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;}
|
||||
|
||||
procedure TUsuariosController.RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable);
|
||||
begin
|
||||
inherited;
|
||||
//
|
||||
end;
|
||||
|
||||
{function TUsuariosController.Guardar(AFormaPago: IBizFormaPago): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if ValidarFormaPago(AFormaPago) then
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
AFormaPago.DataTable.ApplyUpdates;
|
||||
Result := True;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUsuariosController.Localizar(AUsuarios: IBizFormaPago; ADescripcion: String): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
with AUsuarios.DataTable do
|
||||
begin
|
||||
DisableControls;
|
||||
First;
|
||||
if not Locate(fld_UsuariosDESCRIPCION, ADescripcion, []) then
|
||||
Result := False;
|
||||
EnableControls;
|
||||
end;
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;}
|
||||
|
||||
end.
|
||||
94
Source/Base/Usuarios/Data/uCambiarPassword.dfm
Normal file
94
Source/Base/Usuarios/Data/uCambiarPassword.dfm
Normal file
@ -0,0 +1,94 @@
|
||||
object fCambiarPassword: TfCambiarPassword
|
||||
Left = 460
|
||||
Top = 492
|
||||
Width = 361
|
||||
Height = 299
|
||||
Caption = 'Cambiar la contrase'#241'a'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object bAceptar: TButton
|
||||
Left = 136
|
||||
Top = 230
|
||||
Width = 120
|
||||
Height = 25
|
||||
Caption = '&Cambiar la contrase'#241'a'
|
||||
Default = True
|
||||
TabOrder = 0
|
||||
OnClick = bAceptarClick
|
||||
end
|
||||
object bCancelar: TButton
|
||||
Left = 269
|
||||
Top = 230
|
||||
Width = 75
|
||||
Height = 25
|
||||
Cancel = True
|
||||
Caption = '&Cancelar'
|
||||
ModalResult = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
object PageControl1: TPageControl
|
||||
Left = 2
|
||||
Top = 2
|
||||
Width = 349
|
||||
Height = 217
|
||||
ActivePage = pagContrasena
|
||||
TabOrder = 2
|
||||
object pagContrasena: TTabSheet
|
||||
Caption = 'Cambiar la contrase'#241'a'
|
||||
object Label4: TLabel
|
||||
Left = 16
|
||||
Top = 19
|
||||
Width = 167
|
||||
Height = 13
|
||||
Caption = 'Escriba la nueva contrase'#241'a:'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
Transparent = True
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 16
|
||||
Top = 72
|
||||
Width = 257
|
||||
Height = 13
|
||||
Caption = 'Repita la nueva contrase'#241'a para confirmarla:'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
Transparent = True
|
||||
end
|
||||
object edtPassword2: TEdit
|
||||
Left = 16
|
||||
Top = 88
|
||||
Width = 295
|
||||
Height = 21
|
||||
CharCase = ecLowerCase
|
||||
PasswordChar = '*'
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtPassword: TEdit
|
||||
Left = 16
|
||||
Top = 39
|
||||
Width = 295
|
||||
Height = 21
|
||||
CharCase = ecLowerCase
|
||||
PasswordChar = '*'
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
41
Source/Base/Usuarios/Data/uCambiarPassword.pas
Normal file
41
Source/Base/Usuarios/Data/uCambiarPassword.pas
Normal file
@ -0,0 +1,41 @@
|
||||
unit uCambiarPassword;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ComCtrls;
|
||||
|
||||
type
|
||||
TfCambiarPassword = class(TForm)
|
||||
bAceptar: TButton;
|
||||
bCancelar: TButton;
|
||||
Label4: TLabel;
|
||||
edtPassword: TEdit;
|
||||
Label1: TLabel;
|
||||
edtPassword2: TEdit;
|
||||
PageControl1: TPageControl;
|
||||
pagContrasena: TTabSheet;
|
||||
procedure bAceptarClick(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fCambiarPassword: TfCambiarPassword;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TfCambiarPassword.bAceptarClick(Sender: TObject);
|
||||
begin
|
||||
if edtPassword2.Text <> edtPassword.Text then
|
||||
raise Exception.Create('Por favor, introduzca la MISMA contraseña en los dos campos')
|
||||
else
|
||||
ModalResult := mrOK;
|
||||
end;
|
||||
|
||||
end.
|
||||
76
Source/Base/Usuarios/Data/uDataModuleUsuarios.dfm
Normal file
76
Source/Base/Usuarios/Data/uDataModuleUsuarios.dfm
Normal file
@ -0,0 +1,76 @@
|
||||
object DataModuleUsuarios: TDataModuleUsuarios
|
||||
OldCreateOrder = True
|
||||
OnCreate = DAClientDataModuleCreate
|
||||
Height = 205
|
||||
Width = 355
|
||||
object ROLoginService: TRORemoteService
|
||||
Message = dmConexion.ROMessage
|
||||
Channel = dmConexion.ROChannel
|
||||
ServiceName = 'srvLogin'
|
||||
Left = 48
|
||||
Top = 32
|
||||
end
|
||||
object srvUsuarios: TRORemoteService
|
||||
Message = dmConexion.ROMessage
|
||||
Channel = dmConexion.ROChannel
|
||||
ServiceName = 'srvUsuarios'
|
||||
Left = 152
|
||||
Top = 32
|
||||
end
|
||||
object Bin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 48
|
||||
Top = 104
|
||||
end
|
||||
object UserControl1: TUserControl
|
||||
ApplicationID = 'ProjetoNovo'
|
||||
LogControl.TableLog = 'UCLog'
|
||||
EncryptKey = 0
|
||||
Login.InitialLogin.User = 'admin'
|
||||
Login.InitialLogin.Email = 'usercontrol@usercontrol.net'
|
||||
Login.InitialLogin.Password = '123mudar'
|
||||
Login.MaxLoginAttempts = 0
|
||||
ExtraRights = <>
|
||||
TableUsers.FieldUserID = 'UCIdUser'
|
||||
TableUsers.FieldUserName = 'UCUserName'
|
||||
TableUsers.FieldLogin = 'UCLogin'
|
||||
TableUsers.FieldPassword = 'UCPassword'
|
||||
TableUsers.FieldEmail = 'UCEmail'
|
||||
TableUsers.FieldPrivileged = 'UCPrivileged'
|
||||
TableUsers.FieldTypeRec = 'UCTypeRec'
|
||||
TableUsers.FieldProfile = 'UCProfile'
|
||||
TableUsers.FieldKey = 'UCKey'
|
||||
TableUsers.FieldDateExpired = 'UCPassExpired'
|
||||
TableUsers.FieldUserExpired = 'UCUserExpired'
|
||||
TableUsers.FieldUserDaysSun = 'UCUserDaysSun'
|
||||
TableUsers.TableName = 'UCTabUsers'
|
||||
TableEmpresa.FieldID = 'UCID'
|
||||
TableEmpresa.FieldName = 'UCNOME'
|
||||
TableEmpresa.TableName = 'UCEMPRESA'
|
||||
TableEmpresa.Active = False
|
||||
TableEmpresa.IDInteiro = False
|
||||
TableRights.FieldUserID = 'UCIdUser'
|
||||
TableRights.FieldModule = 'UCModule'
|
||||
TableRights.FieldComponentName = 'UCCompName'
|
||||
TableRights.FieldFormName = 'UCFormName'
|
||||
TableRights.FieldKey = 'UCKey'
|
||||
TableRights.TableName = 'UCTabRights'
|
||||
TableUsersLogged.FieldLogonID = 'UCIdLogon'
|
||||
TableUsersLogged.FieldUserID = 'UCIdUser'
|
||||
TableUsersLogged.FieldApplicationID = 'UCApplicationId'
|
||||
TableUsersLogged.FieldMachineName = 'UCMachineName'
|
||||
TableUsersLogged.FieldData = 'UCData'
|
||||
TableUsersLogged.TableName = 'UCTabUsersLogged'
|
||||
TableHistory.TableName = 'UCTABHistory'
|
||||
TableHistory.FieldApplicationID = 'ApplicationID'
|
||||
TableHistory.FieldUserID = 'UserID'
|
||||
TableHistory.FieldEventDate = 'EventDate'
|
||||
TableHistory.FieldEventTime = 'EventTime'
|
||||
TableHistory.FieldForm = 'Form'
|
||||
TableHistory.FieldCaptionForm = 'FormCaption'
|
||||
TableHistory.FieldEvent = 'Event'
|
||||
TableHistory.FieldObs = 'Obs'
|
||||
TableHistory.FieldTableName = 'tName'
|
||||
Left = 192
|
||||
Top = 120
|
||||
end
|
||||
end
|
||||
287
Source/Base/Usuarios/Data/uDataModuleUsuarios.pas
Normal file
287
Source/Base/Usuarios/Data/uDataModuleUsuarios.pas
Normal file
@ -0,0 +1,287 @@
|
||||
unit uDataModuleUsuarios;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, DB, DBClient, uDADataTable,
|
||||
FactuGES_Intf, uIntegerListUtils, uBizEmpresas,
|
||||
UCBase, UCDataConnector, uUCROConn, uDARemoteDataAdapter,
|
||||
uDARemoteCommand, uROClient, uRORemoteService, uDADataStreamer,
|
||||
uDABin2DataStreamer, uDAScriptingProvider, uIDataModuleUsuarios;
|
||||
|
||||
const
|
||||
PERFIL_ADMINISTRADORES = 'Administradores';
|
||||
|
||||
type
|
||||
TDataModuleUsuarios = class(TDataModule, IDataModuleUsuarios)
|
||||
ROLoginService: TRORemoteService;
|
||||
srvUsuarios: TRORemoteService;
|
||||
Bin2DataStreamer: TDABin2DataStreamer;
|
||||
UserControl1: TUserControl;
|
||||
procedure DAClientDataModuleCreate(Sender: TObject);
|
||||
procedure DAClientDataModuleDestroy(Sender: TObject);
|
||||
private
|
||||
FDataConnector : TUCROConn;
|
||||
FUsuario : String;
|
||||
FPassword : String; // Lo guardo para poder hacer una reconexión
|
||||
|
||||
FLoginInfo: TRdxLoginInfo;
|
||||
FEmpresaActual: IBizEmpresa;
|
||||
function CambiarPassword (const APassword : String) : boolean; overload;
|
||||
function GetEsAdministrador: Boolean;
|
||||
|
||||
function GetEmpresas: TIntegerList;
|
||||
|
||||
procedure SetEmpresaActual(const Value: IBizEmpresa);
|
||||
function GetIDEmpresaActual: Integer;
|
||||
procedure SetIDEmpresaActual(const Value: Integer);
|
||||
function GetDataConnector : TUCDataConnector;
|
||||
public
|
||||
procedure InicializarCamposUserControl (AUserControl : TUserControl);
|
||||
function Login: Boolean; overload;
|
||||
function Login(Usuario: String; Password: String): Boolean; overload;
|
||||
procedure Logout;
|
||||
procedure CambiarPassword; overload;
|
||||
|
||||
property EsAdministrador : Boolean read GetEsAdministrador;
|
||||
property IDEmpresaActual : Integer read GetIDEmpresaActual write SetIDEmpresaActual;
|
||||
property EmpresaActual : IBizEmpresa read FEmpresaActual write SetEmpresaActual;
|
||||
property Empresas : TIntegerList read GetEmpresas;
|
||||
property LoginInfo: TRdxLoginInfo read FLoginInfo;
|
||||
property DataConnector : TUCDataConnector read GetDataConnector;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.DFM}
|
||||
|
||||
uses
|
||||
Forms, Controls, uDataTableUtils, uDataModuleConexion, uLoginForm,
|
||||
uCambiarPassword, Dialogs, Windows, uEmpresasController, schUsuariosClient_Intf;
|
||||
|
||||
{ TDAClientDataModule1 }
|
||||
|
||||
procedure TDataModuleUsuarios.DAClientDataModuleCreate(Sender: TObject);
|
||||
begin
|
||||
ROLoginService.Channel := dmConexion.Channel;
|
||||
ROLoginService.Message := dmConexion.Message;
|
||||
|
||||
FDataConnector := TUCROConn.Create(nil);
|
||||
FDataConnector.RemoteService := srvUsuarios;
|
||||
|
||||
FUsuario := '';
|
||||
FPassword := '';
|
||||
FLoginInfo := NIL;
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.Login: Boolean;
|
||||
begin
|
||||
// Intento hacer login si el usuario ya lo había hecho antes
|
||||
if (Length(FUsuario) > 0) then
|
||||
if Login(FUsuario, FPassword) then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Si no funcionar el login anterior o es la primera vez,
|
||||
// saco la pantalla de login
|
||||
with TfLoginForm.Create(NIL) do
|
||||
try
|
||||
if Assigned(FLoginInfo) then
|
||||
edtUser.Text := FLoginInfo.Usuario;
|
||||
Result := (ShowModal = mrOK)
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.Login(Usuario: String; Password: String): Boolean;
|
||||
begin
|
||||
// Libero la información del login anterior (sesión, etc)
|
||||
if Assigned(FLoginInfo) then
|
||||
FreeANDNil(FLoginInfo);
|
||||
|
||||
Result := (ROLoginService as IsrvLogin).Login(Usuario, Password, FLoginInfo);
|
||||
|
||||
if Result then
|
||||
begin
|
||||
// Lo guardo para poder reconectarme
|
||||
FUsuario := Usuario;
|
||||
FPassword := Password;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.Logout;
|
||||
begin
|
||||
(ROLoginService as IsrvLogin).Logout;
|
||||
if Assigned(FLoginInfo) then
|
||||
FreeANDNil(FLoginInfo);
|
||||
FUsuario := '';
|
||||
FPassword := '';
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.SetEmpresaActual(const Value: IBizEmpresa);
|
||||
begin
|
||||
FEmpresaActual := Value;
|
||||
FEmpresaActual.DataTable.Active := True;
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.SetIDEmpresaActual(const Value: Integer);
|
||||
var
|
||||
AEmpresasController : IEmpresasController;
|
||||
AEmpresa : IBizEmpresa;
|
||||
begin
|
||||
AEmpresasController := TEmpresasController.Create;
|
||||
AEmpresa := AEmpresasController.Buscar(Value);
|
||||
AEmpresa.DataTable.Active := True;
|
||||
|
||||
if not AEmpresa.IsEmpty then
|
||||
begin
|
||||
FEmpresaActual := AEmpresa;
|
||||
FEmpresaActual.DataTable.Active := True;
|
||||
end
|
||||
else
|
||||
FEmpresaActual := NIL;
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.DAClientDataModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataConnector) then
|
||||
FreeANDNIL(FDataConnector);
|
||||
|
||||
if Assigned(FLoginInfo) then
|
||||
FreeANDNIL(FLoginInfo);
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.GetDataConnector: TUCDataConnector;
|
||||
begin
|
||||
Result := FDataConnector;
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.GetEmpresas: TIntegerList;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := TIntegerList.Create;
|
||||
|
||||
if not Assigned(FLoginInfo) then
|
||||
raise Exception.Create('Usuario no validado en el sistema (login)');
|
||||
|
||||
for i := 0 to FLoginInfo.Empresas.Count - 1 do
|
||||
Result.Add(FLoginInfo.Empresas.Items[i]);
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.GetEsAdministrador: Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not Assigned(FLoginInfo) then
|
||||
raise Exception.Create('Usuario no validado en el sistema (login)');
|
||||
|
||||
for I := 0 to FLoginInfo.Perfiles.Count - 1 do
|
||||
if FLoginInfo.Perfiles.Items[I] = PERFIL_ADMINISTRADORES then
|
||||
begin
|
||||
Result := True;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.GetIDEmpresaActual: Integer;
|
||||
begin
|
||||
if not Assigned(FEmpresaActual) then
|
||||
Result := ID_NULO
|
||||
else
|
||||
Result := FEmpresaActual.ID;
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.InicializarCamposUserControl(
|
||||
AUserControl: TUserControl);
|
||||
begin
|
||||
if not Assigned(AUserControl) then
|
||||
raise Exception.Create('UserControl no asignado (InicializarUserControl)');
|
||||
|
||||
with AUserControl do
|
||||
begin
|
||||
DataConnector := FDataConnector;
|
||||
|
||||
with TableUsers do
|
||||
begin
|
||||
TableName := nme_USUARIOS;
|
||||
FieldUserID := fld_USUARIOSID;
|
||||
FieldUserName := fld_USUARIOSUSERNAME;
|
||||
FieldLogin := fld_USUARIOSLOGIN;
|
||||
FieldPassword := fld_USUARIOSPASS;
|
||||
FieldEmail := fld_USUARIOSEMAIL;
|
||||
FieldPrivileged := fld_USUARIOSPRIVILEGED;
|
||||
FieldTypeRec := fld_USUARIOSTIPO;
|
||||
FieldProfile := fld_USUARIOSID_PERFIL;
|
||||
FieldUserExpired := fld_USUARIOSBLOQUEADO;
|
||||
FieldDateExpired := fld_USUARIOSPASSEXPIRED;
|
||||
FieldUserDaysSun := fld_USUARIOSUSERDAYSSUN;
|
||||
FieldKey := fld_USUARIOSCHECKSUM;
|
||||
end;
|
||||
|
||||
with TableRights do
|
||||
begin
|
||||
TableName := nme_PERMISOS;
|
||||
FieldUserID := fld_PERMISOSID_USUARIO;
|
||||
FieldModule := fld_PERMISOSMODULO;
|
||||
FieldComponentName := fld_PERMISOSNOMBRECOMP;
|
||||
FieldFormName := fld_PERMISOSEXNOMBREFORM;
|
||||
FieldKey := fld_PERMISOSCHECKSUM;
|
||||
end;
|
||||
|
||||
with TableUsersLogged do
|
||||
begin
|
||||
TableName := nme_USUARIOS_LOGON;
|
||||
FieldLogonID := fld_USUARIOS_LOGONLOGONID;
|
||||
FieldUserID := fld_USUARIOS_LOGONID_USUARIO;
|
||||
FieldApplicationID := fld_USUARIOS_LOGONAPLICACION;
|
||||
FieldMachineName := fld_USUARIOS_LOGONEQUIPO;
|
||||
FieldData := fld_USUARIOS_LOGONDATA;
|
||||
end;
|
||||
|
||||
with TableHistory do
|
||||
begin
|
||||
TableName := nme_USUARIOS_EVENTOS;
|
||||
FieldApplicationID := fld_USUARIOS_EVENTOSAPLICACION;
|
||||
FieldUserID := fld_USUARIOS_EVENTOSID_USUARIO;
|
||||
FieldEventDate := fld_USUARIOS_EVENTOSFECHA;
|
||||
FieldEventTime := fld_USUARIOS_EVENTOSHORA;
|
||||
FieldForm := fld_USUARIOS_EVENTOSFORM;
|
||||
FieldCaptionForm := fld_USUARIOS_EVENTOSTITULO_FORM;
|
||||
FieldEvent := fld_USUARIOS_EVENTOSEVENTO;
|
||||
FieldObs := fld_USUARIOS_EVENTOSNOTAS;
|
||||
FieldTableName := fld_USUARIOS_EVENTOSTNAME;
|
||||
end;
|
||||
|
||||
with TableEmpresa do
|
||||
begin
|
||||
Active := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataModuleUsuarios.CambiarPassword;
|
||||
begin
|
||||
with TfCambiarPassword.Create(NIL) do
|
||||
try
|
||||
if ShowModal = mrOk then
|
||||
if CambiarPassword(edtPassword.Text) then
|
||||
Application.MessageBox('La contraseña ha sido cambiada correctamente.', 'Información', MB_OK);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataModuleUsuarios.CambiarPassword(const APassword: String): boolean;
|
||||
begin
|
||||
{ if not (ROLoginService as IsrvLogin).SetUserPassword(LoginInfo.UserID, APassword) then
|
||||
raise Exception.Create('Error en el servidor. No se ha podido cambiar la contraseña');}
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
1099
Source/Base/Usuarios/Data/uLoginForm.dfm
Normal file
1099
Source/Base/Usuarios/Data/uLoginForm.dfm
Normal file
File diff suppressed because it is too large
Load Diff
101
Source/Base/Usuarios/Data/uLoginForm.pas
Normal file
101
Source/Base/Usuarios/Data/uLoginForm.pas
Normal file
@ -0,0 +1,101 @@
|
||||
unit uLoginForm;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ExtCtrls, ComCtrls, cxGraphics, cxControls,
|
||||
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit,
|
||||
cxImageComboBox, ImgList, PngImageList, pngimage, ToolWin, JvExControls,
|
||||
JvComponent, JvGradient, JvGIF, JvComponentBase, JvFormPlacement,
|
||||
JvAppStorage, JvAppRegistryStorage;
|
||||
|
||||
type
|
||||
TfLoginForm = class(TForm)
|
||||
Panel1: TPanel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
edtPassword: TEdit;
|
||||
bAceptar: TButton;
|
||||
bCancelar: TButton;
|
||||
Label1: TLabel;
|
||||
edtUser: TEdit;
|
||||
JvGradient1: TJvGradient;
|
||||
Button1: TButton;
|
||||
Timer1: TTimer;
|
||||
JvAppRegistryStorage1: TJvAppRegistryStorage;
|
||||
JvFormStorage1: TJvFormStorage;
|
||||
Image1: TImage;
|
||||
procedure bAceptarClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ToolButton4Click(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure Timer1Timer(Sender: TObject);
|
||||
private
|
||||
FIntentos: Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
fLoginForm: TfLoginForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uDataModuleUsuarios, uDataModuleConexion, uDataModuleBase;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
{
|
||||
********************************* TfLoginForm **********************************
|
||||
}
|
||||
procedure TfLoginForm.bAceptarClick(Sender: TObject);
|
||||
var
|
||||
bOk : Boolean;
|
||||
begin
|
||||
{ ShowHourglassCursor;
|
||||
try
|
||||
bOK := dmUsuarios.Login(edtUser.Text, edtPassword.Text);
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
|
||||
if bOk then
|
||||
ModalResult := mrOK
|
||||
else begin
|
||||
Application.MessageBox('Usuario no válido. Compruebe si ha escrito correctamente'
|
||||
+ #13 + #10 + 'el usuario y la contraseña.', 'Atención', MB_OK);
|
||||
Dec(FIntentos);
|
||||
if (FIntentos <= 0) then
|
||||
ModalResult := mrCancel;
|
||||
end;}
|
||||
end;
|
||||
|
||||
procedure TfLoginForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FIntentos := 3;
|
||||
end;
|
||||
|
||||
procedure TfLoginForm.ToolButton4Click(Sender: TObject);
|
||||
begin
|
||||
Timer1.Enabled := False;
|
||||
dmConexion.ConfigurarConexion;
|
||||
Timer1.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfLoginForm.FormShow(Sender: TObject);
|
||||
begin
|
||||
Self.Caption := Self.Caption + ' - ' + dmBase.DarVersion;
|
||||
JvFormStorage1.RestoreFormPlacement;
|
||||
// Hacer login automática si hay usuario/password y no hay más de una base
|
||||
// de datos como opción para conectarse.
|
||||
if ((Length(edtUser.Text) > 0) and (Length(edtPassword.Text) > 0)) then
|
||||
Timer1.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfLoginForm.Timer1Timer(Sender: TObject);
|
||||
begin
|
||||
Timer1.Enabled := False;
|
||||
bAceptar.Click;
|
||||
end;
|
||||
|
||||
end.
|
||||
196
Source/Base/Usuarios/Data/uUCROConn.pas
Normal file
196
Source/Base/Usuarios/Data/uUCROConn.pas
Normal file
@ -0,0 +1,196 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
Unit Name: UCMidasConn
|
||||
Author : Luiz Benevenuto
|
||||
Date : 31/07/2005
|
||||
Purpose : Midas Suporte ( DataSnap )
|
||||
E-mail : luiz@siffra.com
|
||||
URL : www.siffra.com
|
||||
UC : www.usercontrol.com.br
|
||||
Forum : http://www.usercontrol.com.br/modules.php?name=Forums
|
||||
|
||||
registered in UCMidasConnReg.pas
|
||||
-----------------------------------------------------------------------------}
|
||||
|
||||
unit uUCROConn;
|
||||
|
||||
interface
|
||||
|
||||
//{$I 'UserControl.inc'}
|
||||
|
||||
uses
|
||||
Classes,
|
||||
DB,
|
||||
DBClient,
|
||||
SysUtils,
|
||||
UCDataConnector,
|
||||
uRORemoteService,
|
||||
uDADataStreamer,
|
||||
uDABin2DataStreamer,
|
||||
uDARemoteDataAdapter;
|
||||
|
||||
type
|
||||
TUCROConn = class(TUCDataConnector)
|
||||
private
|
||||
FRemoteService: TRORemoteService;
|
||||
FDataAdapter : TDARemoteDataAdapter;
|
||||
FDataStreamer : TDABin2DataStreamer;
|
||||
procedure SetRemoteService(const Value: TRORemoteService);
|
||||
protected
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
public
|
||||
function GetDBObjectName: String; override;
|
||||
function GetTransObjectName: String; override;
|
||||
function UCFindDataConnection: Boolean; override;
|
||||
function UCFindTable(const Tablename: String): Boolean; override;
|
||||
function UCGetSQLDataset(FSQL: String): TDataset; override;
|
||||
procedure UCExecSQL(FSQL: String); override;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property RemoteService : TRORemoteService read FRemoteService write SetRemoteService;
|
||||
end;
|
||||
|
||||
const
|
||||
// Select para as tabelas de sistema !!! Para outro tipo de banco implemente aqui !!!!!
|
||||
|
||||
// Para banco novo !!!
|
||||
// Não esquecer de colocar em TBancoDados, o tipo de banco !!!!!!
|
||||
// Não esquecer de colocar no 'case' de UCFindTable
|
||||
|
||||
SQL_Firebird =
|
||||
'SELECT ' +
|
||||
' UPPER(RDB$RELATIONS.RDB$RELATION_NAME) RDB$RELATION_NAME ' +
|
||||
'FROM ' +
|
||||
' RDB$RELATIONS ' +
|
||||
'WHERE ' +
|
||||
' RDB$RELATIONS.RDB$FLAGS = 1 AND UPPER(RDB$RELATIONS.RDB$RELATION_NAME) = ' +
|
||||
' UPPER(''%s'')';
|
||||
|
||||
SQL_MSSQL = '';
|
||||
|
||||
SQL_Oracle = '';
|
||||
|
||||
SQL_PostgreSQL =
|
||||
'SELECT ' +
|
||||
' UPPER(PG_CLASS.RELNAME) ' +
|
||||
'FROM ' +
|
||||
' PG_CLASS ' +
|
||||
'WHERE ' +
|
||||
' PG_CLASS.RELKIND = ''r'' AND ' +
|
||||
' UPPER(PG_CLASS.RELNAME) LIKE UPPER(''%s'')';
|
||||
|
||||
SQL_MySQL = '';
|
||||
|
||||
SQL_Paradox = '';
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
FactuGES_Intf, uROTypes, uDAClasses, uDADataTable;
|
||||
|
||||
{ TUCROConn }
|
||||
|
||||
constructor TUCROConn.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FDataStreamer := TDABin2DataStreamer.Create(nil);
|
||||
FDataAdapter := TDARemoteDataAdapter.Create(nil);
|
||||
FDataAdapter.DataStreamer := FDataStreamer;
|
||||
FDataAdapter.SetupDefaultRequest;
|
||||
end;
|
||||
|
||||
destructor TUCROConn.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDataAdapter);
|
||||
FreeAndNil(FDataStreamer);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TUCROConn.GetDBObjectName: String;
|
||||
begin
|
||||
if Assigned(FRemoteService) then
|
||||
begin
|
||||
if Owner = FRemoteService.Owner then
|
||||
Result := FRemoteService.Name
|
||||
else
|
||||
Result := FRemoteService.Owner.Name + '.' + FRemoteService.Name;
|
||||
end
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TUCROConn.GetTransObjectName: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure TUCROConn.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
if (Operation = opRemove) and (AComponent = FRemoteService) then
|
||||
begin
|
||||
FreeAndNil(FDataAdapter);
|
||||
FRemoteService := nil;
|
||||
end;
|
||||
inherited Notification(AComponent, Operation);
|
||||
end;
|
||||
|
||||
procedure TUCROConn.SetRemoteService(const Value: TRORemoteService);
|
||||
begin
|
||||
FRemoteService := Value;
|
||||
if Assigned(FRemoteService) then
|
||||
begin
|
||||
with FDataAdapter do
|
||||
begin
|
||||
RemoteService := FRemoteService;
|
||||
GetSchemaCall.RemoteService := FRemoteService;
|
||||
GetDataCall.RemoteService := FRemoteService;
|
||||
UpdateDataCall.RemoteService := FRemoteService;
|
||||
GetScriptsCall.RemoteService := FRemoteService;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUCROConn.UCExecSQL(FSQL: String);
|
||||
begin
|
||||
(FRemoteService as IsrvUsuarios).SQLExecuteCommand(FSQL);
|
||||
end;
|
||||
|
||||
function TUCROConn.UCFindDataConnection: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if Assigned(FRemoteService) then
|
||||
begin
|
||||
FRemoteService.CheckCanConnect;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUCROConn.UCFindTable(const Tablename: String): Boolean;
|
||||
var
|
||||
ASchema : TDASchema;
|
||||
begin
|
||||
ASchema := FDataAdapter.ReadSchema;
|
||||
try
|
||||
Result := Assigned(ASchema.FindDataset(TableName));
|
||||
finally
|
||||
FreeAndNil(ASchema);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUCROConn.UCGetSQLDataset(FSQL: String): TDataset;
|
||||
var
|
||||
AStream : Binary;
|
||||
ADataTable : TDADataTable;
|
||||
begin
|
||||
Result := NIL;
|
||||
AStream := (FRemoteService as IsrvUsuarios).SQLGetData(FSQL, True, -1);
|
||||
if Assigned(AStream) then
|
||||
begin
|
||||
ADataTable := TDADataTable.Create(NIL);
|
||||
ADataTable.LoadFromStream(AStream);
|
||||
Result := ADataTable.Dataset;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
123
Source/Base/Usuarios/Data/uUsuario.dfm
Normal file
123
Source/Base/Usuarios/Data/uUsuario.dfm
Normal file
@ -0,0 +1,123 @@
|
||||
object fUsuario: TfUsuario
|
||||
Left = 523
|
||||
Top = 415
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Datos del usuario'
|
||||
ClientHeight = 309
|
||||
ClientWidth = 308
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Button1: TButton
|
||||
Left = 138
|
||||
Top = 273
|
||||
Width = 75
|
||||
Height = 25
|
||||
Action = actAceptar
|
||||
TabOrder = 1
|
||||
end
|
||||
object Button2: TButton
|
||||
Left = 226
|
||||
Top = 273
|
||||
Width = 75
|
||||
Height = 25
|
||||
Action = actCancelar
|
||||
TabOrder = 2
|
||||
end
|
||||
object TabControl1: TPageControl
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 293
|
||||
Height = 257
|
||||
ActivePage = pagUsuario
|
||||
TabOrder = 0
|
||||
object pagUsuario: TTabSheet
|
||||
Caption = 'Usuario'
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 6
|
||||
Top = 5
|
||||
Width = 274
|
||||
Height = 99
|
||||
Caption = 'GroupBox1'
|
||||
TabOrder = 0
|
||||
DesignSize = (
|
||||
274
|
||||
99)
|
||||
object Label4: TLabel
|
||||
Left = 34
|
||||
Top = 28
|
||||
Width = 39
|
||||
Height = 13
|
||||
Caption = 'Usuario:'
|
||||
Transparent = False
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 16
|
||||
Top = 60
|
||||
Width = 57
|
||||
Height = 13
|
||||
Caption = 'Contrase'#241'a:'
|
||||
Transparent = False
|
||||
end
|
||||
object edtUser: TEdit
|
||||
Left = 88
|
||||
Top = 24
|
||||
Width = 169
|
||||
Height = 21
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtPassword: TEdit
|
||||
Left = 88
|
||||
Top = 56
|
||||
Width = 169
|
||||
Height = 21
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
PasswordChar = '*'
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 7
|
||||
Top = 111
|
||||
Width = 273
|
||||
Height = 110
|
||||
Caption = 'Permisos y seguridad'
|
||||
TabOrder = 1
|
||||
object Label1: TLabel
|
||||
Left = 47
|
||||
Top = 36
|
||||
Width = 26
|
||||
Height = 13
|
||||
Caption = 'Perfil:'
|
||||
Transparent = False
|
||||
end
|
||||
object cbPerfil: TComboBox
|
||||
Left = 88
|
||||
Top = 28
|
||||
Width = 169
|
||||
Height = 21
|
||||
ItemHeight = 13
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object ActionList: TActionList
|
||||
Left = 8
|
||||
Top = 272
|
||||
object actAceptar: TAction
|
||||
Caption = '&Aceptar'
|
||||
end
|
||||
object actCancelar: TAction
|
||||
Caption = '&Cancelar'
|
||||
end
|
||||
end
|
||||
end
|
||||
39
Source/Base/Usuarios/Data/uUsuario.pas
Normal file
39
Source/Base/Usuarios/Data/uUsuario.pas
Normal file
@ -0,0 +1,39 @@
|
||||
unit uUsuario;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ComCtrls, ActnList;
|
||||
|
||||
type
|
||||
TfUsuario = class(TForm)
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
TabControl1: TPageControl;
|
||||
pagUsuario: TTabSheet;
|
||||
GroupBox1: TGroupBox;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
edtUser: TEdit;
|
||||
edtPassword: TEdit;
|
||||
GroupBox2: TGroupBox;
|
||||
Label1: TLabel;
|
||||
cbPerfil: TComboBox;
|
||||
ActionList: TActionList;
|
||||
actAceptar: TAction;
|
||||
actCancelar: TAction;
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fUsuario: TfUsuario;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
end.
|
||||
118
Source/Base/Usuarios/Data/uUsuarios.dfm
Normal file
118
Source/Base/Usuarios/Data/uUsuarios.dfm
Normal file
@ -0,0 +1,118 @@
|
||||
object fUsuarios: TfUsuarios
|
||||
Left = 490
|
||||
Top = 417
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Administraci'#243'n de usuarios'
|
||||
ClientHeight = 401
|
||||
ClientWidth = 550
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Grid: TDBGrid
|
||||
Left = 8
|
||||
Top = 40
|
||||
Width = 425
|
||||
Height = 313
|
||||
DataSource = DADataSource
|
||||
TabOrder = 0
|
||||
TitleFont.Charset = DEFAULT_CHARSET
|
||||
TitleFont.Color = clWindowText
|
||||
TitleFont.Height = -11
|
||||
TitleFont.Name = 'MS Sans Serif'
|
||||
TitleFont.Style = []
|
||||
end
|
||||
object JvNavPanelHeader1: TJvNavPanelHeader
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 550
|
||||
Align = alTop
|
||||
Caption = 'Panel de control'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindow
|
||||
Font.Height = -16
|
||||
Font.Name = 'Arial'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
ColorFrom = 8684164
|
||||
ColorTo = 8684164
|
||||
ImageIndex = 0
|
||||
StyleManager = dmBase.StyleManager
|
||||
ParentStyleManager = False
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 448
|
||||
Top = 40
|
||||
Width = 91
|
||||
Height = 25
|
||||
Action = actNuevo
|
||||
TabOrder = 2
|
||||
end
|
||||
object Button2: TButton
|
||||
Left = 448
|
||||
Top = 136
|
||||
Width = 91
|
||||
Height = 25
|
||||
Action = actModificar
|
||||
TabOrder = 3
|
||||
end
|
||||
object Button3: TButton
|
||||
Left = 448
|
||||
Top = 176
|
||||
Width = 91
|
||||
Height = 25
|
||||
Action = actEliminar
|
||||
TabOrder = 4
|
||||
end
|
||||
object Button4: TButton
|
||||
Left = 448
|
||||
Top = 368
|
||||
Width = 91
|
||||
Height = 25
|
||||
Action = actCerrar
|
||||
TabOrder = 5
|
||||
end
|
||||
object Button5: TButton
|
||||
Left = 448
|
||||
Top = 96
|
||||
Width = 91
|
||||
Height = 25
|
||||
Action = actCambiarPassword
|
||||
TabOrder = 6
|
||||
end
|
||||
object DADataSource: TDADataSource
|
||||
Left = 368
|
||||
Top = 40
|
||||
end
|
||||
object ActionList: TActionList
|
||||
Left = 8
|
||||
Top = 360
|
||||
object actCerrar: TAction
|
||||
Caption = '&Cerrar'
|
||||
OnExecute = actCerrarExecute
|
||||
end
|
||||
object actNuevo: TAction
|
||||
Caption = 'Nuevo usuario'
|
||||
OnUpdate = actNuevoUpdate
|
||||
end
|
||||
object actCambiarPassword: TAction
|
||||
Caption = 'Cambiar contrase'#241'a'
|
||||
OnUpdate = actCambiarPasswordUpdate
|
||||
end
|
||||
object actModificar: TAction
|
||||
Caption = 'Modificar usuario'
|
||||
OnUpdate = actModificarUpdate
|
||||
end
|
||||
object actEliminar: TAction
|
||||
Caption = 'Eliminar usuario'
|
||||
OnUpdate = actEliminarUpdate
|
||||
end
|
||||
end
|
||||
end
|
||||
89
Source/Base/Usuarios/Data/uUsuarios.pas
Normal file
89
Source/Base/Usuarios/Data/uUsuarios.pas
Normal file
@ -0,0 +1,89 @@
|
||||
unit uUsuarios;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, DB, uDADataTable, dbcgrids, uDataModuleUsuarios, StdCtrls,
|
||||
DBCtrls, uDataModuleBase, JvExControls, JvComponent, JvNavigationPane,
|
||||
Grids, DBGrids, ActnList, uDAInterfaces;
|
||||
|
||||
type
|
||||
TfUsuarios = class(TForm)
|
||||
DADataSource: TDADataSource;
|
||||
Grid: TDBGrid;
|
||||
JvNavPanelHeader1: TJvNavPanelHeader;
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
Button4: TButton;
|
||||
Button5: TButton;
|
||||
ActionList: TActionList;
|
||||
actCerrar: TAction;
|
||||
actNuevo: TAction;
|
||||
actCambiarPassword: TAction;
|
||||
actModificar: TAction;
|
||||
actEliminar: TAction;
|
||||
procedure actCerrarExecute(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure actEliminarUpdate(Sender: TObject);
|
||||
procedure actModificarUpdate(Sender: TObject);
|
||||
procedure actCambiarPasswordUpdate(Sender: TObject);
|
||||
procedure actNuevoUpdate(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
procedure AdministrarUsuarios;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
|
||||
procedure AdministrarUsuarios;
|
||||
var
|
||||
fUsuarios: TfUsuarios;
|
||||
begin
|
||||
fUsuarios := TfUsuarios.Create(NIL);
|
||||
try
|
||||
fUsuarios.ShowModal;
|
||||
finally
|
||||
fUsuarios.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.actCerrarExecute(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.FormCreate(Sender: TObject);
|
||||
begin
|
||||
{ DADataSource.DataTable := dmUsuarios.tbl_Usuarios;
|
||||
DADataSource.DataTable.Active := True;}
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.actEliminarUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.actModificarUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.actCambiarPasswordUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled := not (DADataSource.DataTable.IsEmpty);
|
||||
end;
|
||||
|
||||
procedure TfUsuarios.actNuevoUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled := Assigned(DADataSource.DataTable);
|
||||
end;
|
||||
|
||||
end.
|
||||
18
Source/Base/Usuarios/Model/Data/uIDataModuleUsuarios.pas
Normal file
18
Source/Base/Usuarios/Model/Data/uIDataModuleUsuarios.pas
Normal file
@ -0,0 +1,18 @@
|
||||
unit uIDataModuleUsuarios;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
UCBase, UCDataConnector;
|
||||
|
||||
type
|
||||
IDataModuleUsuarios = interface
|
||||
['{F2D2E969-5E87-42DE-A550-E839C4607C72}']
|
||||
procedure InicializarCamposUserControl (AUserControl : TUserControl);
|
||||
function GetDataConnector : TUCDataConnector;
|
||||
property DataConnector : TUCDataConnector read GetDataConnector;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
1464
Source/Base/Usuarios/Model/schUsuariosClient_Intf.pas
Normal file
1464
Source/Base/Usuarios/Model/schUsuariosClient_Intf.pas
Normal file
File diff suppressed because it is too large
Load Diff
1715
Source/Base/Usuarios/Model/schUsuariosServer_Intf.pas
Normal file
1715
Source/Base/Usuarios/Model/schUsuariosServer_Intf.pas
Normal file
File diff suppressed because it is too large
Load Diff
419
Source/Base/Usuarios/Servidor/srvUsuarios_Impl.dfm
Normal file
419
Source/Base/Usuarios/Servidor/srvUsuarios_Impl.dfm
Normal file
@ -0,0 +1,419 @@
|
||||
object srvUsuarios: TsrvUsuarios
|
||||
OldCreateOrder = True
|
||||
OnCreate = DataAbstractServiceCreate
|
||||
SessionManager = dmServer.SessionManager
|
||||
ServiceSchema = schUsuarios
|
||||
ServiceDataStreamer = Bin2DataStreamer
|
||||
AllowExecuteSQL = True
|
||||
AllowWhereSQL = True
|
||||
ExportedDataTables = <>
|
||||
BeforeAcquireConnection = DataAbstractServiceBeforeAcquireConnection
|
||||
Height = 300
|
||||
Width = 300
|
||||
object Diagrams: TDADiagrams
|
||||
Left = 150
|
||||
Top = 88
|
||||
DiagramData = '<Diagrams>'#13#10'</Diagrams>'#13#10
|
||||
end
|
||||
object DataDictionary: TDADataDictionary
|
||||
Fields = <>
|
||||
Left = 150
|
||||
Top = 24
|
||||
end
|
||||
object schUsuarios: TDASchema
|
||||
ConnectionManager = dmServer.ConnectionManager
|
||||
DataDictionary = DataDictionary
|
||||
Diagrams = Diagrams
|
||||
Datasets = <
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
ConnectionType = 'Interbase'
|
||||
Default = True
|
||||
TargetTable = 'USUARIOS'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID'
|
||||
TableField = 'ID'
|
||||
end
|
||||
item
|
||||
DatasetField = 'USERNAME'
|
||||
TableField = 'USERNAME'
|
||||
end
|
||||
item
|
||||
DatasetField = 'LOGIN'
|
||||
TableField = 'LOGIN'
|
||||
end
|
||||
item
|
||||
DatasetField = 'PASS'
|
||||
TableField = 'PASS'
|
||||
end
|
||||
item
|
||||
DatasetField = 'PASSEXPIRED'
|
||||
TableField = 'PASSEXPIRED'
|
||||
end
|
||||
item
|
||||
DatasetField = 'BLOQUEADO'
|
||||
TableField = 'BLOQUEADO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'EMAIL'
|
||||
TableField = 'EMAIL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'USERDAYSSUN'
|
||||
TableField = 'USERDAYSSUN'
|
||||
end
|
||||
item
|
||||
DatasetField = 'PRIVILEGED'
|
||||
TableField = 'PRIVILEGED'
|
||||
end
|
||||
item
|
||||
DatasetField = 'TIPO'
|
||||
TableField = 'TIPO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'ID_PERFIL'
|
||||
TableField = 'ID_PERFIL'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CHECKSUM'
|
||||
TableField = 'CHECKSUM'
|
||||
end>
|
||||
end>
|
||||
Name = 'USUARIOS'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datInteger
|
||||
Required = True
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'USERNAME'
|
||||
DataType = datString
|
||||
Size = 30
|
||||
end
|
||||
item
|
||||
Name = 'LOGIN'
|
||||
DataType = datString
|
||||
Size = 30
|
||||
end
|
||||
item
|
||||
Name = 'PASS'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end
|
||||
item
|
||||
Name = 'PASSEXPIRED'
|
||||
DataType = datDateTime
|
||||
end
|
||||
item
|
||||
Name = 'BLOQUEADO'
|
||||
DataType = datSmallInt
|
||||
end
|
||||
item
|
||||
Name = 'EMAIL'
|
||||
DataType = datString
|
||||
Size = 150
|
||||
end
|
||||
item
|
||||
Name = 'USERDAYSSUN'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'PRIVILEGED'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'TIPO'
|
||||
DataType = datString
|
||||
Size = 1
|
||||
end
|
||||
item
|
||||
Name = 'ID_PERFIL'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'CHECKSUM'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
ConnectionType = 'Interbase'
|
||||
Default = True
|
||||
TargetTable = 'USUARIOS_EVENTOS'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'APLICACION'
|
||||
TableField = 'APLICACION'
|
||||
end
|
||||
item
|
||||
DatasetField = 'ID_USUARIO'
|
||||
TableField = 'ID_USUARIO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'FECHA'
|
||||
TableField = 'FECHA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'HORA'
|
||||
TableField = 'HORA'
|
||||
end
|
||||
item
|
||||
DatasetField = 'FORM'
|
||||
TableField = 'FORM'
|
||||
end
|
||||
item
|
||||
DatasetField = 'TITULO_FORM'
|
||||
TableField = 'TITULO_FORM'
|
||||
end
|
||||
item
|
||||
DatasetField = 'EVENTO'
|
||||
TableField = 'EVENTO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOTAS'
|
||||
TableField = 'NOTAS'
|
||||
end
|
||||
item
|
||||
DatasetField = 'TNAME'
|
||||
TableField = 'TNAME'
|
||||
end>
|
||||
end>
|
||||
Name = 'USUARIOS_EVENTOS'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'APLICACION'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'FECHA'
|
||||
DataType = datString
|
||||
Size = 10
|
||||
end
|
||||
item
|
||||
Name = 'HORA'
|
||||
DataType = datString
|
||||
Size = 8
|
||||
end
|
||||
item
|
||||
Name = 'FORM'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end
|
||||
item
|
||||
Name = 'TITULO_FORM'
|
||||
DataType = datString
|
||||
Size = 100
|
||||
end
|
||||
item
|
||||
Name = 'EVENTO'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'NOTAS'
|
||||
DataType = datMemo
|
||||
end
|
||||
item
|
||||
Name = 'TNAME'
|
||||
DataType = datString
|
||||
Size = 20
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
ConnectionType = 'Interbase'
|
||||
Default = True
|
||||
TargetTable = 'USUARIOS_LOGON'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'LOGONID'
|
||||
TableField = 'LOGONID'
|
||||
end
|
||||
item
|
||||
DatasetField = 'ID_USUARIO'
|
||||
TableField = 'ID_USUARIO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'APLICACION'
|
||||
TableField = 'APLICACION'
|
||||
end
|
||||
item
|
||||
DatasetField = 'EQUIPO'
|
||||
TableField = 'EQUIPO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'DATA'
|
||||
TableField = 'DATA'
|
||||
end>
|
||||
end>
|
||||
Name = 'USUARIOS_LOGON'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'LOGONID'
|
||||
DataType = datString
|
||||
Size = 38
|
||||
Required = True
|
||||
InPrimaryKey = True
|
||||
end
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'APLICACION'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'EQUIPO'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'DATA'
|
||||
DataType = datString
|
||||
Size = 14
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
ConnectionType = 'Interbase'
|
||||
Default = True
|
||||
TargetTable = 'PERMISOS'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID_USUARIO'
|
||||
TableField = 'ID_USUARIO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'MODULO'
|
||||
TableField = 'MODULO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOMBRECOMP'
|
||||
TableField = 'NOMBRECOMP'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CHECKSUM'
|
||||
TableField = 'CHECKSUM'
|
||||
end>
|
||||
end>
|
||||
Name = 'PERMISOS'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'MODULO'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRECOMP'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'CHECKSUM'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
ConnectionType = 'Interbase'
|
||||
Default = True
|
||||
TargetTable = 'PERMISOSEX'
|
||||
StatementType = stAutoSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID_USUARIO'
|
||||
TableField = 'ID_USUARIO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'MODULO'
|
||||
TableField = 'MODULO'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOMBRECOMP'
|
||||
TableField = 'NOMBRECOMP'
|
||||
end
|
||||
item
|
||||
DatasetField = 'NOMBREFORM'
|
||||
TableField = 'NOMBREFORM'
|
||||
end
|
||||
item
|
||||
DatasetField = 'CHECKSUM'
|
||||
TableField = 'CHECKSUM'
|
||||
end>
|
||||
end>
|
||||
Name = 'PERMISOSEX'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
end
|
||||
item
|
||||
Name = 'MODULO'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'NOMBRECOMP'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'NOMBREFORM'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
end
|
||||
item
|
||||
Name = 'CHECKSUM'
|
||||
DataType = datString
|
||||
Size = 250
|
||||
end>
|
||||
end>
|
||||
JoinDataTables = <>
|
||||
UnionDataTables = <>
|
||||
Commands = <>
|
||||
RelationShips = <>
|
||||
UpdateRules = <>
|
||||
Version = 0
|
||||
Left = 48
|
||||
Top = 24
|
||||
end
|
||||
object Bin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 48
|
||||
Top = 88
|
||||
end
|
||||
end
|
||||
65
Source/Base/Usuarios/Servidor/srvUsuarios_Impl.pas
Normal file
65
Source/Base/Usuarios/Servidor/srvUsuarios_Impl.pas
Normal file
@ -0,0 +1,65 @@
|
||||
unit srvUsuarios_Impl;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ This is where you are supposed to code the implementation of your objects. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
{$I Remobjects.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, SysUtils,
|
||||
{RemObjects:} uROXMLIntf, uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
||||
{Required:} uRORemoteDataModule,
|
||||
{Ancestor Implementation:} DataAbstractService_Impl,
|
||||
{Used RODLs:} DataAbstract4_Intf,
|
||||
{Generated:} FactuGES_Intf, uDADataStreamer, uDABin2DataStreamer, uDAClasses;
|
||||
|
||||
type
|
||||
{ TsrvUsuarios }
|
||||
TsrvUsuarios = class(TDataAbstractService, IsrvUsuarios)
|
||||
Diagrams: TDADiagrams;
|
||||
Bin2DataStreamer: TDABin2DataStreamer;
|
||||
schUsuarios: TDASchema;
|
||||
DataDictionary: TDADataDictionary;
|
||||
procedure DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
|
||||
var aConnectionName: string);
|
||||
procedure DataAbstractServiceCreate(Sender: TObject);
|
||||
private
|
||||
protected
|
||||
{ IsrvUsuarios methods }
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
uses
|
||||
{Generated:} FactuGES_Invk, uDataModuleServer;
|
||||
|
||||
procedure Create_srvUsuarios(out anInstance : IUnknown);
|
||||
begin
|
||||
anInstance := TsrvUsuarios.Create(nil);
|
||||
end;
|
||||
|
||||
{ srvUsuarios }
|
||||
procedure TsrvUsuarios.DataAbstractServiceBeforeAcquireConnection(
|
||||
aSender: TObject; var aConnectionName: string);
|
||||
begin
|
||||
ConnectionName := dmServer.ConnectionName;
|
||||
end;
|
||||
|
||||
procedure TsrvUsuarios.DataAbstractServiceCreate(Sender: TObject);
|
||||
begin
|
||||
SessionManager := dmServer.SessionManager;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TROClassFactory.Create('srvUsuarios', Create_srvUsuarios, TsrvUsuarios_Invoker);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
336
Source/Base/Utiles/ClassRegistry/uClassRegistryUtils.pas
Normal file
336
Source/Base/Utiles/ClassRegistry/uClassRegistryUtils.pas
Normal file
@ -0,0 +1,336 @@
|
||||
unit uClassRegistryUtils;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, uGUIBase;
|
||||
|
||||
type
|
||||
IClassRegistry = Interface
|
||||
['{FD23C946-4103-4C67-9C3F-644B52826833}']
|
||||
procedure RegisterClass( aClass: TClass; const aDisplayname: String = '');
|
||||
procedure RegisterClasses( const aClasses: array of TClass;
|
||||
const aDisplaynames: array of String );
|
||||
procedure UnRegisterClass( aClass: TClass );
|
||||
function FindClass( const aClassOrDisplayname: String ): Tclass;
|
||||
function IsClassRegistered( aClass: TClass ): Boolean; overload;
|
||||
function IsClassRegistered( const aDisplayname: String ): Boolean; overload;
|
||||
procedure GetRegisteredClasses( aList: TStrings; aMinClass: TClass = nil);
|
||||
function CreateObject( const aClassOrDisplayname: String ): TObject;
|
||||
end;
|
||||
|
||||
IComponentRegistry = Interface( IClassRegistry )
|
||||
['{04BAA01F-9AF4-4E60-9922-641E127A35C2}']
|
||||
function CreateComponent( const aClassOrDisplayname: String;
|
||||
aOwner:TComponent = nil ): TComponent;
|
||||
end;
|
||||
|
||||
IFormRegistry = Interface( IComponentRegistry )
|
||||
['{28E3BF72-1378-4136-B1FB-027FBB8FE99B}']
|
||||
function CreateForm( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TForm;
|
||||
end;
|
||||
|
||||
IDataModuleRegistry = Interface( IComponentRegistry )
|
||||
['{9D8D1D23-6A5C-4351-9393-093CD8B76788}']
|
||||
function CreateDatamodule( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TDatamodule;
|
||||
end;
|
||||
|
||||
IReportRegistry = Interface( IComponentRegistry )
|
||||
['{49D3C8D5-8FEE-4F15-A6D2-51CB1DB29F8D}']
|
||||
function CreateReport( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TInterfacedObject;
|
||||
end;
|
||||
|
||||
TClassRegistry = class( TInterfacedObject, IClassRegistry )
|
||||
private
|
||||
FList: TStringlist;
|
||||
FMinAcceptableClass: TClass;
|
||||
|
||||
function FindClassByClassname( const aClassname: String ): Tclass;
|
||||
function FindClassByDisplayname( const aDisplayname: String ): TClass;
|
||||
function IsClassAcceptable( aClass: TClass ): Boolean;
|
||||
function GetClasses(index: integer): TClass;
|
||||
function GetCount: Integer;
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass ); virtual;
|
||||
procedure RegisterClass( aClass: TClass; const aDisplayname: String = '');
|
||||
procedure RegisterClasses( const aClasses: array of TClass;
|
||||
const aDisplaynames: array of String );
|
||||
procedure UnRegisterClass( aClass: TClass );
|
||||
function FindClass( const aClassOrDisplayname: String ): Tclass;
|
||||
function IsClassRegistered( aClass: TClass ): Boolean; overload;
|
||||
function IsClassRegistered( const aDisplayname: String ): Boolean; overload;
|
||||
procedure GetRegisteredClasses( aList: TStrings; aMinClass: TClass = nil);
|
||||
function CreateObject( const aClassOrDisplayname: String ): TObject;
|
||||
property MinAcceptableClass: TClass read FMinAcceptableClass;
|
||||
property List: TStringlist read FList;
|
||||
property Count: Integer read GetCount;
|
||||
property Classes[ index: integer ]: TClass read GetClasses;
|
||||
public
|
||||
constructor Create( minAcceptableClass: TClass = nil ); virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TComponentRegistry = class( TClassRegistry, IComponentRegistry )
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass ); override;
|
||||
function CreateComponent( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TComponent;
|
||||
end;
|
||||
|
||||
TFormRegistry = class( TComponentRegistry, IFormRegistry )
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass ); override;
|
||||
function CreateForm( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TForm;
|
||||
end;
|
||||
|
||||
TDataModuleRegistry = class( TComponentRegistry, IDataModuleRegistry )
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass); override;
|
||||
function CreateDatamodule( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TDatamodule;
|
||||
end;
|
||||
|
||||
TReportRegistry = class( TComponentRegistry, IReportRegistry )
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass ); override;
|
||||
function CreateReport( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TInterfacedObject;
|
||||
end;
|
||||
|
||||
EClassRegistryError = class( Exception );
|
||||
|
||||
implementation
|
||||
|
||||
{ TClassRegistry }
|
||||
|
||||
ResourceString
|
||||
eClassnotFound = 'Class "%s" was not found in the registry.';
|
||||
|
||||
constructor TClassRegistry.Create(minAcceptableClass: TClass);
|
||||
begin
|
||||
inherited Create;
|
||||
FList := Tstringlist.Create;
|
||||
ValidateMinAcceptableClass( minAcceptableClass );
|
||||
FMinAcceptableClass := minAcceptableClass;
|
||||
end;
|
||||
|
||||
function TClassRegistry.CreateObject(
|
||||
const aClassOrDisplayname: String): TObject;
|
||||
begin
|
||||
Result := FindClass( aClassOrDisplayname ).Create;
|
||||
end;
|
||||
|
||||
destructor TClassRegistry.Destroy;
|
||||
begin
|
||||
Flist.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TClassRegistry.FindClass(
|
||||
const aClassOrDisplayname: String): Tclass;
|
||||
begin
|
||||
Result := FindClassByDisplayname( aClassOrDisplayname );
|
||||
If not Assigned( Result ) Then
|
||||
Result := FindClassByClassname( aClassOrDisplayname );
|
||||
If not Assigned( Result ) Then
|
||||
raise EClassRegistryError.CreateFmt
|
||||
( eClassnotFound, [ aClassOrDisplayname ] );
|
||||
end;
|
||||
|
||||
function TClassRegistry.FindClassByClassname(
|
||||
const aClassname: String): Tclass;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:= 0 to count-1 do begin
|
||||
Result := classes[i];
|
||||
If Result.ClassNameIs( aClassname ) Then
|
||||
Exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TClassRegistry.FindClassByDisplayname(
|
||||
const aDisplayname: String): TClass;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:= List.IndexOf( aDisplayname );
|
||||
If i >= 0 Then
|
||||
Result := Classes[i]
|
||||
Else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TClassRegistry.GetClasses(index: integer): TClass;
|
||||
begin
|
||||
Result := TClass( List.Objects[index] );
|
||||
end;
|
||||
|
||||
function TClassRegistry.GetCount: Integer;
|
||||
begin
|
||||
Result := List.Count;
|
||||
end;
|
||||
|
||||
procedure TClassRegistry.GetRegisteredClasses(aList: TStrings;
|
||||
aMinClass: TClass);
|
||||
var
|
||||
i: Integer;
|
||||
aClass: TClass;
|
||||
begin
|
||||
Assert( Assigned( aList ));
|
||||
aList.BeginUpdate;
|
||||
try
|
||||
aList.Clear;
|
||||
If not Assigned( aMinClass ) Then
|
||||
aList.Assign( List )
|
||||
else begin
|
||||
For i:= 0 To Count-1 Do Begin
|
||||
aClass := Classes[i];
|
||||
If aClass.InheritsFrom( aMinClass ) Then
|
||||
aList.AddObject( List[i], TObject( aClass ));
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
aList.EndUpdate
|
||||
end;
|
||||
end;
|
||||
|
||||
function TClassRegistry.IsClassAcceptable(aClass: TClass): Boolean;
|
||||
begin
|
||||
Result := Assigned( aClass ) and
|
||||
aClass.InheritsFrom( MinAcceptableClass );
|
||||
end;
|
||||
|
||||
function TClassRegistry.IsClassRegistered(const aDisplayname: String): Boolean;
|
||||
begin
|
||||
Result := List.IndexOf(aDisplayname) >= 0;
|
||||
end;
|
||||
|
||||
function TClassRegistry.IsClassRegistered(aClass: TClass): Boolean;
|
||||
begin
|
||||
Result := List.IndexOfObject( TObject( aClass )) >= 0;
|
||||
end;
|
||||
|
||||
procedure TClassRegistry.RegisterClass(aClass: TClass;
|
||||
const aDisplayname: String);
|
||||
begin
|
||||
Assert( Assigned( aClass ), 'Cannot register Nil class' );
|
||||
If aDisplayname = '' Then
|
||||
RegisterClass( aClass, aClass.Classname )
|
||||
else begin
|
||||
Assert( IsClassAcceptable( aClass ),
|
||||
format('Cannot register %s since it does not inherit from %s',
|
||||
[aclass.classname, MinAcceptableClass.classname] ));
|
||||
Assert( not IsClassRegistered( aClass ),
|
||||
Format('Class %s is already registered.', [aClass.Classname]));
|
||||
List.AddObject( aDisplayname, TObject( aClass ));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TClassRegistry.RegisterClasses(const aClasses: array of TClass;
|
||||
const aDisplaynames: array of String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Assert( High( aClasses ) = High( aDisplaynames ),
|
||||
'Size of both parameter arrays has to be the same.' );
|
||||
for i:= Low( aClasses ) to High( aClasses ) do
|
||||
RegisterClass( aClasses[i], aDisplaynames[i] );
|
||||
end;
|
||||
|
||||
procedure TClassRegistry.UnRegisterClass(aClass: TClass);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:= List.IndexOfObject( TObject( aClass ));
|
||||
If i >= 0 Then
|
||||
List.Delete( i );
|
||||
// does not consider attempt to unregister a class that is not
|
||||
// registered as an error.
|
||||
end;
|
||||
|
||||
procedure TClassRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
If not Assigned( aMinAcceptableClass ) Then
|
||||
aMinAcceptableClass := TObject;
|
||||
end;
|
||||
|
||||
{ TComponentRegistry }
|
||||
|
||||
function TComponentRegistry.CreateComponent(
|
||||
const aClassOrDisplayname: String; aOwner: TComponent): TComponent;
|
||||
var
|
||||
aClass: TComponentClass;
|
||||
begin
|
||||
aClass := TComponentClass( FindClass( aClassOrDisplayname ));
|
||||
Result := aClass.Create( aOwner );
|
||||
end;
|
||||
|
||||
procedure TComponentRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
If not aMinAcceptableClass.InheritsFrom( TComponent )
|
||||
Then
|
||||
aMinAcceptableClass := TComponent;
|
||||
end;
|
||||
|
||||
{ TFormRegistry }
|
||||
|
||||
function TFormRegistry.CreateForm(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent): TForm;
|
||||
begin
|
||||
Result := CreateComponent( aClassOrDisplayname, aOwner ) As TForm;
|
||||
end;
|
||||
|
||||
procedure TFormRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
If not aMinAcceptableClass.InheritsFrom( TForm )
|
||||
Then
|
||||
aMinAcceptableClass := TForm;
|
||||
end;
|
||||
|
||||
{ TDataModuleRegistry }
|
||||
|
||||
function TDataModuleRegistry.CreateDatamodule(
|
||||
const aClassOrDisplayname: String; aOwner: TComponent): TDatamodule;
|
||||
begin
|
||||
Result := CreateComponent( aClassOrDisplayname, aOwner ) As TDatamodule;
|
||||
end;
|
||||
|
||||
procedure TDataModuleRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
If not aMinAcceptableClass.InheritsFrom( TDatamodule )
|
||||
Then
|
||||
aMinAcceptableClass := TDatamodule;
|
||||
end;
|
||||
|
||||
{ TReportRegistry }
|
||||
|
||||
function TReportRegistry.CreateReport(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent): TInterfacedObject;
|
||||
begin
|
||||
Result := CreateObject( aClassOrDisplayname) As TInterfacedObject;
|
||||
// Result := CreateComponent( aClassOrDisplayname, aOwner ) As TInterfacedObject;
|
||||
end;
|
||||
|
||||
procedure TReportRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
If not aMinAcceptableClass.InheritsFrom( TInterfacedObject )
|
||||
Then
|
||||
aMinAcceptableClass := TInterfacedObject;
|
||||
end;
|
||||
|
||||
end.
|
||||
81
Source/Base/Utiles/ClassRegistry/uEditorRegistryUtils.pas
Normal file
81
Source/Base/Utiles/ClassRegistry/uEditorRegistryUtils.pas
Normal file
@ -0,0 +1,81 @@
|
||||
unit uEditorRegistryUtils;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Forms, uClassRegistryUtils, uCustomEditor;
|
||||
|
||||
type
|
||||
{
|
||||
IEditorRegistry = interface (IComponentRegistry)
|
||||
22F14B82-AC61-4987-847E-AF8513DE2A10
|
||||
function CreateEditor(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = NIL): TCustomEditor;
|
||||
end;
|
||||
|
||||
TEditorRegistry = class(TComponentRegistry, IEditorRegistry)
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass); override;
|
||||
function CreateEditor(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil): TCustomEditor;
|
||||
end;
|
||||
}
|
||||
|
||||
IEditorRegistry = interface (IFormRegistry)
|
||||
['{F6AC050F-5547-4E1F-AA44-DA0D06EDA4D7}']
|
||||
function CreateEditor(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = NIL): TForm;
|
||||
end;
|
||||
|
||||
TEditorRegistry = class(TFormRegistry, IEditorRegistry)
|
||||
protected
|
||||
function CreateEditor(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil): TForm;
|
||||
end;
|
||||
|
||||
function CreateEditor(const AName: String; const IID: TGUID; out Intf): Boolean;
|
||||
|
||||
var
|
||||
EditorRegistry : IEditorRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils, cxControls;
|
||||
|
||||
function CreateEditor(const AName: String; const IID: TGUID; out Intf): Boolean;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
Result := Supports(EditorRegistry.CreateEditor(AName, Application), IID, Intf);
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TEditorRegistry }
|
||||
|
||||
function TEditorRegistry.CreateEditor(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent): TForm;
|
||||
begin
|
||||
if not Assigned(AOwner) then
|
||||
AOwner := Application;
|
||||
Result := CreateComponent( aClassOrDisplayname, aOwner ) as TForm;
|
||||
end;
|
||||
|
||||
{procedure TEditorRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
if not aMinAcceptableClass.InheritsFrom(TCustomEditor) then
|
||||
aMinAcceptableClass := TCustomEditor;
|
||||
end;}
|
||||
|
||||
initialization
|
||||
EditorRegistry := TEditorRegistry.Create;
|
||||
|
||||
finalization
|
||||
EditorRegistry := NIL;
|
||||
|
||||
end.
|
||||
59
Source/Base/Utiles/ClassRegistry/uInformeRegistryUtils.pas
Normal file
59
Source/Base/Utiles/ClassRegistry/uInformeRegistryUtils.pas
Normal file
@ -0,0 +1,59 @@
|
||||
unit uInformeRegistryUtils;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Forms, uClassRegistryUtils;
|
||||
|
||||
type
|
||||
IInformeRegistry = interface (IReportRegistry)
|
||||
['{F6AC050F-5547-4E1F-AA44-DA0D06EDA4D7}']
|
||||
function CreateInforme(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = NIL): TInterfacedObject;
|
||||
end;
|
||||
|
||||
TInformeRegistry = class(TReportRegistry, IInformeRegistry)
|
||||
protected
|
||||
function CreateInforme(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil): TInterfacedObject;
|
||||
end;
|
||||
|
||||
function CreateInforme(const AName: String; const IID: TGUID; out Intf): Boolean;
|
||||
|
||||
var
|
||||
InformeRegistry : IInformeRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils, cxControls;
|
||||
|
||||
function CreateInforme(const AName: String; const IID: TGUID; out Intf): Boolean;
|
||||
begin
|
||||
ShowHourglassCursor;
|
||||
try
|
||||
Result := Supports(InformeRegistry.CreateInforme(AName, Application), IID, Intf);
|
||||
finally
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TInformeRegistry }
|
||||
|
||||
function TInformeRegistry.CreateInforme(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent): TInterfacedObject;
|
||||
begin
|
||||
if not Assigned(AOwner) then
|
||||
AOwner := Application;
|
||||
Result := CreateObject( aClassOrDisplayname) as TInterfacedObject;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
InformeRegistry := TInformeRegistry.Create;
|
||||
|
||||
finalization
|
||||
InformeRegistry := NIL;
|
||||
|
||||
end.
|
||||
50
Source/Base/Utiles/ClassRegistry/uViewRegistryUtils.pas
Normal file
50
Source/Base/Utiles/ClassRegistry/uViewRegistryUtils.pas
Normal file
@ -0,0 +1,50 @@
|
||||
unit uViewRegistryUtils;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Forms, uClassRegistryUtils, uCustomView;
|
||||
|
||||
type
|
||||
IViewRegistry = interface (IComponentRegistry)
|
||||
['{F49AE52F-47EC-42AF-8365-A09270E4B45D}']
|
||||
function CreateView(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil): TCustomView;
|
||||
end;
|
||||
|
||||
|
||||
TViewRegistry = class(TComponentRegistry, IViewRegistry)
|
||||
protected
|
||||
procedure ValidateMinAcceptableClass(var aMinAcceptableClass: TClass); override;
|
||||
function CreateView( const aClassOrDisplayname: String;
|
||||
aOwner: TComponent = nil ): TCustomView;
|
||||
end;
|
||||
|
||||
var
|
||||
ViewRegistry : IViewRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
{ TViewRegistry }
|
||||
|
||||
function TViewRegistry.CreateView(const aClassOrDisplayname: String;
|
||||
aOwner: TComponent): TCustomView;
|
||||
begin
|
||||
Result := CreateComponent( aClassOrDisplayname, aOwner ) as TCustomView;
|
||||
end;
|
||||
|
||||
procedure TViewRegistry.ValidateMinAcceptableClass(
|
||||
var aMinAcceptableClass: TClass);
|
||||
begin
|
||||
inherited;
|
||||
if not aMinAcceptableClass.InheritsFrom(TCustomView) then
|
||||
aMinAcceptableClass := TCustomView;
|
||||
end;
|
||||
|
||||
initialization
|
||||
ViewRegistry := TViewRegistry.Create;
|
||||
|
||||
finalization
|
||||
ViewRegistry := NIL;
|
||||
|
||||
end.
|
||||
@ -3,7 +3,7 @@ unit uPasswordUtils;
|
||||
interface
|
||||
|
||||
function EncriptarPassword(const password : string): String;
|
||||
function EncriptarPasswordOSC(const password : string): String;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -19,33 +19,4 @@ begin
|
||||
Result := LowerCase(pass_encriptada);
|
||||
end;
|
||||
|
||||
function EncriptarPasswordOSC(const password : string): String;
|
||||
var
|
||||
t : TMD5Digest;
|
||||
salt : String;
|
||||
pass_encriptada : String;
|
||||
i : integer;
|
||||
begin
|
||||
// for ($i=0; $i<10; $i++) {
|
||||
// $password .= tep_rand();
|
||||
// }
|
||||
//
|
||||
// $salt = substr(md5($password), 0, 2);
|
||||
//
|
||||
// $password = md5($salt . $plain) . ':' . $salt;
|
||||
|
||||
pass_encriptada := '';
|
||||
Randomize;
|
||||
for I := 0 to 9 do
|
||||
pass_encriptada := pass_encriptada + FloatToStr(Random(10000000000));
|
||||
|
||||
t := MD5String(password);
|
||||
salt := Copy(MD5DigestToStr(t), 0, 2);
|
||||
|
||||
t := MD5String(salt + password);
|
||||
pass_encriptada := MD5DigestToStr(t);
|
||||
Result := LowerCase(pass_encriptada) + ':' + salt;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
20
Source/Base/__uExceptions.pas__
Normal file
20
Source/Base/__uExceptions.pas__
Normal file
@ -0,0 +1,20 @@
|
||||
unit uExceptions;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uDADataTable;
|
||||
|
||||
const
|
||||
AUF_FKVIOLATION = 'violation of FOREIGN KEY';
|
||||
AUF_HAVEVALUE = 'must have a value';
|
||||
|
||||
type
|
||||
IApplyUpdateFailedException = interface
|
||||
['{B090A762-3D65-405E-A810-14DB4F6E8F82}']
|
||||
procedure ShowApplyUpdateFailed (const Error: EDAApplyUpdateFailed);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@ -11,7 +11,7 @@
|
||||
<Default.Personality> <Projects>
|
||||
<Projects Name="Base.bpl">Base\Base.bdsproj</Projects>
|
||||
<Projects Name="ControllerBase.bpl">Base\ControllerBase\ControllerBase.bdsproj</Projects>
|
||||
<Projects Name="GUIBase.bpl">Base\GUIBase\GUIBase.bdsproj</Projects>
|
||||
<Projects Name="GUIBase.bpl">GUIBase\GUIBase.bdsproj</Projects>
|
||||
<Projects Name="Empresas_model.bpl">Modulos\Empresas\Model\Empresas_model.bdsproj</Projects>
|
||||
<Projects Name="Empresas_data.bpl">Modulos\Empresas\Data\Empresas_data.bdsproj</Projects>
|
||||
<Projects Name="Empresas_controller.bpl">Modulos\Empresas\Controller\Empresas_controller.bdsproj</Projects>
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
<ItemGroup>
|
||||
<Projects Include="Base\Base.dproj" />
|
||||
<Projects Include="Base\ControllerBase\ControllerBase.dproj" />
|
||||
<Projects Include="Base\GUIBase\GUIBase.dproj" />
|
||||
<Projects Include="GUIBase\GUIBase.dproj" />
|
||||
<Projects Include="Cliente\FactuGES.dproj" />
|
||||
<Projects Include="Modulos\Contactos\Controller\Contactos_controller.dproj" />
|
||||
<Projects Include="Modulos\Contactos\Data\Contactos_data.dproj" />
|
||||
@ -67,40 +67,13 @@
|
||||
<MSBuild Projects="Base\ControllerBase\ControllerBase.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="GUIBase">
|
||||
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="" />
|
||||
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="GUIBase:Clean">
|
||||
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="Clean" />
|
||||
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="GUIBase:Make">
|
||||
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="Make" />
|
||||
<MSBuild Projects="GUIBase\GUIBase.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Usuarios_model">
|
||||
<MSBuild Projects="Modulos\Usuarios\Model\Usuarios_model.dproj" Targets="" />
|
||||
@ -129,6 +102,33 @@
|
||||
<Target Name="Usuarios_controller:Make">
|
||||
<MSBuild Projects="Modulos\Usuarios\Controller\Usuarios_controller.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_model:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Model\Empresas_model.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_data:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Data\Empresas_data.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller:Clean">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="Clean" />
|
||||
</Target>
|
||||
<Target Name="Empresas_controller:Make">
|
||||
<MSBuild Projects="Modulos\Empresas\Controller\Empresas_controller.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Empresas_view">
|
||||
<MSBuild Projects="Modulos\Empresas\Views\Empresas_view.dproj" Targets="" />
|
||||
</Target>
|
||||
@ -292,13 +292,13 @@
|
||||
<MSBuild Projects="Cliente\FactuGES.dproj" Targets="Make" />
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="FactuGES_Server;Base;ControllerBase;GUIBase;Empresas_model;Empresas_data;Empresas_controller;Usuarios_model;Usuarios_data;Usuarios_controller;Empresas_view;Empresas_plugin;FormasPago_model;FormasPago_data;FormasPago_controller;FormasPago_view;FormasPago_plugin;TiposIVA_model;TiposIVA_data;TiposIVA_controller;TiposIVA_view;TiposIVA_plugin;Contactos_model;Contactos_data;Contactos_controller;Contactos_view;Contactos_plugin;FactuGES" />
|
||||
<CallTarget Targets="FactuGES_Server;Base;ControllerBase;GUIBase;Usuarios_model;Usuarios_data;Usuarios_controller;Empresas_model;Empresas_data;Empresas_controller;Empresas_view;Empresas_plugin;FormasPago_model;FormasPago_data;FormasPago_controller;FormasPago_view;FormasPago_plugin;TiposIVA_model;TiposIVA_data;TiposIVA_controller;TiposIVA_view;TiposIVA_plugin;Contactos_model;Contactos_data;Contactos_controller;Contactos_view;Contactos_plugin;FactuGES" />
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="FactuGES_Server:Clean;Base:Clean;ControllerBase:Clean;GUIBase:Clean;Empresas_model:Clean;Empresas_data:Clean;Empresas_controller:Clean;Usuarios_model:Clean;Usuarios_data:Clean;Usuarios_controller:Clean;Empresas_view:Clean;Empresas_plugin:Clean;FormasPago_model:Clean;FormasPago_data:Clean;FormasPago_controller:Clean;FormasPago_view:Clean;FormasPago_plugin:Clean;TiposIVA_model:Clean;TiposIVA_data:Clean;TiposIVA_controller:Clean;TiposIVA_view:Clean;TiposIVA_plugin:Clean;Contactos_model:Clean;Contactos_data:Clean;Contactos_controller:Clean;Contactos_view:Clean;Contactos_plugin:Clean;FactuGES:Clean" />
|
||||
<CallTarget Targets="FactuGES_Server:Clean;Base:Clean;ControllerBase:Clean;GUIBase:Clean;Usuarios_model:Clean;Usuarios_data:Clean;Usuarios_controller:Clean;Empresas_model:Clean;Empresas_data:Clean;Empresas_controller:Clean;Empresas_view:Clean;Empresas_plugin:Clean;FormasPago_model:Clean;FormasPago_data:Clean;FormasPago_controller:Clean;FormasPago_view:Clean;FormasPago_plugin:Clean;TiposIVA_model:Clean;TiposIVA_data:Clean;TiposIVA_controller:Clean;TiposIVA_view:Clean;TiposIVA_plugin:Clean;Contactos_model:Clean;Contactos_data:Clean;Contactos_controller:Clean;Contactos_view:Clean;Contactos_plugin:Clean;FactuGES:Clean" />
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="FactuGES_Server:Make;Base:Make;ControllerBase:Make;GUIBase:Make;Empresas_model:Make;Empresas_data:Make;Empresas_controller:Make;Usuarios_model:Make;Usuarios_data:Make;Usuarios_controller:Make;Empresas_view:Make;Empresas_plugin:Make;FormasPago_model:Make;FormasPago_data:Make;FormasPago_controller:Make;FormasPago_view:Make;FormasPago_plugin:Make;TiposIVA_model:Make;TiposIVA_data:Make;TiposIVA_controller:Make;TiposIVA_view:Make;TiposIVA_plugin:Make;Contactos_model:Make;Contactos_data:Make;Contactos_controller:Make;Contactos_view:Make;Contactos_plugin:Make;FactuGES:Make" />
|
||||
<CallTarget Targets="FactuGES_Server:Make;Base:Make;ControllerBase:Make;GUIBase:Make;Usuarios_model:Make;Usuarios_data:Make;Usuarios_controller:Make;Empresas_model:Make;Empresas_data:Make;Empresas_controller:Make;Empresas_view:Make;Empresas_plugin:Make;FormasPago_model:Make;FormasPago_data:Make;FormasPago_controller:Make;FormasPago_view:Make;FormasPago_plugin:Make;TiposIVA_model:Make;TiposIVA_data:Make;TiposIVA_controller:Make;TiposIVA_view:Make;TiposIVA_plugin:Make;Contactos_model:Make;Contactos_data:Make;Contactos_controller:Make;Contactos_view:Make;Contactos_plugin:Make;FactuGES:Make" />
|
||||
</Target>
|
||||
<Import Condition="Exists('$(MSBuildBinPath)\Borland.Group.Targets')" Project="$(MSBuildBinPath)\Borland.Group.Targets" />
|
||||
</Project>
|
||||
Binary file not shown.
@ -103,8 +103,16 @@
|
||||
<Compiler Name="DuplicatesIgnored">True</Compiler>
|
||||
<Compiler Name="UnitInitSeq">True</Compiler>
|
||||
<Compiler Name="LocalPInvoke">True</Compiler>
|
||||
<Compiler Name="CodePage"></Compiler>
|
||||
</Compiler>
|
||||
<Compiler Name="CodePage"></Compiler> <Compiler Name="TypeInfoImplicitlyAdded">True</Compiler>
|
||||
<Compiler Name="XMLWhitespaceNotAllowed">True</Compiler>
|
||||
<Compiler Name="XMLUnknownEntity">True</Compiler>
|
||||
<Compiler Name="XMLInvalidNameStart">True</Compiler>
|
||||
<Compiler Name="XMLInvalidName">True</Compiler>
|
||||
<Compiler Name="XMLExpectedCharacter">True</Compiler>
|
||||
<Compiler Name="XMLCRefNoResolve">True</Compiler>
|
||||
<Compiler Name="XMLNoParm">True</Compiler>
|
||||
<Compiler Name="XMLNoMatchingParm">True</Compiler>
|
||||
</Compiler>
|
||||
<Linker>
|
||||
<Linker Name="MapFile">3</Linker>
|
||||
<Linker Name="OutputObjs">0</Linker>
|
||||
@ -123,7 +131,7 @@
|
||||
<Directories Name="UnitOutputDir"></Directories>
|
||||
<Directories Name="PackageDLLOutputDir"></Directories>
|
||||
<Directories Name="PackageDCPOutputDir"></Directories>
|
||||
<Directories Name="SearchPath">..\DataAbstract_D10\Lib;..\Base\Lib;..\Base\ControllerBase;..\Base\GUIBase;..\Base\ClassRegistry;..\Base\Usuarios;..\Modulos\Articulos\Lib;..\Modulos\Empresas\Lib;..\Modulos\Contactos\Lib;..\Modulos\Facturas de cliente\Lib;..\Modulos\Pedidos a proveedor\Lib;..\Modulos\Grupos de cliente\Lib;..\Modulos\Articulos\view</Directories>
|
||||
<Directories Name="SearchPath"></Directories>
|
||||
<Directories Name="Packages">rtl;vclx;vcl;dbrtl;vcldb;dbxcds;dbexpress;vclib;ibxpress;indy;dclOfficeXP;VclSmp;dsnap;bdertl;teeui;teedb;tee;vcldbx;vclactnband;dxBarExtItemsD10;dxComnD10;dxBarD10;cxLibraryD10;cxEditorsD10;dxThemeD10;cxDataD10;cxExtEditorsD10;cxGridD10;cxPageControlD10;cxSchedulerD10;cxTreeListD10;cxVerticalGridD10;dxBarDBNavD10;dxBarExtDBItemsD10;tbx_d10;tb2k_d10;ccpack10;ccpack10dsg;cxExportD10;cxIntl5D10;adortl;DataAbstract_Core_D10;DataAbstract_DBXDriver_D10;DataAbstract_Scripting_D10;dxDockingD10;dxLayoutControlD10;dxNavBarD10;dxPSCoreD10;dxsbD10;fqb100;dxLayoutControlcxEditAdaptersD10;dxPScxCommonD10;dxPSLnksD10;vclshlctrls;dxPScxExtCommonD10;dxPScxGridLnkD10;dxPScxPCProdD10;dxPScxScheduler2LnkD10;dxPScxTLLnkD10;dxPSDBTeeChartD10;dxPSTeeChartD10;dxPSdxLCLnkD10;dxPsPrVwAdvD10;GUISDK_D10;JvAppFrmD10R;JvCoreD10R;Jcl;JclVcl;JvSystemD10R;JvStdCtrlsD10R;JvBandsD10R;JvDBD10R;JvDlgsD10R;JvBDED10R;JvCmpD10R;JvCryptD10R;JvCtrlsD10R;JvCustomD10R;JvDockingD10R;JvDotNetCtrlsD10R;JvEDID10R;JvGlobusD10R;JvHMID10R;JvInterpreterD10R;JvJansD10R;JvManagedThreadsD10R;JvMMD10R;JvNetD10R;JvPageCompsD10R;JvPluginD10R;JvPrintPreviewD10R;JvRuntimeDesignD10R;JvTimeFrameworkD10R;JvUIBD10R;JvValidatorsD10R;JvWizardD10R;JvXPCtrlsD10R;PluginSDK_D10R;PNG_D10;PngComponentsD10;inet;RemObjects_WebBroker_D10;RemObjects_RODX_D10;RemObjects_BPDX_D10;RemObjects_Indy_D10;PascalScript_RO_D10;IndyProtocols;IndyCore;IndySystem;DataAbstract_IDE_D10;fsTee10;fs10;frx10;frxADO10;frxBDE10;frxDB10;frxDBX10;frxe10;frxIBX10;frxTee10;fsADO10;fsBDE10;fsDB10;fsIBX10</Directories>
|
||||
<Directories Name="Conditionals">EUREKALOG;EUREKALOG_VER6</Directories>
|
||||
<Directories Name="DebugSourceDirs"></Directories>
|
||||
@ -144,40 +152,42 @@
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<Language>
|
||||
<Language Name="ActiveLang"></Language>
|
||||
<Language Name="ProjectLang">$00000000</Language>
|
||||
<Language Name="RootDir"></Language>
|
||||
</Language>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">2</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">2</VersionInfo>
|
||||
<VersionInfo Name="Release">2</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">3</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">3081</VersionInfo>
|
||||
<VersionInfo Name="Locale">3082</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileVersion">2.2.2.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileVersion">3.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">2.2.2.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="ProductVersion">3.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompileDate">martes, 28 de agosto de 2007 17:06</VersionInfoKeys></VersionInfoKeys> <Excluded_Packages>
|
||||
<VersionInfoKeys Name="CompileDate">domingo, 30 de septiembre de 2007 20:47</VersionInfoKeys></VersionInfoKeys>
|
||||
<Excluded_Packages>
|
||||
|
||||
|
||||
|
||||
<Excluded_Packages Name="C:\Archivos de programa\RemObjects Software\Pascal Script\Dcu\D10\PascalScript_RO_D10.bpl">RemObjects Pascal Script - RemObjects SDK 3.0 Integration</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
</Excluded_Packages> <Signing>
|
||||
<Signing Name="SignAssembly">False</Signing>
|
||||
</Signing>
|
||||
<buildevents/>
|
||||
</Delphi.Personality>
|
||||
<ModelSupport>False</ModelSupport>
|
||||
<!-- EurekaLog First Line
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
-$A8
|
||||
-$B-
|
||||
-$C+
|
||||
-$D-
|
||||
-$D+
|
||||
-$E-
|
||||
-$F-
|
||||
-$G+
|
||||
@ -9,7 +9,7 @@
|
||||
-$I+
|
||||
-$J-
|
||||
-$K-
|
||||
-$L-
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O+
|
||||
@ -22,18 +22,17 @@
|
||||
-$V+
|
||||
-$W-
|
||||
-$X+
|
||||
-$Y-
|
||||
-$YD
|
||||
-$Z1
|
||||
-GD
|
||||
-cg
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-E"C:\Codigo Tecsitel\Output\Debug\Servidor"
|
||||
-N".\"
|
||||
-U"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Imports";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib\Indy10";"C:\Codigo Tecsitel\Lib";"C:\Codigo Tecsitel\Lib\RemObjects\RemObjects_SDK";"C:\Codigo Tecsitel\Lib\RemObjects\Data_Abstract";"C:\Codigo Tecsitel\Lib\CCPack";"C:\Codigo Tecsitel\Lib\CFPack";"C:\Codigo Tecsitel\Lib\GUISDK";"C:\Codigo Tecsitel\Lib\PluginSDK";"C:\Codigo Tecsitel\Lib\DevExpressVCL";"C:\Codigo Tecsitel\Lib\FastReport3";"C:\Codigo Tecsitel\Lib\JCL";"C:\Codigo Tecsitel\Lib\JVCL";"C:\Codigo Tecsitel\Lib\PngComponents";"C:\Codigo Tecsitel\Lib\cxIntl5";"C:\Codigo Tecsitel\Lib\cxIntlPrintSys3";"C:\Codigo Tecsitel\Lib\TB2k+TBX";"C:\Codigo Tecsitel\Lib\Mustangpeak\MPCommonLib";"C:\Codigo Tecsitel\Lib\Mustangpeak\EasyListview";"C:\Codigo Tecsitel\Lib\JSDialog";;"C:\Codigo Tecsitel\Source\Lib";
|
||||
-O"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Imports";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib\Indy10";"C:\Codigo Tecsitel\Lib";"C:\Codigo Tecsitel\Lib\RemObjects\RemObjects_SDK";"C:\Codigo Tecsitel\Lib\RemObjects\Data_Abstract";"C:\Codigo Tecsitel\Lib\CCPack";"C:\Codigo Tecsitel\Lib\CFPack";"C:\Codigo Tecsitel\Lib\GUISDK";"C:\Codigo Tecsitel\Lib\PluginSDK";"C:\Codigo Tecsitel\Lib\DevExpressVCL";"C:\Codigo Tecsitel\Lib\FastReport3";"C:\Codigo Tecsitel\Lib\JCL";"C:\Codigo Tecsitel\Lib\JVCL";"C:\Codigo Tecsitel\Lib\PngComponents";"C:\Codigo Tecsitel\Lib\cxIntl5";"C:\Codigo Tecsitel\Lib\cxIntlPrintSys3";"C:\Codigo Tecsitel\Lib\TB2k+TBX";"C:\Codigo Tecsitel\Lib\Mustangpeak\MPCommonLib";"C:\Codigo Tecsitel\Lib\Mustangpeak\EasyListview";"C:\Codigo Tecsitel\Lib\JSDialog";;"C:\Codigo Tecsitel\Source\Lib";
|
||||
-I"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Imports";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib\Indy10";"C:\Codigo Tecsitel\Lib";"C:\Codigo Tecsitel\Lib\RemObjects\RemObjects_SDK";"C:\Codigo Tecsitel\Lib\RemObjects\Data_Abstract";"C:\Codigo Tecsitel\Lib\CCPack";"C:\Codigo Tecsitel\Lib\CFPack";"C:\Codigo Tecsitel\Lib\GUISDK";"C:\Codigo Tecsitel\Lib\PluginSDK";"C:\Codigo Tecsitel\Lib\DevExpressVCL";"C:\Codigo Tecsitel\Lib\FastReport3";"C:\Codigo Tecsitel\Lib\JCL";"C:\Codigo Tecsitel\Lib\JVCL";"C:\Codigo Tecsitel\Lib\PngComponents";"C:\Codigo Tecsitel\Lib\cxIntl5";"C:\Codigo Tecsitel\Lib\cxIntlPrintSys3";"C:\Codigo Tecsitel\Lib\TB2k+TBX";"C:\Codigo Tecsitel\Lib\Mustangpeak\MPCommonLib";"C:\Codigo Tecsitel\Lib\Mustangpeak\EasyListview";"C:\Codigo Tecsitel\Lib\JSDialog";;"C:\Codigo Tecsitel\Source\Lib";
|
||||
-R"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Imports";"C:\Archivos de programa\CodeGear\RAD Studio\5.0\Lib\Indy10";"C:\Codigo Tecsitel\Lib";"C:\Codigo Tecsitel\Lib\RemObjects\RemObjects_SDK";"C:\Codigo Tecsitel\Lib\RemObjects\Data_Abstract";"C:\Codigo Tecsitel\Lib\CCPack";"C:\Codigo Tecsitel\Lib\CFPack";"C:\Codigo Tecsitel\Lib\GUISDK";"C:\Codigo Tecsitel\Lib\PluginSDK";"C:\Codigo Tecsitel\Lib\DevExpressVCL";"C:\Codigo Tecsitel\Lib\FastReport3";"C:\Codigo Tecsitel\Lib\JCL";"C:\Codigo Tecsitel\Lib\JVCL";"C:\Codigo Tecsitel\Lib\PngComponents";"C:\Codigo Tecsitel\Lib\cxIntl5";"C:\Codigo Tecsitel\Lib\cxIntlPrintSys3";"C:\Codigo Tecsitel\Lib\TB2k+TBX";"C:\Codigo Tecsitel\Lib\Mustangpeak\MPCommonLib";"C:\Codigo Tecsitel\Lib\Mustangpeak\EasyListview";"C:\Codigo Tecsitel\Lib\JSDialog";;"C:\Codigo Tecsitel\Source\Lib";
|
||||
-GD
|
||||
-E"..\..\Output\Debug\Servidor"
|
||||
-LE"C:\Documents and Settings\All Users\Documentos\RAD Studio\5.0\Bpl"
|
||||
-LN"C:\Documents and Settings\All Users\Documentos\RAD Studio\5.0\Dcp"
|
||||
-DEUREKALOG;EUREKALOG_VER6
|
||||
|
||||
@ -3,6 +3,7 @@ program FactuGES_Server;
|
||||
{#ROGEN:..\Servicios\FactuGES.rodl} // RemObjects: Careful, do not remove!
|
||||
|
||||
uses
|
||||
ExceptionLog,
|
||||
uROComInit,
|
||||
Forms,
|
||||
uServerMainForm in 'uServerMainForm.pas' {fServerForm},
|
||||
@ -16,7 +17,7 @@ uses
|
||||
FactuGES_Invk in '..\Servicios\FactuGES_Invk.pas',
|
||||
srvContactos_Impl in '..\Modulos\Contactos\Servidor\srvContactos_Impl.pas' {srvContactos: TDARemoteService},
|
||||
uDatabaseUtils in 'Utiles\uDatabaseUtils.pas',
|
||||
srvLogin_Impl in '..\Servicios\srvLogin_Impl.pas',
|
||||
srvLogin_Impl in 'srvLogin_Impl.pas',
|
||||
srvEmpresas_Impl in '..\Modulos\Empresas\Servidor\srvEmpresas_Impl.pas',
|
||||
uSesionesUtils in 'Utiles\uSesionesUtils.pas',
|
||||
uUsersManager in 'uUsersManager.pas',
|
||||
@ -28,7 +29,7 @@ uses
|
||||
uBizProveedoresServer in '..\Modulos\Contactos\Model\uBizProveedoresServer.pas',
|
||||
uRestriccionesUsuarioUtils in 'Utiles\uRestriccionesUsuarioUtils.pas',
|
||||
uReferenciasUtils in 'Utiles\uReferenciasUtils.pas',
|
||||
srvConfiguracion_Impl in '..\Servicios\srvConfiguracion_Impl.pas' {srvConfiguracion: TDARemoteService},
|
||||
srvConfiguracion_Impl in 'srvConfiguracion_Impl.pas' {srvConfiguracion: TDARemoteService},
|
||||
srvFamilias_Impl in '..\Modulos\Familias\Servidor\srvFamilias_Impl.pas' {srvFamilias: TDARemoteService},
|
||||
schFamiliasClient_Intf in '..\Modulos\Familias\Model\schFamiliasClient_Intf.pas',
|
||||
schFamiliasServer_Intf in '..\Modulos\Familias\Model\schFamiliasServer_Intf.pas',
|
||||
|
||||
@ -2094,6 +2094,7 @@ BEGIN
|
||||
SysConst_SAccessDenied, "File access denied"
|
||||
END
|
||||
|
||||
/* C:\Archivos de programa\EurekaLog 6\Delphi11\DIALOG.RES */
|
||||
/* c:\archivos de programa\codegear\rad studio\5.0\lib\Controls.res */
|
||||
/* C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source\uROPoweredByRemObjectsButton.res */
|
||||
/* C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source\uROHtmlServerInfo.res */
|
||||
@ -2128,10 +2129,10 @@ END
|
||||
/* C:\Codigo Tecsitel\Source\Servidor\Configuracion\uConfiguracion.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servidor\uAcercaDe.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servidor\uServerMainForm.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servicios\srvLogin_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servidor\srvLogin_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Modulos\Contactos\Servidor\srvContactos_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Modulos\Empresas\Servidor\srvEmpresas_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servicios\srvConfiguracion_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Servidor\srvConfiguracion_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Modulos\Familias\Servidor\srvFamilias_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Modulos\Formas de pago\Servidor\srvFormasPago_Impl.dfm */
|
||||
/* C:\Codigo Tecsitel\Source\Modulos\Tipos de IVA\Servidor\srvTiposIVA_Impl.dfm */
|
||||
|
||||
57
Source/Servidor/srvConfiguracion_Impl.dfm
Normal file
57
Source/Servidor/srvConfiguracion_Impl.dfm
Normal file
@ -0,0 +1,57 @@
|
||||
object srvConfiguracion: TsrvConfiguracion
|
||||
OldCreateOrder = True
|
||||
OnCreate = DARemoteServiceCreate
|
||||
SessionManager = dmServer.SessionManager
|
||||
ConnectionName = 'IBX'
|
||||
ServiceSchema = schConfiguracion
|
||||
ServiceDataStreamer = Bin2DataStreamer
|
||||
ExportedDataTables = <>
|
||||
BeforeAcquireConnection = DataAbstractServiceBeforeAcquireConnection
|
||||
Height = 160
|
||||
Width = 300
|
||||
object schConfiguracion: TDASchema
|
||||
ConnectionManager = dmServer.ConnectionManager
|
||||
Datasets = <
|
||||
item
|
||||
Params = <
|
||||
item
|
||||
Name = 'CODIGO'
|
||||
DataType = datString
|
||||
Size = 50
|
||||
Value = ''
|
||||
ParamType = daptInput
|
||||
end>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
TargetTable = 'CONFIGURACION'
|
||||
SQL = 'SELECT VALOR'#10'FROM CONFIGURACION'#10'WHERE CODIGO = :CODIGO'
|
||||
StatementType = stSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'VALOR'
|
||||
TableField = 'VALOR'
|
||||
end>
|
||||
end>
|
||||
Name = 'darValor'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'VALOR'
|
||||
DataType = datString
|
||||
Size = 100
|
||||
end>
|
||||
end>
|
||||
JoinDataTables = <>
|
||||
UnionDataTables = <>
|
||||
Commands = <>
|
||||
RelationShips = <>
|
||||
UpdateRules = <>
|
||||
Version = 0
|
||||
Left = 40
|
||||
Top = 16
|
||||
end
|
||||
object Bin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 40
|
||||
Top = 80
|
||||
end
|
||||
end
|
||||
80
Source/Servidor/srvConfiguracion_Impl.pas
Normal file
80
Source/Servidor/srvConfiguracion_Impl.pas
Normal file
@ -0,0 +1,80 @@
|
||||
unit srvConfiguracion_Impl;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ This is where you are supposed to code the implementation of your objects. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, SysUtils,
|
||||
{RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
||||
{Ancestor Implementation:} DataAbstractService_Impl,
|
||||
{Used RODLs:} DataAbstract4_Intf,
|
||||
{Generated:} FactuGES_Intf, uDAClasses, uDAScriptingProvider,
|
||||
uDABusinessProcessor, uDADataTable, uDABINAdapter, uDADataStreamer,
|
||||
uDABin2DataStreamer;
|
||||
|
||||
|
||||
type
|
||||
{ TsrvConfiguracion }
|
||||
TsrvConfiguracion = class(TDataAbstractService, IsrvConfiguracion)
|
||||
schConfiguracion: TDASchema;
|
||||
Bin2DataStreamer: TDABin2DataStreamer;
|
||||
procedure DARemoteServiceCreate(Sender: TObject);
|
||||
procedure DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
|
||||
var aConnectionName: string);
|
||||
protected
|
||||
{ IsrvConfiguracion methods }
|
||||
function DarValor(const CODIGO: String): String;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
uses
|
||||
{Generated:} FactuGES_Invk, uDAInterfaces, uDataModuleServer, Variants,
|
||||
uROClasses;
|
||||
|
||||
procedure Create_srvConfiguracion(out anInstance : IUnknown);
|
||||
begin
|
||||
anInstance := TsrvConfiguracion.Create(NIL);
|
||||
end;
|
||||
|
||||
{ srvConfiguracion }
|
||||
procedure TsrvConfiguracion.DARemoteServiceCreate(Sender: TObject);
|
||||
begin
|
||||
SessionManager := dmServer.SessionManager;
|
||||
end;
|
||||
|
||||
function TsrvConfiguracion.DarValor(const CODIGO: String): String;
|
||||
var
|
||||
ADataSet : IDADataset;
|
||||
begin
|
||||
try
|
||||
ADataSet := schConfiguracion.NewDataset(Connection, 'darValor', ['CODIGO'], [CODIGO]);
|
||||
ADataSet.Open;
|
||||
if ADataSet.Dataset.RecordCount > 0 then
|
||||
Result := ADataSet.Dataset.Fields[0].AsVariant
|
||||
else
|
||||
RaiseError('Falta variable de configuracion: ' + CODIGO);
|
||||
finally
|
||||
ADataSet.Close;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsrvConfiguracion.DataAbstractServiceBeforeAcquireConnection(
|
||||
aSender: TObject; var aConnectionName: string);
|
||||
begin
|
||||
ConnectionName := dmServer.ConnectionName;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TROClassFactory.Create('srvConfiguracion', Create_srvConfiguracion, TsrvConfiguracion_Invoker);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
149
Source/Servidor/srvLogin_Impl.dfm
Normal file
149
Source/Servidor/srvLogin_Impl.dfm
Normal file
@ -0,0 +1,149 @@
|
||||
object srvLogin: TsrvLogin
|
||||
OldCreateOrder = True
|
||||
OnCreate = DataAbstractServiceCreate
|
||||
ConnectionName = 'IBX'
|
||||
ServiceSchema = schLogin
|
||||
ServiceDataStreamer = Bin2DataStreamer
|
||||
ExportedDataTables = <>
|
||||
BeforeAcquireConnection = DataAbstractServiceBeforeAcquireConnection
|
||||
Height = 300
|
||||
Width = 300
|
||||
object schLogin: TDASchema
|
||||
ConnectionManager = dmServer.ConnectionManager
|
||||
Datasets = <
|
||||
item
|
||||
Params = <
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
Value = '1'
|
||||
ParamType = daptInput
|
||||
end>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
TargetTable = 'EMPRESAS_USUARIOS'
|
||||
SQL =
|
||||
'SELECT '#10' ID_EMPRESA'#10' FROM'#10' EMPRESAS_USUARIOS'#10' WHERE ID_U' +
|
||||
'SUARIO = :ID_USUARIO'
|
||||
StatementType = stSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID_EMPRESA'
|
||||
TableField = 'ID_EMPRESA'
|
||||
end>
|
||||
end>
|
||||
Name = 'EmpresasUsuario'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID_EMPRESA'
|
||||
DataType = datInteger
|
||||
InPrimaryKey = True
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <
|
||||
item
|
||||
Name = 'ID_USUARIO'
|
||||
DataType = datInteger
|
||||
Value = '1'
|
||||
ParamType = daptInput
|
||||
end>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
SQL =
|
||||
'SELECT '#10' PERFILES.PERFIL'#10' FROM'#10' PERFILES, PERFILES_USUARI' +
|
||||
'OS'#10' WHERE PERFILES_USUARIOS.ID_USUARIO = :ID_USUARIO'#10' AND PERF' +
|
||||
'ILES.ID = PERFILES_USUARIOS.ID_PERFIL'
|
||||
StatementType = stSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'PERFIL'
|
||||
TableField = 'PERFIL'
|
||||
end>
|
||||
end>
|
||||
Name = 'PerfilesUsuario'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'PERFIL'
|
||||
DataType = datString
|
||||
Size = 15
|
||||
end>
|
||||
end
|
||||
item
|
||||
Params = <
|
||||
item
|
||||
Name = 'USUARIO'
|
||||
DataType = datString
|
||||
Value = ''
|
||||
ParamType = daptInput
|
||||
end
|
||||
item
|
||||
Name = 'PASS'
|
||||
DataType = datString
|
||||
Value = ''
|
||||
ParamType = daptInput
|
||||
end>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
TargetTable = 'USUARIOS'
|
||||
SQL =
|
||||
'SELECT'#10' ID'#10' FROM'#10' USUARIOS'#10' WHERE USUARIO = :USUARIO AND' +
|
||||
#10' PASS = :PASS AND'#10' ACTIVO = 1'
|
||||
StatementType = stSQL
|
||||
ColumnMappings = <
|
||||
item
|
||||
DatasetField = 'ID'
|
||||
TableField = 'ID'
|
||||
end>
|
||||
end>
|
||||
Name = 'UsuarioPermitido'
|
||||
Fields = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = datInteger
|
||||
InPrimaryKey = True
|
||||
end>
|
||||
end>
|
||||
JoinDataTables = <>
|
||||
UnionDataTables = <>
|
||||
Commands = <
|
||||
item
|
||||
Params = <
|
||||
item
|
||||
Name = 'PASSWORD'
|
||||
DataType = datString
|
||||
Value = ''
|
||||
ParamType = daptInput
|
||||
end
|
||||
item
|
||||
Name = 'USERID'
|
||||
DataType = datString
|
||||
Value = ''
|
||||
ParamType = daptInput
|
||||
end>
|
||||
Statements = <
|
||||
item
|
||||
Connection = 'IBX'
|
||||
TargetTable = 'USUARIOS'
|
||||
SQL =
|
||||
'UPDATE'#10' USUARIOS'#10' SET'#10' PASS = :PASSWORD'#10' WHERE'#10' ID = ' +
|
||||
':USERID'
|
||||
StatementType = stSQL
|
||||
ColumnMappings = <>
|
||||
end>
|
||||
Name = 'SetUserPassword'
|
||||
end>
|
||||
RelationShips = <>
|
||||
UpdateRules = <>
|
||||
Version = 0
|
||||
Left = 40
|
||||
Top = 24
|
||||
end
|
||||
object Bin2DataStreamer: TDABin2DataStreamer
|
||||
Left = 40
|
||||
Top = 88
|
||||
end
|
||||
end
|
||||
146
Source/Servidor/srvLogin_Impl.pas
Normal file
146
Source/Servidor/srvLogin_Impl.pas
Normal file
@ -0,0 +1,146 @@
|
||||
unit srvLogin_Impl;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ This is where you are supposed to code the implementation of your objects. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, SysUtils,
|
||||
{RemObjects:} uROXMLIntf, uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
||||
{Required:} uRORemoteDataModule,
|
||||
{Ancestor Implementation:} DataAbstractService_Impl,
|
||||
{Used RODLs:} DataAbstract4_Intf,
|
||||
{Generated:} FactuGES_Intf, uDAClasses, uDAInterfaces, uDAEngine,
|
||||
uDADataTable, uDABINAdapter, uROClient, uDADataStreamer, uDABin2DataStreamer;
|
||||
|
||||
const
|
||||
PERFIL_ADMINISTRADORES = 'Administradores';
|
||||
|
||||
type
|
||||
{ TsrvLogin }
|
||||
TsrvLogin = class(TDataAbstractService, IsrvLogin)
|
||||
Bin2DataStreamer: TDABin2DataStreamer;
|
||||
schLogin: TDASchema;
|
||||
procedure DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
|
||||
var aConnectionName: string);
|
||||
procedure DataAbstractServiceCreate(Sender: TObject);
|
||||
private
|
||||
protected
|
||||
function Login(const User: String; const Password: String; out LoginInfo: TRdxLoginInfo): Boolean;
|
||||
procedure Logout;
|
||||
function Ping: Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
{Generated:} FactuGES_Invk, uDataModuleServer,
|
||||
Dialogs, IB, Variants, uSesionesUtils;
|
||||
|
||||
procedure Create_srvLogin(out anInstance : IUnknown);
|
||||
begin
|
||||
anInstance := TsrvLogin.Create(NIL);
|
||||
end;
|
||||
|
||||
{ srvLogin }
|
||||
{ TsrvLogin }
|
||||
|
||||
procedure TsrvLogin.DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
|
||||
var aConnectionName: string);
|
||||
begin
|
||||
ConnectionName := dmServer.ConnectionName;
|
||||
end;
|
||||
|
||||
procedure TsrvLogin.DataAbstractServiceCreate(Sender: TObject);
|
||||
begin
|
||||
SessionManager := dmServer.SessionManager;
|
||||
end;
|
||||
|
||||
function TsrvLogin.Login(const User, Password: String; out LoginInfo: TRdxLoginInfo): Boolean;
|
||||
var
|
||||
dsUser,
|
||||
dsPerfiles,
|
||||
dsEmpresas : IDADataset;
|
||||
InternalLoginInfo : TRdxLoginInfo;
|
||||
begin
|
||||
LoginInfo := NIL;
|
||||
Result := False;
|
||||
|
||||
dsUser := schLogin.NewDataset(Connection, 'UsuarioPermitido', ['Usuario', 'Pass'], [User, Password]);
|
||||
|
||||
if (dsUser.RecordCount = 1) then
|
||||
begin
|
||||
try
|
||||
LoginInfo := TRdxLoginInfo.Create();
|
||||
with LoginInfo do
|
||||
begin
|
||||
UserID := dsUser.FieldValues[0];
|
||||
Usuario := User;
|
||||
SessionID := GUIDToString(Session.SessionID);
|
||||
Perfiles := StringArray.Create();
|
||||
Empresas := TRdxEmpresasArray.Create;
|
||||
end;
|
||||
|
||||
// Asigna los perfiles del usuario
|
||||
LoginInfo.Perfiles.Clear;
|
||||
dsPerfiles := schLogin.NewDataset(Connection, 'PerfilesUsuario', ['ID_USUARIO'], [LoginInfo.UserID]);
|
||||
while not dsPerfiles.EOF do
|
||||
begin
|
||||
LoginInfo.Perfiles.Add(VarToStr(dsPerfiles.FieldValues[0]));
|
||||
dsPerfiles.Next;
|
||||
end;
|
||||
|
||||
// Asigna las empresas del usuario
|
||||
LoginInfo.Empresas.Clear;
|
||||
dsEmpresas := schLogin.NewDataset(Connection, 'EmpresasUsuario', ['ID_USUARIO'], [LoginInfo.UserID]);
|
||||
while not dsEmpresas.EOF do
|
||||
begin
|
||||
LoginInfo.Empresas.Add(dsEmpresas.FieldValues[0]);
|
||||
dsEmpresas.Next;
|
||||
end;
|
||||
|
||||
// Guardamos una copia de LoginInfo en el servidor para usarlo
|
||||
// en otros servicios
|
||||
InternalLoginInfo := TRdxLoginInfo.Create;
|
||||
InternalLoginInfo.Assign(LoginInfo);
|
||||
SesionesHelper.SaveSessionObject(Session, SESION_LOGININFO, InternalLoginInfo);
|
||||
|
||||
Result := True;
|
||||
except
|
||||
on e : exception do
|
||||
begin
|
||||
FreeAndNIL(LoginInfo);
|
||||
ShowMessage(e.Message);
|
||||
raise
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
// Invalid login. The temporary session is not to be kept.
|
||||
DestroySession;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsrvLogin.Logout;
|
||||
begin
|
||||
DestroySession;
|
||||
end;
|
||||
|
||||
function TsrvLogin.Ping: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TROClassFactory.Create('srvLogin', Create_srvLogin, TsrvLogin_Invoker);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user