Tecistel/Tecsitel_FactuGES2
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/branches/D2007-DA5@30 0c75b7a4-871f-7646-8a2f-f78d34cc349f

Browse Source
This commit is contained in:
David Arranz 2007-10-03 16:03:28 +00:00
parent 95b3e2290a
commit 2db7e78811
81 changed files with 16830 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

272
Source/Base/Actualizacion/uActualizacion.dfm Normal file
View 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
View 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
View 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
View 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"

26
Source/Base/Base.dpk
View File

@ -24,7 +24,6 @@ package Base;
{$IMAGEBASE $400000} {$IMAGEBASE $400000}
{$DESCRIPTION 'Libreria base de FactuGES'} {$DESCRIPTION 'Libreria base de FactuGES'}
{$IMPLICITBUILD ON} {$IMPLICITBUILD ON}
{$DEFINE DEBUG}
requires requires
rtl, rtl,
@ -58,29 +57,36 @@ requires
JvDlgsD11R, JvDlgsD11R,
JvNetD11R, JvNetD11R,
JvPageCompsD11R, JvPageCompsD11R,
JSDialog100; JSDialog100,
dbrtl,
vcldb,
dsnap,
adortl;
contains contains
uDataTableUtils in 'Utiles\uDataTableUtils.pas', uDataTableUtils in 'Utiles\uDataTableUtils.pas',
uDBSelectionListUtils in 'Utiles\uDBSelectionListUtils.pas', uDBSelectionListUtils in 'Utiles\uDBSelectionListUtils.pas',
uIntegerListUtils in 'Utiles\uIntegerListUtils.pas', uIntegerListUtils in 'Utiles\uIntegerListUtils.pas',
uDataModuleBase in 'uDataModuleBase.pas' {dmBase: TDataModule}, uDataModuleBase in 'uDataModuleBase.pas' {dmBase: TDataModule},
uDataModuleConexion in 'uDataModuleConexion.pas' {dmConexion: TDataModule}, uDataModuleConexion in 'Conexion\uDataModuleConexion.pas' {dmConexion: TDataModule},
uConfigurarConexion in 'uConfigurarConexion.pas' {fConfigurarConexion: TForm}, uConfigurarConexion in 'Conexion\uConfigurarConexion.pas' {fConfigurarConexion: TForm},
uSistemaFunc in 'Utiles\uSistemaFunc.pas', uSistemaFunc in 'Utiles\uSistemaFunc.pas',
FactuGES_Intf in '..\Servicios\FactuGES_Intf.pas', FactuGES_Intf in '..\Servicios\FactuGES_Intf.pas',
uGridUtils in 'Utiles\uGridUtils.pas', uGridUtils in 'Utiles\uGridUtils.pas',
uDateUtils in 'Utiles\uDateUtils.pas', uDateUtils in 'Utiles\uDateUtils.pas',
uDataModuleConfiguracion in 'uDataModuleConfiguracion.pas' {dmConfiguracion: TDataModule}, uDataModuleConfiguracion in 'Configuracion\uDataModuleConfiguracion.pas' {dmConfiguracion: TDataModule},
uViewRegistryUtils in 'ClassRegistry\uViewRegistryUtils.pas', uViewRegistryUtils in 'Utiles\ClassRegistry\uViewRegistryUtils.pas',
uClassRegistryUtils in 'ClassRegistry\uClassRegistryUtils.pas', uClassRegistryUtils in 'Utiles\ClassRegistry\uClassRegistryUtils.pas',
uEditorRegistryUtils in 'ClassRegistry\uEditorRegistryUtils.pas', uEditorRegistryUtils in 'Utiles\ClassRegistry\uEditorRegistryUtils.pas',
uDialogUtils in 'Utiles\uDialogUtils.pas', uDialogUtils in 'Utiles\uDialogUtils.pas',
uNumUtils in 'Utiles\uNumUtils.pas', uNumUtils in 'Utiles\uNumUtils.pas',
uMD5 in 'Utiles\uMD5.pas', uMD5 in 'Utiles\uMD5.pas',
uPasswordUtils in 'Utiles\uPasswordUtils.pas', uPasswordUtils in 'Utiles\uPasswordUtils.pas',
uInfoProjectUtils in 'Utiles\uInfoProjectUtils.pas', uInfoProjectUtils in 'Utiles\uInfoProjectUtils.pas',
uActualizacion in 'uActualizacion.pas' {fActualizacion: Form}, uActualizacion in 'Actualizacion\uActualizacion.pas' {fActualizacion: Form},
uInformeRegistryUtils in 'ClassRegistry\uInformeRegistryUtils.pas'; uInformeRegistryUtils in 'Utiles\ClassRegistry\uInformeRegistryUtils.pas',
uControllerDetallesDTO in 'Controladores\uControllerDetallesDTO.pas',
uControllerBase in 'Controladores\uControllerBase.pas',
uControllerDetallesBase in 'Controladores\uControllerDetallesBase.pas';
end. end.

