Imports System.Data.EntityClient Imports tsl5 Imports tsl5.Enumeraciones Imports System.Net Imports System.Data.Objects Imports DevExpress.Xpf.Core Imports System.Reflection Public Class Utilidades Public Shared Property Usuario As String Public Shared Property NombreUsuario As String Public Shared dsc As New tsl5.Datos.DatosSesionCliente 'Public Shared bdga As tsl5.Datos.BBDD Public Shared EsRemoto As Boolean? = Nothing Private Shared FicheroLog = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\Asegasa\GestionAsegasaLog.txt" ' Public Shared ip As String Private Shared _ListaSituacionesWeb As List(Of enumeraciones) = Nothing Private Shared _ListaPagoWeb As List(Of enumeraciones) = Nothing Friend Shared idTippPE As Integer? Friend Shared idTippBA As Integer? Friend Shared idtrCx As Integer? Friend Shared idtrEx As Integer? Public Shared idSitr1 As Integer? Private Shared Sub ActualizaConexion(deGestionAsegasa As gestionasegasaEntities) Dim idMYSQL As Integer = deGestionAsegasa.ExecuteStoreQuery(Of Integer)("select connection_id() as id").First Dim cn As conexiones If deGestionAsegasa.conexiones.Any(Function(x) x.idMysql = idMYSQL) Then cn = deGestionAsegasa.conexiones.First(Function(x) x.idMysql = idMYSQL) Else cn = New conexiones cn.idMysql = idMYSQL deGestionAsegasa.conexiones.AddObject(cn) End If cn.ip = deGestionAsegasa.ExecuteStoreQuery(Of String)("select host from information_schema.processlist WHERE ID=connection_id()").First If deGestionAsegasa.usuarios.Any(Function(x) x.Usuario = Usuario) Then If cn.Usuario <> Usuario Then cn.Usuario = Usuario 'deGestionAsegasa.usuarios.First(Function(x) x.idUsuario = idUsuario).Usuario cn.FechaHora = AhoraMysql(deGestionAsegasa) deGestionAsegasa.GuardarCambios() End If Else cn.Usuario = Usuario & " * NO ENCONTRADO *" cn.FechaHora = AhoraMysql(deGestionAsegasa) deGestionAsegasa.GuardarCambios() End If End Sub Public Shared Function AhoraMysql(deGestionAsegasa As gestionasegasaEntities) As DateTime Try Dim FechaServidor As DateTime = deGestionAsegasa.ExecuteStoreQuery(Of DateTime)("select now() as Ahora").First Return FechaServidor Catch ex As Exception Return Now End Try End Function Public Shared el As EventLog Public Shared DirectorioLogs As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\ServicioGestionAsegasa\Logs\" Public Shared Sub AñadeLog(ByVal Tipo As tsl5.Enumeraciones.TipoLog, ByVal Asunto As String, ByVal Mensaje As String, Optional ByVal e As Exception = Nothing) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Gestión de logs de la aplicación ' Fecha. Creacion: ??? ' Creada por: manmog ' Ultima Modificacion: 24/11/2010 ' ' Modificaciones: ' =============== Dim sFicheroLog As String = DirectorioLogs & "Log-" & Now.Year.ToString & Now.Month.ToString & ".txt" Try If Not IsNothing(e) Then If Not el Is Nothing Then el.WriteEntry(e.Message & vbCrLf & e.StackTrace, EventLogEntryType.Error) Dim sSeguimientoDePila As String = "Información de la excepción: " & e.ToString & vbCrLf Dim exceptionInterna As Exception = e Do sSeguimientoDePila &= exceptionInterna.StackTrace & vbCrLf exceptionInterna = exceptionInterna.InnerException Loop Until IsNothing(exceptionInterna) If sSeguimientoDePila <> "" Then Mensaje &= vbCrLf & "Seguimiento de pila: " & sSeguimientoDePila End If Select Case Tipo Case tsl5.Enumeraciones.TipoLog.Fallo, tsl5.Enumeraciones.TipoLog.Advertencia If Tipo = tsl5.Enumeraciones.TipoLog.Fallo Then sFicheroLog = DirectorioLogs & "Errores-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" Mensaje = Now.ToString("dd/MM/yyyy HH:mm:ss") & " Error enviado desde " & Environment.MachineName & " VERSION: " & Assembly.GetExecutingAssembly.GetName.Version.ToString & ". " & Mensaje Else Mensaje = Now.ToString("dd/MM/yyyy HH:mm:ss") & " Advertencia enviado desde " & Environment.MachineName & " VERSION: " & Assembly.GetExecutingAssembly.GetName.Version.ToString & ". " & Mensaje End If Dim sDireccionesEnvio As String = "sevilla@tecnosis.net" Dim sServidorSMTP As String = "correo.tecnosis.net" Dim sRemitente = "logs@tecnosis.es" If Environment.MachineName.ToUpper.Trim() = "INTI" OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" Then sDireccionesEnvio = "danmun@tecnosis.net" Asunto = "[`" & Environment.MachineName.Trim & "`] " & Asunto End If 'If Mensaje IsNot Nothing Then Mensaje = Mensaje.Replace(vbCrLf, vbCrLf & "
") tsl5.Correo.Funciones.EnviaCorreo(sServidorSMTP, sRemitente, sDireccionesEnvio, Asunto, Mensaje,,,, "logs@tecnosis.es", "LoGs20i9.",, True) End Select AñadeLogTXT(Mensaje, sFicheroLog) Catch ex As Exception sFicheroLog = DirectorioLogs & "Errores-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" AñadeLogTXT(ex.Message, sFicheroLog) End Try End Sub Public Shared Sub AñadeLogNombre(ByVal nombreLog As String, ByVal Tipo As tsl5.Enumeraciones.TipoLog, ByVal Asunto As String, ByVal Mensaje As String, Optional ByVal forzarEnviarCorreoE As Boolean = False, Optional ByVal forzarDestinatario As String = "", Optional ByVal forzarEnviarSlack As Boolean = False, Optional ByVal excepcion As Exception = Nothing) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Gestión de logs de la aplicación ' Fecha. Creacion: 2020-12-01 ' Creada por: danmun (heredando de manmog) ' Ultima Modificacion: 2020-12-01 ' ' Modificaciones: ' =============== Dim sFicheroLog As String = DirectorioLogs & "Log-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString & ".txt" Try Dim enviarCorreoE As Boolean = False Dim sbAsunto As New Text.StringBuilder Dim sSeguimientoDePila As String = "" sbAsunto.AppendFormat("[`{0}`] ", System.Diagnostics.Process.GetCurrentProcess.ProcessName) sbAsunto.Append(Asunto) '// Decidir si se envía información sobre la excepción If Not IsNothing(excepcion) Then If Not el Is Nothing Then el.WriteEntry(excepcion.Message & vbCrLf & excepcion.StackTrace, EventLogEntryType.Error) sSeguimientoDePila = "Información de la excepción: " & excepcion.ToString & vbCrLf Dim exceptionInterna As Exception = excepcion Do sSeguimientoDePila &= exceptionInterna.StackTrace & vbCrLf exceptionInterna = exceptionInterna.InnerException Loop Until IsNothing(exceptionInterna) End If Mensaje = sbAsunto.ToString & vbCrLf & Mensaje & vbCrLf If Not String.IsNullOrWhiteSpace(sSeguimientoDePila) Then Mensaje &= vbCrLf & "Seguimiento de pila: " & sSeguimientoDePila '// Decidir si se envía correo electrónico Select Case Tipo Case tsl5.Enumeraciones.TipoLog.Fallo, tsl5.Enumeraciones.TipoLog.Advertencia enviarCorreoE = True End Select '// Forzar envío de correo electrónico If forzarEnviarCorreoE OrElse excepcion IsNot Nothing Then enviarCorreoE = True If enviarCorreoE Then Select Case Tipo Case tsl5.Enumeraciones.TipoLog.Fallo sFicheroLog = DirectorioLogs & "Errores-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" Mensaje = Now.ToLongTimeString & " Error enviado desde [`" & Environment.MachineName & "`]." & vbCrLf & Mensaje Case tsl5.Enumeraciones.TipoLog.Advertencia Mensaje = Now.ToLongTimeString & " Advertencia enviada desde [`" & Environment.MachineName & "`]." & vbCrLf & Mensaje Case tsl5.Enumeraciones.TipoLog.Informacion Mensaje = Now.ToLongTimeString & " Información enviada desde [`" & Environment.MachineName & "`]." & vbCrLf & Mensaje Case tsl5.Enumeraciones.TipoLog.Depuracion Mensaje = Now.ToLongTimeString & " Información de depuración enviada desde [`" & Environment.MachineName & "`]." & vbCrLf & Mensaje End Select Dim sDireccionesEnvio As String = "sevilla@tecnosis.net" Dim sServidorSMTP As String = "correo.tecnosis.net" Dim sRemitente = "logs@tecnosis.es" '// Forzar destinatario If Not String.IsNullOrWhiteSpace(forzarDestinatario) Then sDireccionesEnvio = forzarDestinatario End If '// Destinatario especial si se está ejecutando en ciertas máquinas. If Environment.MachineName.ToUpper.Trim() = "INTI" OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" OrElse Environment.MachineName.ToUpper.Trim() = "QUISQUILLA" Then sDireccionesEnvio = "danmun@tecnosis.net" sbAsunto.Insert(0, "[`" & Environment.MachineName.Trim & "`] ") End If 'If Mensaje IsNot Nothing Then Mensaje = Mensaje.Replace(vbCrLf, vbCrLf & "
") tsl5.Correo.Funciones.EnviaCorreo(sServidorSMTP, sRemitente, sDireccionesEnvio, sbAsunto.ToString.Replace("`", ""), Mensaje.Replace("`", ""),,,, "logs@tecnosis.es", "LoGs20i9.") End If '// Decidir si enviar también por Slack If forzarEnviarSlack OrElse Tipo = tsl5.Enumeraciones.TipoLog.Fallo OrElse Tipo = tsl5.Enumeraciones.TipoLog.Advertencia OrElse excepcion IsNot Nothing Then Dim destinoSlack = "asegasa" If forzarEnviarSlack Then destinoSlack = "Avant2" Dim mensajeSlack As New Text.StringBuilder If String.IsNullOrWhiteSpace(Mensaje) Then mensajeSlack.Append(Asunto) Else mensajeSlack.Append(Mensaje) End If tsl5.Utilidades.EnviarNotificacionSlack(mensajeSlack.ToString, destinatario:=destinoSlack, descripcionRemitente:=Reflection.MethodBase.GetCurrentMethod.ToString) End If AñadeLogTXT(Mensaje, sFicheroLog) Catch ex As Exception sFicheroLog = DirectorioLogs & "Errores-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" AñadeLogTXT(ex.Message, sFicheroLog) End Try End Sub Public Shared Sub AñadeLogNombreConFicheroTexto(ByVal nombreLog As String, ByVal Tipo As tsl5.Enumeraciones.TipoLog, ByVal descripcion As String, ByVal nombreDelFichero As String, ByVal textoDelFichero As String, Optional ByVal forzarEnviarCorreoE As Boolean = False, Optional ByVal forzarDestinatario As String = "", Optional ByVal forzarEnviarSlack As Boolean = False, Optional ByVal excepcion As Exception = Nothing) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Gestión de logs de la aplicación ' Fecha. Creacion: 2020-12-01 ' Creada por: danmun (heredando de manmog) ' Ultima Modificacion: 2020-12-01 ' ' Modificaciones: ' =============== Dim rutaCarpetaLogs As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\ServicioGestionAsegasa\Logs\" Dim rutaCarpetaTMP As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) & "\ServicioGestionAsegasa\TMP\" Dim sFicheroLog As String = rutaCarpetaLogs & "Log-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString & ".txt" Try Dim enviarCorreoE As Boolean = False Dim sbAsunto As New Text.StringBuilder Dim sSeguimientoDePila As String = "" sbAsunto.AppendFormat("[`{0}`] ", System.Diagnostics.Process.GetCurrentProcess.ProcessName) sbAsunto.AppendFormat("{0}: guardando y enviando fichero con nombre `{1}`. ", nombreLog, nombreDelFichero) Dim sbMensaje As New Text.StringBuilder '// Lo principal: guardar el fichero de texto. '// UTF-8 sin BOM y tópalante, que esto lo estoy haciendo rápidamente con propósitos de depuración. Dim sRutaFicheroTexto As String = rutaCarpetaTMP & nombreLog & "-" & Today.ToString("yyyy-MM-dd_HH-mm-ss-fff") & "-" & nombreDelFichero IO.File.WriteAllText(sRutaFicheroTexto, textoDelFichero) '// Decidir si se envía información sobre la excepción If Not IsNothing(excepcion) Then If Not el Is Nothing Then el.WriteEntry(excepcion.Message & vbCrLf & excepcion.StackTrace, EventLogEntryType.Error) sSeguimientoDePila = "Información de la excepción: " & excepcion.ToString & vbCrLf Dim exceptionInterna As Exception = excepcion Do sSeguimientoDePila &= exceptionInterna.StackTrace & vbCrLf exceptionInterna = exceptionInterna.InnerException Loop Until IsNothing(exceptionInterna) End If sbMensaje.AppendLine(sbAsunto.ToString) sbMensaje.AppendFormat("{0}{0}Descripción: {1}", vbCrLf, descripcion) sbMensaje.AppendFormat("{0}{0}Fichero guardado en: `{1}`", vbCrLf, sRutaFicheroTexto) sbMensaje.AppendFormat("{0}{0}### Inicio del fichero de texto con nombre `{1}`:{0}```{0}{2}{0}```{0}### Fin del fichero de texto.", vbCrLf, nombreDelFichero, textoDelFichero) If Not String.IsNullOrWhiteSpace(sSeguimientoDePila) Then sbAsunto.AppendLine(vbCrLf & "Seguimiento de pila: " & sSeguimientoDePila) '// Decidir si se envía correo electrónico Select Case Tipo Case tsl5.Enumeraciones.TipoLog.Fallo, tsl5.Enumeraciones.TipoLog.Advertencia enviarCorreoE = True End Select '// Forzar envío de correo electrónico If forzarEnviarCorreoE OrElse excepcion IsNot Nothing Then enviarCorreoE = True If enviarCorreoE Then Select Case Tipo Case tsl5.Enumeraciones.TipoLog.Fallo sFicheroLog = rutaCarpetaLogs & "Errores-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" sbMensaje.Insert(0, Now.ToLongTimeString & " Error enviado desde [`" & Environment.MachineName & "`]." & vbCrLf) Case tsl5.Enumeraciones.TipoLog.Advertencia sbMensaje.Insert(0, Now.ToLongTimeString & " Advertencia enviada desde [`" & Environment.MachineName & "`]." & vbCrLf) Case tsl5.Enumeraciones.TipoLog.Informacion sbMensaje.Insert(0, Now.ToLongTimeString & " Información enviada desde [`" & Environment.MachineName & "`]." & vbCrLf) Case tsl5.Enumeraciones.TipoLog.Depuracion sbMensaje.Insert(0, Now.ToLongTimeString & " Información de depuración enviada desde [`" & Environment.MachineName & "`]." & vbCrLf) End Select Dim sDireccionesEnvio As String = "sevilla@tecnosis.net" Dim sServidorSMTP As String = "correo.tecnosis.net" Dim sRemitente = "logs@tecnosis.es" '// Forzar destinatario If Not String.IsNullOrWhiteSpace(forzarDestinatario) Then sDireccionesEnvio = forzarDestinatario End If '// Destinatario especial si se está ejecutando en ciertas máquinas. If Environment.MachineName.ToUpper.Trim() = "INTI" OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" Then sDireccionesEnvio = "danmun@tecnosis.net" sbAsunto.Insert(0, "[`" & Environment.MachineName.ToUpper.Trim & "`] ") End If 'If nombreDelFichero IsNot Nothing Then nombreDelFichero = nombreDelFichero.Replace(vbCrLf, vbCrLf & "
") tsl5.Correo.Funciones.EnviaCorreo(sServidorSMTP, sRemitente, sDireccionesEnvio, sbAsunto.ToString.Replace("`", ""), sbMensaje.ToString.Replace("`", ""),,,, "logs@tecnosis.es", "LoGs20i9.") End If '// Decidir si enviar también por Slack If forzarEnviarSlack OrElse Tipo = tsl5.Enumeraciones.TipoLog.Fallo OrElse Tipo = tsl5.Enumeraciones.TipoLog.Advertencia OrElse excepcion IsNot Nothing Then Dim destinoSlack = "asegasa" If forzarEnviarSlack Then destinoSlack = "Avant2" Dim mensajeSlack As New Text.StringBuilder mensajeSlack.Append(sbAsunto.ToString) If String.IsNullOrWhiteSpace(sbMensaje.ToString) Then mensajeSlack.Append(sbAsunto.ToString) Else mensajeSlack.Append(sbMensaje.ToString) End If tsl5.Utilidades.EnviarNotificacionSlack(mensajeSlack.ToString, destinatario:=destinoSlack, descripcionRemitente:=Reflection.MethodBase.GetCurrentMethod.ToString) End If AñadeLogTXT(sbAsunto.ToString, sFicheroLog) Catch ex As Exception sFicheroLog = rutaCarpetaLogs & "Errores-" & nombreLog & "-" & Now.Year.ToString & Now.Month.ToString.PadLeft(2, "0") & ".txt" AñadeLogTXT(ex.Message, sFicheroLog) End Try End Sub Public Shared Sub AñadeLogTXT(ByVal Mensaje As String, ByVal FicheroLog As String) Dim sw As IO.StreamWriter = Nothing Try Mensaje = Mensaje.Replace(vbCrLf, "---") If IO.File.Exists(FicheroLog) Then sw = IO.File.AppendText(FicheroLog) Else Dim directorio = IO.Path.GetDirectoryName(FicheroLog) If Not IO.Directory.Exists(directorio) Then tsl5.Utilidades.CreaEstructuraDirectorio(directorio) sw = IO.File.CreateText(FicheroLog) End If Mensaje = Now.ToString & "|" & "Ws: " & System.Diagnostics.Process.GetCurrentProcess.WorkingSet64.ToString.PadLeft(20) & " PMS: " & System.Diagnostics.Process.GetCurrentProcess.PrivateMemorySize64.ToString.PadLeft(20) & "|" & Mensaje sw.WriteLine(Mensaje) Catch ex As Exception Try Dim sDireccionesEnvio As String = "sevilla@tecnosis.net" Dim sServidorSMTP As String = "sevilla2.tecnosis.es" Dim sRemitente = "logs@tecnosis.es" If Environment.MachineName.StartsWith("INTI") OrElse Environment.MachineName.StartsWith("ANTA") OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" Then sDireccionesEnvio = "danmun@tecnosis.net" 'If Mensaje IsNot Nothing Then Mensaje = Mensaje.Replace(vbCrLf, vbCrLf & "
") tsl5.Correo.Funciones.EnviaCorreo(sServidorSMTP, sRemitente, sDireccionesEnvio, "Error AñadeLogTXT. " & Mensaje, Environment.MachineName & ".- " & ex.Message & vbCrLf & ex.StackTrace & vbCrLf & ex.Source,,,, "logs@tecnosis.es", "LoGs20i9.") Catch ex2 As Exception End Try Finally Try sw.Close() Catch End Try End Try End Sub Shared Sub GeneraRegistroCorreoExcepcion(ex As Exception, Rutina As String, Optional MostrarMensajeError As Boolean = False, Optional FicheroImagen As Byte() = Nothing) Try Dim bd = bdGestionAsegasa.gestionasegasaEntities.NuevoContextoCN Dim sMensaje As String = "Usuario: " & bdGestionAsegasa.Utilidades.Usuario & " Versión: " & My.Application.Info.Version.ToString & vbCrLf Dim sStackTrace As String = "Tipo excepción: " & ex.ToString & vbCrLf Dim exError As Exception = ex Do sStackTrace &= exError.StackTrace & vbCrLf exError = exError.InnerException Loop Until IsNothing(exError) If sStackTrace <> "" Then sMensaje &= vbCrLf & "StackTrace: " & sStackTrace Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First bdGestionAsegasa.Utilidades.GeneraRegistroCorreo(bd, "Mensaje Automático. Error en " & Rutina, sMensaje, cuentaorigen, "sevilla@tecnosis.net", FicheroImagen,, "ERROR") Catch ex2 As Exception AñadeLogTXT(ex2.Message, FicheroLog) If MostrarMensajeError Then DXMessageBox.Show(ex2.Message & vbCrLf & ex2.StackTrace, "Error Generando Correo Excepcion") End Try End Sub 'Shared Sub GeneraRegistroCorreoExcepcion(ex As Exception, sAsunto As String, sCuerpo As String, Optional MostrarMensajeError As Boolean = False) ' Try ' Dim bd = bdGestionAsegasa.gestionasegasaEntities.NuevoContextoCN ' Dim sMensaje As String = sCuerpo & vbCrLf & vbCrLf & "Usuario: " & bdGestionAsegasa.Utilidades.Usuario & vbCrLf & vbCrLf ' Dim sStackTrace As String = "Excepción: " & ex.ToString & vbCrLf ' Dim exError As Exception = ex ' Do ' sStackTrace &= exError.StackTrace & vbCrLf & vbCrLf ' exError = exError.InnerException ' Loop Until IsNothing(exError) ' If sStackTrace <> "" Then sMensaje &= vbCrLf & "StackTrace: " & sStackTrace ' Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First ' Dim bFichero() As Byte = Nothing ' bdGestionAsegasa.Utilidades.GeneraRegistroCorreo(bd, sAsunto, sMensaje, cuentaorigen, "sevilla@tecnosis.net") ' Catch ex2 As Exception ' AñadeLogTXT(ex2.Message, FicheroLog) ' If MostrarMensajeError Then DXMessageBox.Show(ex2.Message & vbCrLf & ex2.StackTrace, "Error Generando Correo Excepcion") ' End Try 'End Sub Shared Sub GeneraRegistroCorreoExcepcion(bd As bdGestionAsegasa.gestionasegasaEntities, ex As Exception, sAsunto As String, sCuerpo As String, Optional MostrarMensajeError As Boolean = False, Optional FicheroImagen As Byte() = Nothing) Try Dim sMensaje As String = sCuerpo & vbCrLf & vbCrLf & "Usuario: " & bdGestionAsegasa.Utilidades.Usuario & vbCrLf & vbCrLf Dim sStackTrace As String = "Excepción: " & ex.ToString & vbCrLf Dim exError As Exception = ex Do sStackTrace &= exError.StackTrace & vbCrLf & vbCrLf exError = exError.InnerException Loop Until IsNothing(exError) If sStackTrace <> "" Then sMensaje &= vbCrLf & "StackTrace: " & sStackTrace Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First Dim bFichero() As Byte = Nothing bdGestionAsegasa.Utilidades.GeneraRegistroCorreo(bd, sAsunto, sMensaje, cuentaorigen, "sevilla@tecnosis.net", FicheroImagen,, "ERROR") Catch ex2 As Exception AñadeLogTXT(ex2.Message, FicheroLog) If MostrarMensajeError Then DXMessageBox.Show(ex2.Message & vbCrLf & ex2.StackTrace, "Error Generando Correo Excepcion") End Try End Sub Public Shared Sub GeneraRegistroCorreo(bd As bdGestionAsegasa.gestionasegasaEntities, Asunto As String, Cuerpo As String) Try Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First Dim sRutaAdjunto As String = "" Dim correo = New correos With { .Asunto = Asunto, .Cuerpo = Cuerpo, .Destinatario = "sevilla@tecnosis.net", .DireccionRespuesta = cuentaorigen.Remitente, .FechaCreacion = bdGestionAsegasa.Utilidades.AhoraMysql(bd), .idcuenta = cuentaorigen.idCuenta, .Remitente = cuentaorigen.Remitente } If Environment.MachineName.ToUpper = "INTI" OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" Then correo.Destinatario = "danmun@tecnosis.net" '// Reemplazar los saltos de línea con
porque el correo va en HTML, y si no hacemos esto '// no habrá saltos de línea dentro del correo. 'If correo.Cuerpo IsNot Nothing Then correo.Cuerpo = correo.Cuerpo.Replace(vbCrLf, vbCrLf & "
") '// Guardar en la bd. bd.correos.AddObject(correo) bd.GuardarCambios() Catch ex As Exception Debug.Write(ex.Message) Throw End Try End Sub Public Shared Sub GeneraRegistroCorreo(bd As bdGestionAsegasa.gestionasegasaEntities, Asunto As String, Cuerpo As String, cuenta As cuentascorreo, Destinatario As String, Optional CapturaPantallaError As Byte() = Nothing, Optional idAplicacion As Integer? = Nothing, Optional CodigoAplicacion As String = "") Try Dim sRutaAdjunto As String = "" Dim correo = New correos With { .Asunto = Asunto, .Cuerpo = Cuerpo, .Destinatario = Destinatario, .DireccionRespuesta = cuenta.Remitente, .FechaCreacion = bdGestionAsegasa.Utilidades.AhoraMysql(bd), .idcuenta = cuenta.idCuenta, .Remitente = cuenta.Remitente, .idAplicacion = idAplicacion, .CodigoAplicacion = CodigoAplicacion } If CapturaPantallaError IsNot Nothing Then Dim idtipocapturaerror = bd.enumeraciones.First(Function(x) x.Codigo = "TIPFIC.CAPERROR").idEnumeracion Dim f As New ficheros With f f.NombreFichero = "CapturaPantallaError_" & Now.ToString("yyyyMMddhhmmss") & ".jpg" f.Fichero = CapturaPantallaError f.idTipo = idtipocapturaerror End With bd.ficheros.AddObject(f) correo.ficheros = f End If If Environment.MachineName.ToUpper = "INTI" OrElse Environment.MachineName.ToUpper.Trim() = "CERBERO" Then Destinatario = "danmun@tecnosis.net" bd.correos.AddObject(correo) bd.GuardarCambios() Catch ex As Exception Debug.Write(ex.Message) Throw End Try End Sub Shared Sub GenerarRegistroCorreoAvant2Agente3(bd As bdGestionAsegasa.gestionasegasaEntities, ByRef linea As bdGestionAsegasa.polizassg, ByVal sQuotationID As String, Optional ByVal usuarioAvant2 As String = "") Try '// Los destinatarios de estos correos están en la base de datos. Dim lineasEnumeraciones As List(Of bdGestionAsegasa.enumeraciones) = (From x In bd.enumeraciones Where x.idGrupoEnumeracion = "62" Select x).ToList() Dim sDireccionRespuesta As String = lineasEnumeraciones.Where(Function(x) x.Codigo = "AVANT2.EMAIL.IP.RESPUESTA").FirstOrDefault.ValorAlfabetico1 Dim sDireccionesDestino As New List(Of String) For Each le In lineasEnumeraciones If le.Codigo.StartsWith("AVANT2.EMAIL.IP.DESTINO") Then sDireccionesDestino.Add(le.ValorAlfabetico1) Next Dim sbAsuntoEmail As New Text.StringBuilder Dim sbCuerpoEmail As New Text.StringBuilder sbAsuntoEmail.Append("Avant2: se procederá a la incorporación de una póliza al agente 3") sbCuerpoEmail.AppendLine("Avant2: se procederá a la incorporación de una póliza al agente 3.") sbCuerpoEmail.AppendLine("
") sbCuerpoEmail.AppendLine("No es posible transferir la póliza a su usuario original porque no se encuentra la información del usuario que la emitió desde Avant2.") sbCuerpoEmail.AppendLine("
") sbCuerpoEmail.AppendLine("Hay que revisar que el usuario de Avant2 que realizó la emisión de esta póliza esté correctamente identificado en la aplicación Gestión Asegasa: hay que revisar el campo ""Usuario Avant"" en la ficha del agente o subagente y que no esté de baja.") sbCuerpoEmail.AppendLine("
") sbCuerpoEmail.AppendLine("Datos de la póliza importada al agente 3:") sbCuerpoEmail.AppendLine("
") sbCuerpoEmail.AppendLine(String.Format("quotationID: {0}
", sQuotationID)) Try sbCuerpoEmail.AppendLine(String.Format("Nº de póliza: {0}
", linea.NumeroPoliza)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Compañía: {0}
", linea.companias.Nombre)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Ramo: {0}
", linea.ramos.Descripcion)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("CIF del tomador: {0}
", linea.Tomador.CIF)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Nombre del tomador: {0}
", (linea.Tomador.Nombre & " " & linea.Tomador.Apellidos).Trim)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Fecha de efecto: {0}
", linea.FechaEfecto)) Catch ex As Exception 'Nada, a propósito. End Try Try If Not String.IsNullOrWhiteSpace(usuarioAvant2) Then sbCuerpoEmail.AppendLine(String.Format("Identificador del usuario de Avant 2 que realizó el alta: {0}
", (usuarioAvant2).Trim)) End If Catch ex As Exception 'Nada, a propósito. End Try sbCuerpoEmail.AppendLine("
") sbCuerpoEmail.AppendLine("Fin del correo electrónico.") Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First For Each destinatario In sDireccionesDestino bdGestionAsegasa.Utilidades.GeneraRegistroCorreo(bd, sbAsuntoEmail.ToString, sbCuerpoEmail.ToString, cuentaorigen, destinatario) Next Catch ex2 As Exception AñadeLogTXT(ex2.Message, FicheroLog) End Try End Sub Shared Sub GenerarRegistroCorreoAvant2IncorporacionParcial(bd As bdGestionAsegasa.gestionasegasaEntities, ByRef linea As bdGestionAsegasa.polizassg, ByVal sQuotationID As String) Try '// Los destinatarios de estos correos están en la base de datos. Dim lineasEnumeraciones As List(Of bdGestionAsegasa.enumeraciones) = (From x In bd.enumeraciones Where x.idGrupoEnumeracion = "62" Select x).ToList() Dim sDireccionRespuesta As String = lineasEnumeraciones.Where(Function(x) x.Codigo = "AVANT2.EMAIL.IP.RESPUESTA").FirstOrDefault.ValorAlfabetico1 Dim sDireccionesDestino As New List(Of String) For Each le In lineasEnumeraciones If le.Codigo.StartsWith("AVANT2.EMAIL.IP.DESTINO") Then sDireccionesDestino.Add(le.ValorAlfabetico1) Next Dim sbAsuntoEmail As New Text.StringBuilder Dim sbCuerpoEmail As New Text.StringBuilder sbAsuntoEmail.AppendFormat("Avant2: incorporación parcial de poliza nº {0}, {1}", linea.NumeroPoliza, linea.ramos.Descripcion) sbCuerpoEmail.AppendLine("Avant2, incorporación parcial de póliza.") sbCuerpoEmail.AppendLine("") sbCuerpoEmail.AppendLine("Esto es una incorporación parcial. Avant2 de Codeoscopic no proporciona varios datos de la póliza. Estos campos no proporcionados podrían venir vacios, con los símbolos ~~, con el número -1 o con la fecha 1970/01/01.") sbCuerpoEmail.AppendLine("") sbCuerpoEmail.AppendLine(String.Format("quotationID: {0}", sQuotationID)) Try sbCuerpoEmail.AppendLine(String.Format("Numero de póliza: {0}", linea.NumeroPoliza)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Compañía: {0}", linea.companias.Nombre)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Ramo: {0}", linea.ramos.Descripcion)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("CIF del tomador: {0}", linea.Tomador.CIF)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Nombre del tomador: {0}", (linea.Tomador.Nombre & " " & linea.Tomador.Apellidos).Trim)) Catch ex As Exception 'Nada, a propósito. End Try Try sbCuerpoEmail.AppendLine(String.Format("Fecha de efecto: {0}", linea.FechaEfecto)) Catch ex As Exception 'Nada, a propósito. End Try sbCuerpoEmail.AppendLine("") sbCuerpoEmail.AppendLine("Fin del correo electronico.") Dim cuentaorigen As cuentascorreo = (From c In bd.cuentascorreo Select c Where c.Codigo = "TECNOSIS").First For Each destinatario In sDireccionesDestino bdGestionAsegasa.Utilidades.GeneraRegistroCorreo(bd, sbAsuntoEmail.ToString, sbCuerpoEmail.ToString, cuentaorigen, destinatario) Next Catch ex2 As Exception AñadeLogTXT(ex2.Message, FicheroLog) End Try End Sub Public Shared Function ObtienePermisos(bd As bdGestionAsegasa.gestionasegasaEntities, idPermiso As Nullable(Of Integer), idUsuario As Integer) As tsWPF.Permisos Dim per As New tsWPF.Permisos If (From u In bd.usuarios Select u Where u.idUsuario = idUsuario).First.gruposusuarios.Descripcion = "TECNOSIS" Then per.Consultar = True per.Eliminar = True per.Nuevos = True per.Otros = True per.Modificar = True per.Impresion = True per.Exportar = True Else If idPermiso Is Nothing Then per.Consultar = False per.Eliminar = False per.Nuevos = False per.Otros = False per.Modificar = False per.Impresion = False per.Exportar = False Else Dim au = (From a In bd.autorizacionesusuarios Select a Where a.permisos.idPermiso = idPermiso And a.idUsuario = idUsuario) If au.Count = 0 Then Dim idGrupo As Integer = (From u In bd.usuarios Select u Where u.idUsuario = idUsuario).First.idGrupo Dim ag = (From g In bd.autorizacionesgrupos Select g Where g.permisos.idPermiso = idPermiso And g.idGrupo = idGrupo) If ag.Count = 0 Then per.Consultar = False per.Eliminar = False per.Nuevos = False per.Otros = False per.Modificar = False per.Impresion = False per.Exportar = False Else per.Consultar = ag.First.PermitirConsultas per.Eliminar = ag.First.PermitirEliminaciones per.Nuevos = ag.First.PermitirNuevos per.Otros = ag.First.OtrosPermisos per.Modificar = ag.First.PermitirModificaciones per.Impresion = ag.First.PermitirImpresiones per.Exportar = ag.First.PermitirExportar End If Else per.Consultar = au.First.PermitirConsultas per.Eliminar = au.First.PermitirEliminaciones per.Nuevos = au.First.PermitirNuevos per.Otros = au.First.OtrosPermisos per.Modificar = au.First.PermitirModificaciones per.Impresion = au.First.PermitirImpresiones per.Exportar = au.First.PermitirExportar End If End If End If Return per End Function Public Shared Function ObtienePermisos(bd As bdGestionAsegasa.gestionasegasaEntities, Codigo As String, idUsuario As Integer) As tsWPF.Permisos Try Dim per As New tsWPF.Permisos If bd.usuarios.First(Function(x) x.idUsuario = idUsuario).gruposusuarios.Descripcion = "TECNOSIS" Then per.Consultar = True per.Eliminar = True per.Nuevos = True per.Otros = True per.Modificar = True per.Impresion = True per.Exportar = True Else Dim au = (From a In bd.autorizacionesusuarios Select a Where a.permisos.CodigoPermiso = Codigo And a.idUsuario = idUsuario) If au.Count = 0 Then Dim idGrupo As Integer = (From u In bd.usuarios Select u Where u.idUsuario = idUsuario).First.idGrupo Dim ag = (From g In bd.autorizacionesgrupos Select g Where g.permisos.CodigoPermiso = Codigo And g.idGrupo = idGrupo) If ag.Count = 0 Then per.Consultar = False per.Eliminar = False per.Nuevos = False per.Otros = False per.Modificar = False per.Impresion = False per.Exportar = False Else per.Consultar = ag.First.PermitirConsultas per.Eliminar = ag.First.PermitirEliminaciones per.Nuevos = ag.First.PermitirNuevos per.Otros = ag.First.OtrosPermisos per.Modificar = ag.First.PermitirModificaciones per.Impresion = ag.First.PermitirImpresiones per.Exportar = ag.First.PermitirExportar End If Else per.Consultar = au.First.PermitirConsultas per.Eliminar = au.First.PermitirEliminaciones per.Nuevos = au.First.PermitirNuevos per.Otros = au.First.OtrosPermisos per.Modificar = au.First.PermitirModificaciones per.Impresion = au.First.PermitirImpresiones per.Exportar = au.First.PermitirExportar End If End If Return per Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function Public Shared Function ObtenerNumeroDePolizaDisponibleTractoresAXA(ByVal bd As bdGestionAsegasa.gestionasegasaEntities, Optional ByVal n As UInteger = 0) As String Dim resultado As String = "" Dim inicio As bdGestionAsegasa.enumeraciones Dim fin As bdGestionAsegasa.enumeraciones Dim actual As UInteger = 0 Dim bEncontrado As Boolean = False Dim enumNumeracion = (From x In bd.enumeraciones Where x.Codigo.StartsWith("AXATRACTORES.numeracion.") AndAlso x.ValorAlfabetico1.ToUpper.Trim = "DISPONIBLE" Order By x.Codigo Select x).ToList() Dim idRamoTractores As String = (From x In bd.ramos Where x.Codigo = "1-1" Select x.idRamo).FirstOrDefault Dim idRamoRemolques As String = (From x In bd.ramos Where x.Codigo = "1-1-1" Select x.idRamo).FirstOrDefault ' De todos los posibles rangos, tengo que elegir el más bajo que esté disponible. ' Como lo he ordenado por Codigo, al hacerlo así ya estoy eligiendo el más bajo disponible. ' Con rango más bajo me refiero al valor que está dentro del código, no a los números del rango en sí. ' Formato del código: "AXATRACTORES.numeracion.0000" inicio = enumNumeracion.Where(Function(x) x.Codigo.EndsWith(".inicio")).FirstOrDefault fin = enumNumeracion.Where(Function(x) x.Codigo.EndsWith(".fin")).FirstOrDefault Try If n = 0 Then actual = (From x In bd.polizassg Where x.NumeroPoliza >= inicio.ValorNumerico1 AndAlso x.NumeroPoliza <= fin.ValorNumerico1 AndAlso (x.idRamo = idRamoTractores OrElse x.idRamo = idRamoRemolques) Order By x.NumeroPoliza Descending Select x.NumeroPoliza Take 10).ToList().FirstOrDefault Else actual = n End If Catch ex As Exception ' Nada, significa que aún no existe el primero. End Try If actual = 0 Then ' Si "actual" vale 0 significa que es la primera vez y tenemos que usar el primero del rango. resultado = inicio.ValorNumerico1 bEncontrado = True Else If actual < inicio.ValorNumerico1 Then resultado = inicio.ValorNumerico1 bEncontrado = True ElseIf actual = fin.ValorNumerico1 Then ' Caso en el que hay que pasar a usar el siguiente rango. ' Hay que marcar el actual rango como completado. inicio.ValorAlfabetico1 = "Usado" fin.ValorAlfabetico1 = "Usado" bd.GuardarCambios() resultado = ObtenerNumeroDePolizaDisponibleTractoresAXA(bd) ' Sí, esta es una función recursiva. Está comprobado que esta recursividad funciona adecuadamente según los datos que haya en la base de datos. ElseIf actual > fin.ValorNumerico1 Then 'El número final sí lo podemos usar, por eso la comparación se hace con ">". resultado = -1 'Significa que ya hemos llegado al límite de asignaciones, no podemos asignar más. bEncontrado = True ' TODO: Mirar si hay otro rango más? Dim asunto As String = "TractoresAXA: Se han acabado los nºs de pólizas reservados para el servicio de TractoresAXA. Todas las altas que se realicen a partir de ahora fallarán hasta que se asignen nuevos rangos." Dim cuerpo As String = asunto & vbCrLf & " Hay que avisar a ASEGASA para que gestionen con AXA la asignación de un nuevo rango de nºs de pólizas para este servicio." & vbCrLf & "En método `" & System.Reflection.MethodBase.GetCurrentMethod.ToString & "`. " _ & vbCrLf & Environment.MachineName Call AñadeLog(tsl5.Enumeraciones.TipoLog.Fallo, asunto, cuerpo) tsl5.Utilidades.EnviarNotificacionSlack(asunto, destinatario:="#asegasa", descripcionRemitente:=Reflection.MethodBase.GetCurrentMethod.ToString) Else ' Caso normal, en el que hay que usar el número que sigue, porque seguimos dentro del rango. ' ' Pero tengo que comprobar que "actual + 1" no esté usado. ¿Cómo lo hago? Bueno, sería mucha ' casualidad y mucha mala suerte que dos altas coincidan en el tiempo de tal modo que ambas ' pillen el mismo nº de poliza. resultado = actual + 1 bEncontrado = True End If End If ' TODO: danmun: Lanzar aquí mensajes cuando falten 500, 200, 100, 50, 20, 10, avisando. 'If bEncontrado Then ' Dim numerosReservadosDisponibles As Integer = ComprobarCuantosNumerosReservadosQuedanDisponibles(actual, inicio, fin) ' Dim listaDeLimitesParaEnviarAdvertencias As Integer() = {10, 20, 50, 100, 200, 500} ' Dim bAdvertenciaEnviada As Boolean = False ' ' La idea es la siguiente: dispongo de un array donde tenemos los límites en los que hay que lanzar la advertencia ' ' de que se están gastando los nºs de pólizas reservados para TractoresAXA. El array está ordenado de menor a mayor. ' ' Al recorrer el array, compruebo: ¿quedan menos de 10 números disponibles? Si es así, lanzo advertencia y ya no vuelvo ' ' a realizar más comprobaciones. Si no es así, compruebo con el siguiente límite, que sería 20. Por lo tanto, es posible ' ' completar el recorrido del array sin enviar ninguna advertencia o bien enviando solamente 1. ' For Each i In listaDeLimitesParaEnviarAdvertencias ' If Not bAdvertenciaEnviada AndAlso numerosReservadosDisponibles < i Then ' ' Notificación Slack ' Try ' Dim asunto As String = String.Format("TractoresAXA: quedan menos de {0} nºs de póliza reservados sin usar.", i) ' Dim sbCuerpo As New Text.StringBuilder() ' sbCuerpo.AppendFormat("*TractoresAXA*: quedan menos de {1} nºs de póliza reservados sin usar.{0}", vbCrLf, i) ' sbCuerpo.AppendLine("Es recomendable avisar a ASEGASA para que gestionen con AXA la asignación de un nuevo rango de nºs de pólizas para este servicio.") ' sbCuerpo.AppendFormat("```Próximo nº de póliza que va a ser usado de inmediato: {1}{0}Primer nº del rango actual:{2}{0}Último nº del rango actual: {3}{0}Servidor: {4}```{0}", vbCrLf, ' resultado, inicio.ValorNumerico1, fin.ValorNumerico1, Environment.MachineName) ' sbCuerpo.AppendFormat("En método `{0}` y en máquina `{1}`.", System.Reflection.MethodBase.GetCurrentMethod.ToString, Environment.MachineName) ' Call AñadeLog(tsl5.Enumeraciones.TipoLog.Advertencia, asunto, sbCuerpo.ToString) ' tsl5.Utilidades.EnviarNotificacionSlack(sbCuerpo.ToString, destinatario:="#asegasa", descripcionRemitente:=Reflection.MethodBase.GetCurrentMethod.ToString) ' Catch ex As Exception ' ' Si esta notificación da error no debe pararse el servicio, así que no hago nada. ' End Try ' bAdvertenciaEnviada = True ' End If ' Next 'End If Return resultado End Function End Class