- Añadido un nuevo servicio encargado de la gestión de las REFERENCIAS.

- El servidor muestra una barra de progreso cuando se cierra. 

git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES2/trunk@67 f4e31baf-9722-1c47-927c-6f952f962d4b
This commit is contained in:
David Arranz 2007-12-26 16:13:45 +00:00
parent 49bd022818
commit 96ed7862a2
12 changed files with 498 additions and 16 deletions

View File

@ -1,5 +1,9 @@
<?xml version="1.0" encoding="utf-8"?>
<Library Name="FactuGES" UID="{99553DD5-13B5-40EB-B7E6-D2B9A7C1B4D6}" Version="3.0">
<Groups>
<Group Name="General" UID="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}">
</Group>
</Groups>
<Services>
<Service Name="srvContactos" UID="{A7EF4DF4-CE77-42ED-B157-F5FAC249AAD8}" Ancestor="DataAbstractService">
<Interfaces>
@ -26,6 +30,7 @@
</Interfaces>
</Service>
<Service Name="srvLogin" UID="{F8EE30A7-9452-40FB-9902-E73B782A0CDD}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{399F9DB4-1B34-4140-AB6E-3BC10C0A7034}">
<Operations>
@ -72,6 +77,7 @@
</Interfaces>
</Service>
<Service Name="srvEmpresas" UID="{72868303-9CA9-48D5-A1A1-F60CB223C576}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{590F06D1-26B4-435B-B636-50CB8FFE6353}">
<Operations>
@ -80,6 +86,7 @@
</Interfaces>
</Service>
<Service Name="srvConfiguracion" UID="{D96583A7-8B06-4B2C-8193-CE5FE7DFFBEB}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{0882B8A4-C8AA-424E-8FC1-C6226B670522}">
<Operations>
@ -96,6 +103,7 @@
</Interfaces>
</Service>
<Service Name="srvFamilias" UID="{65318CE1-3062-4248-9396-F7A54EEEC304}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{D351175C-CBFD-4328-BF2A-FDC0B05A6308}">
<Operations>
@ -104,6 +112,7 @@
</Interfaces>
</Service>
<Service Name="srvFormasPago" UID="{98CBCDEA-1259-458F-BBD5-0423D81E6FF2}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{38AA9F85-B454-4A87-B6E8-E9C8BB2A17D9}">
<Operations>
@ -112,6 +121,7 @@
</Interfaces>
</Service>
<Service Name="srvTiposIVA" UID="{1E018962-ADD6-489D-A20E-A3A9B0CA6328}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{09B44AB5-6212-448A-8DF2-A503E3F2C9B1}">
<Operations>
@ -120,6 +130,7 @@
</Interfaces>
</Service>
<Service Name="srvUsuarios" UID="{BB619F7B-23AF-4160-BF44-A8A5CD9209F8}" Ancestor="DataAbstractService">
<Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{29388459-1A0B-46BE-AF9E-66A9E7AABB0B}">
<Operations>
@ -331,6 +342,37 @@
</Interface>
</Interfaces>
</Service>
<Service Name="srvReferencias" UID="{89B1A7B4-E6D5-4520-97BE-52CEA7C97110}" Private="1">
<Documentation><![CDATA[Para uso interno del servidor.]]></Documentation><Group Under="{B6013F6E-68F8-4EDF-85C1-1904BBA5008E}" />
<Interfaces>
<Interface Name="Default" UID="{B957528D-3BE1-412D-A35E-801C97CCD252}">
<Operations>
<Operation Name="DarNuevaReferencia" UID="{EA3276C4-2F49-4BFC-A2F8-97C705FC7C4C}">
<Parameters>
<Parameter Name="Result" DataType="String" Flag="Result">
</Parameter>
<Parameter Name="NombreReferencia" DataType="String" Flag="In" >
</Parameter>
<Parameter Name="EmpresaID" DataType="Integer" Flag="In" >
</Parameter>
</Parameters>
</Operation>
<Operation Name="IncrementarValorReferencia" UID="{03B94B86-1037-4E4A-AF5D-F82575C8900E}">
<Parameters>
<Parameter Name="Result" DataType="Boolean" Flag="Result">
</Parameter>
<Parameter Name="NombreReferencia" DataType="String" Flag="In" >
</Parameter>
<Parameter Name="Valor" DataType="String" Flag="In" >
</Parameter>
<Parameter Name="EmpresaID" DataType="Integer" Flag="In" >
</Parameter>
</Parameters>
</Operation>
</Operations>
</Interface>
</Interfaces>
</Service>
<Service Name="srvContabilidad" UID="{F9C1E163-68DB-447E-82A1-E7D5C940EE7D}" Ancestor="DataAbstractService">
<Interfaces>
<Interface Name="Default" UID="{04CDF2E1-EFC2-4247-AA4F-09BE782C73FA}">