125
Source/Base/Base.dproj
View File

@ -26,7 +26,6 @@
<Version>7.0</Version> <Version>7.0</Version>
<DCC_Optimize>False</DCC_Optimize> <DCC_Optimize>False</DCC_Optimize>
<DCC_GenerateStackFrames>True</DCC_GenerateStackFrames> <DCC_GenerateStackFrames>True</DCC_GenerateStackFrames>
<DCC_Define>DEBUG</DCC_Define>
<DCC_DcuOutput>.\</DCC_DcuOutput> <DCC_DcuOutput>.\</DCC_DcuOutput>
<DCC_ObjOutput>.\</DCC_ObjOutput> <DCC_ObjOutput>.\</DCC_ObjOutput>
<DCC_HppOutput>.\</DCC_HppOutput> <DCC_HppOutput>.\</DCC_HppOutput>
@ -43,12 +42,6 @@
<Borland.ProjectType>Package</Borland.ProjectType> <Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject> <BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="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> <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\dclwebsnap100.bpl">CodeGear WebSnap Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dclsoap100.bpl">CodeGear SOAP Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper 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"> <DelphiCompile Include="Base.dpk">
<MainSource>MainSource</MainSource> <MainSource>MainSource</MainSource>
</DelphiCompile> </DelphiCompile>
<DCCReference Include="..\cxDataD10.dcp" /> <DCCReference Include="..\Servicios\FactuGES_Intf.pas" />
<DCCReference Include="..\cxEditorsD10.dcp" /> <DCCReference Include="Actualizacion\uActualizacion.pas">
<DCCReference Include="..\cxExportD10.dcp" /> <Form>fActualizacion</Form>
<DCCReference Include="..\cxExtEditorsD10.dcp" /> </DCCReference>
<DCCReference Include="..\cxGridD10.dcp" /> <DCCReference Include="ClassRegistry\uClassRegistryUtils.pas" />
<DCCReference Include="..\cxIntl5D10.dcp" /> <DCCReference Include="ClassRegistry\uEditorRegistryUtils.pas" />
<DCCReference Include="..\cxIntlPrintSys3D10.dcp" /> <DCCReference Include="ClassRegistry\uInformeRegistryUtils.pas" />
<DCCReference Include="..\cxLibraryD10.dcp" /> <DCCReference Include="ClassRegistry\uViewRegistryUtils.pas" />
<DCCReference Include="..\cxPageControlD10.dcp" /> <DCCReference Include="Conexion\uConfigurarConexion.pas">
<DCCReference Include="..\DataAbstract_Core_D10.dcp" /> <Form>fConfigurarConexion</Form>
<DCCReference Include="..\dxPSCoreD10.dcp" /> </DCCReference>
<DCCReference Include="..\dxThemeD10.dcp" /> <DCCReference Include="Conexion\uDataModuleConexion.pas">
<DCCReference Include="..\GUISDK_D11.dcp" /> <Form>dmConexion</Form>
<DCCReference Include="..\IndyCore.dcp" /> </DCCReference>
<DCCReference Include="..\IndyProtocols.dcp" /> <DCCReference Include="Configuracion\uDataModuleConfiguracion.pas">
<DCCReference Include="..\IndySystem.dcp" /> <Form>dmConfiguracion</Form>
<DCCReference Include="..\Jcl.dcp" /> </DCCReference>
<DCCReference Include="..\JSDialog100containsuDataTableUtilsin.dcp" /> <DCCReference Include="Controladores\adortl.dcp" />
<DCCReference Include="..\JvCoreD11R.dcp" /> <DCCReference Include="Controladores\cxDataD10.dcp" />
<DCCReference Include="..\JvDlgsD11R.dcp" /> <DCCReference Include="Controladores\cxEditorsD10.dcp" />
<DCCReference Include="..\JvNetD11R.dcp" /> <DCCReference Include="Controladores\cxExportD10.dcp" />
<DCCReference Include="..\JvPageCompsD11R.dcp" /> <DCCReference Include="Controladores\cxExtEditorsD10.dcp" />
<DCCReference Include="..\JvStdCtrlsD11R.dcp" /> <DCCReference Include="Controladores\cxGridD10.dcp" />
<DCCReference Include="..\JvSystemD11R.dcp" /> <DCCReference Include="Controladores\cxIntl5D10.dcp" />
<DCCReference Include="..\PngComponentsD10.dcp" /> <DCCReference Include="Controladores\cxIntlPrintSys3D10.dcp" />
<DCCReference Include="..\PNG_D10.dcp" /> <DCCReference Include="Controladores\cxLibraryD10.dcp" />
<DCCReference Include="..\RemObjects_Core_D10.dcp" /> <DCCReference Include="Controladores\cxPageControlD10.dcp" />
<DCCReference Include="..\rtl.dcp" /> <DCCReference Include="Controladores\DataAbstract_Core_D10.dcp" />
<DCCReference Include="..\TB2k_D10.dcp" /> <DCCReference Include="Controladores\dbrtl.dcp" />
<DCCReference Include="..\tbx_d10.dcp" /> <DCCReference Include="Controladores\dsnap.dcp" />
<DCCReference Include="..\vcl.dcp" /> <DCCReference Include="Controladores\dxPSCoreD10.dcp" />
<DCCReference Include="..\vcljpg.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> </ItemGroup>
</Project> </Project>
<!-- EurekaLog First Line <!-- EurekaLog First Line

