diff --git a/Source/Servicios/FactuGES.RODL b/Source/Servicios/FactuGES.RODL index 09ab5e6c..9e9d0b9f 100644 --- a/Source/Servicios/FactuGES.RODL +++ b/Source/Servicios/FactuGES.RODL @@ -1,5 +1,9 @@ + + + + @@ -26,6 +30,7 @@ + @@ -72,6 +77,7 @@ + @@ -80,6 +86,7 @@ + @@ -96,6 +103,7 @@ + @@ -104,6 +112,7 @@ + @@ -112,6 +121,7 @@ + @@ -120,6 +130,7 @@ + @@ -331,6 +342,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Source/Servicios/FactuGES_Intf.pas b/Source/Servicios/FactuGES_Intf.pas index 0cec4bdf..f6119dd8 100644 --- a/Source/Servicios/FactuGES_Intf.pas +++ b/Source/Servicios/FactuGES_Intf.pas @@ -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. diff --git a/Source/Servicios/FactuGES_Invk.pas b/Source/Servicios/FactuGES_Invk.pas index 46a94785..ec56b432 100644 --- a/Source/Servicios/FactuGES_Invk.pas +++ b/Source/Servicios/FactuGES_Invk.pas @@ -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. diff --git a/Source/Servicios/RODLFILE.res b/Source/Servicios/RODLFILE.res index a6eeaa79..0e891141 100644 Binary files a/Source/Servicios/RODLFILE.res and b/Source/Servicios/RODLFILE.res differ diff --git a/Source/Servidor/FactuGES_Server.RES b/Source/Servidor/FactuGES_Server.RES index ae569de2..5467a1c5 100644 Binary files a/Source/Servidor/FactuGES_Server.RES and b/Source/Servidor/FactuGES_Server.RES differ diff --git a/Source/Servidor/FactuGES_Server.dpr b/Source/Servidor/FactuGES_Server.dpr index 5a2a287e..5dab1f5d 100644 --- a/Source/Servidor/FactuGES_Server.dpr +++ b/Source/Servidor/FactuGES_Server.dpr @@ -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} diff --git a/Source/Servidor/FactuGES_Server.dproj b/Source/Servidor/FactuGES_Server.dproj index f45e3b0d..af897d12 100644 --- a/Source/Servidor/FactuGES_Server.dproj +++ b/Source/Servidor/FactuGES_Server.dproj @@ -29,15 +29,6 @@ FalseTrueFalseTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.03.0.0.0lunes, 19 de noviembre de 2007 18:58 - - - - - - - - - RemObjects Pascal Script - RemObjects SDK 3.0 Integration FactuGES_Server.dpr @@ -153,6 +144,7 @@ +
srvRecibosCliente
TDataAbstractService diff --git a/Source/Servidor/FactuGES_Server.rc b/Source/Servidor/FactuGES_Server.rc index bf200d2a..0a47fa15 100644 --- a/Source/Servidor/FactuGES_Server.rc +++ b/Source/Servidor/FactuGES_Server.rc @@ -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" diff --git a/Source/Servidor/srvReferencias_Impl.dfm b/Source/Servidor/srvReferencias_Impl.dfm new file mode 100644 index 00000000..2a24dc8c --- /dev/null +++ b/Source/Servidor/srvReferencias_Impl.dfm @@ -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 diff --git a/Source/Servidor/srvReferencias_Impl.pas b/Source/Servidor/srvReferencias_Impl.pas new file mode 100644 index 00000000..8c6e51d7 --- /dev/null +++ b/Source/Servidor/srvReferencias_Impl.pas @@ -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. diff --git a/Source/Servidor/uServerMainForm.dfm b/Source/Servidor/uServerMainForm.dfm index 954e90d5..48e0ee33 100644 --- a/Source/Servidor/uServerMainForm.dfm +++ b/Source/Servidor/uServerMainForm.dfm @@ -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 diff --git a/Source/Servidor/uServerMainForm.pas b/Source/Servidor/uServerMainForm.pas index 53ca657b..5e56f34f 100644 --- a/Source/Servidor/uServerMainForm.pas +++ b/Source/Servidor/uServerMainForm.pas @@ -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;