View File

@ -46,6 +46,7 @@ const
IsrvAlbaranesCliente_IID : TGUID = '{6E910718-9AB0-47BB-9875-B0DE66A68D7A}';
IsrvAlbaranesProveedor_IID : TGUID = '{66B71884-5CE4-4574-B825-60CDA956B628}';
IsrvEjercicios_IID : TGUID = '{E99052D5-4ED9-480C-B4D4-384E8C6E4B08}';
IsrvReferencias_IID : TGUID = '{B957528D-3BE1-412D-A35E-801C97CCD252}';
IsrvContabilidad_IID : TGUID = '{04CDF2E1-EFC2-4247-AA4F-09BE782C73FA}';
{ Event ID's }
@ -75,6 +76,7 @@ type
IsrvAlbaranesCliente = interface;
IsrvAlbaranesProveedor = interface;
IsrvEjercicios = interface;
IsrvReferencias = interface;
IsrvContabilidad = interface;
TRdxEmpresasArray = class;
@ -580,6 +582,30 @@ type
function GenerarPGC(const ID_EJERCICIO_COPIA: Integer; const ID_EJERCICIO: Integer): Boolean;
end;
{ IsrvReferencias }
{ Description:
Para uso interno del servidor. }
IsrvReferencias = interface
['{B957528D-3BE1-412D-A35E-801C97CCD252}']
function DarNuevaReferencia(const NombreReferencia: String; const EmpresaID: Integer): String;
function IncrementarValorReferencia(const NombreReferencia: String; const Valor: String; const EmpresaID: Integer): Boolean;
end;
{ CosrvReferencias }
CosrvReferencias = class
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IsrvReferencias;
end;
{ TsrvReferencias_Proxy }
TsrvReferencias_Proxy = class(TROProxy, IsrvReferencias)
protected
function __GetInterfaceName:string; override;
function DarNuevaReferencia(const NombreReferencia: String; const EmpresaID: Integer): String;
function IncrementarValorReferencia(const NombreReferencia: String; const Valor: String; const EmpresaID: Integer): Boolean;
end;
{ IsrvContabilidad }
IsrvContabilidad = interface(IDataAbstractService)
['{04CDF2E1-EFC2-4247-AA4F-09BE782C73FA}']
@ -1478,6 +1504,55 @@ begin
end
end;
{ CosrvReferencias }
class function CosrvReferencias.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IsrvReferencias;
begin
result := TsrvReferencias_Proxy.Create(aMessage, aTransportChannel);
end;
{ TsrvReferencias_Proxy }
function TsrvReferencias_Proxy.__GetInterfaceName:string;
begin
result := 'srvReferencias';
end;
function TsrvReferencias_Proxy.DarNuevaReferencia(const NombreReferencia: String; const EmpresaID: Integer): String;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'FactuGES', __InterfaceName, 'DarNuevaReferencia');
__Message.Write('NombreReferencia', TypeInfo(String), NombreReferencia, []);
__Message.Write('EmpresaID', TypeInfo(Integer), EmpresaID, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(String), result, []);
finally
__Message.UnsetAttributes(__TransportChannel);
__Message.FreeStream;
end
end;
function TsrvReferencias_Proxy.IncrementarValorReferencia(const NombreReferencia: String; const Valor: String; const EmpresaID: Integer): Boolean;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'FactuGES', __InterfaceName, 'IncrementarValorReferencia');
__Message.Write('NombreReferencia', TypeInfo(String), NombreReferencia, []);
__Message.Write('Valor', TypeInfo(String), Valor, []);
__Message.Write('EmpresaID', TypeInfo(Integer), EmpresaID, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(Boolean), result, []);
finally
__Message.UnsetAttributes(__TransportChannel);
__Message.FreeStream;
end
end;
{ CosrvContabilidad }
class function CosrvContabilidad.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IsrvContabilidad;
@ -1516,6 +1591,7 @@ initialization
RegisterProxyClass(IsrvAlbaranesCliente_IID, TsrvAlbaranesCliente_Proxy);
RegisterProxyClass(IsrvAlbaranesProveedor_IID, TsrvAlbaranesProveedor_Proxy);
RegisterProxyClass(IsrvEjercicios_IID, TsrvEjercicios_Proxy);
RegisterProxyClass(IsrvReferencias_IID, TsrvReferencias_Proxy);
RegisterProxyClass(IsrvContabilidad_IID, TsrvContabilidad_Proxy);
@ -1545,6 +1621,7 @@ finalization
UnregisterProxyClass(IsrvAlbaranesCliente_IID);
UnregisterProxyClass(IsrvAlbaranesProveedor_IID);
UnregisterProxyClass(IsrvEjercicios_IID);
UnregisterProxyClass(IsrvReferencias_IID);
UnregisterProxyClass(IsrvContabilidad_IID);
end.