8
Source/Base/Base.drc
View File

@ -14,10 +14,10 @@ BEGIN
uClassRegistryUtils_eClassnotFound, "Class \"%s\" was not found in the registry." uClassRegistryUtils_eClassnotFound, "Class \"%s\" was not found in the registry."
END END
/* C:\Codigo Tecsitel\Source\Base\uConfigurarConexion.dfm */ /* C:\Codigo Tecsitel\Source\Base\Conexion\uConfigurarConexion.dfm */
/* C:\Codigo Tecsitel\Source\Base\uDataModuleConexion.dfm */ /* C:\Codigo Tecsitel\Source\Base\Conexion\uDataModuleConexion.dfm */
/* C:\Codigo Tecsitel\Source\Base\uDataModuleConfiguracion.dfm */ /* C:\Codigo Tecsitel\Source\Base\Configuracion\uDataModuleConfiguracion.dfm */
/* C:\Codigo Tecsitel\Source\Base\uDataModuleBase.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.res */
/* C:\Codigo Tecsitel\Source\Base\Base.drf */ /* C:\Codigo Tecsitel\Source\Base\Base.drf */

BIN
Source/Base/Base.res
View File

Binary file not shown.

112
Source/Base/Conexion/uConfigurarConexion.dfm Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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.

28
Source/Base/Empresas/Controller/View/uIEditorDatosBancarioEmpresa.pas Normal file
View File

@ -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
View 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
View 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.

71
Source/Base/Empresas/Controller/uDatosBancariosEmpresaController.pas Normal file
View File

