Imports System.Runtime.Remoting Imports System.IO Imports System.Xml Imports System.Xml.Serialization Imports System.Windows.Forms Imports System.Drawing Imports tsl5.Enumeraciones Imports tsl5.tsl5Model Public Class Rutinas Shared Sub IniciaServicioNR(Puerto As Integer, Nombre As String, tipo As Type) Dim ht As New Hashtable ht("port") = Puerto ht("name") = Nombre Dim serverProvTcp As New System.Runtime.Remoting.Channels.BinaryServerFormatterSinkProvider serverProvTcp.TypeFilterLevel = Runtime.Serialization.Formatters.TypeFilterLevel.Full Dim clientProvTcp As New System.Runtime.Remoting.Channels.BinaryClientFormatterSinkProvider Dim tc As System.Runtime.Remoting.Channels.Tcp.TcpChannel = New System.Runtime.Remoting.Channels.Tcp.TcpChannel(ht, clientProvTcp, serverProvTcp) System.Runtime.Remoting.RemotingConfiguration.RegisterWellKnownServiceType(tipo, Nombre & ".soap", WellKnownObjectMode.Singleton) End Sub Shared Function ObtieneObjetoServicioNR(Servidor As String, Puerto As Integer, Nombre As String) As tsl5.Interfaces.IServicioNR Dim sr As tsl5.Interfaces.IServicioNR Dim sPuertoNR As String = Puerto sr = System.Activator.GetObject(GetType(tsl5.Interfaces.IServicioNR), "tcp://" & Servidor & ":" & sPuertoNR & "/" & Nombre & ".soap") Return sr End Function 'Shared Function ObtieneActualizaciones(VersionServidor As Datos.Actualizacion, ByRef VersionAComparar As Datos.Actualizacion) As tsl5.Enumeraciones.tipoActualizacionEnum ' Dim TipoActualizacion As tsl5.Enumeraciones.tipoActualizacionEnum = Enumeraciones.tipoActualizacionEnum.No_Actualizar ' Dim NuevosElementos As New List(Of Datos.ElementoActualizable) ' For Each fichero In VersionServidor.Elementos 'VersionAComparar.Elementos ' Dim sNombreFichero As String = fichero.NombreFichero ' Dim sRutaFichero As String = fichero.RutaFichero ' Dim TipoFichero As TipoFicheroActualizableEnum = fichero.tipoFichero ' Dim fs = From f In VersionAComparar.Elementos Where f.NombreFichero = sNombreFichero And f.tipoFichero = TipoFichero And f.RutaFichero = sRutaFichero Select f ' If fs.Count = 0 Then ' Dim NuevoFich As New Datos.ElementoActualizable ' NuevoFich = fichero ' NuevoFich.Comparacion = Enumeraciones.ComparacionEnum.Nuevo ' NuevosElementos.Add(NuevoFich) ' If NuevoFich.tipoFichero = Enumeraciones.tipoFicheroActualizableEnum.Datos Then ' If TipoActualizacion = Enumeraciones.tipoActualizacionEnum.No_Actualizar Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Sin_Reinicio ' ElseIf TipoActualizacion = TipoActualizacionEnum.Actualizacion_Con_Reinicio Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Mixta ' End If ' Else ' If TipoActualizacion = Enumeraciones.tipoActualizacionEnum.No_Actualizar Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Con_Reinicio ' Else ' If TipoActualizacion = TipoActualizacionEnum.Actualizacion_Sin_Reinicio Then TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Mixta ' End If ' End If ' Else ' If fs(0).FechaModificacion <> fichero.FechaModificacion Then ' If fichero.tipoFichero = Enumeraciones.tipoFicheroActualizableEnum.Datos Then ' If TipoActualizacion = Enumeraciones.tipoActualizacionEnum.No_Actualizar Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Sin_Reinicio ' ElseIf TipoActualizacion = TipoActualizacionEnum.Actualizacion_Con_Reinicio Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Mixta ' End If ' Else ' If TipoActualizacion = Enumeraciones.tipoActualizacionEnum.No_Actualizar Then ' TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Con_Reinicio ' Else ' If TipoActualizacion = TipoActualizacionEnum.Actualizacion_Sin_Reinicio Then TipoActualizacion = Enumeraciones.tipoActualizacionEnum.Actualizacion_Mixta ' End If ' End If ' fs(0).Comparacion = Enumeraciones.ComparacionEnum.Diferente ' fs(0).FechaModificacion = fichero.FechaModificacion ' Else ' fs(0).Comparacion = Enumeraciones.ComparacionEnum.Sin_Cambios ' End If ' End If ' Next ' For Each fichero In VersionAComparar.Elementos ' Dim sNombreFichero As String = fichero.NombreFichero ' Dim sRutaFichero As String = fichero.RutaFichero ' Dim TipoFichero As TipoFicheroActualizableEnum = fichero.tipoFichero ' Dim fs = From f In VersionServidor.Elementos Where f.NombreFichero = sNombreFichero And f.tipoFichero = TipoFichero And f.RutaFichero = sRutaFichero Select f ' 'Dim fs = From f In VersionServidor.Elementos Where f.NombreFichero = sNombreFichero Select f ' If fs.Count = 0 Then ' fichero.Comparacion = Enumeraciones.ComparacionEnum.Inexistente ' End If ' Next ' For Each fichero In NuevosElementos ' VersionAComparar.Elementos.Add(fichero) ' Next ' Return TipoActualizacion 'End Function 'Public Shared Function ObtieneVersionFicherosRecursivo(NombreActualizacion As String, RutaDatos As String) As Datos.Actualizacion ' Dim Actualizacion As New Datos.Actualizacion ' ObtieneVersion(Actualizacion, RutaDatos, RutaDatos, Enumeraciones.TipoFicheroActualizableEnum.Datos) ' Actualizacion.Nombre = NombreActualizacion ' Return Actualizacion 'End Function 'Public Shared Sub ObtieneVersion(ByRef Version As Datos.Actualizacion, Ruta As String, RutaInicial As String, TipoFichero As Enumeraciones.tipoFicheroActualizableEnum) ' Dim iBarra As Integer = 1 ' If Ruta.EndsWith("\") Then iBarra = 0 ' Dim sDirectorios() As String = IO.Directory.GetDirectories(Ruta) ' For Each sdirectorio In sDirectorios ' ObtieneVersion(Version, sdirectorio, RutaInicial, TipoFichero) ' Next ' Dim sFicheros() As String = IO.Directory.GetFiles(Ruta) ' Dim sfichero As String ' Dim ea As Datos.ElementoActualizable ' Dim fi As FileInfo ' For Each sfichero In sFicheros ' ea = New Datos.ElementoActualizable ' ea.NombreFichero = sfichero.Substring(Ruta.Length + iBarra) ' fi = New FileInfo(sfichero) ' ea.FechaModificacion = fi.LastWriteTimeUtc ' ea.tipoFichero = TipoFichero ' ea.RutaFichero = "" ' If Ruta <> RutaInicial Then ea.RutaFichero = Ruta.Substring(RutaInicial.Length).trimStart("\") & "\" ' Version.Elementos.Add(ea) ' Next 'End Sub ' Shared Function GeneraDatosActualizacion(NombreActualizacion As String, RutaDatos As String) As Datos.Actualizacion ' Dim act As New Datos.Actualizacion ' act = ObtieneVersionFicherosRecursivo(NombreActualizacion, RutaDatos) ' Return act 'End Function 'Shared Sub InicioServicios(ByRef Configuracion As Datos.DatosConfiguracionServicio, ByRef VersionesFicherosCliente() As Datos.Actualizacion, ServicioNetRemoting As Type) ' 'ReDim VersionesFicherosCliente(Configuracion.OtrosActualizadores.Count - 1) ' 'Dim da As New Datos.Actualizacion ' 'For i = 0 To Configuracion.OtrosActualizadores.Count - 1 ' ' da = ObtieneVersionFicherosRecursivo(Configuracion.OtrosActualizadores(i).Nombre, Configuracion.OtrosActualizadores(i).RutaDatos) ' ' VersionesFicherosCliente(i) = da ' 'Next ' Call tsl5.Rutinas.IniciaServicioNR(Configuracion.PuertoNR, Configuracion.NombreServicio, ServicioNetRemoting) 'End Sub Shared Function IniciarSesion(FicheroConfiguracion As String, Usuario As String, SHA1passwd As String, ByRef idGrupoBD As Integer, dllProcesos As String) As tsl5.Datos.DatosSesionCliente Try Dim configuracionservidor As New tsl5.Datos.DatosConfiguracionServicio configuracionservidor = Datos.DatosConfiguracionServicio.CargaConfiguracion(FicheroConfiguracion, dllProcesos) Dim bd As New MySql.Data.MySqlClient.MySqlConnection(bbdd.GeneraConnectionStringMySQL(configuracionservidor.BasesDatos(0).Servidor, configuracionservidor.BasesDatos(0).DataBase, configuracionservidor.BasesDatos(0).Usuario, configuracionservidor.BasesDatos(0).Password, configuracionservidor.BasesDatos(0).Puerto)) Dim drUsuario As DataRow = bbdd.ObtienePrimeraFilaMysql(bd, "Select * From Usuarios where Usuario=? and SHA1passwd=?", {Usuario, SHA1passwd}) If drUsuario Is Nothing Then Throw New Exception("Usuario no válido") Dim drGrupo As DataRow = bbdd.ObtienePrimeraFilaMysql(bd, "Select * From GruposUsuarios where idGrupo=?", {drUsuario("idGrupo")}) Dim ds As New tsl5.Datos.DatosSesionCliente ds.IdSesion = 1 'TODO: leer de constante ds.idUsuario = drUsuario("idUsuarios") ds.idGrupoMenu = drGrupo("idGrupoMenu") idGrupoBD = drUsuario("idGrupobd") Return ds Catch ex As Exception Throw ex End Try End Function Public Shared Function ObtieneDatConexClienteSinServicio(FicheroConf As String, Peticion As tsl5.Datos.DatosConfiguracionCliente, idGrupoBD As Integer) As tsl5.Datos.DatosConexionCliente Try Return tsl5.Rutinas.ObtieneDatosConexionCliente(FicheroConf, Peticion.ConstantesCliente.NombreServicio, Peticion.ServidorActivo.Localizacion, idGrupoBD, "") Catch exc As Exception Throw New Exception(exc.Message, exc) End Try End Function Shared Function ObtieneDatosConexionClienteSinServicio(FicheroConfiguracion As String, NombreServicio As String, Localizacion As Enumeraciones.LocalizacionesEnum, idGrupoBD As Integer, dllProcesos As String) As tsl5.Datos.DatosConexionCliente Try Dim configuracionservidor As New tsl5.Datos.DatosConfiguracionServicio configuracionservidor = Datos.DatosConfiguracionServicio.CargaConfiguracion(FicheroConfiguracion, dllProcesos) Dim bd As New MySql.Data.MySqlClient.MySqlConnection(bbdd.GeneraConnectionStringMySQL(configuracionservidor.BasesDatos(0).Servidor, configuracionservidor.BasesDatos(0).DataBase, configuracionservidor.BasesDatos(0).Usuario, configuracionservidor.BasesDatos(0).Password, configuracionservidor.BasesDatos(0).Puerto)) ' ''Dim drUsuario As DataRow = bbdd.ObtienePrimeraFilaMysql(bd, "Select * From Usuarios where Usuario=? and SHA1passwd=?", {Peticion.Usuario, Peticion.Password}) ' ''If drUsuario Is Nothing Then Throw New Exception("Usuario no válido") Dim dtBBDD As DataTable = bbdd.ObtieneTablaMysql(bd, "SELECT * FROM conexionesbd inner join grupobd on grupobd.idgrupobd=conexionesbd.idgrupobd where grupobd.idgrupobd=?", {idGrupoBD}) Dim dcc As New tsl5.Datos.DatosConexionCliente For Each dr In dtBBDD.Rows Dim bbdd As New tsl5.Datos.BBDD bbdd.Usuario = dr("Usuario") bbdd.Password = dr("Password") bbdd.DataBase = dr("Esquema") If Localizacion = Enumeraciones.LocalizacionesEnum.Local Then bbdd.Servidor = dr("ServidorLocal") bbdd.Puerto = dr("PuertoLocal") Else bbdd.Servidor = dr("ServidorRemoto") bbdd.Puerto = dr("PuertoRemoto") End If dcc.BasesDatos.Add(bbdd) Next 'Dim act = From a In configuracionservidor.OtrosActualizadores Where a.Nombre = NombreServicio Select a 'If Localizacion = Enumeraciones.LocalizacionesEnum.Local Then ' dcc.ServidorActualizador = act(0).ServidorLocal 'Else ' dcc.ServidorActualizador = act(0).ServidorRemoto 'End If Return dcc Catch ex As Exception Throw ex End Try End Function Shared Function ObtieneDatosConexionCliente(FicheroConfiguracion As String, NombreServicio As String, Localizacion As Enumeraciones.LocalizacionesEnum, idGrupoBD As Integer, dllProcesos As String) As tsl5.Datos.DatosConexionCliente Try Dim configuracionservidor As New tsl5.Datos.DatosConfiguracionServicio configuracionservidor = Datos.DatosConfiguracionServicio.CargaConfiguracion(FicheroConfiguracion, dllProcesos) Dim bd As New MySql.Data.MySqlClient.MySqlConnection(bbdd.GeneraConnectionStringMySQL(configuracionservidor.BasesDatos(0).Servidor, configuracionservidor.BasesDatos(0).DataBase, configuracionservidor.BasesDatos(0).Usuario, configuracionservidor.BasesDatos(0).Password, configuracionservidor.BasesDatos(0).Puerto)) ' ''Dim drUsuario As DataRow = bbdd.ObtienePrimeraFilaMysql(bd, "Select * From Usuarios where Usuario=? and SHA1passwd=?", {Peticion.Usuario, Peticion.Password}) ' ''If drUsuario Is Nothing Then Throw New Exception("Usuario no válido") Dim dtBBDD As DataTable = bbdd.ObtieneTablaMysql(bd, "SELECT * FROM conexionesbd inner join grupobd on grupobd.idgrupobd=conexionesbd.idgrupobd where grupobd.idgrupobd=?", {idGrupoBD}) Dim dcc As New tsl5.Datos.DatosConexionCliente For Each dr In dtBBDD.Rows Dim bbdd As New tsl5.Datos.BBDD bbdd.Usuario = dr("Usuario") bbdd.Password = dr("Password") bbdd.DataBase = dr("Esquema") If Localizacion = Enumeraciones.LocalizacionesEnum.Local Then bbdd.Servidor = dr("ServidorLocal") bbdd.Puerto = dr("PuertoLocal") Else bbdd.Servidor = dr("ServidorRemoto") bbdd.Puerto = dr("PuertoRemoto") End If dcc.BasesDatos.Add(bbdd) Next 'Dim act = From a In configuracionservidor.OtrosActualizadores Where a.Nombre = NombreServicio Select a 'If Localizacion = Enumeraciones.LocalizacionesEnum.Local Then ' dcc.ServidorActualizador = act(0).ServidorLocal 'Else ' dcc.ServidorActualizador = act(0).ServidorRemoto 'End If Return dcc Catch ex As Exception Throw ex End Try End Function Shared Function IniciaSesion(sr As tsl5.Interfaces.IServicioNR, Usuario As String, Contraseña As String, idGrupoBD As Integer) As Datos.DatosSesionCliente Dim e As Exception = Nothing Dim dsc As Datos.DatosSesionCliente dsc = sr.IniciaSesion(Usuario, Contraseña, idGrupoBD, e) If Not e Is Nothing Then Throw e Return dsc End Function Public Shared Function IniciaSesionSinServicio(Usuario As String, Contraseña As String, ByRef idGrupoBD As Integer, Aplicacion As String, ByRef ex As System.Exception) As tsl5.Datos.DatosSesionCliente Try ex = Nothing Dim sSHA1passwd As String = crypt.SHA1("M3Soft." & Contraseña) Dim sFicheroConf As String = ObtieneFicheroConfiguracionGenerico(Aplicacion) Return tsl5.Rutinas.IniciarSesion(sFicheroConf, Usuario, sSHA1passwd, idGrupoBD, "") Catch exc As Exception ex = exc Return Nothing End Try End Function Shared Function ObtieneFicheroConfiguracionGenerico(Aplicacion) As String Dim sRutaConfiguraciones As String sRutaConfiguraciones = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\Depuracion\" & Aplicacion & "\Servidor\ServidorConfig.xml" If Not IO.File.Exists(sRutaConfiguraciones) Then sRutaConfiguraciones = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\" & Aplicacion & "\Servidor\ServidorConfig.xml" End If Return sRutaConfiguraciones End Function Shared Function ObtieneDatConexCliente(Dcc As Datos.DatosConfiguracionCliente, ByRef sr As tsl5.Interfaces.IServicioNR, idGrupoBD As Integer) As Datos.DatosConexionCliente Dim e As Exception = Nothing Dim dc As Datos.DatosConexionCliente sr = tsl5.Rutinas.ObtieneObjetoServicioNR(Dcc.ServidorActivo.Servidor, Dcc.ServidorActivo.Puerto, Dcc.ConstantesCliente.NombreServicio) 'dc = sr.IniciaSesion(Dcc, e) dc = sr.ObtieneDatosConexionCliente(Dcc, idGrupoBD, e) If Not e Is Nothing Then Throw e Return dc End Function 'Shared Sub ActualizaCliente(DatConfCli As Datos.DatosConfiguracionCliente, ByRef DatConexCli As Datos.DatosConexionCliente, sr As tsl5.Interfaces.IServicioNR) ' Try ' If Not Windows.Forms.Application.StartupPath.ToLower.StartsWith("c:\tecnosis.tfs\") Then ' Dim da As New Datos.Actualizacion ' Dim e As Exception = Nothing ' da = tsl5.Rutinas.GeneraDatosActualizacion(DatConfCli.ConstantesCliente.NombreServicio, DatConfCli.ConstantesCliente.RutaDatos) ' Dim ap As Enumeraciones.tipoActualizacionEnum = sr.CompruebaActualizacionesCliente(DatConfCli.ConstantesCliente.NombreServicio, da, e) ' If Not e Is Nothing Then Throw e ' Select Case ap ' Case Enumeraciones.tipoActualizacionEnum.Actualizacion_Mixta ' Actualiza(da, DatConfCli, DatConexCli, TipoFicheroActualizableEnum.Datos) ' LlamaActualizadorAuxiliar(da, DatConfCli, DatConexCli) ' Case Enumeraciones.tipoActualizacionEnum.Actualizacion_Sin_Reinicio ' Actualiza(da, DatConfCli, DatConexCli, TipoFicheroActualizableEnum.Datos) ' Case TipoActualizacionEnum.Actualizacion_Con_Reinicio ' LlamaActualizadorAuxiliar(da, DatConfCli, DatConexCli) ' End Select ' End If ' Catch ex As Exception ' Throw ex ' End Try 'End Sub 'Public Shared Sub Actualiza(DatosActualizacion As Datos.Actualizacion, DatConfCli As Datos.DatosConfiguracionCliente, DatConexCli As Datos.DatosConexionCliente, FicherosAActualizar As TipoFicheroActualizableEnum) ' Try ' If IO.Directory.Exists(DatConfCli.ConstantesCliente.RutaTmp) Then IO.Directory.Delete(DatConfCli.ConstantesCliente.RutaTmp, True) ' IO.Directory.CreateDirectory(DatConfCli.ConstantesCliente.RutaTmp) ' Dim fActualizador As New frmActualizador ' fActualizador.tipoActualizacion = FicherosAActualizar ' fActualizador.DatosActualizacion = DatosActualizacion ' fActualizador.DatConfCli = DatConfCli ' fActualizador.DatConexCli = DatConexCli ' fActualizador.ShowDialog() ' Catch ex As Exception ' Throw ex ' End Try 'End Sub 'Private Shared Sub DescargaElementoFTP(servidorActualizacion As Datos.ServidorActualizacion, NombreFichero As String, RutaDescarga As String) ' Dim ftp As New Dart.PowerTCP.SecureFtp.Ftp ' ftp.Server = servidorActualizacion.Servidor ' ftp.Username = servidorActualizacion.Usuario ' ftp.Password = servidorActualizacion.Contraseña ' ftp.Passive = servidorActualizacion.Pasivo ' ftp.ServerPort = servidorActualizacion.Puerto ' If servidorActualizacion.SSL Then ' ftp.Security = Dart.PowerTCP.SecureFtp.Security.Implicit ' Else ' ftp.Security = Dart.PowerTCP.SecureFtp.Security.None ' End If ' ftp.Get(servidorActualizacion.Directorio & NombreFichero, RutaDescarga & NombreFichero) 'End Sub 'Private Shared Sub DescargaElementoSamba(servidorActualizacion As Datos.ServidorActualizacion, NombreFichero As String, RutaDescarga As String) ' IO.File.Copy(servidorActualizacion.Directorio & "\" & NombreFichero, RutaDescarga & NombreFichero, True) 'End Sub 'Private Shared Sub LlamaActualizadorAuxiliar(da As Datos.Actualizacion, DatConfCli As Datos.DatosConfiguracionCliente, DatConexCli As Datos.DatosConexionCliente) ' Dim DatosActAux As New Datos.DatosActualizadorAuxiliar ' DatosActAux.Actualizacion = da ' DatosActAux.ConfiguracionCliente = DatConfCli ' DatosActAux.ConexionCliente = DatConexCli ' DatosActAux.RutaEjecutable = Windows.Forms.Application.StartupPath & "\" & Process.GetCurrentProcess.ProcessName & ".exe" ' Dim sFicDatosAct As String ' sFicDatosAct = DatConfCli.ConstantesCliente.RutaDatos & "\ActualizadorAuxiliar\DatosActAux.xml" ' Utilidades.serializar(DatosActAux, sFicDatosAct) ' If Not IO.File.Exists(DatConfCli.ConstantesCliente.RutaDatos & "\ActualizadorAuxiliar\ActualizadorAuxiliar.exe") Then ' MsgBox("No existe el programa actualizador", MsgBoxStyle.Critical, "Error") ' Else ' Process.Start(DatConfCli.ConstantesCliente.RutaDatos & "\ActualizadorAuxiliar\ActualizadorAuxiliar.exe", sFicDatosAct) ' 'MsgBox("El programa se tiene que actualizar.") ' 'Windows.Forms.Application.Exit() ' Environment.Exit(0) ' End If 'End Sub Shared Sub GeneraMenus(Formulario As Form, datconexcli As Datos.DatosConexionCliente, datsesioncli As Datos.DatosSesionCliente, Evento As EventHandler) Dim menuprincipal As New MenuStrip Dim bd As tsl5Entities menuprincipal.Location = New Point(0.0) Dim tsmi As ToolStripMenuItem Select Case datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Tipo Case TipoBD.MYSQL bd = bbdd.ConectarTsl5EntityMySQL(datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Servidor, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).DataBase, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Puerto, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Usuario, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Password, "tsl5Model") Case TipoBD.SQLSERVER bd = bbdd.ConectarTsl5EntitySQLServer(datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Servidor, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).DataBase, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Usuario, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Password, "tsl5Model") Case TipoBD.LOCALDB bd = bbdd.ConectarTsl5EntityLocalDB(datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Servidor, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).Fichero, datconexcli.BasesDatos(datconexcli.NumeroBDConfiguracion).DataBase, "tsl5Model") Case Else Throw New Exception("Tipo de bd no soportado") End Select Dim menuiniciales = (From m In bd.menus Where m.idGrupoMenu = datsesioncli.idGrupoMenu Order By m.Orden Select m).ToList For Each mi In menuiniciales tsmi = New ToolStripMenuItem(mi.Texto, Nothing, Evento) Call generamenurecursivo(bd, tsmi, mi, Evento) menuprincipal.Items.Add(tsmi) Next Formulario.Controls.Add(menuprincipal) Formulario.MainMenuStrip = menuprincipal End Sub Private Shared Sub generamenurecursivo(bd As tsl5Entities, ByRef tsmi As ToolStripMenuItem, mi As menus, Evento As EventHandler) Dim tssmi As ToolStripMenuItem Dim submenus = (From m In bd.menus Where m.idMenuPadre = mi.idMenus Order By m.Orden Select m).ToList For Each sm In submenus tssmi = New ToolStripMenuItem(sm.Texto, Nothing, Evento) tssmi.Tag = sm.Accion tssmi.ToolTipText = sm.Ayuda Call generamenurecursivo(bd, tssmi, sm, Evento) tsmi.DropDownItems.Add(tssmi) Next End Sub Public Shared Function Ttagi(ByVal sValortag As String, ByVal sToken As String) As String Ttagi = "" Try sValortag = "|" & sValortag & "|" If InStr(1, "|" & sValortag & "|", "|" & sToken & "=", vbTextCompare) > 0 Then Ttagi = Mid(sValortag, (InStr(1, sValortag, "|" & sToken & "=") + Len(sToken) + 2), InStr(1, Mid(sValortag, InStr(1, sValortag, "|" & sToken & "=") + Len(sToken) + 2), "|") - 1) End If Catch ex As Exception Throw ex End Try End Function Public Shared Function FindType(ByVal name As String) As Type Dim base As Type base = Reflection.Assembly.GetEntryAssembly.GetType(name, False, True) If base IsNot Nothing Then Return base base = Reflection.Assembly.GetExecutingAssembly.GetType(name, False, True) If base IsNot Nothing Then Return base For Each assembly As Reflection.Assembly In _ AppDomain.CurrentDomain.GetAssemblies base = assembly.GetType(name, False, True) If base IsNot Nothing Then Return base Next Throw New Exception("Clase no encontrada") End Function Public Shared Sub InicioCliente(NombreServicio As String, Formulario As Form, tcFormularios As System.Windows.Forms.TabControl, FichConfProduccion As String, FichConfDesarrollo As String, Evento As EventHandler, ByRef datconfcli As Datos.DatosConfiguracionCliente, ByRef datconexcli As Datos.DatosConexionCliente, ByRef datsesioncli As Datos.DatosSesionCliente) Try Dim fidentificacion As New frmIdentificacion Dim sr As tsl5.Interfaces.IServicioNR = Nothing Dim datconfapl As Datos.DatosConfiguracionAplicacion = Nothing Dim sFichConf As String If IO.File.Exists(FichConfDesarrollo) Then sFichConf = FichConfDesarrollo Else sFichConf = FichConfProduccion End If Dim bReintentar As Boolean = True Dim bCambiarConfiguracion As Boolean Dim bGuardarConfiguracion As Boolean Do If bReintentar Then If Not IO.File.Exists(sFichConf) Or bCambiarConfiguracion Then Dim fConfig As New frmConfiguracionAplicacion Dim ServLocal As New tsl5.Datos.Servidor Dim ServRemoto As New tsl5.Datos.Servidor If datconfapl Is Nothing Then fConfig.tbRutaDatos.Text = IO.Path.GetDirectoryName(sFichConf) & "\datos\" fConfig.tbRutaTemporales.Text = IO.Path.GetDirectoryName(sFichConf) & "\tmp\" Else fConfig.tbRutaDatos.Text = datconfcli.ConstantesCliente.RutaDatos fConfig.tbRutaTemporales.Text = datconfcli.ConstantesCliente.RutaTmp For Each servidor In datconfapl.Servidores Try If servidor.Localizacion = LocalizacionesEnum.Local Then fConfig.tbServidorLocal.Text = servidor.Servidor fConfig.tbPuertoLocal.Text = servidor.Puerto Else fConfig.tbServidorRemoto.Text = servidor.Servidor fConfig.tbPuertoRemoto.Text = servidor.Puerto End If Catch ex As Exception End Try Next End If fConfig.tbServidorLocal.Focus() fConfig.ShowDialog() Dim conscli As New Datos.ConstantesCliente conscli.NombreServicio = NombreServicio conscli.RutaDatos = fConfig.tbRutaDatos.Text conscli.RutaTmp = fConfig.tbRutaTemporales.Text conscli.RutaAplicacion = Windows.Forms.Application.StartupPath datconfapl = New Datos.DatosConfiguracionAplicacion datconfapl.ConstantesCliente = conscli If fConfig.tbServidorLocal.Text.Trim <> "" Then ServLocal.Localizacion = LocalizacionesEnum.Local ServLocal.Servidor = fConfig.tbServidorLocal.Text ServLocal.Puerto = fConfig.tbPuertoLocal.Text datconfapl.Servidores.Add(ServLocal) End If If fConfig.tbServidorRemoto.Text.Trim <> "" Then ServRemoto.Localizacion = LocalizacionesEnum.Remoto ServRemoto.Servidor = fConfig.tbServidorRemoto.Text ServRemoto.Puerto = fConfig.tbPuertoRemoto.Text datconfapl.Servidores.Add(ServRemoto) End If bGuardarConfiguracion = True Else datconfapl = New Datos.DatosConfiguracionAplicacion datconfapl = tsl5.Utilidades.DeserializaFichero(sFichConf, datconfapl.GetType) End If End If Try Dim bConectado As Boolean = False For Each servidor In datconfapl.Servidores Try datconfcli = New Datos.DatosConfiguracionCliente datconfcli.ServidorActivo = servidor datconfcli.ConstantesCliente = datconfapl.ConstantesCliente datconfcli.NombreEjecutable = Process.GetCurrentProcess.ProcessName & ".exe" datconexcli = tsl5.Rutinas.ObtieneDatConexCliente(datconfcli, sr, 1) bConectado = True Exit For Catch ex As Exception End Try Next If Not bConectado Then Throw New Exception("No se ha podido conectar con ninguno de los servidores") If bGuardarConfiguracion Then If IO.File.Exists(sFichConf) Then IO.File.Delete(sFichConf) tsl5.Utilidades.CreaEstructuraDirectorio(IO.Path.GetDirectoryName(sFichConf)) tsl5.Utilidades.CreaEstructuraDirectorio(datconfcli.ConstantesCliente.RutaDatos) tsl5.Utilidades.CreaEstructuraDirectorio(datconfcli.ConstantesCliente.RutaTmp) tsl5.Utilidades.serializar(datconfapl, sFichConf) End If Exit Do Catch ex As Exception Select Case MsgBox(ex.Message & vbCrLf & "Pulse si para volver a intentar, 'no' para modificar la configuración, cancelar para salir de la aplicación", MsgBoxStyle.YesNoCancel, "¡Atención!") Case MsgBoxResult.No bReintentar = True If IO.File.Exists(sFichConf) Then IO.File.Delete(sFichConf) Case MsgBoxResult.Yes bReintentar = False Case MsgBoxResult.Cancel Environment.Exit(0) End Select End Try Loop ' tsl5.Rutinas.ActualizaCliente(datconfcli, datconexcli, sr) 'solo datos 20120614 Dim exc As Exception = Nothing Dim idGrupoBD As Integer Do exc = Nothing Try If fidentificacion.ShowDialog = Windows.Forms.DialogResult.OK Then datsesioncli = sr.IniciaSesion(fidentificacion.tbUsuario.Text, fidentificacion.tbClave.Text, idGrupoBD, exc) If Not exc Is Nothing Then Throw exc Exit Do Else Environment.Exit(0) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Atención") End Try Loop If idGrupoBD <> 1 Then datconexcli = tsl5.Rutinas.ObtieneDatConexCliente(datconfcli, sr, idGrupoBD) tsl5.Rutinas.GeneraMenus(Formulario, datconexcli, datsesioncli, Evento) tcFormularios.CausesValidation = False Formulario.IsMdiContainer = True Dim c As Control For Each c In Formulario.Controls If TypeOf c Is MdiClient Then ' '' c.BackColor = Color.FromArgb(8, 98, 83) c.BackColor = Color.White Exit For End If Next Catch ex As Exception MsgBox(ex.Message & vbCrLf & ex.StackTrace, MsgBoxStyle.Exclamation, "Error frmInicio_Load") Environment.Exit(0) Finally Formulario.Enabled = True End Try End Sub Public Shared Sub InicioClienteSinServicio(Aplicacion As String, Formulario As Form, tcFormularios As System.Windows.Forms.TabControl, FicheroConfServidor As String, FichConfProduccion As String, FichConfDesarrollo As String, Evento As EventHandler, ByRef datconfcli As Datos.DatosConfiguracionCliente, ByRef datconexcli As Datos.DatosConexionCliente, ByRef datsesioncli As Datos.DatosSesionCliente, Optional NumeroBDServicio As Integer = 0) Try Dim fidentificacion As New frmIdentificacion 'Dim sr As tsl5.Interfaces.IServicioNR = Nothing Dim datconfapl As Datos.DatosConfiguracionAplicacion = Nothing Dim sFichConf As String If IO.File.Exists(FichConfDesarrollo) Then sFichConf = FichConfDesarrollo Else sFichConf = FichConfProduccion End If Dim bReintentar As Boolean = True Dim bCambiarConfiguracion As Boolean Dim bGuardarConfiguracion As Boolean Do If bReintentar Then If Not IO.File.Exists(sFichConf) Or bCambiarConfiguracion Then Dim fConfig As New frmConfiguracionAplicacion Dim ServLocal As New tsl5.Datos.Servidor Dim ServRemoto As New tsl5.Datos.Servidor If datconfapl Is Nothing Then fConfig.tbRutaDatos.Text = IO.Path.GetDirectoryName(sFichConf) & "\datos\" fConfig.tbRutaTemporales.Text = IO.Path.GetDirectoryName(sFichConf) & "\tmp\" Else fConfig.tbRutaDatos.Text = datconfcli.ConstantesCliente.RutaDatos fConfig.tbRutaTemporales.Text = datconfcli.ConstantesCliente.RutaTmp For Each servidor In datconfapl.Servidores Try If servidor.Localizacion = LocalizacionesEnum.Local Then fConfig.tbServidorLocal.Text = servidor.Servidor fConfig.tbPuertoLocal.Text = servidor.Puerto Else fConfig.tbServidorRemoto.Text = servidor.Servidor fConfig.tbPuertoRemoto.Text = servidor.Puerto End If Catch ex As Exception End Try Next End If fConfig.tbServidorLocal.Focus() fConfig.ShowDialog() Dim conscli As New Datos.ConstantesCliente conscli.NombreServicio = "" conscli.RutaDatos = fConfig.tbRutaDatos.Text conscli.RutaTmp = fConfig.tbRutaTemporales.Text conscli.RutaAplicacion = Windows.Forms.Application.StartupPath datconfapl = New Datos.DatosConfiguracionAplicacion datconfapl.ConstantesCliente = conscli If fConfig.tbServidorLocal.Text.Trim <> "" Then ServLocal.Localizacion = LocalizacionesEnum.Local ServLocal.Servidor = fConfig.tbServidorLocal.Text ServLocal.Puerto = fConfig.tbPuertoLocal.Text datconfapl.Servidores.Add(ServLocal) End If If fConfig.tbServidorRemoto.Text.Trim <> "" Then ServRemoto.Localizacion = LocalizacionesEnum.Remoto ServRemoto.Servidor = fConfig.tbServidorRemoto.Text ServRemoto.Puerto = fConfig.tbPuertoRemoto.Text datconfapl.Servidores.Add(ServRemoto) End If bGuardarConfiguracion = True Else datconfapl = New Datos.DatosConfiguracionAplicacion datconfapl = tsl5.Utilidades.DeserializaFichero(sFichConf, datconfapl.GetType) End If End If Try Dim bConectado As Boolean = False For Each servidor In datconfapl.Servidores Try datconfcli = New Datos.DatosConfiguracionCliente datconfcli.ServidorActivo = servidor datconfcli.ConstantesCliente = datconfapl.ConstantesCliente datconfcli.NombreEjecutable = Process.GetCurrentProcess.ProcessName & ".exe" datconexcli = tsl5.Rutinas.ObtieneDatConexClienteSinServicio(FicheroConfServidor, datconfcli, 1) bConectado = True Exit For Catch ex As Exception End Try Next If Not bConectado Then Throw New Exception("No se ha podido conectar con ninguno de los servidores") If bGuardarConfiguracion Then If IO.File.Exists(sFichConf) Then IO.File.Delete(sFichConf) tsl5.Utilidades.CreaEstructuraDirectorio(IO.Path.GetDirectoryName(sFichConf)) tsl5.Utilidades.CreaEstructuraDirectorio(datconfcli.ConstantesCliente.RutaDatos) tsl5.Utilidades.CreaEstructuraDirectorio(datconfcli.ConstantesCliente.RutaTmp) tsl5.Utilidades.serializar(datconfapl, sFichConf) End If Exit Do Catch ex As Exception Select Case MsgBox(ex.Message & vbCrLf & "Pulse si para volver a intentar, 'no' para modificar la configuración, cancelar para salir de la aplicación", MsgBoxStyle.YesNoCancel, "¡Atención!") Case MsgBoxResult.No bReintentar = True If IO.File.Exists(sFichConf) Then IO.File.Delete(sFichConf) Case MsgBoxResult.Yes bReintentar = False Case MsgBoxResult.Cancel Environment.Exit(0) End Select End Try Loop ' tsl5.Rutinas.ActualizaCliente(datconfcli, datconexcli, sr) 'solo datos 20120614 Dim exc As Exception = Nothing Dim idGrupoBD As Integer Do exc = Nothing Try If fidentificacion.ShowDialog = Windows.Forms.DialogResult.OK Then datsesioncli = IniciaSesionSinServicio(fidentificacion.tbUsuario.Text, fidentificacion.tbClave.Text, idGrupoBD, Aplicacion, exc) If Not exc Is Nothing Then Throw exc Exit Do Else Environment.Exit(0) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Atención") End Try Loop If idGrupoBD <> 1 Then datconexcli = tsl5.Rutinas.ObtieneDatConexClienteSinServicio(FicheroConfServidor, datconfcli, idGrupoBD) tsl5.Rutinas.GeneraMenus(Formulario, datconexcli, datsesioncli, Evento) tcFormularios.CausesValidation = False Formulario.IsMdiContainer = True Dim c As Control For Each c In Formulario.Controls If TypeOf c Is MdiClient Then ' '' c.BackColor = Color.FromArgb(8, 98, 83) c.BackColor = Color.White Exit For End If Next Catch ex As Exception MsgBox(ex.Message & vbCrLf & ex.StackTrace, MsgBoxStyle.Exclamation, "Error frmInicio_Load") Environment.Exit(0) Finally Formulario.Enabled = True End Try End Sub End Class