View File

@ -176,6 +176,14 @@ type
procedure Invoke_GenerarPGC(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
TsrvReferencias_Invoker = class(TROInvoker)
private
protected
published
procedure Invoke_DarNuevaReferencia(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
procedure Invoke_IncrementarValorReferencia(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
TsrvContabilidad_Invoker = class(TDataAbstractService_Invoker)
private
protected
@ -687,5 +695,53 @@ begin
end;
end;
{ TsrvReferencias_Invoker }
procedure TsrvReferencias_Invoker.Invoke_DarNuevaReferencia(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function DarNuevaReferencia(const NombreReferencia: String; const EmpresaID: Integer): String; }
var
NombreReferencia: String;
EmpresaID: Integer;
lResult: String;
begin
try
__Message.Read('NombreReferencia', TypeInfo(String), NombreReferencia, []);
__Message.Read('EmpresaID', TypeInfo(Integer), EmpresaID, []);
lResult := (__Instance as IsrvReferencias).DarNuevaReferencia(NombreReferencia, EmpresaID);
__Message.InitializeResponseMessage(__Transport, 'FactuGES', 'srvReferencias', 'DarNuevaReferenciaResponse');
__Message.Write('Result', TypeInfo(String), lResult, []);
__Message.Finalize;
__Message.UnsetAttributes(__Transport);
finally
end;
end;
procedure TsrvReferencias_Invoker.Invoke_IncrementarValorReferencia(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function IncrementarValorReferencia(const NombreReferencia: String; const Valor: String; const EmpresaID: Integer): Boolean; }
var
NombreReferencia: String;
Valor: String;
EmpresaID: Integer;
lResult: Boolean;
begin
try
__Message.Read('NombreReferencia', TypeInfo(String), NombreReferencia, []);
__Message.Read('Valor', TypeInfo(String), Valor, []);
__Message.Read('EmpresaID', TypeInfo(Integer), EmpresaID, []);
lResult := (__Instance as IsrvReferencias).IncrementarValorReferencia(NombreReferencia, Valor, EmpresaID);
__Message.InitializeResponseMessage(__Transport, 'FactuGES', 'srvReferencias', 'IncrementarValorReferenciaResponse');
__Message.Write('Result', TypeInfo(Boolean), lResult, []);
__Message.Finalize;
__Message.UnsetAttributes(__Transport);
finally
end;
end;
initialization
end.

Binary file not shown.

Binary file not shown.

View File

@ -56,8 +56,6 @@ uses
uRptPresupuestosCliente_Server in '..\Modulos\Presupuestos de cliente\Reports\uRptPresupuestosCliente_Server.pas' {RptPresupuestosCliente},
schAlbaranesClienteClient_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteClient_Intf.pas',
schAlbaranesClienteServer_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteServer_Intf.pas',
schRecibosClienteClient_Intf in '..\Modulos\Recibos de cliente\Model\schRecibosClienteClient_Intf.pas',
schRecibosClienteServer_Intf in '..\Modulos\Recibos de cliente\Model\schRecibosClienteServer_Intf.pas',
srvRecibosProveedor_Impl in '..\Modulos\Recibos de proveedor\Servidor\srvRecibosProveedor_Impl.pas' {srvRecibosProveedor: TDataAbstractService},
uBizFacturasClienteServer in '..\Modulos\Facturas de cliente\Model\uBizFacturasClienteServer.pas',
srvFacturasProveedor_Impl in '..\Modulos\Facturas de proveedor\Servidor\srvFacturasProveedor_Impl.pas' {srvFacturasProveedor: TDataAbstractService},
@ -88,6 +86,7 @@ uses
schRemesasClienteServer_Intf in '..\Modulos\Remesas de cliente\Model\schRemesasClienteServer_Intf.pas',
srvInventario_Impl in '..\Modulos\Inventario\Servidor\srvInventario_Impl.pas' {srvInventario: TDataAbstractService},
srvHistoricoMovimientos_Impl in '..\Modulos\Historico de movimientos\Servidor\srvHistoricoMovimientos_Impl.pas' {srvHistoricoMovimientos: TDataAbstractService},
srvReferencias_Impl in 'srvReferencias_Impl.pas' {srvReferencias: TDataAbstractService},
schInventarioClient_Intf in '..\Modulos\Inventario\Model\schInventarioClient_Intf.pas',
schInventarioServer_Intf in '..\Modulos\Inventario\Model\schInventarioServer_Intf.pas',
schHistoricoMovimientosClient_Intf in '..\Modulos\Historico de movimientos\Model\schHistoricoMovimientosClient_Intf.pas',
@ -97,12 +96,15 @@ uses
schEjerciciosServer_Intf in '..\ApplicationBase\Ejercicios\Model\schEjerciciosServer_Intf.pas',
schEjerciciosClient_Intf in '..\ApplicationBase\Ejercicios\Model\schEjerciciosClient_Intf.pas',
srvContabilidad_Impl in '..\Modulos\Contabilidad\Servidor\srvContabilidad_Impl.pas' {srvContabilidad: TDataAbstractService},
schContactosClient_Intf in '..\Modulos\Contactos\Model\schContactosClient_Intf.pas',
schContactosServer_Intf in '..\Modulos\Contactos\Model\schContactosServer_Intf.pas',
schFacturasClienteClient_Intf in '..\Modulos\Facturas de cliente\Model\schFacturasClienteClient_Intf.pas',
schFacturasClienteServer_Intf in '..\Modulos\Facturas de cliente\Model\schFacturasClienteServer_Intf.pas',
uBizPagosClienteServer in '..\Modulos\Recibos de cliente\Model\uBizPagosClienteServer.pas',
schContabilidadServer_Intf in '..\Modulos\Contabilidad\Model\schContabilidadServer_Intf.pas',
schContabilidadClient_Intf in '..\Modulos\Contabilidad\Model\schContabilidadClient_Intf.pas',
schContabilidadServer_Intf in '..\Modulos\Contabilidad\Model\schContabilidadServer_Intf.pas';
schRecibosClienteClient_Intf in '..\Modulos\Recibos de cliente\Model\schRecibosClienteClient_Intf.pas',
schRecibosClienteServer_Intf in '..\Modulos\Recibos de cliente\Model\schRecibosClienteServer_Intf.pas',
schContactosClient_Intf in '..\Modulos\Contactos\Model\schContactosClient_Intf.pas',
schContactosServer_Intf in '..\Modulos\Contactos\Model\schContactosServer_Intf.pas';
{$R *.res}
{$R ..\Servicios\RODLFile.res}

View File

@ -29,15 +29,6 @@
<Borland.ProjectType />
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><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">3.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys><VersionInfoKeys Name="CompileDate">lunes, 19 de noviembre de 2007 18:58</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><Source><Source Name="MainSource">FactuGES_Server.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
@ -153,6 +144,7 @@
</DCCReference>
<DCCReference Include="..\Modulos\Recibos de cliente\Model\schRecibosClienteClient_Intf.pas" />
<DCCReference Include="..\Modulos\Recibos de cliente\Model\schRecibosClienteServer_Intf.pas" />
<DCCReference Include="..\Modulos\Recibos de cliente\Model\uBizPagosClienteServer.pas" />
<DCCReference Include="..\Modulos\Recibos de cliente\Servidor\srvRecibosCliente_Impl.pas">
<Form>srvRecibosCliente</Form>
<DesignClass>TDataAbstractService</DesignClass>

View File

@ -14,7 +14,7 @@ BEGIN
BEGIN
VALUE "FileVersion", "1.0.0.0\0"
VALUE "ProductVersion", "1.0.0.0\0"
VALUE "CompileDate", "lunes, 17 de diciembre de 2007 20:43\0"
VALUE "CompileDate", "miércoles, 26 de diciembre de 2007 16:31\0"
END
END
BLOCK "VarFileInfo"

View File

@ -0,0 +1,112 @@
object srvReferencias: TsrvReferencias
OldCreateOrder = True
SessionManager = dmServer.SessionManager
Height = 300
Width = 300
object schReferencias: TDASchema
ConnectionManager = dmServer.ConnectionManager
Datasets = <
item
IsPublic = False
Params = <>
Statements = <
item
Connection = 'IBX'
ConnectionType = 'Interbase'
Default = True
TargetTable = 'REFERENCIAS'
Name = 'IBX'
StatementType = stAutoSQL
ColumnMappings = <
item
DatasetField = 'ID'
TableField = 'ID'
end
item
DatasetField = 'ID_EMPRESA'
TableField = 'ID_EMPRESA'
end
item
DatasetField = 'CODIGO'
TableField = 'CODIGO'
end
item
DatasetField = 'VALOR'
TableField = 'VALOR'
end
item
DatasetField = 'DESCRIPCION'
TableField = 'DESCRIPCION'
end>
end>
Name = 'Referencias'
Fields = <
item
Name = 'ID'
DataType = datInteger
GeneratorName = 'GEN_REFERENCIAS_ID'
Required = True
InPrimaryKey = True
end
item
Name = 'ID_EMPRESA'
DataType = datInteger
end
item
Name = 'CODIGO'
DataType = datString
Size = 50
Required = True
end
item
Name = 'VALOR'
DataType = datString
Size = 255
Required = True
end
item
Name = 'DESCRIPCION'
DataType = datString
Size = 255
end>
end>
JoinDataTables = <>
UnionDataTables = <>
Commands = <
item
IsPublic = False
Params = <
item
Name = 'VALOR'
Value = ''
end
item
Name = 'CODIGO'
Value = ''
end>
Statements = <
item
Connection = 'IBX'
ConnectionType = 'Interbase'
Default = True
TargetTable = 'REFERENCIAS'
Name = 'IBX'
SQL =
'UPDATE REFERENCIAS SET'#10' VALOR = :VALOR'#10'WHERE CODIGO = :CODIGO' +
#10' AND {Where}'#10
StatementType = stSQL
ColumnMappings = <>
end>
Name = 'ModificarValorReferencia'
end>
RelationShips = <>
UpdateRules = <>
Version = 0
Left = 40
Top = 24
end
object Bin2DataStreamer: TDABin2DataStreamer
Left = 40
Top = 88
end
end

View File

@ -0,0 +1,159 @@
unit srvReferencias_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,
{Used RODLs:} DataAbstract4_Intf,
{Generated:} FactuGES_Intf, uDADataStreamer, uDABin2DataStreamer, uDAClasses;
type
{ TsrvReferencias }
TsrvReferencias = class(TRORemoteDataModule, IsrvReferencias)
Bin2DataStreamer: TDABin2DataStreamer;
schReferencias: TDASchema;
private
public
{ IsrvReferencias methods }
function DarNuevaReferencia(const NombreReferencia: String;
const EmpresaID: Integer = -1): String;
function IncrementarValorReferencia(const NombreReferencia: String;
const Valor: String; const EmpresaID: Integer = -1): Boolean;
end;
implementation
{$R *.dfm}
uses
{Generated:} FactuGES_Invk, Variants,
uDataModuleServer, uDAInterfaces, uROClasses, uReferenciasUtils;
procedure Create_srvReferencias(out anInstance : IUnknown);
begin
anInstance := TsrvReferencias.Create(nil);
end;
{ srvReferencias }
function TsrvReferencias.DarNuevaReferencia(const NombreReferencia: String;
const EmpresaID: Integer = -1): String;
var
ASchema : TDASchema;
AConn : IDAConnection;
dsData: IDADataset;
AWhere : TDAWhereExpression;
AWhereExpr1: TDAWhereExpression;
AWhereExpr2: TDAWhereExpression;
begin
Result := '';
{ Construir la expresión del Where a partir de los parámetros
que se reciban.
}
with TDAWhereBuilder.Create do
try
AWhereExpr1 := NewBinaryExpression(NewField('', 'CODIGO'),
NewConstant(NombreReferencia, datString),
dboEqual);
if (EmpresaID <> -1) then
begin
AWhereExpr2 := NewBinaryExpression(NewField('', 'ID_EMPRESA'),
NewConstant(EmpresaID, datInteger),
dboEqual);
AWhere := NewBinaryExpression(AWhereExpr1, AWhereExpr2, dboAnd);
end
else
AWhere := AWhereExpr1;
finally
Free;
end;
ASchema := schReferencias;
AConn := dmServer.ConnectionManager.NewConnection(dmServer.ConnectionManager.GetDefaultConnectionName);
try
try
dsData := ASchema.NewDataset(AConn, 'Referencias', ['VALOR'], '', '', False, True);
dsData.DynamicWhere.Expression := AWhere;
except
RaiseError('No existe la tabla REFERENCIAS');
end;
dsData.Active := True;
if dsData.IsEmpty then
RaiseError('No existe la referencia ' + NombreReferencia + ' en la tabla REFERENCIAS.');
Result := dsData.FieldByName('VALOR').AsString;
finally
dsData := NIL;
end;
end;
function TsrvReferencias.IncrementarValorReferencia(const NombreReferencia: String;
const Valor: String; const EmpresaID: Integer = -1): Boolean;
var
ASchema : TDASchema;
AConn : IDAConnection;
dsCommand: IDASQLCommand;
AWhere : TDAWhereExpression;
begin
Result := False;
AWhere := NIL;
{ Construir la expresión del Where a partir de los parámetros
que se reciban.
}
if (EmpresaID <> -1) then
begin
with TDAWhereBuilder.Create do
try
AWhere := NewBinaryExpression(NewField('', 'ID_EMPRESA'), NewConstant(EmpresaID, datInteger), dboEqual);
finally
Free;
end;
end;
ASchema := schReferencias;
AConn := dmServer.ConnectionManager.NewConnection(dmServer.ConnectionManager.GetDefaultConnectionName);
try
try
dsCommand := ASchema.NewCommand(AConn, 'ModificarValorReferencia');
with dsCommand do
begin
ParamByName('CODIGO').AsString := NombreReferencia;
ParamByName('VALOR').AsString := DarReferenciaSiguiente(Valor);
if EmpresaID <> -1 then
dsCommand.DynamicWhere.Expression := AWhere;
end;
dsCommand.Execute;
AConn.CommitTransaction;
Result := True;
except
RaiseError('Error al asignar la nueva referencia ' + Valor + ' en tablas');
AConn.RollbackTransaction;
end;
finally
dsCommand := NIL;
end;
end;
initialization
TROClassFactory.Create('srvReferencias', Create_srvReferencias, TsrvReferencias_Invoker);
finalization
end.

View File

@ -13,6 +13,8 @@ object fServerForm: TfServerForm
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object JvGradient1: TJvGradient
@ -1068,4 +1070,12 @@ object fServerForm: TfServerForm
Left = 240
Top = 208
end
object JvProgressDialog1: TJvProgressDialog
Interval = 10
ShowCancel = False
Smooth = True
ScreenPosition = poDesktopCenter
Left = 280
Top = 208
end
end

View File

@ -7,7 +7,7 @@ uses
uROClient, uROPoweredByRemObjectsButton, uROClientIntf, uROServer,
uROBinMessage, uROIndyHTTPServer, uROIndyTCPServer, frxClass, frxPreview,
JvAppInst, JvComponentBase, ExtCtrls, JvExControls, JvGradient, XPMan,
ActnList, Menus, JvGIF, AppEvnts;
ActnList, Menus, JvGIF, AppEvnts, JvBaseDlg, JvProgressDialog;
type
TfServerForm = class(TForm)
@ -32,6 +32,7 @@ type
N1: TMenuItem;
JvAppInstances1: TJvAppInstances;
TrayIcon1: TTrayIcon;
JvProgressDialog1: TJvProgressDialog;
procedure actCerrarExecute(Sender: TObject);
procedure actRestartExecute(Sender: TObject);
procedure actOpcionesExecute(Sender: TObject);
@ -39,6 +40,8 @@ type
procedure actConexionesExecute(Sender: TObject);
procedure JvAppInstances1CmdLineReceived(Sender: TObject;
CmdLine: TStrings);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
@ -77,6 +80,35 @@ begin
dmServer.RefrescarConexion;
end;
procedure TfServerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := False;
with JvProgressDialog1 do
begin
InitValues(0, 100, 10, 0, 'Cerrar FactuGES Server', 'Espere mientras FactuGES Server se cierra...');
Show;
while dmServer.HTTPServer.Active do
begin
if (Position + Interval > Max) then
Position := Min
else
Position := Position + Interval;
Refresh;
dmServer.HTTPServer.Active := False;
Sleep(500);
TrayIcon1.Visible := False;
end;
Hide;
end;
CanClose := True;
end;
procedure TfServerForm.FormCreate(Sender: TObject);
begin
dmServer := TdmServer.Create(Application);
end;
procedure TfServerForm.actOpcionesExecute(Sender: TObject);
var
AForm : TForm;