@ -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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

1490
Source/Base/Empresas/Model/schEmpresasServer_Intf.pas Normal file
View File

File diff suppressed because it is too large Load Diff

99
Source/Base/Empresas/Model/uBizEmpresas.pas Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

Binary file not shown.

178
Source/Base/Empresas/Test/uEmpresasController_Test.pas Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

101
Source/Base/Usuarios/Data/uLoginForm.pas Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

1715
Source/Base/Usuarios/Model/schUsuariosServer_Intf.pas Normal file
View File

File diff suppressed because it is too large Load Diff

419
Source/Base/Usuarios/Servidor/srvUsuarios_Impl.dfm Normal file
View 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
View 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
View 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
View 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
View 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
View 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.

31
Source/Base/Utiles/uPasswordUtils.pas
View File

@ -3,7 +3,7 @@ unit uPasswordUtils;
interface interface
function EncriptarPassword(const password : string): String; function EncriptarPassword(const password : string): String;
function EncriptarPasswordOSC(const password : string): String;
implementation implementation
uses uses
@ -19,33 +19,4 @@ begin
Result := LowerCase(pass_encriptada); Result := LowerCase(pass_encriptada);
end; 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. end.

20
Source/Base/__uExceptions.pas__ Normal file
View 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.

2
Source/FactuGES_Group.bdsgroup
View File

@ -11,7 +11,7 @@
<Default.Personality> <Projects> <Default.Personality> <Projects>
<Projects Name="Base.bpl">Base\Base.bdsproj</Projects> <Projects Name="Base.bpl">Base\Base.bdsproj</Projects>
<Projects Name="ControllerBase.bpl">Base\ControllerBase\ControllerBase.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_model.bpl">Modulos\Empresas\Model\Empresas_model.bdsproj</Projects>
<Projects Name="Empresas_data.bpl">Modulos\Empresas\Data\Empresas_data.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> <Projects Name="Empresas_controller.bpl">Modulos\Empresas\Controller\Empresas_controller.bdsproj</Projects>

68
Source/FactuGES_Group.groupproj
View File

@ -6,7 +6,7 @@
<ItemGroup> <ItemGroup>
<Projects Include="Base\Base.dproj" /> <Projects Include="Base\Base.dproj" />
<Projects Include="Base\ControllerBase\ControllerBase.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="Cliente\FactuGES.dproj" />
<Projects Include="Modulos\Contactos\Controller\Contactos_controller.dproj" /> <Projects Include="Modulos\Contactos\Controller\Contactos_controller.dproj" />
<Projects Include="Modulos\Contactos\Data\Contactos_data.dproj" /> <Projects Include="Modulos\Contactos\Data\Contactos_data.dproj" />
@ -67,40 +67,13 @@
<MSBuild Projects="Base\ControllerBase\ControllerBase.dproj" Targets="Make" /> <MSBuild Projects="Base\ControllerBase\ControllerBase.dproj" Targets="Make" />
</Target> </Target>
<Target Name="GUIBase"> <Target Name="GUIBase">
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="" /> <MSBuild Projects="GUIBase\GUIBase.dproj" Targets="" />
</Target> </Target>
<Target Name="GUIBase:Clean"> <Target Name="GUIBase:Clean">
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="Clean" /> <MSBuild Projects="GUIBase\GUIBase.dproj" Targets="Clean" />
</Target> </Target>
<Target Name="GUIBase:Make"> <Target Name="GUIBase:Make">
<MSBuild Projects="Base\GUIBase\GUIBase.dproj" Targets="Make" /> <MSBuild Projects="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" />
</Target> </Target>
<Target Name="Usuarios_model"> <Target Name="Usuarios_model">
<MSBuild Projects="Modulos\Usuarios\Model\Usuarios_model.dproj" Targets="" /> <MSBuild Projects="Modulos\Usuarios\Model\Usuarios_model.dproj" Targets="" />
@ -129,6 +102,33 @@
<Target Name="Usuarios_controller:Make"> <Target Name="Usuarios_controller:Make">
<MSBuild Projects="Modulos\Usuarios\Controller\Usuarios_controller.dproj" Targets="Make" /> <MSBuild Projects="Modulos\Usuarios\Controller\Usuarios_controller.dproj" Targets="Make" />
</Target> </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"> <Target Name="Empresas_view">
<MSBuild Projects="Modulos\Empresas\Views\Empresas_view.dproj" Targets="" /> <MSBuild Projects="Modulos\Empresas\Views\Empresas_view.dproj" Targets="" />
</Target> </Target>
@ -292,13 +292,13 @@
<MSBuild Projects="Cliente\FactuGES.dproj" Targets="Make" /> <MSBuild Projects="Cliente\FactuGES.dproj" Targets="Make" />
</Target> </Target>
<Target Name="Build"> <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>
<Target Name="Clean"> <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>
<Target Name="Make"> <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> </Target>
<Import Condition="Exists('$(MSBuildBinPath)\Borland.Group.Targets')" Project="$(MSBuildBinPath)\Borland.Group.Targets" /> <Import Condition="Exists('$(MSBuildBinPath)\Borland.Group.Targets')" Project="$(MSBuildBinPath)\Borland.Group.Targets" />
</Project> </Project>

BIN
Source/Servidor/FactuGES_Server.RES
View File

Binary file not shown.

40
Source/Servidor/FactuGES_Server.bdsproj
View File

@ -103,7 +103,15 @@
<Compiler Name="DuplicatesIgnored">True</Compiler> <Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler> <Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler> <Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="CodePage"></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> </Compiler>
<Linker> <Linker>
<Linker Name="MapFile">3</Linker> <Linker Name="MapFile">3</Linker>
@ -123,7 +131,7 @@
<Directories Name="UnitOutputDir"></Directories> <Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories> <Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></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="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="Conditionals">EUREKALOG;EUREKALOG_VER6</Directories>
<Directories Name="DebugSourceDirs"></Directories> <Directories Name="DebugSourceDirs"></Directories>
@ -144,40 +152,42 @@
<Parameters Name="LoadAllSymbols">True</Parameters> <Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters> <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters> </Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo> <VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo> <VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo> <VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">2</VersionInfo> <VersionInfo Name="MajorVer">3</VersionInfo>
<VersionInfo Name="MinorVer">2</VersionInfo> <VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">2</VersionInfo> <VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo> <VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo> <VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo> <VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo> <VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo> <VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo> <VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">3081</VersionInfo> <VersionInfo Name="Locale">3082</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo> <VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo> </VersionInfo>
<VersionInfoKeys> <VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys> <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></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="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></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="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 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> </Delphi.Personality>
<ModelSupport>False</ModelSupport> <ModelSupport>False</ModelSupport>
<!-- EurekaLog First Line <!-- EurekaLog First Line

19
Source/Servidor/FactuGES_Server.cfg
View File

@ -1,7 +1,7 @@
-$A8 -$A8
-$B- -$B-
-$C+ -$C+
-$D- -$D+
-$E- -$E-
-$F- -$F-
-$G+ -$G+
@ -9,7 +9,7 @@
-$I+ -$I+
-$J- -$J-
-$K- -$K-
-$L- -$L+
-$M- -$M-
-$N+ -$N+
-$O+ -$O+
@ -22,18 +22,17 @@
-$V+ -$V+
-$W- -$W-
-$X+ -$X+
-$Y- -$YD
-$Z1 -$Z1
-GD
-cg -cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+ -H+
-W+ -W+
-M
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-E"C:\Codigo Tecsitel\Output\Debug\Servidor" -E"..\..\Output\Debug\Servidor"
-N".\" -LE"C:\Documents and Settings\All Users\Documentos\RAD Studio\5.0\Bpl"
-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"; -LN"C:\Documents and Settings\All Users\Documentos\RAD Studio\5.0\Dcp"
-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"; -DEUREKALOG;EUREKALOG_VER6
-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

5
Source/Servidor/FactuGES_Server.dpr
View File

@ -3,6 +3,7 @@ program FactuGES_Server;
{#ROGEN:..\Servicios\FactuGES.rodl} // RemObjects: Careful, do not remove! {#ROGEN:..\Servicios\FactuGES.rodl} // RemObjects: Careful, do not remove!
uses uses
ExceptionLog,
uROComInit, uROComInit,
Forms, Forms,
uServerMainForm in 'uServerMainForm.pas' {fServerForm}, uServerMainForm in 'uServerMainForm.pas' {fServerForm},
@ -16,7 +17,7 @@ uses
FactuGES_Invk in '..\Servicios\FactuGES_Invk.pas', FactuGES_Invk in '..\Servicios\FactuGES_Invk.pas',
srvContactos_Impl in '..\Modulos\Contactos\Servidor\srvContactos_Impl.pas' {srvContactos: TDARemoteService}, srvContactos_Impl in '..\Modulos\Contactos\Servidor\srvContactos_Impl.pas' {srvContactos: TDARemoteService},
uDatabaseUtils in 'Utiles\uDatabaseUtils.pas', 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', srvEmpresas_Impl in '..\Modulos\Empresas\Servidor\srvEmpresas_Impl.pas',
uSesionesUtils in 'Utiles\uSesionesUtils.pas', uSesionesUtils in 'Utiles\uSesionesUtils.pas',
uUsersManager in 'uUsersManager.pas', uUsersManager in 'uUsersManager.pas',
@ -28,7 +29,7 @@ uses
uBizProveedoresServer in '..\Modulos\Contactos\Model\uBizProveedoresServer.pas', uBizProveedoresServer in '..\Modulos\Contactos\Model\uBizProveedoresServer.pas',
uRestriccionesUsuarioUtils in 'Utiles\uRestriccionesUsuarioUtils.pas', uRestriccionesUsuarioUtils in 'Utiles\uRestriccionesUsuarioUtils.pas',
uReferenciasUtils in 'Utiles\uReferenciasUtils.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}, srvFamilias_Impl in '..\Modulos\Familias\Servidor\srvFamilias_Impl.pas' {srvFamilias: TDARemoteService},
schFamiliasClient_Intf in '..\Modulos\Familias\Model\schFamiliasClient_Intf.pas', schFamiliasClient_Intf in '..\Modulos\Familias\Model\schFamiliasClient_Intf.pas',
schFamiliasServer_Intf in '..\Modulos\Familias\Model\schFamiliasServer_Intf.pas', schFamiliasServer_Intf in '..\Modulos\Familias\Model\schFamiliasServer_Intf.pas',

5
Source/Servidor/FactuGES_Server.drc
View File

@ -2094,6 +2094,7 @@ BEGIN
SysConst_SAccessDenied, "File access denied" SysConst_SAccessDenied, "File access denied"
END 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\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\uROPoweredByRemObjectsButton.res */
/* C:\Archivos de programa\RemObjects Software\RemObjects SDK for Delphi\Source\uROHtmlServerInfo.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\Configuracion\uConfiguracion.dfm */
/* C:\Codigo Tecsitel\Source\Servidor\uAcercaDe.dfm */ /* C:\Codigo Tecsitel\Source\Servidor\uAcercaDe.dfm */
/* C:\Codigo Tecsitel\Source\Servidor\uServerMainForm.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\Contactos\Servidor\srvContactos_Impl.dfm */
/* C:\Codigo Tecsitel\Source\Modulos\Empresas\Servidor\srvEmpresas_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\Familias\Servidor\srvFamilias_Impl.dfm */
/* C:\Codigo Tecsitel\Source\Modulos\Formas de pago\Servidor\srvFormasPago_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 */ /* C:\Codigo Tecsitel\Source\Modulos\Tipos de IVA\Servidor\srvTiposIVA_Impl.dfm */

57
Source/Servidor/srvConfiguracion_Impl.dfm Normal file
View 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
View 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
View 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
View 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.