Comunes/tsl5
10
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Agregar archivos de proyecto.

Browse Source
This commit is contained in:
Manuel Moguer
2026-05-14 09:52:12 +02:00
parent 3a8fc53e4e
commit f8102dd7f1
78 changed files with 34070 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
App.Config Normal file
View File

@@ -0,0 +1,73 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<system.diagnostics>
<sources>
<!-- En esta sección se define la configuración del registro para My.Application.Log -->
<source name="DefaultSource" switchName="DefaultSwitch">
<listeners>
<add name="FileLog" />
<!-- Quite los comentarios de la sección posterior para escribir en el registro de eventos de la aplicación -->
<!--<add name="EventLog"/>-->
</listeners>
</source>
</sources>
<switches>
<add name="DefaultSwitch" value="Information" />
</switches>
<sharedListeners>
<add name="FileLog" type="Microsoft.VisualBasic.Logging.FileLogTraceListener, Microsoft.VisualBasic, Version=8.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL" initializeData="FileLogWriter" />
<!-- Quite los comentarios de la sección posterior y reemplace APPLICATION_NAME con el nombre de su aplicación para escribir en el registro de eventos de la aplicación -->
<!--<add name="EventLog" type="System.Diagnostics.EventLogTraceListener" initializeData="APPLICATION_NAME"/> -->
</sharedListeners>
</system.diagnostics>
<entityFramework>
<defaultConnectionFactory type="System.Data.Entity.Infrastructure.LocalDbConnectionFactory, EntityFramework">
<parameters>
<parameter value="v11.0" />
</parameters>
</defaultConnectionFactory>
</entityFramework>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.8" />
</startup>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-6.0.3.0" newVersion="6.0.3.0" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.0.5.0" newVersion="4.0.5.0" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Memory" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.0.5.0" newVersion="4.0.5.0" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="Microsoft.Extensions.Logging.Abstractions" publicKeyToken="adb9793829ddae60" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-7.0.0.1" newVersion="7.0.0.1" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="Microsoft.Bcl.AsyncInterfaces" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-10.0.0.7" newVersion="10.0.0.7" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.1.5.0" newVersion="4.1.5.0" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Text.Encodings.Web" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-9.0.0.3" newVersion="9.0.0.3" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Diagnostics.DiagnosticSource" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-10.0.0.7" newVersion="10.0.0.7" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Threading.Tasks.Extensions" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.2.4.0" newVersion="4.2.4.0" />
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>

BIN
Baget/nuget.exe Normal file
View File

Binary file not shown.

18
Baget/tsl5v2.nuspec Normal file
View File

@@ -0,0 +1,18 @@
<?xml version="1.0"?>
<package>
<metadata>
<id>tsl5</id>
<version>3.0.2</version>
<authors>Manuel</authors>
<owners>Tecnosis S.A.</owners>
<requireLicenseAcceptance>false</requireLicenseAcceptance>
<description>Utilidades varias de tecnosis.</description>
<tags>tsl5 .net48</tags>
<dependencies>
<group targetFramework=".NETFramework4.8" />
</dependencies>
</metadata>
<files>
<file src="C:\tecnosis.git\Comunes\tsl5v2\bin\Debug\tsl5.dll" target="lib\net48\" />
</files>
</package>

804
Bancos/Bancos.vb Normal file
View File

@@ -0,0 +1,804 @@
Imports System.Text
Imports tsl5.Extensiones
Imports tsl5.Extensiones.StringExtensions
Namespace Bancos
'Namespace AEB_19
' Public Class DatosFichero
' Property FechaSoporte As Date
' Property FechaCargo As Date
' Property Presentador As New DatosPresentador
' Property Ordenantes As New List(Of DatosOrdenante)
' End Class
' Public Class DatosPresentador
' Property Nombre As String
' Property NIF As String
' Property EntidadReceptora As String
' Property Oficina As String
' End Class
' Public Class DatosOrdenante
' Property Nombre As String
' Property NIF As String
' Property CuentaAbono As New CuentaBancaria
' Property Procedimiento As String
' Property DatosRecibo As New List(Of DatosRecibo)
' End Class
' Public Class DatosRecibo
' Property NIF_Cliente As String
' Property CodigoReferencia As String
' Property NombreTitularDomiciliacion As String
' Property CuentaAdeudo As New CuentaBancaria
' Property Importe As Double
' Property Conceptos As String()
' Property CamposOpcionales As New CamposOpcionales
' End Class
' Public Class CamposOpcionales
' Property NombreTitularCuenta As String
' Property DomicilioTitularCuenta As String
' Property PlazaDomicilioTitularCuenta As String
' Property CodigoPostalTitularCuenta As String
' End Class
' Public Class CuentaBancaria
' Property Entidad As String
' Property Oficina As String
' Property DC As String
' Property NumeroCuenta As String
' End Class
' Public Class Utilidades
' Public Shared Sub GeneraFichero(Datos As DatosFichero, Fichero As String, Optional ByVal Sobreescribir As Boolean = False)
' If Sobreescribir Then
' If IO.File.Exists(Fichero) Then IO.File.Delete(Fichero)
' Else
' If IO.File.Exists(Fichero) Then Throw New Exception("Fichero " & Fichero & " existente")
' End If
' Dim fs As New IO.FileStream(Fichero, IO.FileMode.CreateNew)
' GeneraFichero(Datos, fs)
' fs.Close()
' End Sub
' Public Shared Sub GeneraFichero(Datos As DatosFichero, ByRef st As IO.Stream)
' ' CompruebaDatos(Datos)
' Try
' Dim Registro As String
' ' Dim ms As New IO.MemoryStream
' Dim sw As New IO.StreamWriter(st, System.Text.Encoding.GetEncoding("iso-8859-1"))
' Dim iNumRegOrdenante, iNumRegPresentador As Integer
' ' REGISTRO DE CABECERA 1 (PRESENTADOR)
' Registro = "51"
' Registro &= "80"
' Registro &= Datos.Presentador.NIF.Substring(0, Math.Min(Datos.Presentador.NIF.Length, 9)).PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= FechaAEB(Datos.FechaSoporte)
' Registro &= "".PadLeft(6, " ")
' Registro &= Datos.Presentador.Nombre.Substring(0, Math.Min(Datos.Presentador.Nombre.Length, 40)).PadRight(40, " ")
' Registro &= "".PadLeft(20, " ")
' Registro &= Datos.Presentador.EntidadReceptora
' Registro &= Datos.Presentador.Oficina
' Registro &= "".PadRight(12, " ")
' Registro &= "".PadRight(40, " ")
' Registro &= "".PadRight(14, " ")
' iNumRegPresentador += 1
' sw.WriteLine(Registro)
' ' REGISTRO DE CABECERA 2 (ORDENANTE)
' Dim ordenante As tsl5.Bancos.AEB_19.DatosOrdenante
' Dim dTotalOrd, dTotalGen As Double
' For Each ordenante In Datos.Ordenantes
' iNumRegOrdenante = 0
' dTotalOrd = 0
' Registro = "53"
' Registro &= "80"
' Registro &= ordenante.NIF.Substring(0, Math.Min(ordenante.NIF.Length, 9)).PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= FechaAEB(Datos.FechaSoporte)
' Registro &= FechaAEB(Datos.FechaCargo)
' Registro &= ordenante.Nombre.Substring(0, Math.Min(ordenante.Nombre.Length, 40)).PadRight(40, " ")
' Registro &= "".PadLeft(20, " ")
' Registro &= ordenante.CuentaAbono.Entidad
' Registro &= ordenante.CuentaAbono.Oficina
' Registro &= ordenante.CuentaAbono.DC
' Registro &= ordenante.CuentaAbono.NumeroCuenta
' Registro &= "".PadRight(8, " ")
' Registro &= ordenante.Procedimiento
' Registro &= "".PadRight(10, " ")
' Registro &= "".PadRight(40, " ")
' Registro &= "".PadRight(14, " ")
' iNumRegOrdenante += 1
' sw.WriteLine(Registro)
' Dim dr As tsl5.Bancos.AEB_19.DatosRecibo
' For Each dr In ordenante.DatosRecibo
' ' REGISTRO INDIVIDUAL OBLIGATORIO
' Registro = "56"
' Registro &= "80"
' Registro &= ordenante.NIF.PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= dr.CodigoReferencia.PadRight(12, " ")
' Registro &= dr.NombreTitularDomiciliacion.Substring(0, Math.Min(dr.NombreTitularDomiciliacion.Length, 40)).PadRight(40, " ")
' Registro &= dr.CuentaAdeudo.Entidad.PadLeft(4, "0")
' Registro &= dr.CuentaAdeudo.Oficina.PadLeft(4, "0")
' Registro &= dr.CuentaAdeudo.DC.PadLeft(2, "0")
' Registro &= dr.CuentaAdeudo.NumeroCuenta.PadLeft(10, "0")
' Registro &= (Math.Round(dr.Importe, 2) * 100).ToString.PadLeft(10, "0")
' dTotalOrd += Math.Round(dr.Importe, 2)
' Registro &= "".PadRight(6, " ")
' Registro &= "".PadRight(10, " ")
' Registro &= dr.Conceptos(0).Substring(0, Math.Min(dr.Conceptos(0).Length, 40)).PadRight(40, " ")
' Registro &= "".PadRight(8, " ")
' iNumRegOrdenante += 1
' sw.WriteLine(Registro)
' ' REGISTROS INDIVIDUALES OPCIONALES (DEL 1 AL 5)
' For i = 1 To 15 Step 3
' If dr.Conceptos.Length >= i + 1 Then
' Registro = "56"
' Registro &= (81 + (i \ 3)).ToString
' Registro &= ordenante.NIF.Substring(0, Math.Min(ordenante.NIF.Length, 9)).PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= dr.CodigoReferencia.PadRight(12, " ")
' Registro &= dr.Conceptos(i).Substring(0, Math.Min(dr.Conceptos(i).Length, 40)).PadRight(40, " ")
' If dr.Conceptos.Length >= i + 2 Then
' Registro &= dr.Conceptos(i + 1).Substring(0, Math.Min(dr.Conceptos(i + 1).Length, 40)).PadRight(40, " ")
' If dr.Conceptos.Length >= i + 3 Then
' Registro &= dr.Conceptos(i + 2).Substring(0, Math.Min(dr.Conceptos(i + 2).Length, 40)).PadRight(40, " ")
' Else
' Registro &= "".PadRight(40, " ")
' End If
' Else
' Registro &= "".PadRight(40, " ")
' Registro &= "".PadRight(40, " ")
' End If
' Registro &= "".PadRight(14, " ")
' iNumRegOrdenante += 1
' sw.WriteLine(Registro)
' Else
' Exit For
' End If
' Next
' ' REGISTRO OPCIONAL 6º
' If dr.CamposOpcionales.NombreTitularCuenta <> "" Or dr.CamposOpcionales.DomicilioTitularCuenta <> "" Or dr.CamposOpcionales.PlazaDomicilioTitularCuenta <> "" Or dr.CamposOpcionales.CodigoPostalTitularCuenta <> "" Then
' Registro = "56"
' Registro &= "86"
' Registro &= ordenante.NIF.PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= dr.CodigoReferencia.PadRight(12, " ")
' Registro &= dr.CamposOpcionales.NombreTitularCuenta.Substring(0, Math.Min(dr.CamposOpcionales.NombreTitularCuenta.Length, 40)).PadRight(40, " ")
' Registro &= dr.CamposOpcionales.DomicilioTitularCuenta.Substring(0, Math.Min(dr.CamposOpcionales.DomicilioTitularCuenta.Length, 40)).PadRight(40, " ")
' Registro &= dr.CamposOpcionales.PlazaDomicilioTitularCuenta.Substring(0, Math.Min(dr.CamposOpcionales.PlazaDomicilioTitularCuenta.Length, 35)).PadRight(35, " ")
' Registro &= dr.CamposOpcionales.CodigoPostalTitularCuenta.Substring(0, Math.Min(dr.CamposOpcionales.CodigoPostalTitularCuenta.Length, 5)).PadRight(5, " ")
' Registro &= "".PadRight(14, " ")
' iNumRegOrdenante += 1
' sw.WriteLine(Registro)
' End If
' Next
' ' REGISTRO TOTAL DE ORDENANTE
' Registro = "58"
' Registro &= "80"
' Registro &= Datos.Presentador.NIF.PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= "".PadLeft(12, " ")
' Registro &= "".PadLeft(40, " ")
' Registro &= "".PadLeft(20, " ")
' Registro &= (Math.Round(dTotalOrd, 2) * 100).ToString.PadLeft(10, "0")
' Registro &= "".PadLeft(6, " ")
' Registro &= ordenante.DatosRecibo.Count.ToString.PadLeft(10, "0")
' iNumRegOrdenante += 1
' Registro &= (iNumRegOrdenante).ToString.PadLeft(10, "0")
' Registro &= "".PadLeft(20, " ")
' Registro &= "".PadLeft(18, " ")
' sw.WriteLine(Registro)
' iNumRegPresentador += iNumRegOrdenante
' dTotalGen += dTotalOrd
' Next
' ' REGISTRO DE CABECERA 2 (PRESENTADOR)
' Registro = "58"
' Registro &= "80"
' Registro &= Datos.Presentador.NIF.PadLeft(9, "0")
' Registro &= "".PadLeft(3, " ")
' Registro &= "".PadLeft(12, " ")
' Registro &= "".PadLeft(40, " ")
' Registro &= "".PadLeft(20, " ")
' Registro &= (dTotalGen * 100).ToString.PadLeft(10, "0")
' Registro &= "".PadLeft(6, " ")
' Registro &= Datos.Ordenantes.Count.ToString.PadLeft(10, "0")
' iNumRegPresentador += 1
' Registro &= (iNumRegPresentador).ToString.PadLeft(10, "0")
' Registro &= "".PadLeft(20, " ")
' Registro &= "".PadLeft(18, " ")
' sw.WriteLine(Registro)
' sw.Close()
' st.Close()
' Catch ex As Exception
' Throw ex
' End Try
' End Sub
' Public Shared Function FechaAEB(Fecha As Date) As String
' Return Fecha.Day.ToString.PadLeft(2, "0") & Fecha.Month.ToString.PadLeft(2, "0") & (Fecha.Year Mod 100).ToString.PadLeft(2, "0")
' End Function
' End Class
'End Namespace
Public Enum TiposAdeudosEnum
''' <summary>
''' Último pago
''' </summary>
''' <remarks></remarks>
FNAL
''' <summary>
''' Primer pago
''' </summary>
''' <remarks></remarks>
FRST
''' <summary>
''' Pago Único
''' </summary>
''' <remarks></remarks>
OOFF
''' <summary>
''' Pago Recurrente
''' </summary>
''' <remarks></remarks>
RCUR
End Enum
''' <summary>
''' Overall description
''' </summary>
''' <remarks></remarks>
Public Enum CategoriaPropositoEnum
''' <summary>
''' Transferencia de gestión de efectivo. La transacción es una instrucción general de gestión de efectivo
''' </summary>
''' <remarks></remarks>
CASH
''' <summary>
''' Pago de Tarjeta de Crédito. La transacción está relacionada con un pago de tarjeta de crédito.
''' </summary>
''' <remarks></remarks>
CCRD
''' <summary>
''' Pago de liquidación de operaciones. La transacción está realizada con la liquidación de una operación.Por ejemplo: una operación de compraventa de divisa o una operación de valores.
''' </summary>
''' <remarks></remarks>
CORT
''' <summary>
''' Pago de Tarjeta de Débito. La transacción está relacionada con un pago de tarjeta de débito.
''' </summary>
''' <remarks></remarks>
DCRD
''' <summary>
''' Dividendos. La transacción es el pago de dividendos.
''' </summary>
''' <remarks></remarks>
DIVI
''' <summary>
''' Pago de la administración. La transacción es el pago a o de un departamento de la administración pública.
''' </summary>
''' <remarks></remarks>
GOVT
''' <summary>
''' Cobertura. La transacción está relacionada con el pago de una operación de cobertura.
''' </summary>
''' <remarks></remarks>
HEDG
''' <summary>
''' Pago de tarjeta de crédito irrevocable. La transacción es un reembolso de un pago de tarjeta de crédito.
''' </summary>
''' <remarks></remarks>
ICCP
''' <summary>
''' Pago de tarjeta de débito irrevocable. La transacción es un reembolso de un pago de tarjeta de débito.
''' </summary>
''' <remarks></remarks>
IDCP
''' <summary>
''' Pago intra-compañía. La transacción es un pago intra-compañía. Por ejemplo: un pago entre dos compañías pertenecientes a un mismo grupo.
''' </summary>
''' <remarks></remarks>
INTC
''' <summary>
''' Intereses. La transacción es un pago de intereses.
''' </summary>
''' <remarks></remarks>
INTE
''' <summary>
'''Préstamos. La transacción está relacionada con la transferencia de un préstamo a un prestatario.
''' </summary>
''' <remarks></remarks>
LOAN
''' <summary>
''' Pago de pensión. La transacción es el pago de una pensión
''' </summary>
''' <remarks></remarks>
PENS
''' <summary>
''' Nóminas. La transacción es el pago de nóminas.
''' </summary>
''' <remarks></remarks>
SALA
''' <summary>
''' Valores. La transacción es el pago de valores.
''' </summary>
''' <remarks></remarks>
SECU
''' <summary>
''' Valores. La transacción es el pago de valores.
''' </summary>
''' <remarks></remarks>
SSBE
''' <summary>
''' Pago de asistencia a Seguridad Social. La transacción es de una asistencia de S.S. Por ejemplo: el pago hecho por la S.S. para el mantenimiento de individuos.
''' </summary>
''' <remarks></remarks>
SUPP
''' <summary>
''' Pago de impuestos. La transacción está relacionada con el pago de impuestos.
''' </summary>
''' <remarks></remarks>
TAXS
''' <summary>
''' Comercio. La transacción está relacionada con el pago de una transacción comercial.
''' </summary>
''' <remarks></remarks>
TRAD
''' <summary>
''' Pago de tesorería. La transacción está relacionada con operaciones de tesorería.
''' </summary>
''' <remarks></remarks>
TREA
''' <summary>
''' IVA. La transacción es el pago del IVA.
''' </summary>
''' <remarks></remarks>
VATX
''' <summary>
''' Retenciones. La transacción está relacionada con el pago de retenciones (impuestos)
''' </summary>
''' <remarks></remarks>
WHLD
End Enum
Public Class Genericas
Public Shared Function CalcularDigitoControlBancario(Banco As Integer, Oficina As Integer, Cuenta As Double) As String
Dim sBank As String
Dim sSubBank As String
Dim sAccount As String
Dim Temporal As Integer
sBank = Format(Banco, "0000")
sSubBank = Format(Oficina, "0000")
sAccount = Format(Cuenta, "0000000000")
Temporal = 0
Temporal = Temporal + Mid(sBank, 1, 1) * 4
Temporal = Temporal + Mid(sBank, 2, 1) * 8
Temporal = Temporal + Mid(sBank, 3, 1) * 5
Temporal = Temporal + Mid(sBank, 4, 1) * 10
Temporal = Temporal + Mid(sSubBank, 1, 1) * 9
Temporal = Temporal + Mid(sSubBank, 2, 1) * 7
Temporal = Temporal + Mid(sSubBank, 3, 1) * 3
Temporal = Temporal + Mid(sSubBank, 4, 1) * 6
Temporal = 11 - (Temporal Mod 11)
If Temporal = 11 Then
CalcularDigitoControlBancario = "0"
ElseIf Temporal = 10 Then
CalcularDigitoControlBancario = "1"
Else
CalcularDigitoControlBancario = Format(Temporal, "0")
End If
Temporal = 0
Temporal = Temporal + Mid(sAccount, 1, 1) * 1
Temporal = Temporal + Mid(sAccount, 2, 1) * 2
Temporal = Temporal + Mid(sAccount, 3, 1) * 4
Temporal = Temporal + Mid(sAccount, 4, 1) * 8
Temporal = Temporal + Mid(sAccount, 5, 1) * 5
Temporal = Temporal + Mid(sAccount, 6, 1) * 10
Temporal = Temporal + Mid(sAccount, 7, 1) * 9
Temporal = Temporal + Mid(sAccount, 8, 1) * 7
Temporal = Temporal + Mid(sAccount, 9, 1) * 3
Temporal = Temporal + Mid(sAccount, 10, 1) * 6
Temporal = 11 - (Temporal Mod 11)
If Temporal = 11 Then
CalcularDigitoControlBancario = CalcularDigitoControlBancario + "0"
ElseIf Temporal = 10 Then
CalcularDigitoControlBancario = CalcularDigitoControlBancario + "1"
Else
CalcularDigitoControlBancario = CalcularDigitoControlBancario + Format(Temporal, "0")
End If
End Function
Public Shared Function IBANCorrecto(IBAN As String) As Boolean
'Try
' If IBAN.NothingAVacio.Length <> 24 Then
' Return False
' Else
' Dim CodigoPais As String = IBAN.Substring(0, 2)
' Dim CodigoBanco As String = IBAN.Substring(4, 4)
' Dim CodigoOficina As String = IBAN.Substring(8, 4)
' Dim DigitoControl As String = IBAN.Substring(12, 2)
' Dim Cuenta As String = IBAN.Substring(14, 10)
' Dim sIBAN = CalcularIBAN(CodigoPais, CodigoBanco, CodigoOficina, DigitoControl, Cuenta)
' Return sIBAN = IBAN
' End If
'Catch ex As Exception
' Return False
'End Try
If IBAN.NothingAVacio <> "" Then
IBAN = IBAN.Replace(" ", "")
Dim validator As New IbanNet.IbanValidator
Return validator.Validate(IBAN).IsValid
Else
Return False
End If
End Function
Public Shared Function CalcularIBAN(ByVal CodigoPais As String,
ByVal CodigoBanco As String,
ByVal CodigoOficina As String,
ByVal DigitoControl As String,
ByVal Cuenta As String) As String
Dim s1 As String = CodigoBanco + CodigoOficina + DigitoControl + Cuenta + CodigoPais + "00", s2 As String = ""
'Substitute letters
For i As Integer = 0 To s1.Length - 1
If IsNumeric(s1.Substring(i, 1)) = True Then
s2 += s1.Substring(i, 1)
Else
s2 += Convert.ToString(Asc(s1.Substring(i, 1)) - 55).PadLeft(2, "0")
End If
Next
'Return the IBAN
Return CodigoPais + MOD_97_10(s2) + CodigoBanco + CodigoOficina + DigitoControl + Cuenta
End Function
Public Shared Function CalcularIBAN_ES(ByVal CCC As String) As String
Return CalcularIBAN("ES", CCC.Split("-")(0), CCC.Split("-")(1), CCC.Split("-")(2), CCC.Split("-")(3))
End Function
Public Shared Function CalcularIdentificadorSEPA(ByVal CIF As String, Optional CodigoPais As String = "ES", Optional Sufijo As String = "000") As String
Try
Dim s As String = CIF.Trim & CodigoPais & "00"
Dim sResultado As String = ""
Dim c As Char
For Each c In s
If Char.IsNumber(c) Then
sResultado &= c.ToString
Else
sResultado &= (Asc(c) - 55).ToString
End If
Next
Return CodigoPais & MOD_97_10(sResultado) & Sufijo & CIF
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Private Shared Function MOD_97_10(ByVal s As String) As String
Dim s1 As String, s2 As String
Dim l1 As Integer, l2 As Integer
s1 = s.Substring(0, 9)
s2 = s.Substring(s1.Length)
l1 = Convert.ToInt32(s1)
l2 = l1 Mod 97
While s2 <> ""
If Len(s2) > 7 Then
s1 = Convert.ToString(l2).PadLeft(2, "0") + s2.Substring(0, 7)
s2 = s2.Substring(7)
Else
s1 = Convert.ToString(l2).PadLeft(2, "0") + s2
s2 = ""
End If
l1 = Convert.ToInt32(s1)
l2 = l1 Mod 97
End While
Return Convert.ToString(98 - l2).PadLeft(2, "0")
End Function
End Class
Namespace SEPA
Public Class DatosFichero
Property FechaSoporte As DateTime
Property FechaCargo As Date
Property Presentador As New DatosPresentador
Property Acreedores As New List(Of DatosAcreedor)
Property ReferenciaIdentificativa As String
End Class
Public Class DatosPresentador
Property Nombre As String
Property NIF As String
Property Sufijo As String
Property EntidadReceptora As String
Property Oficina As String
Property DOMICILIO As String
Property NUMERO As String
Property CPO As String
Property CIUDAD As String
Property PAIS As String
End Class
Public Class DatosAcreedor
Property Nombre As String
Property NIF As String
Property Sufijo As String
Property CuentaAbono As New CuentaBancaria
Property Procedimiento As String
Property FechaCobro As DateTime
Property Direccion As String
Property CodigoPostal As String
Property Municipio As String
Property Provincia As String
Property CodigoPais As String
Property DatosRecibo As New List(Of DatosRecibo)
Property Libre1 As String
Property Libre2 As String
Property DOMICILIO As String
Property NUMERO As String
Property CPO As String
Property CIUDAD As String
Property PAIS As String
End Class
Public Class DatosRecibo
Property CodigoReferencia As String
Property CodigoReferenciaMandato As String
Property FechaMandato As Date
Property NombreDeudor As String
Property DireccionDeudor1 As String
Property DireccionDeudor2 As String
Property DireccionDeudor3 As String
Property CodigoPaisDeudor As String
Property TipoIdentificacionDeudor As String
Property IdentificacionDeudor As String
Property IdentificacionDeudorEmisorCodigo As String
Property CuentaAdeudo As New CuentaBancaria
Property TipoAdeudo As TiposAdeudosEnum
Property CategoriaProposito As CategoriaPropositoEnum
Property Importe As Double
Property CamposOpcionales As New CamposOpcionales
Property PropositoAdeudo As String
Property Concepto As String
Property Libre As String
Property NombreUltimoAcreedor As String
Property TipoIdentificacionUltimoAcreedor As String 'Campo 7 Opcional 2
Property IdentificacionUltimoAcreedor As String 'campo 8 opcional 2
Property IdentificacionUltimoAcreedorEmisorCodigo As String 'CAMPO 9 Opcional 2
Property NombreTitularDomiciliacion As String 'CAMPO 10 Opcional 2
Property TITitularDomiciliacion As String 'CAMPO 11 Opcional 2
Property IdentificacionTitularDomiciliacion As String 'CAMPO 12 Opcional 2
Property IdentificacionTitularDomiciliacionEmisorCodigo As String ' CAMPO 13 Opcional 2
Property Libre2 As String ' CAMPO 14 Opcional 2
End Class
Public Class CamposOpcionales
Property NombreTitularCuenta As String
Property DomicilioTitularCuenta As String
Property PlazaDomicilioTitularCuenta As String
Property CodigoPostalTitularCuenta As String
End Class
Public Class CuentaBancaria
Property BIC As String
Property IBAN As String
ReadOnly Property EntidadBancariaEspaña As String
Get
If IBAN.NothingAVacio.Length = 24 AndAlso IBAN.Substring(0, 2) = "ES" Then
Return IBAN.Substring(4, 4)
Else
Return ""
End If
End Get
End Property
End Class
Public Class Utilidades
Public Shared Sub GeneraFichero(Datos As DatosFichero, Fichero As String, Optional ByVal Sobreescribir As Boolean = False)
If Sobreescribir Then
If IO.File.Exists(Fichero) Then IO.File.Delete(Fichero)
Else
If IO.File.Exists(Fichero) Then Throw New Exception("Fichero " & Fichero & " existente")
End If
Dim fs As New IO.FileStream(Fichero, IO.FileMode.CreateNew)
GeneraFichero19_14(Datos, fs)
fs.Close()
End Sub
Public Shared Sub GeneraFichero19_14(Datos As DatosFichero, ByRef st As IO.Stream)
Try
Dim Registro As String
' Dim ms As New IO.MemoryStream
Dim sw As New IO.StreamWriter(st, System.Text.Encoding.GetEncoding("iso-8859-1"))
'Dim iNumRegAcreedor , iNumRegPresentador As Integer
' REGISTRO DE CABECERA 1 (PRESENTADOR)
Dim dTotalAcreedorFP, dTotalAcreedor, dTotalPresentador As Double
Dim iNumRegistrosAcreedorFP, iNumRegistrosAcreedor, iNumRegistrosPresentador As Integer
Dim iNumAdeudosAcreedorFP, iNumAdeudosAcreedor, iNumAdeudosPresentador As Integer
Registro = "01" ' CAMPO 1
Registro &= "19154" ' CAMPO 2 'ANTES 19143
Registro &= "001" ' CAMPO 3
Registro &= Bancos.Genericas.CalcularIdentificadorSEPA(Datos.Presentador.NIF, , Datos.Presentador.Sufijo).PadRight(35, " ") ' CAMPO 4
Registro &= Datos.Presentador.Nombre.ConvierteAAlfanumerico.PadRight(70, " ") ' CAMPO 5
Registro &= FechaSEPA(Datos.FechaSoporte) ' CAMPO 6
Registro &= "PRE" & FechaHoraSEPA(Now) & Datos.ReferenciaIdentificativa.PadRight(13, " ") ' CAMPO 7
Registro &= Datos.Presentador.EntidadReceptora.PadRight(4, " ") ' CAMPO 8
Registro &= Datos.Presentador.Oficina.PadRight(4, " ") ' CAMPO 9
Registro &= "".PadLeft(434, " ") ' CAMPO 10
sw.WriteLine(Registro)
' REGISTRO DE CABECERA 2 (ACREEDOR)
Dim acreedor As New tsl5.Bancos.SEPA.DatosAcreedor
' Dim dTotalOrd, dTotalGen As Double
' Dim iTotalRegAcreedor As Integer
For Each acreedor In Datos.Acreedores
iNumAdeudosAcreedor = 0
iNumAdeudosAcreedorFP = 0
iNumRegistrosAcreedor = 1
iNumRegistrosAcreedorFP = 1
Registro = "02" ' CAMPO 1
Registro &= "19154" ' CAMPO 2 'ANTES 19143
Registro &= "002" ' CAMPO 3
Registro &= Bancos.Genericas.CalcularIdentificadorSEPA(acreedor.NIF, , acreedor.Sufijo).PadRight(35, " ") 'CAMPO 4
Registro &= FechaSEPA(acreedor.FechaCobro) 'CAMPO 5
Registro &= acreedor.Nombre.ConvierteAAlfanumerico.Substring(0, Math.Min(acreedor.Nombre.Length, 70)).PadRight(70, " ") 'CAMPO 6
Registro &= acreedor.Direccion.Substring(0, Math.Min(acreedor.Direccion.Length, 50)).PadRight(50, " ") ' CAMPO 7
Dim sCodPosMun As String = acreedor.CodigoPostal & " " & acreedor.Municipio
Registro &= sCodPosMun.Substring(0, Math.Min(sCodPosMun.Length, 50)).PadRight(50, " ") ' CAMPO 8
Registro &= acreedor.Provincia.Substring(0, Math.Min(acreedor.Provincia.Length, 40)).PadRight(40, " ") ' CAMPO 9
Registro &= acreedor.CodigoPais.Substring(0, Math.Min(acreedor.Provincia.Length, 2)).PadRight(2, " ") ' CAMPO 10
Registro &= acreedor.CuentaAbono.IBAN.PadRight(34, " ") ' CAMPO 11
Registro &= "".PadRight(301, " ") ' CAMPO 12
sw.WriteLine(Registro)
Dim dr As tsl5.Bancos.SEPA.DatosRecibo
For Each dr In acreedor.DatosRecibo
' REGISTRO INDIVIDUAL OBLIGATORIO
iNumAdeudosAcreedor += 1
iNumAdeudosAcreedorFP += 1
iNumRegistrosAcreedor += 1
iNumRegistrosAcreedorFP += 1
Registro = "03" 'CAMPO 1
Registro &= "19154" ' CAMPO 2 'ANTES 19143
Registro &= "003" 'CAMPO 3
Registro &= dr.CodigoReferencia.Substring(0, Math.Min(dr.CodigoReferencia.Length, 35)).PadRight(35, " ") 'CAMPO 4
Registro &= dr.CodigoReferenciaMandato.Substring(0, Math.Min(dr.CodigoReferenciaMandato.Length, 35)).PadRight(35, " ") 'CAMPO 5
Registro &= dr.TipoAdeudo.ToString.PadRight(4, " ") 'CAMPO 6
Registro &= dr.CategoriaProposito.ToString.PadRight(4, " ") 'CAMPO 7
Registro &= (Math.Round(dr.Importe, 2, MidpointRounding.AwayFromZero) * 100).ToString.PadLeft(11, "0") 'CAMPO 8
Registro &= FechaSEPA(dr.FechaMandato) 'CAMPO 9
Registro &= dr.CuentaAdeudo.BIC.NothingAVacio.Substring(0, Math.Min(dr.CuentaAdeudo.BIC.NothingAVacio.Length, 11)).PadRight(11, " ") 'CAMPO 10
Registro &= dr.NombreDeudor.ConvierteAAlfanumerico.Substring(0, Math.Min(dr.NombreDeudor.Length, 70)).PadRight(70, " ") 'CAMPO 11
Registro &= dr.DireccionDeudor1.Substring(0, Math.Min(dr.DireccionDeudor1.Length, 50)).PadRight(50, " ") 'CAMPO 12
Registro &= dr.DireccionDeudor2.Substring(0, Math.Min(dr.DireccionDeudor2.Length, 50)).PadRight(50, " ") 'CAMPO 13
Registro &= dr.DireccionDeudor3.Substring(0, Math.Min(dr.DireccionDeudor3.Length, 40)).PadRight(40, " ") 'CAMPO 14
Registro &= dr.CodigoPaisDeudor.Substring(0, Math.Min(dr.CodigoPaisDeudor.Length, 2)).PadRight(2, " ") 'CAMPO 15
If dr.IdentificacionDeudor.Length > 0 Then
If "01234567890X".Contains(dr.IdentificacionDeudor.Substring(0, 1)) Then
Registro &= dr.TipoIdentificacionDeudor.PadRight(1, "2") 'CAMPO 16
dr.IdentificacionDeudor = "J" & dr.IdentificacionDeudor
Else
Registro &= dr.TipoIdentificacionDeudor.PadRight(1, "1") 'CAMPO 16
dr.IdentificacionDeudor = "I" & dr.IdentificacionDeudor
End If
Else
Registro &= dr.TipoIdentificacionDeudor.PadRight(1, " ") 'CAMPO 16
End If
Registro &= dr.IdentificacionDeudor.Substring(0, Math.Min(dr.IdentificacionDeudor.Length, 36)).PadRight(36, " ") 'CAMPO 17
Registro &= dr.IdentificacionDeudorEmisorCodigo.Substring(0, Math.Min(dr.IdentificacionDeudorEmisorCodigo.Length, 35)).PadRight(35, " ") 'CAMPO 18
Registro &= "A" 'dr.IdentificadorCuentaDeudor 'CAMPO 19
Dim sIBAN As String = dr.CuentaAdeudo.IBAN
Registro &= sIBAN.Substring(0, Math.Min(sIBAN.Length, 34)).PadRight(34, " ") 'CAMPO 20
Registro &= dr.PropositoAdeudo.Substring(0, Math.Min(dr.PropositoAdeudo.Length, 4)).PadRight(4, " ") 'CAMPO 21
Registro &= dr.Concepto.Substring(0, Math.Min(dr.Concepto.Length, 140)).PadRight(140, " ") 'CAMPO 22
Registro &= dr.Libre.Substring(0, Math.Min(dr.Libre.Length, 19)).PadRight(19, " ") 'CAMPO 23
dTotalAcreedorFP += Math.Round(dr.Importe, 2, MidpointRounding.AwayFromZero)
dTotalAcreedor += Math.Round(dr.Importe, 2, MidpointRounding.AwayFromZero)
sw.WriteLine(Registro)
If dr.NombreTitularDomiciliacion <> "" Then
Registro = "03" 'CAMPO 1
Registro &= "19154" ' CAMPO 2 'ANTES 19143
Registro &= "004" 'CAMPO 3
Registro &= dr.CodigoReferencia.Substring(0, Math.Min(dr.CodigoReferencia.Length, 35)).PadRight(35, " ") 'CAMPO 4
Registro &= dr.CodigoReferenciaMandato.Substring(0, Math.Min(dr.CodigoReferenciaMandato.Length, 35)).PadRight(35, " ") 'CAMPO 5
Registro &= dr.NombreUltimoAcreedor.ConvierteAAlfanumerico.Substring(0, Math.Min(dr.NombreUltimoAcreedor.Length, 70)).PadRight(70, " ") 'CAMPO 6
Registro &= dr.TipoIdentificacionUltimoAcreedor.PadRight(1, " ") 'CAMPO 7
Registro &= dr.IdentificacionUltimoAcreedor.Substring(0, Math.Min(dr.IdentificacionUltimoAcreedor.Length, 36)).PadRight(36, " ") 'CAMPO 8
Registro &= dr.IdentificacionUltimoAcreedorEmisorCodigo.Substring(0, Math.Min(dr.IdentificacionUltimoAcreedorEmisorCodigo.Length, 35)).PadRight(35, " ") 'CAMPO 9
Registro &= dr.NombreTitularDomiciliacion.ConvierteAAlfanumerico.Substring(0, Math.Min(dr.NombreTitularDomiciliacion.Length, 70)).PadRight(70, " ") 'CAMPO 10
Registro &= dr.TITitularDomiciliacion.PadRight(1, " ") 'CAMPO 11
Registro &= dr.IdentificacionTitularDomiciliacion.Substring(0, Math.Min(dr.IdentificacionTitularDomiciliacion.Length, 36)).PadRight(36, " ") 'CAMPO 12
Registro &= dr.IdentificacionTitularDomiciliacionEmisorCodigo.Substring(0, Math.Min(dr.IdentificacionTitularDomiciliacionEmisorCodigo.Length, 35)).PadRight(35, " ") 'CAMPO 13
Registro &= dr.Libre2.Substring(0, Math.Min(dr.Libre2.Length, 236)).PadRight(236, " ") 'CAMPO 14
iNumRegistrosAcreedor += 1
iNumRegistrosAcreedorFP += 1
sw.WriteLine(Registro)
End If
Next
' REGISTRO TOTAL DE Acreedor por fechas de cobro
iNumRegistrosAcreedorFP += 1
Registro = "04" 'CAMPO 1
Registro &= Bancos.Genericas.CalcularIdentificadorSEPA(acreedor.NIF, , acreedor.Sufijo).PadRight(35, " ") 'CAMPO 2
Registro &= FechaSEPA(acreedor.FechaCobro) 'CAMPO 3
Registro &= (Math.Round(dTotalAcreedorFP, 2, MidpointRounding.AwayFromZero) * 100).ToString.PadLeft(17, "0") ' CAMPO 4
Registro &= iNumAdeudosAcreedorFP.ToString.PadLeft(8, "0") 'CAMPO 4
Registro &= iNumRegistrosAcreedorFP.ToString.PadLeft(10, "0") 'CAMPO 5
Registro &= acreedor.Libre1.ToString.PadRight(520, " ") 'CAMPO 7
sw.WriteLine(Registro)
' REGISTRO TOTAL DE Acreedor
iNumRegistrosAcreedor += 2 '1 más por el registro anterior fecha de pago
Registro = "05" 'CAMPO 1
Registro &= Bancos.Genericas.CalcularIdentificadorSEPA(acreedor.NIF, , acreedor.Sufijo).PadRight(35, " ") 'CAMPO 2
Registro &= (Math.Round(dTotalAcreedor, 2, MidpointRounding.AwayFromZero) * 100).ToString.PadLeft(17, "0") 'CAMPO 3
Registro &= iNumAdeudosAcreedor.ToString.PadLeft(8, "0") 'CAMPO 4
Registro &= iNumRegistrosAcreedor.ToString.PadLeft(10, "0") 'CAMPO 5
Registro &= acreedor.Libre2.ToString.PadRight(528, " ") 'CAMPO 6
sw.WriteLine(Registro)
iNumAdeudosPresentador += iNumAdeudosAcreedor
iNumRegistrosPresentador += iNumRegistrosAcreedor
dTotalPresentador += dTotalAcreedor
Next
' REGISTRO TOTALES
iNumRegistrosPresentador += 2 'cabecera y total
Registro = "99"
Registro &= (Math.Round(dTotalPresentador, 2, MidpointRounding.AwayFromZero) * 100).ToString.PadLeft(17, "0")
Registro &= iNumAdeudosPresentador.ToString.PadLeft(8, "0")
Registro &= iNumRegistrosPresentador.ToString.PadLeft(10, "0")
Registro &= acreedor.Libre2.ToString.PadRight(563, " ") 'CAMPO 6
sw.WriteLine(Registro)
sw.Close()
st.Close()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
Public Shared Function FechaSEPA(Fecha As Date) As String
Return Fecha.Year.ToString & Fecha.Month.ToString.PadLeft(2, "0") & Fecha.Day.ToString.PadLeft(2, "0")
End Function
Public Shared Function FechaHoraSEPA(Fecha As DateTime) As String
Return Fecha.Year.ToString & Fecha.Month.ToString.PadLeft(2, "0") & Fecha.Day.ToString.PadLeft(2, "0") & Fecha.Hour.ToString.PadLeft(2, "0") & Fecha.Minute.ToString.PadLeft(2, "0") & Fecha.Second.ToString.PadLeft(2, "0") & Fecha.Millisecond.ToString.PadLeft(5, "0")
End Function
End Class
End Namespace
End Namespace

163
Bancos/SEPA1914xml.vb Normal file
View File

@@ -0,0 +1,163 @@
Imports tsl5.Bancos.SEPA
Imports tsl5.Bancos
Imports tsl5.SEPA_1914XML
Imports tsl5.Extensiones
Namespace SEPA1914xml
Public Class Utilidades
Public Shared Sub GeneraFichero19_14xml(Datos As DatosFichero, ByVal FicheroXML As String, Optional Sobreescribir As Boolean = True)
Try
If Sobreescribir Then
If IO.File.Exists(FicheroXML) Then IO.File.Delete(FicheroXML)
Else
If IO.File.Exists(FicheroXML) Then Throw New Exception("Fichero " & FicheroXML & " existente")
End If
Dim NumTotalRecibos As Integer
Dim SumaTotalRecibos As Decimal
Dim Document As New SEPA_1914XML.Document
Document.CstmrDrctDbtInitn = New SEPA_1914XML.CustomerDirectDebitInitiationV02
Document.CstmrDrctDbtInitn.GrpHdr = New SEPA_1914XML.GroupHeader39
Document.CstmrDrctDbtInitn.GrpHdr.MsgId = Datos.ReferenciaIdentificativa.ToString 'IDENTIFICACION UNICA
Document.CstmrDrctDbtInitn.GrpHdr.CreDtTm = Datos.FechaCargo.Year.ToString & "-" & Datos.FechaCargo.Month.ToString.PadLeft(2, "0") & "-" & Datos.FechaCargo.Day.ToString.PadLeft(2, "0")
Document.CstmrDrctDbtInitn.GrpHdr.CtrlSumSpecified = True
Document.CstmrDrctDbtInitn.GrpHdr.InitgPty = New SEPA_1914XML.PartyIdentification32
Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.Nm = Datos.Presentador.Nombre
Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.Id = New Party6Choice
Dim org(0) As GenericOrganisationIdentification1
Dim core As New OrganisationIdentificationSchemeName1Choice
core.Item = "CORE"
core.ItemElementName = ItemChoiceType.Cd
org(0) = New GenericOrganisationIdentification1 With {.Id = Bancos.Genericas.CalcularIdentificadorSEPA(Datos.Presentador.NIF, , Datos.Presentador.Sufijo),
.SchmeNm = core}
Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.Id.Item = New OrganisationIdentification4 With {.Othr = org}
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr = New SEPA_1914xml.PostalAddress6
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr.StrtNm = Datos.Presentador.DOMICILIO
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr.BldgNb = Datos.Presentador.NUMERO
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr.PstCd = Datos.Presentador.CPO
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr.TwnNm = Datos.Presentador.CIUDAD
'Document.CstmrDrctDbtInitn.GrpHdr.InitgPty.PstlAdr.Ctry = Datos.Presentador.PAIS
Dim ListaPmtInf As New List(Of SEPA_1914XML.PaymentInstructionInformation4)
Dim acreedor As New tsl5.Bancos.SEPA.DatosAcreedor
For Each acreedor In Datos.Acreedores
Dim PmtInf As New SEPA_1914XML.PaymentInstructionInformation4
PmtInf.PmtInfId = Bancos.Genericas.CalcularIdentificadorSEPA(Datos.Presentador.NIF) & "-" & Datos.ReferenciaIdentificativa.ToString ' acreedor.NIF
PmtInf.PmtMtd = SEPA_1914XML.PaymentMethod2Code.DD
PmtInf.BtchBookg = True 'False
PmtInf.NbOfTxs = acreedor.DatosRecibo.Count
PmtInf.CtrlSum = Math.Round(acreedor.DatosRecibo.Sum(Function(x) x.Importe), 2, MidpointRounding.AwayFromZero)
NumTotalRecibos += acreedor.DatosRecibo.Count
SumaTotalRecibos += PmtInf.CtrlSum
PmtInf.PmtTpInf = New SEPA_1914XML.PaymentTypeInformation20
' PmtInf.PmtTpInf.SvcLvl = New SEPA_1914xml.ServiceLevel8Choice With {.ItemElementName = SEPA_1914xml.ItemChoiceType4.Cd, .Item = "SEPA"}
PmtInf.PmtTpInf.LclInstrm = New SEPA_1914XML.LocalInstrument2Choice With {.ItemElementName = SEPA_1914XML.ItemChoiceType5.Cd, .Item = "CORE"}
PmtInf.PmtTpInf.SeqTpSpecified = True
PmtInf.PmtTpInf.SeqTp = SequenceType1Code.RCUR
PmtInf.PmtTpInf.CtgyPurp = New CategoryPurpose1Choice With {.ItemElementName = ItemChoiceType6.Cd, .Item = "TRAD"}
PmtInf.ReqdColltnDt = Datos.FechaCargo
PmtInf.Cdtr = New SEPA_1914XML.PartyIdentification32
PmtInf.Cdtr.Nm = acreedor.Nombre
PmtInf.Cdtr.PstlAdr = New SEPA_1914XML.PostalAddress6
PmtInf.Cdtr.PstlAdr.StrtNm = acreedor.Direccion
' PmtInf.Cdtr.PstlAdr.BldgNb = "" ' NUMERO
PmtInf.Cdtr.PstlAdr.PstCd = acreedor.CodigoPostal
PmtInf.Cdtr.PstlAdr.TwnNm = acreedor.Municipio
PmtInf.Cdtr.PstlAdr.Ctry = acreedor.CodigoPais
PmtInf.CdtrAcct = New SEPA_1914XML.CashAccount16
PmtInf.CdtrAcct.Id = New SEPA_1914XML.AccountIdentification4Choice With {.Item = acreedor.CuentaAbono.IBAN}
PmtInf.CdtrAcct.Ccy = "EUR"
PmtInf.CdtrAgt = New SEPA_1914XML.BranchAndFinancialInstitutionIdentification4
PmtInf.CdtrAgt.FinInstnId = New SEPA_1914XML.FinancialInstitutionIdentification7 With {.BIC = acreedor.CuentaAbono.BIC}
PmtInf.ChrgBr = ChargeBearerType1Code.SLEV
PmtInf.ChrgBrSpecified = True
'PmtInf.CdtrSchmeId = New sepa_1914xml.PartyIdentification32
'Dim oprvtid As New sepa_1914xml.Party6Choice
'oprvtid.Item = New GenericOrganisationIdentification1 With {.Id = Bancos.Genericas.CalcularIdentificadorSEPA(acreedor.NIF, , acreedor.Sufijo), .SchmeNm = New FinancialIdentificationSchemeName1Choice With {.ItemElementName = ItemChoiceType3.Prtry, .Item = "SEPA"}}
'PmtInf.CdtrSchmeId.Id = oprvtid
PmtInf.CdtrSchmeId = New SEPA_1914XML.PartyIdentification32
PmtInf.CdtrSchmeId.Id = New Party6Choice
Dim orga(0) As GenericOrganisationIdentification1
Dim cora1 As New OrganisationIdentificationSchemeName1Choice
cora1.Item = "SEPA"
cora1.ItemElementName = ItemChoiceType.Prtry
orga(0) = New GenericOrganisationIdentification1 With {.Id = Bancos.Genericas.CalcularIdentificadorSEPA(acreedor.NIF, , acreedor.Sufijo),
.SchmeNm = cora1}
PmtInf.CdtrSchmeId.Id.Item = New OrganisationIdentification4 With {.Othr = orga}
' tsl5.Utilidades.Serializar(oprvtid, FicheroXML)
Dim dr As tsl5.Bancos.SEPA.DatosRecibo
Dim recibos As New List(Of DirectDebitTransactionInformation9)
Dim FechaAhora = Now.ToString("yyyyMMddhhmmss")
Dim i As Integer
For Each dr In acreedor.DatosRecibo
' REGISTRO INDIVIDUAL OBLIGATORIO
i += 1
Dim recibo As New DirectDebitTransactionInformation9
recibo.PmtId = New PaymentIdentification1 With {.InstrId = Now.ToString("yyyyMMddhhmmss") & "-" & i.ToString.PadLeft(4, "0"), .EndToEndId = dr.CodigoReferencia}
recibo.InstdAmt = New ActiveOrHistoricCurrencyAndAmount With {.Ccy = "EUR", .Value = Math.Round(dr.Importe, 2, MidpointRounding.AwayFromZero)}
recibo.DrctDbtTx = New DirectDebitTransaction6 With {.MndtRltdInf = New MandateRelatedInformation6 With {.MndtId = dr.CodigoReferenciaMandato, .DtOfSgntr = dr.FechaMandato, .DtOfSgntrSpecified = True, .AmdmntInd = False}}
recibo.DbtrAgt = New BranchAndFinancialInstitutionIdentification4 With {.FinInstnId = New FinancialInstitutionIdentification7 With {.BIC = dr.CuentaAdeudo.BIC}}
recibo.Dbtr = New PartyIdentification32
recibo.Dbtr.Nm = dr.NombreTitularDomiciliacion
If dr.NombreTitularDomiciliacion.NothingAVacio = "" Then Throw New Exception("El recibo " & dr.CodigoReferencia & " No tiene nombre del titular de la cuenta.")
recibo.Dbtr.PstlAdr = New PostalAddress6
recibo.Dbtr.PstlAdr.Ctry = "ES"
If dr.DireccionDeudor1 <> "" Then
Dim Direccion(0) As String
Direccion(0) = dr.DireccionDeudor1
If dr.DireccionDeudor2 <> "" Then
ReDim Preserve Direccion(1)
Direccion(1) = dr.DireccionDeudor2
End If
If dr.DireccionDeudor3 <> "" Then
ReDim Preserve Direccion(2)
Direccion(2) = dr.DireccionDeudor3
End If
recibo.Dbtr.PstlAdr.AdrLine = Direccion
End If
recibo.Dbtr.Id = New Party6Choice
Dim orgr(0) As GenericPersonIdentification1
Dim corr1 As New PersonIdentificationSchemeName1Choice
corr1.Item = "CORE"
corr1.ItemElementName = ItemChoiceType.Cd
orgr(0) = New GenericPersonIdentification1
If dr.IdentificacionDeudor <> "" Then orgr(0).Id = Bancos.Genericas.CalcularIdentificadorSEPA(dr.IdentificacionDeudor, , acreedor.Sufijo)
orgr(0).SchmeNm = corr1
recibo.Dbtr.Id.Item = New PersonIdentification5 With {.Othr = orgr}
recibo.DbtrAcct = New CashAccount16
recibo.DbtrAcct.Id = New AccountIdentification4Choice With {.Item = dr.CuentaAdeudo.IBAN}
recibo.Purp = New Purpose2Choice With {.ItemElementName = ItemChoiceType8.Cd, .Item = "CASH"}
Dim Conceptos(0) As String
Conceptos(0) = dr.Concepto
recibo.RmtInf = New RemittanceInformation5 With {.Ustrd = Conceptos}
recibos.Add(recibo)
Next
PmtInf.DrctDbtTxInf = recibos.ToArray
ListaPmtInf.Add(PmtInf)
Next
Document.CstmrDrctDbtInitn.GrpHdr.NbOfTxs = NumTotalRecibos
Document.CstmrDrctDbtInitn.GrpHdr.CtrlSum = Math.Round(SumaTotalRecibos, 2, MidpointRounding.AwayFromZero)
Document.CstmrDrctDbtInitn.PmtInf = ListaPmtInf.ToArray
tsl5.Utilidades.Serializar(Document, FicheroXML)
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
End Class
End Namespace

159
Bancos/SEPA3414.vb Normal file
View File

@@ -0,0 +1,159 @@
Imports tsl5.SEPA_3414
Namespace SEPA3414
Public Class Ordenante
Property CIF As String
Property NOMBRE As String
Property DOMICILIO As String
Property NUMERO As String
Property CPO As String
Property CIUDAD As String
Property PAIS As String
Property IBAN As String
Property BIC As String
Property SUFIJO As String
Property ENELMISMODIA As Boolean = False
End Class
Public Class Beneficiario
Property CIF As String
Property ImporteTransferencia As Double
Property IdentificacionPago As String
Property IdentificacionPagoFichero As String
Property IBAN As String
Property BIC As String
Property NOMBRE As String
Property Proposito As String
End Class
Public Class Utilidades
Public Shared Sub GeneraXML(Ordenante As Ordenante, ListaBeneficiarios As List(Of Beneficiario), FicheroXML As String, FechaEnvio As DateTime, FechaEjecucion As DateTime)
Try
'
' COMPROBACIONES
'
Dim benibaninc = ListaBeneficiarios.Where(Function(x) tsl5.Bancos.Genericas.IBANCorrecto(x.IBAN) = False).ToList
Dim ListaErrores As String = ""
If benibaninc.Count > 0 Then
For Each ben In benibaninc
ListaErrores &= "El beneficiacio " & ben.NOMBRE & " Pago: " & ben.IdentificacionPago & " tiene un IBAN Incorrecto." & vbCrLf
Next
End If
If ListaErrores <> "" Then Throw New Exception(ListaErrores)
Dim org(0) As GenericOrganisationIdentification1
org(0) = New GenericOrganisationIdentification1 With {.Id = Ordenante.CIF & Ordenante.SUFIJO}
Dim Document As New SEPA_3414.Document
Document.CstmrCdtTrfInitn = New SEPA_3414.CustomerCreditTransferInitiationV03
Document.CstmrCdtTrfInitn.GrpHdr = New SEPA_3414.GroupHeader32
'Dim GrupoCabecera = Document.CstmrCdtTrfInitn.GrpHdr
Document.CstmrCdtTrfInitn.GrpHdr.MsgId = Now.ToString 'IDENTIFICACION UNICA
' Dim FechaEnvio As DateTime = Now
' Dim FechaEjecucion As DateTime = Now
Document.CstmrCdtTrfInitn.GrpHdr.CreDtTm = FechaEnvio.ToString("yyyy-MM-ddTHH:mm:ss")
Document.CstmrCdtTrfInitn.GrpHdr.NbOfTxs = ListaBeneficiarios.Where(Function(X) X.ImporteTransferencia > 0).Count.ToString
Document.CstmrCdtTrfInitn.GrpHdr.CtrlSum = ListaBeneficiarios.Where(Function(X) X.ImporteTransferencia > 0).Sum(Function(x) x.ImporteTransferencia).ToString("F2").Replace(",", ".")
Document.CstmrCdtTrfInitn.GrpHdr.CtrlSumSpecified = True
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty = New SEPA_3414.PartyIdentification32
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.Nm = Ordenante.NOMBRE
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.Id = New Party6Choice With {.Item = New OrganisationIdentification4 With {.Othr = org}}
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr = New SEPA_3414.PostalAddress6
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr.StrtNm = Ordenante.DOMICILIO
If Ordenante.NUMERO <> "" Then Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr.BldgNb = Ordenante.NUMERO
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr.PstCd = Ordenante.CPO
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr.TwnNm = Ordenante.CIUDAD
Document.CstmrCdtTrfInitn.GrpHdr.InitgPty.PstlAdr.Ctry = Ordenante.PAIS
'Dim listaInformacionPago As List(Of SEPA_3414.PaymentInstructionInformation3)
'Dim informacionpago As SEPA_3414.PaymentInstructionInformation3
Dim ListaPmtInf As New List(Of SEPA_3414.PaymentInstructionInformation3)
Dim PmtInf As New SEPA_3414.PaymentInstructionInformation3
PmtInf.PmtInfId = Ordenante.CIF
PmtInf.PmtMtd = SEPA_3414.PaymentMethod3Code.TRF
If Ordenante.BIC = "UCJAES2MXXX" Then
PmtInf.BtchBookg = False ' para unicaja
PmtInf.BtchBookgSpecified = True ' para unicaja
PmtInf.NbOfTxs = Document.CstmrCdtTrfInitn.GrpHdr.NbOfTxs
PmtInf.CtrlSum = Math.Round(ListaBeneficiarios.Where(Function(X) X.ImporteTransferencia > 0).Sum(Function(x) x.ImporteTransferencia), 2, MidpointRounding.AwayFromZero)
PmtInf.CtrlSumSpecified = True ' para unicaja
PmtInf.PmtTpInf = New SEPA_3414.PaymentTypeInformation19
PmtInf.PmtTpInf.SvcLvl = New SEPA_3414.ServiceLevel8Choice With {.Item = "SEPA"} ' para Unicaja
PmtInf.PmtTpInf.LclInstrm = New SEPA_3414.LocalInstrument2Choice With {.Item = "SDCL"} ' para Unicaja
If ListaBeneficiarios(0).Proposito IsNot Nothing AndAlso ListaBeneficiarios(0).Proposito <> "" Then
PmtInf.PmtTpInf.CtgyPurp = New SEPA_3414.CategoryPurpose1Choice ' para Unicaja
PmtInf.PmtTpInf.CtgyPurp.Item = ListaBeneficiarios(0).Proposito ' para Unicaja
End If
End If
PmtInf.ReqdExctnDt = FechaEjecucion
'PmtInf.BtchBookg = False
PmtInf.Dbtr = New SEPA_3414.PartyIdentification32
PmtInf.Dbtr.Id = New Party6Choice
PmtInf.Dbtr.Id.Item = New OrganisationIdentification4 With {.Othr = org}
PmtInf.Dbtr.Nm = Ordenante.NOMBRE
PmtInf.Dbtr.PstlAdr = New SEPA_3414.PostalAddress6
PmtInf.Dbtr.PstlAdr.StrtNm = Ordenante.DOMICILIO
If Ordenante.NUMERO <> "" Then PmtInf.Dbtr.PstlAdr.BldgNb = Ordenante.NUMERO
PmtInf.Dbtr.PstlAdr.PstCd = Ordenante.CPO
PmtInf.Dbtr.PstlAdr.TwnNm = Ordenante.CIUDAD
PmtInf.Dbtr.PstlAdr.Ctry = Ordenante.PAIS
PmtInf.DbtrAcct = New SEPA_3414.CashAccount16
PmtInf.DbtrAcct.Id = New SEPA_3414.AccountIdentification4Choice With {.Item = Ordenante.IBAN}
PmtInf.DbtrAgt = New SEPA_3414.BranchAndFinancialInstitutionIdentification4
PmtInf.DbtrAgt.FinInstnId = New SEPA_3414.FinancialInstitutionIdentification7
PmtInf.DbtrAgt.FinInstnId.BIC = Ordenante.BIC
'If Ordenante.ENELMISMODIA Then
' PmtInf.PmtTpInf = New SEPA_3414.PaymentTypeInformation19
' PmtInf.PmtTpInf.SvcLvl = New SEPA_3414.ServiceLevel8Choice With {.Item = "SEPA"}
' PmtInf.PmtTpInf.LclInstrm = New SEPA_3414.LocalInstrument2Choice With {.Item = "SDCL"}
'End If
' PmtInf.Dbtr.Id.Item = Ordenante.CIF & "SEV"
Dim cts As New List(Of SEPA_3414.CreditTransferTransactionInformation10)
Dim ct As SEPA_3414.CreditTransferTransactionInformation10
For Each Beneficiario In ListaBeneficiarios
If Beneficiario.ImporteTransferencia > 0 Then
ct = New SEPA_3414.CreditTransferTransactionInformation10
ct.PmtId = New SEPA_3414.PaymentIdentification1
ct.PmtId.InstrId = Beneficiario.IdentificacionPago.Trim.PadRight(35, " ").Substring(0, 35)
ct.PmtId.EndToEndId = Beneficiario.IdentificacionPago.Trim.PadRight(35, " ").Substring(0, 35)
If Beneficiario.IdentificacionPagoFichero <> "" Then
ct.RmtInf = New SEPA_3414.RemittanceInformation5
ct.RmtInf.Ustrd = {Beneficiario.IdentificacionPagoFichero}
End If
If Beneficiario.Proposito <> "" Then
ct.PmtTpInf = New SEPA_3414.PaymentTypeInformation19
If Ordenante.ENELMISMODIA Then
ct.PmtTpInf.SvcLvl = New SEPA_3414.ServiceLevel8Choice With {.Item = "SEPA"}
ct.PmtTpInf.LclInstrm = New SEPA_3414.LocalInstrument2Choice With {.Item = "SDCL"}
End If
ct.PmtTpInf.CtgyPurp = New SEPA_3414.CategoryPurpose1Choice
ct.PmtTpInf.CtgyPurp.Item = Beneficiario.Proposito
End If
Dim sImporteTransferencia = Beneficiario.ImporteTransferencia.ToString("F2").Replace(",", ".")
ct.Amt = New SEPA_3414.AmountType3Choice
ct.Amt.Item = New SEPA_3414.ActiveOrHistoricCurrencyAndAmount With {.Ccy = "EUR", .Value = sImporteTransferencia}
ct.ChrgBr = SEPA_3414.ChargeBearerType1Code.DEBT
ct.CdtrAgt = New SEPA_3414.BranchAndFinancialInstitutionIdentification4
ct.CdtrAgt.FinInstnId = New SEPA_3414.FinancialInstitutionIdentification7
' ct.CdtrAgt.FinInstnId.BIC = Beneficiario.BIC
ct.Cdtr = New SEPA_3414.PartyIdentification32
ct.Cdtr.Nm = tsl5.Extensiones.StringExtensions.ConvierteAAlfanumerico(Beneficiario.NOMBRE, "ÁÉÍÓÚáéíóúÑñÜü", "AEIOUaeiouNnUu")
ct.CdtrAcct = New SEPA_3414.CashAccount16
ct.CdtrAcct.Id = New SEPA_3414.AccountIdentification4Choice With {.Item = Beneficiario.IBAN}
cts.Add(ct)
End If
Next
PmtInf.CdtTrfTxInf = cts.ToArray
ListaPmtInf.Add(PmtInf)
' Document.CstmrCdtTrfInitn = New SEPA_3414.CustomerCreditTransferInitiationV03
Document.CstmrCdtTrfInitn.PmtInf = ListaPmtInf.ToArray
tsl5.Utilidades.SerializarUTF8(Document, FicheroXML)
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
End Class
End Namespace

4537
Bancos/pain_001_001_03.vb Normal file
View File

File diff suppressed because it is too large Load Diff

3979
Bancos/pain_002_001_03.vb Normal file
View File

File diff suppressed because it is too large Load Diff

4419
Bancos/pain_008_001_02.vb Normal file
View File

File diff suppressed because it is too large Load Diff

424
ClienteServicioWeb.vb Normal file
View File

@@ -0,0 +1,424 @@
Imports System.Xml
Imports System.Net
Imports System.IO
Imports System.Web
Imports System.Text.RegularExpressions
Imports tsl5.Extensiones.BinaryReaderExtensions
''' <summary>
''' Esta clase es una alternativa para cuando no puedes usar un cliente WCF (Referencia de Servicio) o la interfaz generada por wdsl.exe de .Net Framework 2.0.
''' Permite invocar métodos de un servicio web conociendo la URL del "endpoint" del servicio web, pero con la pega de que los mensajes que se envían para
''' invocar los servicios deben ser generados manualmente.
''' </summary>
Public Class ClienteServicioWeb
Public Property Url() As String
Get
Return m_Url
End Get
Set(value As String)
m_Url = value
End Set
End Property
Private m_Url As String
Public Property Method() As String
Get
Return m_Method
End Get
Private Set(value As String)
m_Method = value
End Set
End Property
Private m_Method As String
Private RequestString As String = [String].Empty
Private Username As String = [String].Empty
Private Password As String = [String].Empty
Private sAuth As String = [String].Empty
Public Params As New Dictionary(Of String, String)()
Public ResponseSOAP As XDocument = XDocument.Parse("<root/>")
Public ResultXML As XDocument = XDocument.Parse("<root/>")
Public ResultString As String = [String].Empty
Public Sub New()
Url = [String].Empty
Method = [String].Empty
End Sub
Public Sub New(baseUrl As String)
Url = baseUrl
Method = [String].Empty
End Sub
Public Sub New(baseUrl As String, methodName As String)
Url = baseUrl
Method = methodName
End Sub
#Region "Métodos públicos"
''' <summary>
''' Añade un parámetro a la llamada al método del servicio web.
''' </summary>
''' <param name="name">Nombre del parámetro (sensible a mayúsculas).</param>
''' <param name="value">Valor del parámetro.</param>
''' <remarks>Intermanente estos parámetros se mandan como parámetros POST.</remarks>
Public Sub AddParameter(name As String, value As String)
Params.Add(name, value)
End Sub
''' <summary>
''' Añade credenciales para autenticarse en el servicio web usando autenticación HTTP básica.
''' </summary>
''' <param name="username"></param>
''' <param name="password"></param>
''' <remarks>Se usa codificación UTF-8 para transmitir estas credenciales.</remarks>
Public Sub AddBasicAuthenticationCredential(ByVal username As String, ByVal password As String)
Me.sAuth = System.Convert.ToBase64String(System.Text.Encoding.GetEncoding("ISO-8859-1").GetBytes(username & ":" + password))
Me.Username = username
Me.Password = password
End Sub
Public Sub SetRequestString(ByVal sRequest As String)
Me.RequestString = sRequest
End Sub
Public Sub Invoke(Optional ByVal ignoreSSLErrors As Boolean = False)
Invoke(Method, True, ignoreSSLErrors = ignoreSSLErrors)
End Sub
''' <summary>
''' Invoca un método del servicio web, identificado por su nombre.
''' </summary>
''' <param name="methodName">Nombre del método del servicio web.</param>
Public Sub Invoke(methodName As String,
Optional ByVal ignoreSSLErrors As Boolean = False)
Invoke(methodName, True, ignoreSSLErrors = ignoreSSLErrors)
End Sub
''' <summary>
''' Limpia todos los datos del objeto excepto la URL del endpoint del servicio web.
''' Es útil para realizar subsecuentes llamadas al mismo servicio web, con otros datos o invocando a otros métodos.
''' </summary>
Public Sub CleanLastInvoke()
ResponseSOAP = InlineAssignHelper(ResultXML, Nothing)
ResultString = InlineAssignHelper(Method, [String].Empty)
Params = New Dictionary(Of String, String)()
End Sub
#End Region
#Region "Métodos auxiliares públicos"
''' <summary>
''' Remove all xmlns:* instances from the passed XmlDocument to simplify our xpath expressions
''' </summary>
Public Shared Function RemoveNamespaces(oldXml As XDocument) As XDocument
' FROM: http://social.msdn.microsoft.com/Forums/en-US/bed57335-827a-4731-b6da-a7636ac29f21/xdocument-remove-namespace?forum=linqprojectgeneral
Try
Dim newXml As XDocument = XDocument.Parse(Regex.Replace(oldXml.ToString(), "(xmlns:?[^=]*=[""][^""]*[""])", "", RegexOptions.IgnoreCase Or RegexOptions.Multiline))
Return newXml
Catch [error] As XmlException
Throw New XmlException([error].Message + " at WSCUtils.RemoveNamespaces")
End Try
End Function
''' <summary>
''' Remove all xmlns:* instances from the passed XmlDocument to simplify our xpath expressions
''' </summary>
Public Shared Function RemoveNamespaces(oldXml As String) As XDocument
Dim newXml As XDocument = XDocument.Parse(oldXml)
Return RemoveNamespaces(newXml)
End Function
''' <summary>
''' Elimina todos los espacios de nombres de un documento XML
''' </summary>
Public Shared Function EliminarEspaciosDeNombres(xDocumento As XDocument) As XDocument
' FROM: http://social.msdn.microsoft.com/Forums/en-US/bed57335-827a-4731-b6da-a7636ac29f21/xdocument-remove-namespace?forum=linqprojectgeneral
Try
Dim sRespuestaSinNamespaces As String = System.Text.RegularExpressions.Regex.Replace(xDocumento.ToString(),
"(xmlns:?[^=]*=[""][^""]*[""])", "",
System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline)
sRespuestaSinNamespaces = System.Text.RegularExpressions.Regex.Replace(sRespuestaSinNamespaces,
"<\w+:", "<",
System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline)
sRespuestaSinNamespaces = System.Text.RegularExpressions.Regex.Replace(sRespuestaSinNamespaces,
"</\w+:", "</",
System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline)
Return XDocument.Parse(sRespuestaSinNamespaces)
Catch [error] As XmlException
Throw New XmlException([error].Message + " at WSCUtils.EliminarEspaciosDeNombres")
End Try
End Function
''' <summary>
''' Converts a string that has been HTML-enconded for HTTP transmission into a decoded string.
''' </summary>
''' <param name="escapedString">String to decode.</param>
''' <returns>Decoded (unescaped) string.</returns>
Public Shared Function UnescapeString(escapedString As String) As String
Return HttpUtility.HtmlDecode(escapedString)
End Function
#End Region
#Region "Métodos auxiliares privados"
Private Function GetCredential() As CredentialCache
'ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3
Dim credentialCache As New CredentialCache()
credentialCache.Add(New System.Uri(Me.Url), "Basic", New NetworkCredential(Me.Username, Me.Password))
Return credentialCache
End Function
''' <summary>
''' Checks if the WebService's URL and the WebMethod's name are valid. If not, throws ArgumentNullException.
''' </summary>
''' <param name="methodName">Web Method name (optional)</param>
Private Sub AssertCanInvoke(Optional methodName As String = "")
If Url = [String].Empty Then
Throw New ArgumentNullException("You tried to invoke a webservice without specifying the WebService's URL.")
End If
If (methodName = "") AndAlso (Method = [String].Empty) Then
Throw New ArgumentNullException("You tried to invoke a webservice without specifying the WebMethod.")
End If
End Sub
''' <summary>
''' Invokes a Web Method, with its parameters encoded or not.
''' </summary>
''' <param name="methodName">Name of the web method you want to call (case sensitive)</param>
''' <param name="encode">Do you want to encode your parameters? (default: true)</param>
Private Function Invoke(methodName As String, encode As Boolean,
Optional ByVal ignoreSSLErrors As Boolean = False) As String
AssertCanInvoke(methodName)
Dim soapStr As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCr & vbLf & " <soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance""" & vbCr & vbLf & " xmlns:xsd=""http://www.w3.org/2001/XMLSchema""" & vbCr & vbLf & " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & vbCr & vbLf & " <soap:Body>" & vbCr & vbLf & " <{0} xmlns=""http://tempuri.org/"">" & vbCr & vbLf & " {1}" & vbCr & vbLf & " </{0}>" & vbCr & vbLf & " </soap:Body>" & vbCr & vbLf & " </soap:Envelope>"
Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest)
If ignoreSSLErrors Then
req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True
End If
req.Headers.Add("SOAPAction", (Convert.ToString("""http://tempuri.org/") & methodName) + """")
req.ContentType = "text/xml;charset=""utf-8"""
req.Accept = "text/xml"
req.Method = "POST"
'If Not String.IsNullOrWhiteSpace(sAuth) Then
' req.Headers.Add("Authorization", "Basic " + sAuth)
'End If
If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then
req.Credentials = GetCredential()
req.PreAuthenticate = True
End If
Using stm As Stream = req.GetRequestStream()
Dim postValues As String = ""
For Each param In Params
If encode Then
postValues += String.Format("<{0}>{1}</{0}>", HttpUtility.UrlEncode(param.Key), HttpUtility.UrlEncode(param.Value))
Else
postValues += String.Format("<{0}>{1}</{0}>", param.Key, param.Value)
End If
Next
soapStr = String.Format(soapStr, methodName, postValues)
Using stmw As New StreamWriter(stm)
stmw.Write(soapStr)
End Using
End Using
Using responseReader As New StreamReader(req.GetResponse().GetResponseStream())
Dim result As String = responseReader.ReadToEnd()
ResponseSOAP = XDocument.Parse(UnescapeString(result))
End Using
Me.ResultString = ResponseSOAP.ToString
Me.ResultXML = ResponseSOAP
Return ResponseSOAP.ToString
End Function
Public Function InvokeUsingRequestString(ByVal methodName As String, ByVal sRequest As String,
Optional ByVal cert As System.Security.Cryptography.X509Certificates.X509Certificate2 = Nothing,
Optional ByVal ignoreSSLErrors As Boolean = False) As XDocument
PreInvoke()
AssertCanInvoke(methodName)
Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest)
If ignoreSSLErrors Then
req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True
End If
req.ContentType = "text/xml;charset=""utf-8"""
req.Accept = "text/xml"
req.Method = "POST"
If cert IsNot Nothing Then
req.ClientCertificates.Add(cert)
End If
'If Not String.IsNullOrWhiteSpace(sAuth) Then
' req.Headers.Add("Authorization", "Basic " + sAuth)
'End If
If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then
req.Credentials = GetCredential()
req.PreAuthenticate = True
End If
Using stm As Stream = req.GetRequestStream()
Using stmw As New StreamWriter(stm)
stmw.Write(sRequest)
End Using
End Using
Dim respuesta As String = String.Empty
Dim resultado As String = String.Empty
Dim sbError As New Text.StringBuilder
sbError.AppendLine("<WebExceptionsList>")
Try
Using responseReader As New StreamReader(req.GetResponse().GetResponseStream())
respuesta = responseReader.ReadToEnd()
End Using
For Each linea As String In respuesta.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
If Not (linea.StartsWith("Content-") OrElse linea.StartsWith("--uuid:")) Then
resultado += linea & Environment.NewLine
End If
Next
Catch exTO As TimeoutException
resultado = "<WebException>Tiempo de espera agotado. El servidor del servicio web no respondió a la petición.</WebException>"
Catch ex As WebException
Using response As WebResponse = ex.Response
Dim httpResponse As HttpWebResponse = DirectCast(response, HttpWebResponse)
If httpResponse IsNot Nothing Then
Try
sbError.AppendLine(String.Format("<WebException>({0}) {1}</WebException>", DirectCast(httpResponse.StatusCode, Integer), httpResponse.StatusDescription))
Catch ex2 As Exception
sbError.AppendLine("<WebException>Error desconocido del servidor del servicio web.</WebException>")
End Try
Else
sbError.AppendLine("<WebException>No hay objeto de tipo HttpWebResponse.</WebException>")
End If
Dim sRespuesta As String = String.Empty
If response IsNot Nothing Then
Try
Using data As Stream = response.GetResponseStream()
Using reader = New StreamReader(data)
sRespuesta = reader.ReadToEnd()
End Using
End Using
Catch ex2 As Exception
resultado = sbError.ToString
End Try
Else
sbError.AppendLine("<WebException>No hay objeto de tipo WebResponse.</WebException>")
End If
If sRespuesta IsNot Nothing AndAlso sRespuesta.Length > 0 Then
Dim xRespuesta As New XDocument
Try
xRespuesta = XDocument.Parse(sRespuesta)
resultado = sRespuesta
Catch ex3 As Exception
'Nada
End Try
If xRespuesta.ToString.Length < 1 Then
resultado = sbError.ToString
End If
Else
resultado = sbError.ToString
End If
sbError.AppendLine(String.Format("<WebException>{0}</WebException>", ex.ToString))
sbError.AppendLine("</WebExceptionsList>")
resultado = sbError.ToString
End Using
If String.IsNullOrWhiteSpace(resultado) Then
sbError.AppendLine(String.Format("<WebException>{0}</WebException>", ex.ToString))
sbError.AppendLine("</WebExceptionsList>")
resultado = sbError.ToString
End If
End Try
Dim unescapedString As String = UnescapeString(resultado.Trim)
Try
ResponseSOAP = XDocument.Parse(unescapedString.Trim)
Catch ex As XmlException
ResponseSOAP = XDocument.Parse(resultado.Trim)
End Try
PosInvoke()
Me.ResultString = ResponseSOAP.ToString
Me.ResultXML = ResponseSOAP
Return ResponseSOAP
End Function
''' <summary>
''' Realiza una petición a un servicio web usando un nombre de método, una cadena para la petición, y recogiendo la petición como un array de bytes.
''' </summary>
''' <param name="methodName">Nombre del método.</param>
''' <param name="sRequest">Cadena con la petición que se realizará al servicio web.</param>
''' <param name="cert"></param>
''' <returns>Un array de bytes con el contenido de la respuesta realizada al servicio web.</returns>
''' <remarks>Este método solo debería usarse con descargas que quepan en memoria RAM, teniendo en cuenta las posibles restricciones de memoria que el sistema operativo puda tener para procesos individuales.</remarks>
Public Function InvokeBinaryUsingRequestString(ByVal methodName As String, ByVal sRequest As String,
Optional ByVal cert As System.Security.Cryptography.X509Certificates.X509Certificate2 = Nothing,
Optional ByVal ignoreSSLErrors As Boolean = False) As Byte()
PreInvoke()
AssertCanInvoke(methodName)
Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest)
If ignoreSSLErrors Then
req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True
End If
req.ContentType = "text/xml;charset=""utf-8"""
req.Accept = "text/xml"
req.Method = "POST"
If cert IsNot Nothing Then
req.ClientCertificates.Add(cert)
End If
'If Not String.IsNullOrWhiteSpace(sAuth) Then
' req.Headers.Add("Authorization", "Basic " + sAuth)
'End If
If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then
req.Credentials = GetCredential()
req.PreAuthenticate = True
End If
Using stm As Stream = req.GetRequestStream()
Using stmw As New StreamWriter(stm)
stmw.Write(sRequest)
End Using
End Using
Dim respuesta As String = String.Empty
Dim resultado As Byte() = New Byte(0) {}
Dim sError As String = String.Empty
Dim sb As New Text.StringBuilder
Dim binaryBuffer As Byte()
Using binaryReader As New BinaryReader(req.GetResponse().GetResponseStream())
binaryBuffer = binaryReader.ReadAllBytes
End Using
resultado = binaryBuffer
PosInvoke()
Return resultado
End Function
''' <summary>
''' This method should be called before each Invoke().
''' </summary>
Friend Sub PreInvoke()
CleanLastInvoke()
' feel free to add more instructions to this method
End Sub
''' <summary>
''' This method should be called after each (successful or unsuccessful) Invoke().
''' </summary>
Friend Sub PosInvoke()
' feel free to add more instructions to this method
End Sub
Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
#End Region
End Class

14
Compresion.vb Normal file
View File

@@ -0,0 +1,14 @@

Public Class Compresion
Public Shared Function ComprimirCadena(Cadena As String) As Byte()
Dim ms As New IO.MemoryStream
Dim gz As New System.IO.Compression.GZipStream(ms, IO.Compression.CompressionMode.Compress)
Dim sw As New IO.BinaryWriter(gz)
sw.Write(System.Text.Encoding.UTF8.GetBytes(Cadena))
sw.Close()
Return ms.ToArray()
End Function
End Class

850
Correo.vb Normal file
View File

@@ -0,0 +1,850 @@
Option Strict Off
Imports System.IO
Imports System.Net.Mail
Imports System.Net
Imports System.Security.Cryptography.X509Certificates
Imports System.Net.Security
Imports System.Net.Mime
Imports System.IO.Compression
Imports tsl5.Extensiones
Imports System.Text
Namespace Correo
Public Class ConfCuentaCorreo
Property Puerto As Integer
Property SSL As Boolean
Property ServidorSMTP As String
Property CuentaCorreo As String
Property Contraseña As String
Property Remitente As String
End Class
Public Class Funciones
Public Shared Sub EnviaCorreoCompruebaHTML(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos() As MemoryStream,
ByVal NombreFicherosAdjuntos() As String,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional ByVal NombreRemitente As String = "")
If FicherosAdjuntos.Count = 1 AndAlso NombreFicherosAdjuntos(0).EndsWith(".html.zip") Then
Dim sDirectorioTMP As String = tsl5.Utilidades.ObtieneDirectorioAleatorio
zip.ExtraeTodoDeZip(FicherosAdjuntos(0), sDirectorioTMP)
' tsZIP.zip.ExtraeTodoDeZip("f:\temp\csc.html.zip", sDirectorioTMP)
Dim sFichCuerpo = IO.Directory.GetFiles(sDirectorioTMP, "*.html")(0)
Dim sCuerpo = System.Text.Encoding.UTF8.GetString(IO.File.ReadAllBytes(sFichCuerpo))
Dim avHtml As AlternateView = AlternateView.CreateAlternateViewFromString(sCuerpo, Nothing, MediaTypeNames.Text.Html)
Dim diradj = IO.Directory.GetDirectories(sDirectorioTMP)(0)
Dim ficadj = IO.Directory.GetFiles(diradj)
For Each f In ficadj
Dim ms As New MemoryStream(IO.File.ReadAllBytes(f))
Dim inline As New LinkedResource(ms, "image/" & IO.Path.GetExtension(f).Trim("."))
inline.ContentId = IO.Path.GetFileNameWithoutExtension(f)
avHtml.LinkedResources.Add(inline)
Next
Dim avs As New List(Of AlternateView)
avs.Add(avHtml)
EnviaCorreoHtml(ServidorSMTP, Remitente, Destinatario, Asunto, Cuerpo, Nothing, avs, CC, BCC, CuentaCorreo, ContraseñaCorreo, Puerto, UsarSSL, True, ResponderA, NombreRemitente)
IO.Directory.Delete(sDirectorioTMP, True)
Else
EnviaCorreo(ServidorSMTP, Remitente, Destinatario, Asunto, Cuerpo, FicherosAdjuntos, NombreFicherosAdjuntos, CC, BCC, CuentaCorreo, ContraseñaCorreo, Puerto, UsarSSL, CuerpoenHTML, ResponderA, NombreRemitente)
End If
End Sub
Public Shared Sub EnviaCorreoHtml(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal AttachMents As List(Of Attachment),
ByVal AlternateViews As List(Of AlternateView),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente))
End If
myMessage.Sender = New MailAddress(Remitente, NombreRemitente)
myMessage.From = New MailAddress(Remitente, NombreRemitente)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
For Each scc In CC.Split(";")
myMessage.CC.Add(scc)
Next
End If
If BCC <> "" Then
For Each sbcc In BCC.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If AttachMents IsNot Nothing Then
For Each att In AttachMents
myMessage.Attachments.Add(att)
Next
End If
If AlternateViews IsNot Nothing Then
For Each av In AlternateViews
myMessage.AlternateViews.Add(av)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal AttachMents As List(Of Attachment),
ByVal AlternateViews As List(Of AlternateView),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "", Optional CredencialesConDominio As Boolean = False,
Optional ProtocoloSeguridad As SecurityProtocolType = SecurityProtocolType.Tls,
Optional NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
If Destinatario.NothingAVacio = "" And CC.NothingAVacio <> "" Then
Destinatario = CC
CC = ""
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage()
myMessage.Subject = Asunto
myMessage.Body = Cuerpo
myMessage.From = New MailAddress(Remitente, NombreRemitente)
Dim sDestinatarios() As String = Nothing
sDestinatarios = Destinatario.Split(";")
For Each dest In sDestinatarios
dest = dest.Trim
If dest.Trim <> "" Then
myMessage.To.Add(New MailAddress(dest, dest, Encoding.UTF8))
End If
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8))
' myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente, Encoding.UTF8))
End If
myMessage.Sender = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
Dim scc = CC.Split(";")
For Each c In scc
If c <> "" Then myMessage.CC.Add(c)
Next
End If
If BCC <> "" Then
Dim sbcc = BCC.Split(";")
For Each b In sbcc
If b <> "" Then myMessage.Bcc.Add(b)
Next
End If
If AttachMents IsNot Nothing Then
For Each att In AttachMents
myMessage.Attachments.Add(att)
Next
End If
If AlternateViews IsNot Nothing Then
For Each av In AlternateViews
myMessage.AlternateViews.Add(av)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
If CredencialesConDominio Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo, CuentaCorreo.Split("@")(1))
Else
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
End If
SmtpMail.EnableSsl = UsarSSL
' SmtpMail.TargetName = "STARTTLS/smtp.office365.com"
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Timeout = 1000 * 60 * 5
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos() As MemoryStream,
ByVal NombreFicherosAdjuntos() As String,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim, Encoding.UTF8))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente, Encoding.UTF8))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8))
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente, Encoding.UTF8))
End If
myMessage.Sender = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
For Each scc In CC.Split(";")
myMessage.CC.Add(scc)
Next
End If
If BCC <> "" Then
For Each sbcc In BCC.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
myAttch = New Attachment(FicherosAdjuntos(i), NombreFicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.UseDefaultCredentials = False
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos As List(Of String),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False,
Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' Destinatario = "danmun@tecnosis.eu"
'End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim, Encoding.UTF8))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente, Encoding.UTF8))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8))
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente, Encoding.UTF8))
End If
myMessage.Sender = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
If CC <> "" Then
myMessage.CC.Add(CC)
End If
If BCC <> "" Then
myMessage.Bcc.Add(BCC)
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(FicherosAdjuntos(i)) Then
myAttch = New Attachment(FicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal destinatarios As List(Of String),
ByVal asunto As String,
ByVal cuerpo As String,
ByVal ficherosAdjuntos As List(Of String),
Optional ByVal cc As String = "",
Optional ByVal bcc As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal cuerpoEsHTML As Boolean = False,
Optional ByVal responderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' Destinatario = "danmun@tecnosis.eu"
'End If
asunto = asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage
myMessage.Body = cuerpo
myMessage.Subject = asunto
For Each destinatario In destinatarios
myMessage.To.Add(New MailAddress(destinatario, destinatario, Encoding.UTF8))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
myMessage.ReplyToList.Add(New MailAddress(remitente, NombreRemitente, Encoding.UTF8))
Else
myMessage.ReplyToList.Add(New MailAddress(responderA, responderA, Encoding.UTF8))
myMessage.ReplyToList.Add(New MailAddress(remitente, NombreRemitente, Encoding.UTF8))
End If
myMessage.Sender = New MailAddress(remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(remitente, NombreRemitente, Encoding.UTF8)
If cc <> "" Then
For Each scc In cc.Split(";")
myMessage.CC.Add(scc)
Next
End If
If bcc <> "" Then
For Each sbcc In bcc.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If Not ficherosAdjuntos Is Nothing Then
iCnt = ficherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(ficherosAdjuntos(i)) Then
myAttch = New Attachment(ficherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If servidorSMTP <> "" Then SmtpMail.Host = servidorSMTP
SmtpMail.Port = puerto
If cuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
SmtpMail.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
Optional ByVal FicherosAdjuntos As ArrayList = Nothing,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False,
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim, Encoding.UTF8))
Next
myMessage.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.Sender = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
If CC <> "" Then
Dim scc = CC.Split(";")
For Each c In scc
If c <> "" Then myMessage.CC.Add(c)
Next
End If
If BCC <> "" Then
Dim sbcc = BCC.Split(";")
For Each b In sbcc
If b <> "" Then myMessage.Bcc.Add(b)
Next
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(FicherosAdjuntos(i)) Then
myAttch = New Attachment(FicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreoVariosAdjuntos(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
Optional ByVal FicherosAdjuntos As List(Of FicheroAdjunto) = Nothing,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False,
Optional NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim, Encoding.UTF8))
Next
myMessage.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.Sender = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
myMessage.From = New MailAddress(Remitente, NombreRemitente, Encoding.UTF8)
If CC <> "" Then
myMessage.CC.Add(CC)
End If
If BCC <> "" Then
myMessage.Bcc.Add(BCC)
End If
Dim cd As System.Net.Mime.ContentDisposition
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If FicherosAdjuntos(i).Ruta <> "" Then
If IO.File.Exists(FicherosAdjuntos(i).Ruta) Then
myAttch = New Attachment(FicherosAdjuntos(i).Ruta)
cd = myAttch.ContentDisposition
cd.FileName = FicherosAdjuntos(i).NombreFichero
myMessage.Attachments.Add(myAttch)
End If
Else
If Not FicherosAdjuntos(i).Fichero Is Nothing AndAlso FicherosAdjuntos(i).Fichero.Length > 0 Then
myAttch = New Attachment(New IO.MemoryStream(FicherosAdjuntos(i).Fichero), FicherosAdjuntos(i).NombreFichero)
cd = myAttch.ContentDisposition
cd.FileName = FicherosAdjuntos(i).NombreFichero
myMessage.Attachments.Add(myAttch)
End If
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
''' <summary>
''' Envía un correo electrónico. Puede recibir adjuntos mediante un Dictionary(Of String, Stream).
''' </summary>
''' <param name="servidorSMTP"></param>
''' <param name="remitente"></param>
''' <param name="destinatario"></param>
''' <param name="asunto"></param>
''' <param name="cuerpo"></param>
''' <param name="adjuntos">Un Dictionary(Of String, Stream). La clave es el nombre del archivo adjunto, el valor es el contenido del archivo adjunto en forma de Stream.</param>
''' <param name="cc"></param>
''' <param name="bcc"></param>
''' <param name="cuentaCorreo"></param>
''' <param name="contraseñaCorreo"></param>
''' <param name="puerto"></param>
''' <param name="usarSSL"></param>
''' <remarks></remarks>
Public Shared Sub EnviarCorreoElectrónico(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal destinatario As String,
ByVal asunto As String,
ByVal cuerpo As String,
Optional ByVal adjuntos As Dictionary(Of String, Stream) = Nothing,
Optional ByVal cc As String = "",
Optional ByVal bcc As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = remitente
Dim clienteSMTP As SmtpClient
Dim mensaje As MailMessage
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' destinatario = "danmun@tecnosis.eu"
'End If
asunto = asunto.Replace(Environment.NewLine, " ")
' mensaje = New MailMessage(remitente, destinatario, asunto, cuerpo)
mensaje = New MailMessage
mensaje.Body = cuerpo
mensaje.Subject = asunto
Dim destinatarios = destinatario.Split(";")
For Each destinatario In destinatarios
mensaje.To.Add(New MailAddress(destinatario.Trim, destinatario.Trim, Encoding.UTF8))
Next
mensaje.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
mensaje.ReplyToList.Add(New MailAddress(remitente, NombreRemitente, Encoding.UTF8))
Else
mensaje.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8))
mensaje.ReplyToList.Add(New MailAddress(remitente, NombreRemitente, Encoding.UTF8))
End If
mensaje.Sender = New MailAddress(remitente, NombreRemitente)
mensaje.From = New MailAddress(remitente, NombreRemitente)
If cc <> "" Then
mensaje.CC.Add(cc)
End If
If bcc <> "" Then
mensaje.Bcc.Add(bcc)
End If
If Not adjuntos Is Nothing Then
If adjuntos.Count > 0 Then
For Each adjunto In adjuntos
mensaje.Attachments.Add(New Attachment(adjunto.Value, adjunto.Key))
Next
End If
End If
clienteSMTP = New SmtpClient
If servidorSMTP <> "" Then clienteSMTP.Host = servidorSMTP
clienteSMTP.Port = puerto
If cuentaCorreo <> "" Then
clienteSMTP.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
clienteSMTP.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
clienteSMTP.Send(mensaje)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreoMultiplesDestinatarios(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal listaDestinatarios As List(Of String),
ByVal asunto As String,
ByVal cuerpo As String,
ByVal ficherosAdjuntos As List(Of String),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal responderA As String = "",
Optional ByVal NombreRemitente As String = "")
Try
If NombreRemitente = "" Then NombreRemitente = remitente
Dim misAdjuntos As Attachment
Dim clienteSMTP As SmtpClient
Dim miMensaje As MailMessage
Dim i, iCnt As Integer
'// Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WINXP-PARALLELS" OrElse
' Environment.MachineName = "WINXP-DE-DANIEL" OrElse
' Environment.MachineName.ToUpper = "Win81PDdanmun".ToUpper OrElse
' Environment.MachineName.ToUpper.StartsWith("INTI") Then
' listaDestinatarios = New List(Of String)
' listaDestinatarios.Add("danmun@tecnosis.net")
'End If
For Each destinatario In listaDestinatarios
asunto = asunto.Replace(Environment.NewLine, " ")
miMensaje = New MailMessage(New MailAddress(remitente, NombreRemitente, Encoding.UTF8), New MailAddress(destinatario, destinatario, Encoding.UTF8)) With {
.Subject = asunto,
.Body = cuerpo,
.BodyEncoding = Text.Encoding.UTF8
}
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
miMensaje.ReplyToList.Add(New MailAddress(remitente, NombreRemitente))
Else
miMensaje.ReplyToList.Add(New MailAddress(responderA, responderA))
miMensaje.ReplyToList.Add(New MailAddress(remitente, NombreRemitente))
End If
miMensaje.Sender = New MailAddress(remitente, NombreRemitente)
If CC <> "" Then
miMensaje.CC.Add(CC)
End If
If BCC <> "" Then
miMensaje.Bcc.Add(BCC)
End If
If Not ficherosAdjuntos Is Nothing Then
iCnt = ficherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(ficherosAdjuntos(i)) Then
misAdjuntos = New Attachment(ficherosAdjuntos(i))
miMensaje.Attachments.Add(misAdjuntos)
'misAdjuntos.Dispose()
End If
Next
End If
clienteSMTP = New SmtpClient
If servidorSMTP <> "" Then clienteSMTP.Host = servidorSMTP
clienteSMTP.Port = puerto
If cuentaCorreo <> "" Then
clienteSMTP.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
clienteSMTP.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 Or SecurityProtocolType.Ssl3
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
clienteSMTP.Send(miMensaje)
System.Threading.Thread.Sleep(1000 * (listaDestinatarios.Count - 1))
Next
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
End Class
Public Class FicheroAdjunto
Property Ruta As String
Property NombreFichero As String
Property Fichero As Byte()
End Class
End Namespace

175
CorreoOAuth2.vb Normal file
View File

@@ -0,0 +1,175 @@
Imports System.Net
Imports System.Net.Mail
Imports System.Net.Security
Imports System.Security.Cryptography.X509Certificates
Imports Microsoft.Identity.Client
Imports System.Threading.Tasks
Imports System.Text
Public Class CorreoOAuth2
Public Shared Async Function EnviaCorreoOffice365(ByVal ServidorSMTP As String,
ByVal ClientId As String,
ByVal TenantId As String,
ByVal ClientSecret As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal AttachMents As List(Of Attachment),
ByVal AlternateViews As List(Of AlternateView),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal Puerto As Integer = 587,
Optional ByVal UsarSSL As Boolean = True,
Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "",
Optional NombreRemitente As String = "") As Task
Try
If NombreRemitente = "" Then NombreRemitente = Remitente
' Validación para entornos de desarrollo
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
If String.IsNullOrEmpty(Destinatario) AndAlso Not String.IsNullOrEmpty(CC) Then
Destinatario = CC
CC = ""
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
Dim myMessage As New MailMessage()
' Configuración del mensaje
myMessage.Subject = Asunto
myMessage.Body = Cuerpo
myMessage.From = New MailAddress(Remitente, NombreRemitente)
myMessage.IsBodyHtml = CuerpoenHTML
' Destinatarios
For Each dest In Destinatario.Split(";"c).Where(Function(d) Not String.IsNullOrWhiteSpace(d))
myMessage.To.Add(New MailAddress(dest.Trim(), dest.Trim(), Encoding.UTF8))
Next
' CC
If Not String.IsNullOrEmpty(CC) Then
For Each c In CC.Split(";"c)
myMessage.CC.Add(c.Trim())
Next
End If
' BCC
If Not String.IsNullOrEmpty(BCC) Then
For Each b In BCC.Split(";"c)
myMessage.Bcc.Add(b.Trim())
Next
End If
' Responder a
If String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8))
End If
' Adjuntos
If AttachMents IsNot Nothing Then
For Each att In AttachMents
myMessage.Attachments.Add(att)
Next
End If
' Vistas alternativas
If AlternateViews IsNot Nothing Then
For Each av In AlternateViews
myMessage.AlternateViews.Add(av)
Next
End If
' Configuración del cliente SMTP
Dim SmtpMail As New SmtpClient(ServidorSMTP, Puerto)
SmtpMail.EnableSsl = UsarSSL
' Obtener token OAuth
Dim token = Await GetOAuthToken(ClientId, TenantId, ClientSecret, Remitente)
' Configurar credenciales OAuth
SmtpMail.Credentials = New NetworkCredential(Remitente, token)
SmtpMail.UseDefaultCredentials = False
' Configuración de seguridad
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback =
Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Timeout = 1000 * 60 * 5 ' 5 minutos
' Envío del correo
Await SmtpMail.SendMailAsync(myMessage)
Catch ex As Exception
Throw New Exception("Error al enviar correo: " & ex.Message, ex)
End Try
End Function
Private Shared ListadoTokens As New List(Of TokenMicrosoft)
Private Shared Async Function GetOAuthToken(ByVal ClientId As String, ByVal TenantId As String,
ByVal ClientSecret As String, ByVal Remitente As String) As Task(Of String)
Dim tm = ListadoTokens.FirstOrDefault(Function(x) x.id = ClientId & "-" & TenantId)
If tm Is Nothing Then
tm = New TokenMicrosoft
tm.id = ClientId & "-" & TenantId
ListadoTokens.Add(tm)
End If
If tm.FechaCreacion.HasValue = False OrElse Date.UtcNow.Subtract(tm.FechaCreacion).TotalMinutes > 30 Then
tm.FechaCreacion = Date.UtcNow
Dim app As IConfidentialClientApplication
Dim result As AuthenticationResult = Nothing
Dim scopes As String() = {"https://outlook.office365.com/.default"}
' Primero intentamos con credenciales de cliente (si hay ClientSecret)
If Not String.IsNullOrEmpty(ClientSecret) Then
app = ConfidentialClientApplicationBuilder.Create(ClientId) _
.WithAuthority(AzureCloudInstance.AzurePublic, TenantId) _
.WithClientSecret(ClientSecret) _
.Build()
Try
result = Await app.AcquireTokenForClient(scopes).ExecuteAsync()
Return result.AccessToken
Catch ex As MsalServiceException
Throw New Exception("Error al obtener token con credenciales de cliente: " & ex.Message, ex)
End Try
End If
' Si no hay ClientSecret o falló, intentamos con flujo interactivo (solo para desarrollo)
Dim publicApp = PublicClientApplicationBuilder.Create(ClientId) _
.WithAuthority(AzureCloudInstance.AzurePublic, TenantId) _
.Build()
Try
result = Await publicApp.AcquireTokenInteractive(scopes).ExecuteAsync()
tm.Token = result.AccessToken
Return result.AccessToken
Catch ex As MsalServiceException
Throw New Exception("Error al obtener token interactivo: " & ex.Message, ex)
End Try
Else
Return tm.Token
End If
End Function
Private Class TokenMicrosoft
Property id As String
Property FechaCreacion As DateTime?
Property Token As String
End Class
End Class

209
Datos.vb Normal file
View File

@@ -0,0 +1,209 @@
Imports tsl5.Enumeraciones
Imports System.Runtime.Serialization
Imports System.Configuration
Imports System.Text.Json
Namespace Datos
<DataContractAttribute(IsReference:=True)> _
<Serializable()> Public Class BBDD
Property Tipo As TipoBD
Property Servidor As String
Property DataBase As String
Property Puerto As Integer
Property Usuario As String
Property Password As String
Property Fichero As String
Property SegundosTimeout As Integer = 300
Property Pooling As Boolean
Property SSL As Boolean
Property FicheroCertificado As String
Property PasswordCertificado As String
Public Property id As String
Public Shared Function ObtieneJSONBD(idBD As String, idUsuarioBD As String, idServidor As String, tipo As TipoBD) As String
Dim bd As New tsl5.Datos.BBDD
With bd
.Usuario = ConfigurationManager.AppSettings(idUsuarioBD)
If .Usuario = "" Then Throw New Exception("Usuario bd " & idUsuarioBD & " no encontrado en la configuracion")
.DataBase = ConfigurationManager.AppSettings(idBD & "Esquema")
.Password = ConfigurationManager.AppSettings(idBD & "Pass" & idUsuarioBD)
.Servidor = ConfigurationManager.AppSettings(idBD & "Serv" & idServidor)
.Tipo = tipo
End With
Dim options As New JsonSerializerOptions() With {.IncludeFields = True}
Dim JSONString = JsonSerializer.Serialize(bd, options)
Return JSONString
End Function
End Class
<Serializable()> Public Class DatosConfiguracionServicio
Property NombreServicio As String
Property PuertoNR As Integer
Property BasesDatos As New List(Of BBDD)
Property Detener As Boolean
Property Directorios As New Directorios
Property Version As String
Property NumeroBDConfiguracion As Integer
Shared Function CargaConfiguracion(FicheroConfiguracion As String, DllProcesos As String) As DatosConfiguracionServicio
Dim dcs As New DatosConfiguracionServicio
dcs = tsl5.Utilidades.DeserializaFichero(FicheroConfiguracion, GetType(DatosConfiguracionServicio))
If DllProcesos <> "" And IO.File.Exists(DllProcesos) Then
Try
Dim ensamblado As System.Reflection.Assembly
ensamblado = System.Reflection.Assembly.LoadFrom(System.Windows.Forms.Application.StartupPath & "\" & DllProcesos)
dcs.Version = ensamblado.GetName.Version.ToString
Catch
End Try
End If
dcs.Directorios.DirectorioConfiguraciones = IO.Path.GetDirectoryName(FicheroConfiguracion)
Return dcs
End Function
End Class
<Serializable()> Public Class Directorios
Property Temporal As String
Property Flags As String
Property Plantillas As String
Property Logs As String
Property Datos As String
Property DatosLocales As String
Property DirectorioConfiguraciones As String
End Class
<Serializable()> Public Class DatosConfiguracionCliente
Property ServidorActivo As New Servidor
Property ConstantesCliente As New ConstantesCliente
Property NombreEjecutable As String
End Class
<Serializable()> Public Class ConstantesCliente
Property NombreServicio As String
Property RutaAplicacion As String
Property RutaDatos As String
Property RutaTmp As String
End Class
<Serializable()> Public Class DatosConfiguracionAplicacion
Property Servidores As New List(Of Servidor)
Property ConstantesCliente As New ConstantesCliente
End Class
<Serializable()> Public Class DatosSesionCliente
Property IdSesion As Long
Property idUsuario As Integer
Property idGrupoMenu As Integer
Property idGruboBD As Integer
End Class
<Serializable()> Public Class DatosConexionCliente
Property BasesDatos As New List(Of BBDD)
Property NumeroBDConfiguracion As Integer
' Property ServidorActualizador As New ServidorActualizacion
End Class
<Serializable()> Public Class DatosOperacion
Property Usuario As String
Property Password As String
Property IdSesion As Long
Property Operacion As Enumeraciones.TiposOperacionesEnum
Property Datos As Object
End Class
'<Serializable()> Public Class Actualizador
' Property Nombre As String
' 'Property Tipo As Enumeraciones.tipoAplicacionActualizableEnum
' Property ServidorLocal As New ServidorActualizacion
' Property ServidorRemoto As New ServidorActualizacion
' Property FicheroConfiguracionXML As String
' ' Property RutaEnsamblados As String
' Property RutaDatos As String
'End Class
'<Serializable()> Public Class ActualizadorPropio
' Property FicheroConfiguracionXML As String
' ' Property RutaEnsamblados As String
' Property RutaDatos As String
' Property RutaLogs As String
'End Class
'<Serializable()> Public Class Actualizacion
' Property Nombre As String
' Property Elementos As New List(Of ElementoActualizable)
'End Class
'<Serializable()> Public Class ElementoActualizable
' Property NombreFichero As String
' Property RutaFichero As String
' Property TipoFichero As Enumeraciones.tipoFicheroActualizableEnum
' Property FechaModificacion As DateTime
' Property Comparacion As Enumeraciones.ComparacionEnum
'End Class
<Serializable()> Public Class Servidor
Property Servidor As String
Property Puerto As Integer
Property Localizacion As Enumeraciones.LocalizacionesEnum
End Class
'<Serializable()> Public Class ServidorActualizacion
' Property TipoServidorActualizacion As Enumeraciones.tiposServidoresActualizacionEnum
' Property Servidor As String
' Property Puerto As Integer
' Property SSL As Boolean
' Property Pasivo As Boolean
' Property Usuario As String
' Property Contraseña As String
' Property Directorio As String
'End Class
'<Serializable()> Public Class DatosActualizadorAuxiliar
' Property RutaEjecutable As String
' Property Actualizacion As Datos.Actualizacion
' Property ConfiguracionCliente As Datos.DatosConfiguracionCliente
' Property ConexionCliente As Datos.DatosConexionCliente
'End Class
'<Serializable()> Public Class DatosLogs
' Friend EmailDestinatarios As String
' Friend ServidorSMTP As String
' Friend Cuenta As String
' Friend Contraseña As String
' Friend Puerto As Integer
' Friend UsarSSL As Boolean
'End Class
End Namespace
Namespace Enumeraciones
Public Enum LocalizacionesEnum
Local = 0
Remoto = 1
End Enum
Public Enum TiposOperacionesEnum
ObtieneFichero = 0
ObtieneString = 1
End Enum
'Public Enum TiposServidoresActualizacionEnum
' Samba = 0
' FTP = 1
'End Enum
'Public Enum ComparacionEnum
' Sin_Cambios = 0
' Diferente = 1
' Nuevo = 2
' Inexistente = 3
'End Enum
'Public Enum TipoActualizacionEnum
' No_Actualizar = 0
' Actualizacion_Sin_Reinicio = 1
' Actualizacion_Con_Reinicio = 2
' Actualizacion_Mixta = 3
'End Enum
'Public Enum TipoFicheroActualizableEnum
' Ensamblado = 0
' Datos = 1
'End Enum
Public Enum TipoLog
InicioServicio = 0
Fallo = 1
Advertencia = 2
ErroresEnFtp = 3
Otros = 4
Informacion = 5
Depuracion = 6
FinServicio = 99
End Enum
<DataContractAttribute(IsReference:=True)> _
<Serializable> _
Public Enum TipoBD
MYSQL
LOCALDB
SQLSERVER
ORACLE
End Enum
End Namespace

64
Extensiones/BinaryReaderExtensions.vb Normal file
View File

@@ -0,0 +1,64 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module BinaryReaderExtensions
<Extension()>
Public Function ReadAllBytes(ByVal reader As IO.BinaryReader) As Byte()
Const bufferSize As Integer = 4095
Using ms = New IO.MemoryStream()
Dim buffer As Byte() = New Byte(bufferSize) {}
Dim count As Integer
Dim bFinish As Boolean = False
Do Until bFinish
count = reader.Read(buffer, 0, buffer.Length)
If count = 0 Then
bFinish = True
Else
ms.Write(buffer, 0, count)
End If
Loop
'While (count = reader.Read(buffer, 0, buffer.Length)) <> 0
' ms.Write(buffer, 0, count)
'End While
Return ms.ToArray()
End Using
End Function
End Module
Public Class LineReader
Inherits IO.BinaryReader
Public Sub New(ByVal stream As IO.Stream, ByVal encoding As Text.Encoding)
MyBase.New(stream, encoding)
End Sub
Public currentPos As Integer
Private stringBuffer As Text.StringBuilder
Public Function ReadLine() As String
currentPos = 0
Dim buf As Char() = New Char(0) {}
stringBuffer = New Text.StringBuilder()
Dim lineEndFound As Boolean = False
While MyBase.Read(buf, 0, 1) > 0
currentPos += 1
If buf(0) = Microsoft.VisualBasic.Strings.ChrW(10) Then
lineEndFound = True
Else
stringBuffer.Append(buf(0))
End If
If lineEndFound Then
Return stringBuffer.ToString()
End If
End While
Return stringBuffer.ToString()
End Function
End Class
End Namespace

158
Extensiones/DateTimeExtensions.vb Normal file
View File

@@ -0,0 +1,158 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DateTimeExtensions
<Extension()>
Public Function FechaNulableAString(Fecha As Date?) As String
If Fecha Is Nothing Then
Return ""
Else
Return Fecha.Value.ToString("dd/MM/yyyy")
End If
End Function
<Extension()>
Public Function FechaHoraStringADate(Fecha As String, Optional SinSegundos As Boolean = False) As DateTime?
Dim dt As New DateTime
If Fecha = "0" Then
Return Nothing
Else
If Fecha.Contains("_") Then
Dim s() As String = Fecha.Split("_")
dt = New DateTime(s(0), s(1), s(2), s(3), s(4), s(5))
Else
If Fecha.Contains(".") And (Fecha.Length = 13 Or Fecha.Length = 12) Then
Fecha = Fecha.Split(".")(0) & Fecha.Split(".")(1).Substring(0, 2) & Math.Round(Double.Parse(Fecha.Split(".")(1).Substring(2)) * 60 / 100, 0, MidpointRounding.AwayFromZero).ToString.PadLeft(2, "0") & "00"
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(4, 2), Fecha.Substring(6, 2), Fecha.Substring(8, 2), Fecha.Substring(10, 2), Fecha.Substring(12, 2))
Else
If Fecha.Length = 14 Then
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(4, 2), Fecha.Substring(6, 2), Fecha.Substring(8, 2), Fecha.Substring(10, 2), Fecha.Substring(12, 2))
Else
If Fecha.Length = 19 Then
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(5, 2), Fecha.Substring(8, 2), Fecha.Substring(11, 2), Fecha.Substring(14, 2), Fecha.Substring(17, 2))
Else
If Fecha.Length = 6 Then Fecha = "19" & Fecha
If Fecha.Contains(".") Then
Dim horas = Double.Parse(Fecha.Split(".")(1).PadRight(6, "0")) / 10000
Dim Segundos = horas * 60 * 60
Dim ts = TimeSpan.FromSeconds(Segundos)
dt = New DateTime(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
dt = dt + ts
Else
dt = New Date(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
End If
End If
End If
End If
End If
If SinSegundos Then dt = New Date(dt.Year, dt.Month, dt.Day, dt.Hour, dt.Minute, 0)
Return dt
End If
End Function
<Extension()>
Public Function Maximo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As Nullable(Of DateTime)
Dim t1, t2 As Long
If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
If t1 > t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function Minimo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As Nullable(Of DateTime)
Dim t1, t2 As Long
If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
If t1 < t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function MesCastellano(Fecha As Date) As String
Select Case Fecha.Month
Case 1
Return "Enero"
Case 2
Return "Febrero"
Case 3
Return "Marzo"
Case 4
Return "Abril"
Case 5
Return "Mayo"
Case 6
Return "Junio"
Case 7
Return "Julio"
Case 8
Return "Agosto"
Case 9
Return "Septiembre"
Case 10
Return "Octubre"
Case 11
Return "Noviembre"
Case Else
Return "Diciembre"
End Select
End Function
<Extension>
Public Function ValorNumerico(Fecha As Date) As Long
Return Fecha.Year * 10000 + Fecha.Month * 100 + Fecha.Day
End Function
<Extension>
Public Function ValorNumerico(Fecha As Nullable(Of Date)) As Long
If Fecha Is Nothing Then
Return 0
Else
Return Fecha.Value.Year * 10000 + Fecha.Value.Month * 100 + Fecha.Value.Day
End If
End Function
<Extension>
Public Function UnixTimeStampToDateTime(ByVal unixTimeStamp As Double) As DateTime
Dim dateTime As DateTime = New DateTime(1970, 1, 1, 0, 0, 0, 0, DateTimeKind.Utc)
dateTime = dateTime.AddSeconds(unixTimeStamp).ToLocalTime()
Return dateTime
End Function
'Public Function Maximo(Fecha1 As DateTime, Fecha2 As DateTime) As DateTime
' Dim t1, t2 As Long
' If Fecha1 Is Nothing Then t1 = Fecha1.Ticks
' If Not Fecha2 Is Nothing Then t2 = Fecha2.Ticks
' If t1 > t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
'Public Function Minimo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As DateTime
' Dim t1, t2 As Long
' If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
' If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
' If t1 < t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
'Public Function Maximo(Fecha1 As Nullable(Of Date), Fecha2 As Nullable(Of Date)) As Date
' Dim t1, t2 As Long
' If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
' If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
' If t1 > t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
End Module
End Namespace

26
Extensiones/DoubleExtensions.vb Normal file
View File

@@ -0,0 +1,26 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DoubleExtensions
<Extension()> Function APalabras(Numero As Double) As String
Return NumerosAPalabras.ToCardinal(Numero)
End Function
<Extension()> Function AEurosEnLetras(Numero As Double) As String
Dim EnteroDecimal As Int32 = Int(Math.Round((Numero - Int(Numero)) * Math.Pow(10, 2)))
If EnteroDecimal > 0 Then
Dim convertidor As New NumerosAPalabras(True, "", "Euros con", True)
Return convertidor.ToCustomCardinal(Numero).Trim & " céntimos"
Else
Return NumerosAPalabras.ToCardinal(Numero).Trim & " Euros"
End If
End Function
<Extension()> Function EntreValores(Valor As Double, RangoMenor As Double, RangoMayor As Double) As Boolean
Return Valor >= RangoMenor And Valor <= RangoMayor
End Function
<Extension()> Function NothingA0(Valor As Double?) As Double
Return If(Valor.HasValue, Valor, 0)
End Function
End Module
End Namespace

1964
Extensiones/Dynamic.vb Normal file
View File

File diff suppressed because it is too large Load Diff

111
Extensiones/EntityExtensions.vb Normal file
View File

@@ -0,0 +1,111 @@
Imports System.Runtime.CompilerServices
Imports System.Data.Objects.DataClasses
Imports System.Runtime.Serialization
Imports System.IO
Imports System.Reflection
Imports System.Runtime.Serialization.Formatters.Binary
Namespace Extensiones
Public Module EntityExtensions
''' <summary>
''' Extension method to Enitity Object.
''' Deeply clone the Object.
''' </summary>
''' <param name="source">Entity Object need to be cloned </param>
''' <returns>The cloned object</returns>
<Extension()>
Public Function Clone(Of T As EntityObject)(ByVal source As T) As T
Dim ser As New DataContractSerializer(GetType(T))
Using stream As MemoryStream = New MemoryStream
ser.WriteObject(stream, source)
stream.Seek(0, SeekOrigin.Begin)
Return DirectCast(ser.ReadObject(stream), T)
End Using
End Function
<Extension()>
Public Function ClearEntityObject(Of T As Class)(ByVal source As T, ByVal bCheckHierarchy As Boolean) As T
If (source Is Nothing) Then
Throw New Exception("Null Object cannot be cloned")
End If
Dim tObj As Type = source.GetType
If (Not tObj.GetProperty("EntityKey") Is Nothing) Then
tObj.GetProperty("EntityKey").SetValue(source, Nothing, Nothing)
End If
If bCheckHierarchy Then
Dim PropertyList As List(Of PropertyInfo) = Enumerable.ToList(Of PropertyInfo)((From a In source.GetType.GetProperties
Where a.PropertyType.Name.Equals("ENTITYCOLLECTION`1", StringComparison.OrdinalIgnoreCase)
Select a))
Dim prop As PropertyInfo
For Each prop In PropertyList
Dim keys As IEnumerable = DirectCast(tObj.GetProperty(prop.Name).GetValue(source, Nothing), IEnumerable)
Dim key As Object
For Each key In keys
'Dim kk = ((From a In key.GetType.GetProperties
'Where (a.PropertyType.Name.Equals("EntityReference`1", StringComparison.OrdinalIgnoreCase))
' Select a))
'Dim ochildprop = (From a In key.[GetType]().GetProperties() Where a.PropertyType.Name = "EntityReference`1").SingleOrDefault()
Dim childProp As EntityReference = Enumerable.FirstOrDefault(Of PropertyInfo)((From a In key.GetType.GetProperties
Where (a.PropertyType.Name.Equals("EntityReference`1", StringComparison.OrdinalIgnoreCase))
Select a)).GetValue(key, Nothing)
ClearEntityObject(childProp, False)
ClearEntityObject(key, True)
Next
Next
End If
Return source
End Function
''' <summary>
''' Clear the entity of object and all related child objects
''' </summary>
''' <param name="source">Entity Object need to be cleared</param>
''' <param name="bcheckHierarchy">This parameter is used to determine whether to clear all the child object</param>
''' <returns></returns>
<Extension()>
Public Function ClearEntityReference(ByVal source As EntityObject, ByVal bCheckHierarchy As Boolean) As EntityObject
Return ClearEntityObject(source, bCheckHierarchy)
End Function
<Extension>
Public Function LoadAllChild(source As EntityObject) As EntityObject
Dim PropList As List(Of PropertyInfo) = (From a In source.[GetType]().GetProperties() Where a.PropertyType.Name = "EntityCollection`1").ToList()
For Each prop As PropertyInfo In PropList
Dim instance As Object = prop.GetValue(source, Nothing)
Dim isLoad As Boolean = CBool(instance.[GetType]().GetProperty("IsLoaded").GetValue(instance, Nothing))
If Not isLoad Then
Dim mi As MethodInfo = (From a In instance.[GetType]().GetMethods() Where a.Name = "Load" AndAlso a.GetParameters().Length = 0).FirstOrDefault()
mi.Invoke(instance, Nothing)
End If
Next
Return DirectCast(source, EntityObject)
End Function
<Extension>
Public Function DeepClone(Of T As EntityObject)(ByVal source As T) As T
Using ms = New MemoryStream()
Dim formatter = New BinaryFormatter()
formatter.Serialize(ms, source)
ms.Position = 0
Return DirectCast(formatter.Deserialize(ms), T)
End Using
End Function
'<Extension>
'Public Function ToDataTable(Of T As Class)(ByVal Lista As List(Of T)) As DataTable
' Dim dt As New DataTable(GetType(T).Name)
' Dim props = GetType(T).GetProperties(BindingFlags.Public Or BindingFlags.Instance)
' For Each p In props
' Next
'End Function
<Extension()>
Public Function ObtieneContexto(entity As Objects.DataClasses.EntityObject) As Objects.ObjectContext
Dim relationshipManager = DirectCast(entity, Objects.DataClasses.IEntityWithRelationships).RelationshipManager
Dim wrappedOwnerProperty = relationshipManager.GetType.GetProperty("WrappedOwner", Reflection.BindingFlags.Instance Or BindingFlags.NonPublic)
Return wrappedOwnerProperty.GetValue(relationshipManager).Context
End Function
End Module
End Namespace

155
Extensiones/IEnumerable.vb Normal file
View File

@@ -0,0 +1,155 @@
Imports System.Runtime.CompilerServices
Imports System.Data.Objects.DataClasses
Imports System.Runtime.Serialization
Imports System.IO
Imports System.Reflection
Imports System.Runtime.Serialization.Formatters.Binary
Namespace Extensiones
Public Module IEnumerableExtensions
<Extension()>
Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T)) As DataTable
Return New ObjectShredder(Of T)().Shred(source, Nothing, Nothing)
End Function
<Extension()>
Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
Return New ObjectShredder(Of T)().Shred(source, table, options)
End Function
End Module
End Namespace
Public Class ObjectShredder(Of T)
Private _fi As FieldInfo()
Private _pi As PropertyInfo()
Private _ordinalMap As Dictionary(Of String, Integer)
Private _type As Type
Public Sub New()
_type = GetType(T)
_fi = _type.GetFields()
_pi = _type.GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") Or x.PropertyType.Name.Contains("EntityCollection") Or x.PropertyType.Name.Contains("EntityState") Or x.PropertyType.Name.Contains("EntityKey") Or x.PropertyType.BaseType.Name = "EntityObject")).ToArray
_ordinalMap = New Dictionary(Of String, Integer)()
End Sub
Public Function Shred(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
If GetType(T).IsPrimitive Then
Return ShredPrimitive(source, table, options)
End If
If table Is Nothing Then
table = New DataTable(GetType(T).Name)
End If
table = ExtendTable(table, GetType(T))
table.BeginLoadData()
Using e As IEnumerator(Of T) = source.GetEnumerator()
While e.MoveNext()
If options IsNot Nothing Then
table.LoadDataRow(ShredObject(table, e.Current), CType(options, LoadOption))
Else
table.LoadDataRow(ShredObject(table, e.Current), True)
End If
End While
End Using
table.EndLoadData()
Return table
End Function
Public Function ShredPrimitive(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
If table Is Nothing Then
table = New DataTable(GetType(T).Name)
End If
If Not table.Columns.Contains("Value") Then
table.Columns.Add("Value", GetType(T))
End If
table.BeginLoadData()
Using e As IEnumerator(Of T) = source.GetEnumerator()
Dim values As Object() = New Object(table.Columns.Count - 1) {}
While e.MoveNext()
values(table.Columns("Value").Ordinal) = e.Current
If options IsNot Nothing Then
table.LoadDataRow(values, CType(options, LoadOption))
Else
table.LoadDataRow(values, True)
End If
End While
End Using
table.EndLoadData()
Return table
End Function
Public Function ExtendTable(ByVal table As DataTable, ByVal type As Type) As DataTable
For Each f As FieldInfo In type.GetFields()
If Not _ordinalMap.ContainsKey(f.Name) Then
Dim dc As DataColumn = If(table.Columns.Contains(f.Name), table.Columns(f.Name), table.Columns.Add(f.Name, f.FieldType))
_ordinalMap.Add(f.Name, dc.Ordinal)
End If
Next
Dim Propiedades = type.GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") Or x.PropertyType.Name.Contains("EntityCollection") Or x.PropertyType.Name.Contains("EntityState") Or x.PropertyType.Name.Contains("EntityKey") Or x.PropertyType.BaseType.Name = "EntityObject"))
For Each p As PropertyInfo In Propiedades
If Not _ordinalMap.ContainsKey(p.Name) Then
Try
Dim propiedad = p.PropertyType
If propiedad Is GetType(Integer?) Then
propiedad = GetType(Integer)
ElseIf propiedad Is GetType(Double?) Then
propiedad = GetType(Double)
ElseIf propiedad Is GetType(Long?) Then
propiedad = GetType(Long)
ElseIf propiedad Is GetType(DateTime?) Then
propiedad = GetType(DateTime)
ElseIf propiedad Is GetType(Date?) Then
propiedad = GetType(Date)
ElseIf propiedad Is GetType(Boolean?) Then
propiedad = GetType(Boolean)
End If
Dim dc As DataColumn = If(table.Columns.Contains(p.Name), table.Columns(p.Name), table.Columns.Add(p.Name, propiedad))
_ordinalMap.Add(p.Name, dc.Ordinal)
Catch ex As Exception
Debug.Write(ex.Message)
End Try
End If
Next
Return table
End Function
Public Function ShredObject(ByVal table As DataTable, ByVal instance As T) As Object()
Dim fi As FieldInfo() = _fi
Dim pi As PropertyInfo() = _pi
If instance.[GetType]() <> GetType(T) Then
ExtendTable(table, instance.[GetType]())
fi = instance.[GetType]().GetFields()
pi = instance.[GetType]().GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") Or x.PropertyType.Name.Contains("EntityCollection") Or x.PropertyType.Name.Contains("EntityState") Or x.PropertyType.Name.Contains("EntityKey") Or x.PropertyType.BaseType.Name = "EntityObject")).ToArray
End If
Dim values As Object() = New Object(table.Columns.Count - 1) {}
For Each f As FieldInfo In fi
values(_ordinalMap(f.Name)) = f.GetValue(instance)
Next
For Each p As PropertyInfo In pi
values(_ordinalMap(p.Name)) = p.GetValue(instance, Nothing)
Next
Return values
End Function
End Class

16
Extensiones/IntegerExtensions.vb Normal file
View File

@@ -0,0 +1,16 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module IntegerExtensions
<Extension()> Function APalabras(Numero As Integer) As String
Return NumerosAPalabras.ToCardinal(Numero)
End Function
<Extension()> Function EntreValores(Valor As Integer, RangoMenor As Integer, RangoMayor As Integer) As Boolean
Return Valor >= RangoMenor And Valor <= RangoMayor
End Function
<Extension()> Function NothingA0(Valor As Integer?) As Integer
Return If(Valor.HasValue, Valor, 0)
End Function
End Module
End Namespace

27
Extensiones/LoggerExtensions.vb Normal file
View File

@@ -0,0 +1,27 @@
Imports System.Runtime.CompilerServices
Imports Microsoft.Extensions.Logging
Public Module LoggerExtensions
'// Ejemplo de uso de la extensión LogVariable():
'//
'// ' Registrar información de una variable
'// Dim peassoVariable As String = "Hello, World!"
'// logger.LogVariable("peassoVariable", peassoVariable, LogLevel.Debug)
<Extension()>
Public Sub LogVariable(ByVal logger As ILogger, variableName As String, variableValue As Object, logLevel As LogLevel)
Try
If logger Is Nothing Then Throw New ArgumentNullException(NameOf(logger))
If variableName Is Nothing Then Throw New ArgumentNullException(NameOf(variableName))
Dim variableType As String = If(variableValue IsNot Nothing, variableValue.GetType().FullName, "Null")
Dim variableContent As String = If(variableValue IsNot Nothing, variableValue.ToString(), "Null")
Dim message As String = $"Variable Name: {variableName}, Type: {variableType}, Value: {variableContent}"
logger.Log(logLevel, New EventId(), message, exception:=Nothing, Function(s, e) s.ToString())
Catch ex As Exception
Debug.WriteLine($"Excepción en LoggerExtensions.LogVariable: {ex}")
End Try
End Sub
End Module

16
Extensiones/NameValueCollection.vb Normal file
View File

@@ -0,0 +1,16 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module NameValueCollection
<Extension()>
Public Function ToPairs(collection As Specialized.NameValueCollection) As IEnumerable(Of KeyValuePair(Of String, String))
If collection Is Nothing Then
Throw New ArgumentNullException("collection")
End If
Return collection.Cast(Of String)().[Select](Function(key) New KeyValuePair(Of String, String)(key, collection(key)))
End Function
End Module
End Namespace

14
Extensiones/ObjetExtensions.vb Normal file
View File

@@ -0,0 +1,14 @@
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Namespace Extensiones
Public Module ObjetExtensions
<Extension>
Public Function ObjetoNothingAVacio(ByVal Cadena As Object) As String
If Cadena Is Nothing Then
Return ""
Else
Return Cadena.ToString
End If
End Function
End Module
End Namespace

65
Extensiones/SerializableDictionary.vb Normal file
View File

@@ -0,0 +1,65 @@
Imports System.Collections.Generic
Imports System.Text
Imports System.Xml.Serialization
Namespace Extensiones
<XmlRoot("dictionary")> _
Public Class SerializableDictionary(Of TKey, TValue)
Inherits Dictionary(Of TKey, TValue)
Implements IXmlSerializable
#Region "IXmlSerializable Members"
Public Function GetSchema() As System.Xml.Schema.XmlSchema Implements IXmlSerializable.GetSchema
Return Nothing
End Function
Public Sub ReadXml(reader As System.Xml.XmlReader) Implements IXmlSerializable.ReadXml
Dim keySerializer As New XmlSerializer(GetType(TKey))
Dim valueSerializer As New XmlSerializer(GetType(TValue))
Dim wasEmpty As Boolean = reader.IsEmptyElement
reader.Read()
If wasEmpty Then
Return
End If
While reader.NodeType <> System.Xml.XmlNodeType.EndElement
reader.ReadStartElement("item")
reader.ReadStartElement("key")
Dim key As TKey = DirectCast(keySerializer.Deserialize(reader), TKey)
reader.ReadEndElement()
reader.ReadStartElement("value")
Dim value As TValue = DirectCast(valueSerializer.Deserialize(reader), TValue)
reader.ReadEndElement()
Me.Add(key, value)
reader.ReadEndElement()
reader.MoveToContent()
End While
reader.ReadEndElement()
End Sub
Public Sub WriteXml(writer As System.Xml.XmlWriter) Implements IXmlSerializable.WriteXml
Dim keySerializer As New XmlSerializer(GetType(TKey))
Dim valueSerializer As New XmlSerializer(GetType(TValue))
For Each key As TKey In Me.Keys
writer.WriteStartElement("item")
writer.WriteStartElement("key")
keySerializer.Serialize(writer, key)
writer.WriteEndElement()
writer.WriteStartElement("value")
Dim value As TValue = Me(key)
valueSerializer.Serialize(writer, value)
writer.WriteEndElement()
writer.WriteEndElement()
Next
End Sub
#End Region
End Class
End Namespace

711
Extensiones/StringExtensions.vb Normal file
View File

@@ -0,0 +1,711 @@
Option Strict Off
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Imports System.Text.RegularExpressions
Imports tsl5.ValidarDocumentoIdentidad
Imports System.Globalization
Imports System.Text
Namespace codificacion
Public Class Caracteres
Public Shared juegos()() As Char = New Char()() {"ñѺªçÇáéíóúÁÉÍÓÚàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛäëïöüÄËÏÖÜ¡", "·¶úùµ´ÄÅÕÆÇàÜåçíÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ¸", "·¶úùµ´aeiouAEIOUÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ¸"}
Public Enum JuegoCaracteres
WINDOWS = 0
ROMAN8 = 1
ROMAN8_SIN_ACENTOS = 2
End Enum
End Class
End Namespace
Namespace Extensiones
Public Module StringExtensions
<Extension()>
Public Function EsDNIValido(ByVal DNI As String) As Boolean
Try
Dim v As New ValidarDocumentoIdentidad(DNI)
Return v.EsCorrecto
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsCIFValido(ByVal DNI As String) As Boolean
Try
Return validateCif(DNI)
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function TipoDocumentoIdentidad(ByVal DNI As String) As TiposDocumentosEnum
Try
Dim v As New ValidarDocumentoIdentidad(DNI)
If v.EsCorrecto = False Then Throw New Exception("No es un documento de identidad correcto")
Return v.TipoDocumento
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
<Extension()>
Public Function EsEmailValido(ByVal email As String) As Boolean
Try
email = email.NothingAVacio.Trim.ToLower
If email.NothingAVacio = "" Then
Return False
Else
Dim addr = New System.Net.Mail.MailAddress(email)
Return addr.Address = email
End If
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsListaEmailsValida(ByVal Listaemail As String) As Boolean
Try
If Listaemail.NothingAVacio = "" Then
Return False
Else
Dim emails = Listaemail.Split(";")
For Each email In emails
email = email.NothingAVacio.Trim.ToLower
If email <> "" Then
Dim addr = New System.Net.Mail.MailAddress(email)
If addr.Address <> email Then
Throw New Exception("Email incorrecto")
End If
End If
Next
Return True
End If
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsNumeroTelefonoMovilEspañolValido(ByVal Telefono As String) As Boolean
Telefono = Telefono.NothingAVacio.Trim
Dim Valido As Boolean = True
If Telefono.Length = 9 Then
If Not (Telefono.StartsWith("6") Or Telefono.StartsWith("7")) Then
Valido = False
End If
ElseIf Telefono.Length = 11 Then
If Not Telefono.StartsWith("34") Then
Valido = False
End If
ElseIf Telefono.Length = 12 Then
If Not Telefono.StartsWith("+34") Then
Valido = False
End If
Else
Valido = False
End If
If Valido Then
For i = 1 To Telefono.Length - 1
If Not "1234567890".Contains(Telefono.Substring(i, 1)) Then
Valido = False
Exit For
End If
Next
End If
Return Valido
End Function
<Extension()>
Public Function EsNumeroTelefonoEspañolValido(ByVal Telefono As String) As Boolean
Telefono = Telefono.NothingAVacio.Trim
Dim Valido As Boolean = True
If Telefono.Length = 9 Then
If Not (Telefono.StartsWith("6") Or Telefono.StartsWith("7") Or Telefono.StartsWith("8") Or Telefono.StartsWith("9")) Then
Valido = False
End If
ElseIf Telefono.Length = 11 Then
If Not Telefono.StartsWith("34") Then
Valido = False
End If
ElseIf Telefono.Length = 12 Then
If Not Telefono.StartsWith("+34") Then
Valido = False
End If
Else
Valido = False
End If
If Valido Then
For i = 1 To Telefono.Length - 1
If Not "1234567890".Contains(Telefono.Substring(i, 1)) Then
Valido = False
Exit For
End If
Next
End If
Return Valido
End Function
<Extension()>
Public Function HoraDecimalASexagesimal(ByVal Cadena As String) As String
If Cadena.Contains(".") Then
Dim ParteDecimal = CInt(Cadena.Split(".")(1).PadRight(2, "0").Substring(0, 2))
Dim Minutos = Math.Min(59, Math.Round(ParteDecimal * 60 / 100, 0, MidpointRounding.AwayFromZero))
Return Cadena.Split(".")(0).PadLeft(2, "0") & ":" & Minutos.ToString.PadLeft(2, "0")
Else
Return Cadena.PadLeft(2, "0") & ":00"
End If
End Function
<Extension()>
Public Function HoraStringATimeSpan(ByVal Cadena As String) As TimeSpan
Dim TS As TimeSpan
If Cadena = "00:00" Then
TS = New TimeSpan(0)
Else
Dim HoraEntera As String = Cadena
If Cadena.StartsWith("-") Then HoraEntera = Cadena.Substring(1)
If HoraEntera.Split(":").Length = 3 Then
TS = New TimeSpan(CInt(HoraEntera.Split(":")(0)), CInt(HoraEntera.Split(":")(1)), CInt(HoraEntera.Split(":")(2)))
Else
TS = New TimeSpan(CInt(HoraEntera.Split(":")(0)), CInt(HoraEntera.Split(":")(1)), 0)
End If
If Cadena.StartsWith("-") Then
TS = -TS
End If
End If
Return TS
End Function
<Extension()>
Public Function ATimeSpan(ByVal Cadena As String) As TimeSpan
Dim TS As TimeSpan
If Cadena = "0" Then
TS = New TimeSpan(0)
Else
Dim HoraEntera As String = Cadena
If Cadena.StartsWith("-") Then HoraEntera = Cadena.Substring(1)
If HoraEntera.Contains(".") Then
TS = New TimeSpan(CInt(HoraEntera.Split(".")(0)), (Double.Parse("0." & HoraEntera.Split(".")(1), Globalization.CultureInfo.InvariantCulture) * 60), 0)
Else
TS = New TimeSpan(CInt(HoraEntera.Split(".")(0)), 0, 0)
End If
If Cadena.StartsWith("-") Then
TS = -TS
End If
End If
Return TS
End Function
<Extension()>
Public Function NothingAVacio(ByVal Cadena As String) As String
If Cadena Is Nothing OrElse Cadena Is DBNull.Value Then
Return ""
Else
Return Cadena
End If
End Function
<Extension()>
Public Sub ImprimirEnConsola(ByVal aString As String)
Console.WriteLine(aString)
End Sub
<Extension()>
Public Sub ImprimirEnConsolaDeDepuracion(ByVal aString As String)
System.Diagnostics.Debug.WriteLine(aString)
End Sub
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena.</remarks>
<Extension()>
Public Function AcortarPorLaIzquierda(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(aString.Length - longitud, longitud).TrimEnd
Else
resultado = aString
End If
Return resultado
End If
End Function
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena.</remarks>
<Extension()>
Public Function Acortar(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud).TrimEnd
Else
resultado = aString
End If
Return resultado
End If
End Function
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena.</remarks>
<Extension()>
Public Function AcortarNombreFichero(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
Dim extension = IO.Path.GetExtension(aString)
Dim filename = IO.Path.GetFileNameWithoutExtension(aString)
longitud = longitud - extension.Length
resultado = aString.Substring(filename, longitud).TrimEnd & extension
Else
resultado = aString
End If
Return resultado
End If
End Function
<Extension()>
Public Function LongitudFija(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud)
Else
resultado = aString.PadRight(longitud, " ")
End If
Return resultado
End If
End Function
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada. Nunca lanza excepciones, aunque no exista el objeto.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena. Nunca lanza excepciones, aunque no exista el objeto.</remarks>
<Extension()>
Public Function AcortarSinExcepciones(ByVal aString As String, ByVal longitud As Integer) As String
Dim resultado As String
Try
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud).TrimEnd
Else
resultado = aString
End If
Catch ex As Exception
resultado = ""
End Try
Return resultado
End Function
''' <summary>
''' Recorta por el final de la cadena el número de caracteres especificado en "longitud".
''' </summary>
''' <param name="aString">La cadena a manipular.</param>
''' <param name="longitud">El número de caracteres que se desea recortar al final de la cadena.</param>
''' <returns>La cadena original pero con "longitud" caracteres menos al final.</returns>
''' <remarks>Nunca lanza excepciones. Si la cadena es más corta que el número de caracteres que se desea recortar, se devuelve cadena vacía.</remarks>
''' <example>Si "aString" vale "patata" y "longitud" vale "2", el resultado es "pata".</example>
<Extension()>
Public Function RecortarPorElFinal(ByVal aString As String, ByVal longitud As Integer) As String
Dim resultado As String = ""
If aString IsNot Nothing AndAlso aString.Length > longitud Then
resultado = aString.Substring(0, aString.Length - longitud)
End If
Return resultado
End Function
<Extension()>
Public Function ToMySql(d As Date) As String
Return d.ToString("yyyy-MM-dd HH:mm:ss")
End Function
<Extension()>
Public Function ConvierteDeWindowsARoman8(ByVal CadenaAconvertir As String) As String
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.WINDOWS, codificacion.Caracteres.JuegoCaracteres.ROMAN8)
End Function
<Extension()>
Public Function ConvierteDeWindowsARoman8SinAcentos(ByVal CadenaAconvertir As String) As String
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.WINDOWS, codificacion.Caracteres.JuegoCaracteres.ROMAN8_SIN_ACENTOS)
End Function
<Extension()>
Public Function ConvierteDeRoman8AWindows(ByVal CadenaAconvertir As String) As String
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.ROMAN8, codificacion.Caracteres.JuegoCaracteres.WINDOWS)
End Function
<Extension()>
Public Function ConvierteAAlfanumerico(ByVal StringOrigen As String, Optional cOrigen As String = "ÁÉÍÓÚÜáéíóúü", Optional cDestino As String = "AEIOUUaeiouu", Optional cPermitidos As String = "ABCDEFGHIJKLMNÑOPQRSTUVWXYZabcdefghijklmnñopqrstuvwxyz0123456789,.") As String
Try
Dim iNumChar As Integer, i
iNumChar = StringOrigen.Length - 1
Dim idx As Integer
Dim sDestino As String = ""
For i = 0 To iNumChar
'If cPermitidos.Contains(StringOrigen.Substring(i, 1)) Then
' sDestino &= StringOrigen.Substring(i, 1)
'Else
' If cOrigen.Contains(StringOrigen.Substring(i, 1)) Then
' idx = cOrigen.IndexOf(StringOrigen.Substring(i, 1))
' sDestino &= cDestino.Substring(idx, 1)
' Else
' sDestino &= " "
' End If
'End If
If cOrigen.Contains(StringOrigen.Substring(i, 1)) Then
idx = cOrigen.IndexOf(StringOrigen.Substring(i, 1))
sDestino &= cDestino.Substring(idx, 1)
Else
If cPermitidos.Contains(StringOrigen.Substring(i, 1)) Then
sDestino &= StringOrigen.Substring(i, 1)
Else
sDestino &= " "
End If
End If
Next
Return sDestino
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
Public Function ConvierteStrings(ByVal StringOrigen As String, ByVal jcOrigen As codificacion.Caracteres.JuegoCaracteres, ByVal jcDestino As codificacion.Caracteres.JuegoCaracteres) As String
Try
Dim iNumChar As Integer, i, pos As Integer
Dim cAux(), cOrigen(), cDestino() As Char
cOrigen = codificacion.Caracteres.juegos(jcOrigen)
cDestino = codificacion.Caracteres.juegos(jcDestino)
iNumChar = cOrigen.Length
cAux = StringOrigen
For i = 0 To iNumChar - 1
pos = 0
Do
pos = InStr(pos + 1, StringOrigen, cOrigen(i), CompareMethod.Binary)
If pos > 0 Then
cAux(pos - 1) = cDestino(i)
End If
Loop Until pos = 0
Next
ConvierteStrings = cAux
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
<Extension()>
Public Function FechaHoraStringADateTime(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateTime?
Try
If Fecha = "0" OrElse Fecha = "" Then
Return Nothing
Else
If Fecha.Length > 16 AndAlso Fecha.Substring(11, 1) = "/" Then
Dim f As Date = FechaStringADate(Fecha.Substring(0, 11), True)
Dim sHora = Fecha.Substring(12).Split(":")
Dim Hora As Integer = CInt(sHora(0))
Dim Minutos As Integer = CInt(sHora(1))
Dim Segundos As Integer = 0
If sHora.Length > 2 Then
Segundos = CInt(sHora(2))
End If
Return New DateTime(f.Year, f.Month, f.Day, Hora, Minutos, Segundos)
Else
If Fecha.Length = 16 AndAlso Fecha.Substring(10, 1) = "T" Then ' yyyy-MM-ddTHH:mm
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(5, 2)), CInt(Fecha.Substring(8, 2)), CInt(Fecha.Substring(11, 2)), CInt(Fecha.Substring(14, 2)), 0)
Else
If Fecha.Contains(".") Then
Dim HoraMinutos = CInt(Fecha.Split(".")(1).Acortar(4).PadRight(4, "0"))
Dim Minuto = (HoraMinutos Mod 100) / 100 * 60
Dim Hora = Math.Truncate(HoraMinutos / 100)
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), Hora, Minuto, 0)
Else
If Fecha.Length = 19 Then
Return Date.Parse(Fecha)
ElseIf Fecha.Length = 14 Then
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), CInt(Fecha.Substring(8, 2)), CInt(Fecha.Substring(10, 2)), CInt(Fecha.Substring(12, 2)))
ElseIf Fecha.Length = 12 Then
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), CInt(Fecha.Substring(8, 2)), CInt(Fecha.Substring(10, 2)), 0)
ElseIf Fecha.Length = 11 Then
Return FechaStringADate(Fecha, True)
Else
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), 0, 0, 0)
End If
End If
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw New Exception(ex.Message, ex)
End If
End Try
End Function
<Extension()>
Public Function FechaStringADate(Fecha As String, Optional NuloSiInvalido As Boolean = True) As Date?
Try
Fecha = Fecha.Trim
If Fecha = "0" Or Fecha = "" Then
Return Nothing
Else
Dim cSeparador As String = ""
If Fecha.Contains("de") Then
Fecha = Fecha.Replace(" de ", "-")
End If
If Fecha.Contains("-") Then cSeparador = "-"
If Fecha.Contains("/") Then cSeparador = "/"
If Fecha.Contains(".") Then
If Fecha.Split(".")(0).Length >= 8 Then
Fecha = Fecha.Split(".")(0)
Else
If cSeparador = "" Then cSeparador = "."
End If
End If
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") Or Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") Or Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") Or Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") Or Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") Or Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") Or Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") Or Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") Or Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") Or Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") Or Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") Or Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") Or Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New Date(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
'Throw New Exception("formato de fecha no soportado")
Else
Dim mFecha() As String
mFecha = Fecha.Split(cSeparador)
If mFecha(0).Length >= 4 Then
Dim año As Integer = Integer.Parse(mFecha(0).Replace(".", "").Acortar(4))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New Date(año, iMes, Integer.Parse(mFecha(2)))
Else
Return New Date(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(2)))
End If
Else
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", "").Acortar(4))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New Date(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New Date(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
End If
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw New Exception(ex.Message, ex)
End If
End Try
End Function
<Extension()>
Public Function FechaHoraAstring(FechaHora As DateTime) As String
Return FechaHora.Year.ToString & FechaHora.Month.ToString.PadLeft(2, "0") & FechaHora.Day.ToString.PadLeft(2, "0") & FechaHora.Hour.ToString.PadLeft(2, "0") & FechaHora.Minute.ToString.PadLeft(2, "0") & FechaHora.Second.ToString.PadLeft(2, "0")
End Function
''' <summary>
''' Compute LevenshteinDistance.
''' </summary>
<Extension()>
Public Function LevenshteinDistance(ByVal s As String, ByVal t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim d(n + 1, m + 1) As Integer
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
Dim i As Integer
Dim j As Integer
For i = 0 To n
d(i, 0) = i
Next
For j = 0 To m
d(0, j) = j
Next
For i = 1 To n
For j = 1 To m
Dim cost As Integer
If t(j - 1) = s(i - 1) Then
cost = 0
Else
cost = 1
End If
d(i, j) = Math.Min(Math.Min(d(i - 1, j) + 1, d(i, j - 1) + 1),
d(i - 1, j - 1) + cost)
Next
Next
Return d(n, m)
End Function
<Extension()>
Public Function EliminarComillasTipograficas(s As String) As String
If Not String.IsNullOrEmpty(s) Then
Return s.Replace("‘"c, "'"c).Replace("’"c, "'"c).Replace(ChrW(&H201C), """"c).Replace(ChrW(&H201D), """"c)
Else
Return s
End If
End Function
<Extension()>
Public Function PrimeraLetraMayusculas(s As String) As String
If s <> "" Then
Return s.First().ToString().ToUpper() + [String].Join("", s.Skip(1)).ToLower
Else
Return ""
End If
End Function
<Extension()>
Public Function PrimeraLetraFraseMayusculas(s As String) As String
If s.Trim <> "" Then
Dim spalabras = s.Split(" ")
Dim sResultado As String = ""
For Each p In spalabras
sResultado &= " " & p.PrimeraLetraMayusculas
Next
Return sResultado.Substring(1)
Else
Return ""
End If
End Function
<Extension()>
Public Function PrimeraLetraFraseMayusculasSinArticulos(s As String) As String
If s.Trim <> "" Then
Dim spalabras = s.Split(" ")
Dim sResultado As String = ""
For Each p In spalabras
sResultado &= " " & p.PrimeraLetraMayusculas
Next
sResultado = sResultado.Substring(1)
sResultado = sResultado.Replace(" El ", " el ").Replace(" Y ", " y ").Replace(" Lo ", " lo ").Replace(" La ", " la ").Replace(" DeL ", " del ").Replace(" De ", " de ").Replace(" Los ", " los ").Replace(" Las ", " las ")
Return sResultado
Else
Return ""
End If
End Function
Public Function EliminaPalabrasComunes(palabras As List(Of String)) As List(Of String)
Dim PalabrasAEliminar As String()
PalabrasAEliminar = {"a", "ante", "bajo", "cabe", "con", "contra", "de", "desde", "durante", "en", "entre", "hacia", "hasta", "mediante", "para", "por", "segun", "sin", "so", "sobre", "tras", "versus", "", "via", "el", "la", "lo", "los", "las", "un", "una", "uno", "unos", "al", "del", "que", "ya"}
Return palabras.Except(PalabrasAEliminar).ToList
End Function
'<Extension()>
'Public Function ReemplazarAcentos(value As String) As String
' If (String.IsNullOrEmpty(value)) Then Return String.Empty
' Dim caracteresNoPermitidos As String = "áéíóúàèìòùÁÉÍÓÚÀÈÌÒÙäÄëËïÏöÖüÜ"
' ' NO ELIMINAR LOS CARACTERES REPETIDOS, Y RESPETAR EL ORDEN
' ' EN EL QUE SE ENCUENTRAN DEFINIDOS. Si se añaden más caracteres
' ' no permitidos, añadir en la misma posición su correspondiente
' ' carácter permmitido.
' '
' Dim caracteresPermitidos As String = "aeiouaeiouAEIOUAEIOUaAeEiIoOuU"
' Dim chars As Char() = caracteresNoPermitidos.ToCharArray()
' Dim buffer As New System.Text.StringBuilder(256)
' buffer.Append(value)
' For Each letra As Char In value
' ' NOTA: para utilizar el método Contains hay que
' ' importar el espacio de nombres System.Linq, lo que
' ' significa utilizar .NET 3.5 o superior.
' '
' If (chars.Contains(letra)) Then
' Dim index As Int32 = caracteresNoPermitidos.IndexOf(letra)
' buffer.Replace(letra, caracteresPermitidos(index))
' End If
' Next
' Return buffer.ToString()
'End Function
<Extension()>
Public Function SoloLetrasYNumeros(cadena As String) As String
Dim pattern As String = "[^a-zA-Z0-9ñÑ ]"
Return Regex.Replace(cadena, pattern, String.Empty)
End Function
<Extension()>
Public Function ReemplazarAcentos(value As String) As String
Dim toReplace() As Char = "àèìòùÀÈÌÒÙ äëïöüÄËÏÖÜ âêîôûÂÊÎÔÛ áéíóúÁÉÍÓÚðÐýÝ ãõÃÕšŠžŽçÇåÅøØ".ToCharArray
Dim replaceChars() As Char = "aeiouAEIOU aeiouAEIOU aeiouAEIOU aeiouAEIOUdDyY aoAOsSzZcCaAoO".ToCharArray
For index As Integer = 0 To toReplace.GetUpperBound(0)
value = value.Replace(toReplace(index), replaceChars(index))
Next
Return value
End Function
<Extension()>
Public Function RemoveDiacritics(ByVal text As String) As String
If text IsNot Nothing Then
Dim normalizedString = text.Normalize(NormalizationForm.FormD)
Dim stringBuilder = New StringBuilder(capacity:=normalizedString.Length)
For i As Integer = 0 To normalizedString.Length - 1
Dim c As Char = normalizedString(i)
Dim unicodeCategory = CharUnicodeInfo.GetUnicodeCategory(c)
If unicodeCategory <> UnicodeCategory.NonSpacingMark Then
stringBuilder.Append(c)
End If
Next
Return stringBuilder.ToString().Normalize(NormalizationForm.FormC)
Else
Return ""
End If
End Function
End Module
End Namespace

20
Extensiones/TimeSpanExtensions.vb Normal file
View File

@@ -0,0 +1,20 @@
Option Strict Off
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Namespace Extensiones
Public Module TimeSpanExtensions
<Extension()>
Public Function TimeSpanAHoraString(ByVal ts As TimeSpan?) As String
If ts.HasValue AndAlso ts.Value.Ticks <> 0 Then
If ts.Value.TotalMinutes < 0 Then
Return "-" & Fix(Math.Abs(ts.Value.TotalHours)).ToString.PadLeft(2, "0") & ":" & Math.Abs(CInt(ts.Value.Minutes)).ToString.PadLeft(2, "0")
Else
Return Fix(Math.Abs(ts.Value.TotalHours)).ToString.PadLeft(2, "0") & ":" & Math.Abs(CInt(ts.Value.Minutes)).ToString.PadLeft(2, "0")
End If
Else
Return "00:00"
End If
End Function
End Module
End Namespace

184
Ficheros.vb Normal file
View File

@@ -0,0 +1,184 @@
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Xml
Public Class Ficheros
Public Shared Function FicheroAArrayBytes(ByVal RutaFichero As String) As Byte()
Return IO.File.ReadAllBytes(RutaFichero)
'FicheroAArrayBytes = Nothing
'Try
' Dim fstmp As IO.FileStream, by() As Byte
' fstmp = IO.File.OpenRead(RutaFichero)
' ReDim by(fstmp.Length - 1)
' fstmp.Read(by, 0, fstmp.Length)
' fstmp.Close()
' FicheroAArrayBytes = by
'Catch ex As Exception
' Throw New Exception(ex.Message, ex)
'End Try
End Function
Public Shared Function FicheroAString(ByVal RutaFichero As String) As String
Dim s As String
Dim tr As IO.TextReader = New IO.StreamReader(RutaFichero)
s = tr.ReadToEnd
Return s
End Function
Public Shared Sub ByteArrayAFichero(Datos() As Byte, NombreFichero As String, Optional Sobreescribir As Boolean = False)
If Not IO.Directory.Exists(IO.Path.GetDirectoryName(NombreFichero)) Then Utilidades.CreaEstructuraDirectorio(IO.Path.GetDirectoryName(NombreFichero))
If IO.File.Exists(NombreFichero) And Sobreescribir Then IO.File.Delete(NombreFichero)
Dim oFileStream As System.IO.FileStream
oFileStream = New System.IO.FileStream(NombreFichero, System.IO.FileMode.Create)
oFileStream.Write(Datos, 0, Datos.Length)
oFileStream.Close()
End Sub
Public Shared Sub EliminaCaracteresInvalidosXML(FicheroOrigen As String, FicheroDestino As String)
Dim reader As TextReader = New StreamReader(FicheroOrigen)
Dim writer As TextWriter = New StreamWriter([FicheroDestino])
Dim linea As String = reader.ReadLine
Do Until linea Is Nothing
writer.WriteLine(CleanInvalidXmlChars(linea))
linea = reader.ReadLine
Loop
writer.WriteLine(CleanInvalidXmlChars(reader.ReadToEnd()))
writer.Flush()
reader.Close()
writer.Close()
End Sub
Public Shared Sub EliminaCaracteresInvalidosXML(stOrigen As Stream, stDestino As Stream)
Dim reader As TextReader = New StreamReader(stOrigen)
Dim writer As TextWriter = New StreamWriter(stDestino)
Dim linea As String = reader.ReadLine
Do Until linea Is Nothing
writer.WriteLine(CleanInvalidXmlChars(linea))
linea = reader.ReadLine
Loop
writer.WriteLine(CleanInvalidXmlChars(reader.ReadToEnd()))
writer.Flush()
reader.Close()
' writer.Close()
stDestino.Position = 0
End Sub
Public Shared Function CleanInvalidXmlChars(text As String) As String
Dim re As String = "[^\x09\x0A\x0D\x20-\xD7FF\xE000-\xFFFD\x10000-x10FFFF]"
Return Regex.Replace(text, re, "")
End Function
Public Shared Function IndentaFicheroXML(ByVal FicheroOrigen As String, Codificacion As Text.Encoding) As String
Dim result As String = ""
Dim mStream As MemoryStream = New MemoryStream()
Dim writer As XmlTextWriter = New XmlTextWriter(mStream, Codificacion)
Dim document As XmlDocument = New XmlDocument()
Try
document.Load(FicheroOrigen)
writer.Formatting = Formatting.Indented
document.WriteContentTo(writer)
writer.Flush()
mStream.Flush()
mStream.Position = 0
Dim sReader As StreamReader = New StreamReader(mStream)
Dim formattedXml As String = sReader.ReadToEnd()
result = formattedXml
Catch __unusedXmlException1__ As XmlException
End Try
mStream.Close()
writer.Close()
Return result
End Function
Public Shared Function IndentaXML(ByVal xml As String, Codificacion As Text.Encoding) As String
Dim result As String = ""
Dim mStream As MemoryStream = New MemoryStream()
Dim writer As XmlTextWriter = New XmlTextWriter(mStream, Codificacion)
Dim document As XmlDocument = New XmlDocument()
Try
document.LoadXml(xml)
writer.Formatting = Formatting.Indented
document.WriteContentTo(writer)
writer.Flush()
mStream.Flush()
mStream.Position = 0
Dim sReader As StreamReader = New StreamReader(mStream)
Dim formattedXml As String = sReader.ReadToEnd()
result = formattedXml
Catch __unusedXmlException1__ As XmlException
End Try
mStream.Close()
writer.Close()
Return result
End Function
Public Shared Sub ObtieneFicherosRecursivo(ByVal Ruta As String, ByRef Ficheros() As String, OmitirErrores As Boolean)
Dim sFicheros() As String = IO.Directory.GetFiles(Ruta)
Dim iNumeroFicheros As Integer
If Not IsNothing(Ficheros) Then iNumeroFicheros = Ficheros.Length
ReDim Preserve Ficheros(sFicheros.Length - 1 + iNumeroFicheros)
sFicheros.CopyTo(Ficheros, iNumeroFicheros)
Dim sDirectorio, sDirectorios() As String
Try
sDirectorios = IO.Directory.GetDirectories(Ruta)
For Each sDirectorio In sDirectorios
Try
ObtieneFicherosRecursivo(sDirectorio, Ficheros, OmitirErrores)
Catch ex As Exception
If Not OmitirErrores Then
Throw New Exception(ex.Message, ex)
End If
End Try
Next
Catch ex As Exception
If Not OmitirErrores Then
Throw New Exception(ex.Message, ex)
End If
End Try
End Sub
Public Shared Sub EliminaDirectorio(Directorio As String, OmitirErrores As Boolean)
Dim dirs = IO.Directory.GetDirectories(Directorio)
For Each carpeta In dirs
Try
IO.Directory.Delete(carpeta, True)
Catch ex As Exception
If Not OmitirErrores Then
Throw New Exception(ex.Message, ex)
End If
End Try
Next
Dim sFicheros() As String = Nothing
ObtieneFicherosRecursivo(Directorio, sFicheros, OmitirErrores)
For Each f In sFicheros
Try
IO.File.Delete(f)
Catch ex As Exception
If Not OmitirErrores Then
Throw New Exception(ex.Message, ex)
End If
End Try
Next
End Sub
Public Shared Sub EliminaFicherosTemporales()
Dim tempfolder As String = Path.GetTempPath()
EliminaDirectorio(tempfolder, True)
End Sub
Public Shared Function AcortarNombreArchivo(ByVal nombreArchivo As String, ByVal longitudMaximaIncluyendoExtension As Integer) As String
' Obtén la extensión del archivo
Dim extension As String = System.IO.Path.GetExtension(nombreArchivo)
' Obtén el nombre base del archivo sin la extensión
Dim nombreBase As String = System.IO.Path.GetFileNameWithoutExtension(nombreArchivo)
' Acorta el nombre base si es necesario
If nombreArchivo.Length > longitudMaximaIncluyendoExtension Then
nombreBase = nombreBase.Substring(0, longitudMaximaIncluyendoExtension - extension.Length)
End If
' Combina el nombre base acortado con la extensión
Return nombreBase & extension
End Function
End Class

216
Hacienda/Modelo190.vb Normal file
View File

@@ -0,0 +1,216 @@
Namespace Modelo190
Public Class DatosModelo190
Public Property Declarante As RegistroDeclarante
Public Property Perceptores As List(Of RegistroPerceptor)
End Class
Public Class RegistroDeclarante
Public Property TipoRegistro As String = "1" ' 1
Public Property ModeloDeclaracion As String = "190" ' 2-4
Public Property Ejercicio As String = "" ' 5-8
Public Property NifDeclarante As String = "" ' 9-17
Public Property ApeNombreRsoDeclarante As String = "" '18-57
Public Property TipodeSoporte As String = "T" '58
Public Property PerConQuienRelacionarseTlf As String = "" ' 59-67
Public Property PerConQuienRelacionarseNom As String = "" ' 68-107
Public Property NumIdenDecla As String = "" ' 108-120
Public Property DeclComploSust As String = "" ' 121-122
Public Property NumIdenDeclaAnt As String = "" ' 123-135
Public Property NumTotaldePercepciones As String = "" ' 136-144
Public Property ImpTotPercepcionesSigno As String = "" ' 145
'Public Property ImpTotPercepciones As String = "" ' 146-160 146-158 parte entera 159-160 parte decimal
Public Property ImpTotPercepcionesParEnt As String = "" '146-158
Public Property ImpTotPercepcionesParDec As String = "" '159-160
Public Property ImpTotRetencionesParEnt As String = "" '161-173
Public Property ImpTotRetencionesParDec As String = "" '174-175
'Public Property ImpTotRetenciones As String = "" ' 161-175 161-173 parte entera 174-175 parte decimal
Public Property CorreoElectronicoPerConQuienRelacionarse As String = "" ' 176-225
Public Property Blancos As String = " ".PadRight(262, " ") '226-487
Public Property SelloElectronico As String = " ".PadRight(13, " ") '488-500
End Class
Public Class RegistroPerceptor
Public Property TipoRegistro As String
Public Property ModeloDeclaracion As String = "190"
Public Property Ejercicio As String = "" ' 5-8
Public Property NifDeclarante As String = "" ' 9-17
Public Property NifPerceptor As String = "" ' 18-26
Public Property NifRepresentateLegal As String = "" ' 27-35
Public Property ApeNombreRsoPerceptor As String = "" '36-75
Public Property CodigoProvincial As String = "41" '76-77
Public Property ClavePercepcion As String = "" '78
Public Property SubClave As String = "" '79-80
Public Property PerDineNoIncaLabSigno As String = "" '81
Public Property PerDineNoIncaLabPerint As Double = 0
Public Property PerDineNoIncaLabPerintParEnt As String = "" '82-92
Public Property PerDineNoIncaLabPerintParDec As String = "" '93-94
Public Property PerDineNoIncaLabRetPra As Double = 0
Public Property PerDineNoIncaLabRetPraParEnt As String = "" '95-105
Public Property PerDineNoIncaLabRetPraParDec As String = "" '106-107
Public Property PerEspNoIncaLabSigno As String = "" '108
Public Property PerEspNoIncaLabPerint As Double = 0
Public Property PerEspNoIncaLabPerintParEnt As String = "" '109-119
Public Property PerEspNoIncaLabPerintParDec As String = "" '120-121
Public Property PerEspNoIncaLabRetPra As Double = 0 '122-132
Public Property PerEspNoIncaLabRetPraParEnt As String = "" '122-132
Public Property PerEspNoIncaLabRetPraParDec As String = "" '133-134
Public Property PerEspNoIncaLabRetRep As Double = 0
Public Property PerEspNoIncaLabRetRepParEnt As String = "" '135-145
Public Property PerEspNoIncaLabRetRepParDec As String = "" '146-147
Public Property EjercicioDevengo As String = "0000" '148-151
Public Property CeutaOMelilla As String = "" '152
Public Property AñoNacimiento As String = "" '153-156
Public Property SituacionFamilia As String = "" '157
Public Property NifConyuge As String = "" '158-166
Public Property Discapacidad As String = "" '167
Public Property ContratoRelacion As String = "" '168
Public Property Guion As String = "" '169
Public Property MovilidadGeografica As String = "" '170
Public Property ReduccionesAplicable As String = "" '171-181 parte entera 182-183 parte decimal
Public Property GastosDeducibles As Double = 0
Public Property GastosDeduciblesEnt As String = "" '184-194 parte entera
Public Property GastosDeduciblesDec As String = "" ' 195-196 parte decimal
Public Property PensionCompensatoria As Double = 0
Public Property PensionCompensatoriaEnt As String = "" '197-207 parte entera
Public Property PensionCompensatoriaDec As String = "" '208-209 parte decimal
Public Property AnualidadporAlimentos As Double = 0
Public Property AnualidadporAlimentosEnt As String = "" '210-220 parte entera
Public Property AnualidadporAlimentosDec As String = "" '221-222 parte decimal
Public Property HijosyOtrosDecendientes As String = "" '223-228
Public Property HijosyOtrosDecendientesConDiscapacidad As String = "" '229-240
Public Property Ascendientes As String = "" '241-244
Public Property AscendientesConDiscapacidad As String = "" '245-250
Public Property Com3PrimerosHijos As String = "" '251-253
Public Property ComuPresVivHab As String = "" '254
Public Property PerDineDerIncaLabSigno As String = "" '255
Public Property PerDineIncaLabPerint As Double = 0
Public Property PerDineIncaLabPerintParEnt As String = "" '256-266
Public Property PerDineIncaLabPerintParDec As String = "" '267-268
Public Property PerDineIncaLabRetPra As Double = 0
Public Property PerDineIncaLabRetPraParEnt As String = "" '269-279
Public Property PerDineIncaLabRetPraParDec As String = "" '280-281
Public Property PerEspDerIncaLabSigno As String = "" '282
Public Property PerEspIncaLabPerint As Double = 0
Public Property PerEspIncaLabPerintParEnt As String = "" '283-293
Public Property PerEspIncaLabPerintParDec As String = "" '294-295
Public Property PerEspIncaLabRetPra As Double = 0
Public Property PerEspIncaLabRetPraParEnt As String = "" '296-306
Public Property PerEspIncaLabRetPraParDec As String = "" '307-308
Public Property PerEspIncaLabRetRep As Double = 0
Public Property PerEspIncaLabRetRepParEnt As String = "" '309-319
Public Property PerEspIncaLabRetRepParDec As String = "" '320-321
Public Property PerTitularConvivencia As String = "0" '322
Public Property RetEIngrEstEnDipuForPaisVascoYNavarra As String = "0".PadRight(66, "0") ' 323-387
Public Property TotalPercepcionesIntegras As Double = 0
Public Property TotalRetencionesIntegras As Double = 0
Public Property Blancos As String = " ".PadRight(112, " ") '388-500
End Class
Public Class Utilidades
Public Shared Sub GeneraFichero(Datos As DatosModelo190, Fichero As String)
Try
' Dim fs As New IO.FileStream(Fichero, IO.FileMode.CreateNew)
' Dim sw As New IO.StreamWriter(fs, System.Text.Encoding.GetEncoding("iso-8859-1"))
Dim sw As New IO.StreamWriter(Fichero, False, System.Text.Encoding.GetEncoding("iso-8859-1"))
Dim RegDeclarante As String
RegDeclarante = Datos.Declarante.TipoRegistro.PadLeft(1, " ")
RegDeclarante &= Datos.Declarante.ModeloDeclaracion.PadRight(3, " ")
RegDeclarante &= Datos.Declarante.Ejercicio.PadLeft(4, "0")
RegDeclarante &= Datos.Declarante.NifDeclarante.PadLeft(9, "0")
RegDeclarante &= Datos.Declarante.ApeNombreRsoDeclarante.Replace(",", "").PadRight(40, " ")
RegDeclarante &= Datos.Declarante.TipodeSoporte.PadLeft(1, " ")
RegDeclarante &= Datos.Declarante.PerConQuienRelacionarseTlf.PadLeft(9, "0")
RegDeclarante &= Datos.Declarante.PerConQuienRelacionarseNom.PadRight(40, " ")
RegDeclarante &= Datos.Declarante.NumIdenDecla.PadLeft(13, "0")
RegDeclarante &= Datos.Declarante.DeclComploSust.PadRight(2, " ")
RegDeclarante &= Datos.Declarante.NumIdenDeclaAnt.PadLeft(13, "0")
RegDeclarante &= Datos.Declarante.NumTotaldePercepciones.PadLeft(9, "0")
RegDeclarante &= Datos.Declarante.ImpTotPercepcionesSigno.PadLeft(1, " ")
RegDeclarante &= Datos.Declarante.ImpTotPercepcionesParEnt.PadLeft(13, "0") '146-158
RegDeclarante &= Datos.Declarante.ImpTotPercepcionesParDec.PadLeft(2, "0") '159-160
RegDeclarante &= Datos.Declarante.ImpTotRetencionesParEnt.PadLeft(13, "0") '161-173
RegDeclarante &= Datos.Declarante.ImpTotRetencionesParDec.PadLeft(2, "0") '174-175
RegDeclarante &= Datos.Declarante.CorreoElectronicoPerConQuienRelacionarse.PadRight(50, " ")
RegDeclarante &= Datos.Declarante.Blancos.PadRight(262, " ")
RegDeclarante &= Datos.Declarante.SelloElectronico.PadRight(13, " ")
sw.WriteLine(RegDeclarante)
For Each p In Datos.Perceptores
If p.NifPerceptor = "27289008Z" Then
Dim parate = 12
End If
Dim RegPerceptor As String
RegPerceptor = p.TipoRegistro.PadLeft(1, " ")
RegPerceptor &= p.ModeloDeclaracion.PadRight(3, " ")
RegPerceptor &= p.Ejercicio.PadLeft(4, "0")
RegPerceptor &= p.NifDeclarante.PadLeft(9, "0")
RegPerceptor &= p.NifPerceptor.PadLeft(9, "0")
RegPerceptor &= p.NifRepresentateLegal.PadLeft(9, " ")
RegPerceptor &= p.ApeNombreRsoPerceptor.Replace(",", " ").Replace("Á", "A").Replace("É", "E").Replace("Í", "I").Replace("Ó", "O").Replace("Ú", "U").Replace("Ü", "U").Replace("Ñ", "N").Replace(" ", " ").PadRight(40, " ").Substring(0, 40)
RegPerceptor &= p.CodigoProvincial.PadLeft(2, "00")
RegPerceptor &= p.ClavePercepcion.PadLeft(1, " ")
RegPerceptor &= p.SubClave.PadLeft(2, "00")
RegPerceptor &= p.PerDineNoIncaLabSigno.PadLeft(1, " ")
RegPerceptor &= p.PerDineNoIncaLabPerintParEnt.PadLeft(11, "0")
RegPerceptor &= p.PerDineNoIncaLabPerintParDec.PadLeft(2, "0")
RegPerceptor &= p.PerDineNoIncaLabRetPraParEnt.PadLeft(11, "0") '95-105
RegPerceptor &= p.PerDineNoIncaLabRetPraParDec.PadLeft(2, "0") '106-107
RegPerceptor &= p.PerEspNoIncaLabSigno.PadLeft(1, " ")
RegPerceptor &= p.PerEspNoIncaLabPerintParEnt.PadLeft(11, "0") '109-119
RegPerceptor &= p.PerEspNoIncaLabPerintParDec.PadLeft(2, "0") '120-121
RegPerceptor &= p.PerEspNoIncaLabRetPraParEnt.PadLeft(11, "0") '122-132
RegPerceptor &= p.PerEspNoIncaLabRetPraParDec.PadLeft(2, "0") '133-134
RegPerceptor &= p.PerEspNoIncaLabRetRepParEnt.PadLeft(11, "0") '135-145
RegPerceptor &= p.PerEspNoIncaLabRetRepParDec.PadLeft(2, "0") '146-147
RegPerceptor &= p.EjercicioDevengo.PadLeft(4, "0") '148-151
RegPerceptor &= p.CeutaOMelilla.PadLeft(1, "0") '152-152
RegPerceptor &= p.AñoNacimiento.PadLeft(4, "0") '153-156
RegPerceptor &= p.SituacionFamilia.PadLeft(1, "0") '157-157
RegPerceptor &= p.NifConyuge.PadLeft(9, " ") '158-166
RegPerceptor &= p.Discapacidad.PadLeft(1, "0") '167-167
RegPerceptor &= p.ContratoRelacion.PadLeft(1, "0") '168-168
RegPerceptor &= p.Guion.PadLeft(1, "0") '169-169
RegPerceptor &= p.MovilidadGeografica.PadLeft(1, "0") '170-170
RegPerceptor &= p.ReduccionesAplicable.PadLeft(13, "0") '171-183
RegPerceptor &= p.GastosDeduciblesEnt.PadLeft(11, "0") '184-194 parte entera
RegPerceptor &= p.GastosDeduciblesDec.PadLeft(2, "0") ' 195-196 parte decimal
RegPerceptor &= p.PensionCompensatoriaEnt.PadLeft(11, "0") '197-207 parte entera
RegPerceptor &= p.PensionCompensatoriaDec.PadLeft(2, "0") '208-209 parte decimal
RegPerceptor &= p.AnualidadporAlimentosEnt.PadLeft(11, "0") '210-220 parte entera
RegPerceptor &= p.AnualidadporAlimentosDec.PadLeft(2, "0") '221-222 parte decimal
RegPerceptor &= p.HijosyOtrosDecendientes.PadLeft(6, "0")
RegPerceptor &= p.HijosyOtrosDecendientesConDiscapacidad.PadLeft(12, "0")
RegPerceptor &= p.Ascendientes.PadLeft(4, "0")
RegPerceptor &= p.AscendientesConDiscapacidad.PadLeft(6, "0")
RegPerceptor &= p.Com3PrimerosHijos.PadLeft(3, "0")
RegPerceptor &= p.ComuPresVivHab.PadLeft(1, "0")
RegPerceptor &= p.PerDineDerIncaLabSigno.PadLeft(1, " ")
RegPerceptor &= p.PerDineIncaLabPerintParEnt.PadLeft(11, "0") '256-266
RegPerceptor &= p.PerDineIncaLabPerintParDec.PadLeft(2, "0") '267-268
RegPerceptor &= p.PerDineIncaLabRetPraParEnt.PadLeft(11, "0") '269-279
RegPerceptor &= p.PerDineIncaLabRetPraParDec.PadLeft(2, "0") '280-281
RegPerceptor &= p.PerEspDerIncaLabSigno.PadLeft(1, " ")
RegPerceptor &= p.PerEspIncaLabPerintParEnt.PadLeft(11, "0") '283-293
RegPerceptor &= p.PerEspIncaLabPerintParDec.PadLeft(2, "0") '294-295
RegPerceptor &= p.PerEspIncaLabRetPraParEnt.PadLeft(11, "0") '296-306
RegPerceptor &= p.PerEspIncaLabRetPraParDec.PadLeft(2, "0") '307-308
RegPerceptor &= p.PerEspIncaLabRetRepParEnt.PadLeft(11, "0") '309-319
RegPerceptor &= p.PerEspIncaLabRetRepParDec.PadLeft(2, "0") '320-321
RegPerceptor &= p.PerTitularConvivencia.PadLeft(1, "0") '322
RegPerceptor &= p.RetEIngrEstEnDipuForPaisVascoYNavarra.PadLeft(66, "0") ' 323-388
RegPerceptor &= p.Blancos.PadRight(112, " ") '389-500
sw.WriteLine(RegPerceptor)
Next
sw.Close()
'fs.Close()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
End Class
End Namespace

65
HttpUserAgentEndpointBehavior.vb Normal file
View File

@@ -0,0 +1,65 @@
Imports System.ServiceModel
Imports System.ServiceModel.Channels
Imports System.ServiceModel.Dispatcher
Imports System.ServiceModel.Description
Imports System.ComponentModel
Public Class HttpUserAgentMessageInspector
Implements IClientMessageInspector
Private Const USER_AGENT_HTTP_HEADER As String = "user-agent"
Private m_userAgent As String
Public Sub New(ByVal userAgent As String)
Me.m_userAgent = userAgent
End Sub
#Region "IClientMessageInspector Members"
Public Sub AfterReceiveReply(ByRef reply As System.ServiceModel.Channels.Message, ByVal correlationState As Object) Implements IClientMessageInspector.AfterReceiveReply
End Sub
Public Function BeforeSendRequest(ByRef request As System.ServiceModel.Channels.Message, ByVal channel As System.ServiceModel.IClientChannel) As Object Implements IClientMessageInspector.BeforeSendRequest
Dim httpRequestMessage As HttpRequestMessageProperty
Dim httpRequestMessageObject As New Object
If request.Properties.TryGetValue(HttpRequestMessageProperty.Name, httpRequestMessageObject) Then
httpRequestMessage = TryCast(httpRequestMessageObject, HttpRequestMessageProperty)
If String.IsNullOrEmpty(httpRequestMessage.Headers(USER_AGENT_HTTP_HEADER)) Then
httpRequestMessage.Headers(USER_AGENT_HTTP_HEADER) = Me.m_userAgent
End If
Else
httpRequestMessage = New HttpRequestMessageProperty()
httpRequestMessage.Headers.Add(USER_AGENT_HTTP_HEADER, Me.m_userAgent)
request.Properties.Add(HttpRequestMessageProperty.Name, httpRequestMessage)
End If
Return Nothing
End Function
#End Region
End Class
Public Class HttpUserAgentEndpointBehavior
Implements IEndpointBehavior
Private m_userAgent As String
Public Sub New(ByVal userAgent As String)
Me.m_userAgent = userAgent
End Sub
#Region "IEndpointBehavior Members"
Public Sub AddBindingParameters(ByVal endpoint As ServiceEndpoint, ByVal bindingParameters As System.ServiceModel.Channels.BindingParameterCollection) Implements IEndpointBehavior.AddBindingParameters
End Sub
Public Sub ApplyClientBehavior(ByVal endpoint As ServiceEndpoint, ByVal clientRuntime As System.ServiceModel.Dispatcher.ClientRuntime) Implements IEndpointBehavior.ApplyClientBehavior
Dim inspector As New HttpUserAgentMessageInspector(Me.m_userAgent)
clientRuntime.MessageInspectors.Add(inspector)
End Sub
Public Sub ApplyDispatchBehavior(ByVal endpoint As ServiceEndpoint, ByVal endpointDispatcher As System.ServiceModel.Dispatcher.EndpointDispatcher) Implements IEndpointBehavior.ApplyDispatchBehavior
End Sub
Public Sub Validate(ByVal endpoint As ServiceEndpoint) Implements IEndpointBehavior.Validate
End Sub
#End Region
End Class

51
Imagen.vb Normal file
View File

@@ -0,0 +1,51 @@
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.IO
Public Class Imagen
Public Shared Function ResizeImage(ByVal image As Image,
ByVal size As Size, Optional ByVal preserveAspectRatio As Boolean = True) As Image
Dim newWidth As Integer
Dim newHeight As Integer
If preserveAspectRatio Then
Dim originalWidth As Integer = image.Width
Dim originalHeight As Integer = image.Height
Dim percentWidth As Single = CSng(size.Width) / CSng(originalWidth)
Dim percentHeight As Single = CSng(size.Height) / CSng(originalHeight)
Dim percent As Single = If(percentHeight < percentWidth,
percentHeight, percentWidth)
newWidth = CInt(originalWidth * percent)
newHeight = CInt(originalHeight * percent)
Else
newWidth = size.Width
newHeight = size.Height
End If
Dim newImage As Image = New Bitmap(newWidth, newHeight)
Using graphicsHandle As Graphics = Graphics.FromImage(newImage)
graphicsHandle.InterpolationMode = InterpolationMode.HighQualityBicubic
graphicsHandle.DrawImage(image, 0, 0, newWidth, newHeight)
End Using
Return newImage
End Function
Public Shared Function ImagenAByteArray(Imagen As Image, ByVal format As ImageFormat, Optional Calidad As Long = 100) As Byte()
Dim jpgEncoder As ImageCodecInfo = ImageCodecInfo.GetImageEncoders().First(Function(x) x.FormatID = format.Guid)
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)
Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, Calidad)
'myEncoderParameters.Param.Append(myEncoderParameter)
myEncoderParameters.Param(0) = myEncoderParameter
'Dim converter As New ImageConverter
'Dim bytes As Byte() = converter.ConvertTo(Imagen, GetType(Byte()))
Dim ms As New MemoryStream
Imagen.Save(ms, jpgEncoder, myEncoderParameters)
Return ms.ToArray
End Function
End Class

706
InicioServicioYClientes/Rutinas.vb Normal file
View File

@@ -0,0 +1,706 @@
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
<System.Diagnostics.DebuggerStepThrough()> 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

145
InicioServicioYClientes/frmConfiguracionAplicacion.resx Normal file
View File

@@ -0,0 +1,145 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.typeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAEAEBAAAAEAIABoBAAAFgAAACgAAAAQAAAAIAAAAAEAIAAAAAAAQAQAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAABmMwD/ZjMA/2YzAP9mMwD/ZjMA/2YzAP9mMwD/ZjMA/2YzAP9mMwD/ZjMA/2Yz
AP8AAAAAAAAAAAAAAABmMwD/////////////////////////////////////////////////////////
////////ZjMA/wAAAABmMwD/////////////////////////////////////////////////////////
//////////////////9mMwD/ZjMA////////////cEAQ/3BAEP9wQBD/cEAQ////////////cEAQ////
//9wQBD/cEAQ////////////ZjMA/2YzAP////////////////9wQBD/cEAQ/////////////////3BA
EP9wQBD//////3BAEP9wQBD//////2YzAP9mMwD/////////////////cEAQ/3BAEP//////////////
//////////////////9wQBD/cEAQ//////9mMwD/ZjMA/////////////////3BAEP9wQBD/////////
/////////////3BAEP9wQBD/cEAQ/3BAEP//////ZjMA/2YzAP////////////////9wQBD/cEAQ////
/////////////3BAEP9wQBD/cEAQ/3BAEP///////////2YzAP9mMwD/////////////////cEAQ/3BA
EP////////////////9wQBD/cEAQ//////////////////////9mMwD/ZjMA//////9wQBD//////3BA
EP9wQBD//////3BAEP//////cEAQ/3BAEP//////cEAQ/3BAEP//////ZjMA/2YzAP//////cEAQ/3BA
EP9wQBD/cEAQ/3BAEP9wQBD///////////9wQBD/cEAQ//////9wQBD//////2YzAP9mMwD/////////
//////////////////////////////////////////////////////////////////9mMwD/AAAAAGYz
AP////////////////////////////////////////////////////////////////9mMwD/AAAAAAAA
AAAAAAAAZjMA/2YzAP9mMwD/ZjMA/2YzAP9mMwD/ZjMA/2YzAP9mMwD/ZjMA/2YzAP9mMwD/AAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAA//8AAMADAACAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAB
AADAAwAA//8AAA==
</value>
</data>
</root>

288
InicioServicioYClientes/frmConfiguracionAplicacion.vb Normal file
View File

@@ -0,0 +1,288 @@
Imports System.Data
Imports System.Data.OleDb
Imports cablin.clFuncionesGenericas
Imports cablin
Public Class frmConfiguracionAplicacion
Inherits System.Windows.Forms.Form
Private bIdentificacionValida As Boolean
Private WithEvents tlbBarraGenerica As New ucBarraGenerica
Friend WithEvents tbPuertoLocal As System.Windows.Forms.textBox
Friend WithEvents Label2 As System.Windows.Forms.Label
Friend WithEvents tbRutaDatos As System.Windows.Forms.textBox
Friend WithEvents Label4 As System.Windows.Forms.Label
Friend WithEvents tbRutaTemporales As System.Windows.Forms.textBox
Friend WithEvents Label5 As System.Windows.Forms.Label
Friend WithEvents tbPuertoRemoto As System.Windows.Forms.textBox
Friend WithEvents Label3 As System.Windows.Forms.Label
Friend WithEvents tbServidorRemoto As System.Windows.Forms.textBox
Friend WithEvents Label6 As System.Windows.Forms.Label
Public WithEvents clCab As cablin.clCabLin
'Friend NombreServicio As String
'Friend Puerto As String
'Friend FicheroConfig As String
#Region " C<>digo generado por el Dise<73>ador de Windows Forms "
Public Sub New()
MyBase.New()
'El Dise<73>ador de Windows Forms requiere esta llamada.
InitializeComponent()
'Agregar cualquier inicializaci<63>n despu<70>s de la llamada a InitializeComponent()
End Sub
'Form reemplaza a Dispose para limpiar la lista de componentes.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Requerido por el Dise<73>ador de Windows Forms
Private components As System.ComponentModel.IContainer
'NOTA: el Dise<73>ador de Windows Forms requiere el siguiente procedimiento
'Puede modificarse utilizando el Dise<73>ador de Windows Forms.
'No lo modifique con el editor de c<>digo.
Friend WithEvents Estado As System.Windows.Forms.Label
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents tbServidorLocal As System.Windows.Forms.textBox
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmConfiguracionAplicacion))
Me.Estado = New System.Windows.Forms.Label()
Me.Label1 = New System.Windows.Forms.Label()
Me.tbServidorLocal = New System.Windows.Forms.textBox()
Me.tbPuertoLocal = New System.Windows.Forms.textBox()
Me.Label2 = New System.Windows.Forms.Label()
Me.tbRutaDatos = New System.Windows.Forms.textBox()
Me.Label4 = New System.Windows.Forms.Label()
Me.tbRutaTemporales = New System.Windows.Forms.textBox()
Me.Label5 = New System.Windows.Forms.Label()
Me.tbPuertoRemoto = New System.Windows.Forms.textBox()
Me.Label3 = New System.Windows.Forms.Label()
Me.tbServidorRemoto = New System.Windows.Forms.textBox()
Me.Label6 = New System.Windows.Forms.Label()
Me.SuspendLayout()
'
'Estado
'
Me.Estado.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
Me.Estado.ForeColor = System.Drawing.Color.Red
Me.Estado.Location = New System.Drawing.Point(16, 64)
Me.Estado.Name = "Estado"
Me.Estado.Size = New System.Drawing.Size(653, 16)
Me.Estado.tabIndex = 19
Me.Estado.text = "Estado:"
'
'Label1
'
Me.Label1.Location = New System.Drawing.Point(21, 99)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(138, 16)
Me.Label1.tabIndex = 28
Me.Label1.text = "Servidor Local:"
'
'tbServidorLocal
'
Me.tbServidorLocal.Location = New System.Drawing.Point(173, 95)
Me.tbServidorLocal.Name = "tbServidorLocal"
Me.tbServidorLocal.Size = New System.Drawing.Size(196, 20)
Me.tbServidorLocal.tabIndex = 27
Me.tbServidorLocal.tag = "IND:1|NBD:N-E:ServidorLocal|USC:1"
'
'tbPuertoLocal
'
Me.tbPuertoLocal.Location = New System.Drawing.Point(173, 121)
Me.tbPuertoLocal.Name = "tbPuertoLocal"
Me.tbPuertoLocal.Size = New System.Drawing.Size(196, 20)
Me.tbPuertoLocal.tabIndex = 29
Me.tbPuertoLocal.tag = "IND:2|NBD:N-E:PuertoLocal|USC:1"
'
'Label2
'
Me.Label2.Location = New System.Drawing.Point(21, 125)
Me.Label2.Name = "Label2"
Me.Label2.Size = New System.Drawing.Size(138, 16)
Me.Label2.tabIndex = 30
Me.Label2.text = "Puerto Local:"
'
'tbRutaDatos
'
Me.tbRutaDatos.Location = New System.Drawing.Point(173, 224)
Me.tbRutaDatos.Name = "tbRutaDatos"
Me.tbRutaDatos.Size = New System.Drawing.Size(496, 20)
Me.tbRutaDatos.tabIndex = 33
Me.tbRutaDatos.tag = "IND:5|NBD:N-E:RutaDatos|BCO:O|USC:1"
'
'Label4
'
Me.Label4.Location = New System.Drawing.Point(21, 229)
Me.Label4.Name = "Label4"
Me.Label4.Size = New System.Drawing.Size(138, 16)
Me.Label4.tabIndex = 34
Me.Label4.text = "Ruta Datos:"
'
'tbRutaTemporales
'
Me.tbRutaTemporales.Location = New System.Drawing.Point(173, 251)
Me.tbRutaTemporales.Name = "tbRutaTemporales"
Me.tbRutaTemporales.Size = New System.Drawing.Size(496, 20)
Me.tbRutaTemporales.tabIndex = 35
Me.tbRutaTemporales.tag = "IND:6|NBD:N-E:RutaFicherosTemporales|BCO:O|USC:1"
'
'Label5
'
Me.Label5.Location = New System.Drawing.Point(21, 256)
Me.Label5.Name = "Label5"
Me.Label5.Size = New System.Drawing.Size(138, 16)
Me.Label5.tabIndex = 36
Me.Label5.text = "Ruta Ficheros Temporales:"
'
'tbPuertoRemoto
'
Me.tbPuertoRemoto.Location = New System.Drawing.Point(173, 186)
Me.tbPuertoRemoto.Name = "tbPuertoRemoto"
Me.tbPuertoRemoto.Size = New System.Drawing.Size(196, 20)
Me.tbPuertoRemoto.tabIndex = 39
Me.tbPuertoRemoto.tag = "IND:4|NBD:N-E:PuertoRemoto|BCO:O|USC:1"
'
'Label3
'
Me.Label3.Location = New System.Drawing.Point(21, 190)
Me.Label3.Name = "Label3"
Me.Label3.Size = New System.Drawing.Size(138, 16)
Me.Label3.tabIndex = 40
Me.Label3.text = "Puerto Remoto:"
'
'tbServidorRemoto
'
Me.tbServidorRemoto.Location = New System.Drawing.Point(173, 160)
Me.tbServidorRemoto.Name = "tbServidorRemoto"
Me.tbServidorRemoto.Size = New System.Drawing.Size(196, 20)
Me.tbServidorRemoto.tabIndex = 37
Me.tbServidorRemoto.tag = "IND:3|NBD:N-E:ServidorRemoto|USC:1"
'
'Label6
'
Me.Label6.Location = New System.Drawing.Point(21, 164)
Me.Label6.Name = "Label6"
Me.Label6.Size = New System.Drawing.Size(138, 16)
Me.Label6.tabIndex = 38
Me.Label6.text = "Servidor Remoto:"
'
'frmConfiguracionAplicacion
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.BackColor = System.Drawing.SystemColors.Control
Me.ClientSize = New System.Drawing.Size(681, 345)
Me.ControlBox = False
Me.Controls.Add(Me.tbPuertoRemoto)
Me.Controls.Add(Me.Label3)
Me.Controls.Add(Me.tbServidorRemoto)
Me.Controls.Add(Me.Label6)
Me.Controls.Add(Me.tbRutaTemporales)
Me.Controls.Add(Me.Label5)
Me.Controls.Add(Me.tbRutaDatos)
Me.Controls.Add(Me.Label4)
Me.Controls.Add(Me.tbPuertoLocal)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.tbServidorLocal)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.Estado)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MinimizeBox = False
Me.Name = "frmConfiguracionAplicacion"
Me.ShowInTaskbar = False
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
Me.tag = "APSB:S"
Me.text = "Configuraci<EFBFBD>n de la Aplicaci<63>n"
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
#End Region
Private Sub frmcambioPin_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Call AgregaBarraGenerica(Me, CType(tlbBarraGenerica, Object))
clCab = New clCabLin(Me, "Instalacion", Nothing)
Me.tlbBarraGenerica.tlbSiguiente.Enabled = False
Me.tlbBarraGenerica.tlbSiguiente.Visible = False
Me.tlbBarraGenerica.tlbAlmacenar.Visible = True
Me.tlbBarraGenerica.tlbAlmacenar.Enabled = True
Me.tlbBarraGenerica.tlbLimpiarPantalla.Visible = False
Me.tlbBarraGenerica.tlbSalir.Enabled = True
Me.tlbBarraGenerica.tlbEliminaFicha.Visible = False
clCab.Estado = "Introduzca Datos"
Call RedibujaBarraGenerica(tlbBarraGenerica.tbGenerico)
End Sub
Private Sub clCab_DespuesFPulsado(ByVal Tecla As String) Handles clCab.DespuesFPulsado
Select Case Tecla
Case "1"
Try
If Me.tbServidorLocal.text <> "" Then
If Me.tbPuertoLocal.text = "" Then
Throw New Exception("Si especifica un servidor local, debe especificar el puerto de conexi<78>n Local")
End If
End If
If Me.tbPuertoLocal.text <> "" Then
If Me.tbServidorLocal.text = "" Then
Throw New Exception("Si especifica un puerto local, debe especificar el servidor de conexi<78>n Local")
End If
End If
If Me.tbServidorRemoto.text <> "" Then
If Me.tbPuertoRemoto.text = "" Then
Throw New Exception("Si especifica un servidor remoto, debe especificar el puerto de conexi<78>n remoto")
End If
End If
If Me.tbPuertoRemoto.text <> "" Then
If Me.tbServidorRemoto.text = "" Then
Throw New Exception("Si especifica un puerto remoto, debe especificar el servidor de conexi<78>n remoto")
End If
End If
If Me.tbServidorRemoto.text = "" And Me.tbServidorLocal.text = "" Then
Throw New Exception("Debe especificar al menos un servidor")
End If
Me.Close()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error")
' Environment.Exit(0)
End Try
Case "8"
Environment.Exit(0)
End Select
End Sub
Public Shared Sub RedibujaBarraGenerica(ByVal BarraHerramientas As Windows.Forms.ToolBar)
Try
Dim butBoton As Windows.Forms.ToolBarButton, iNumbotones As Integer
For Each butBoton In BarraHerramientas.Buttons
If butBoton.Visible Then
iNumbotones += 1
End If
Next
BarraHerramientas.Width = (BarraHerramientas.ButtonSize.Width * iNumbotones) + 10
BarraHerramientas.Parent.Width = BarraHerramientas.Width
Catch ex As Exception
MsgBox(ex.Message & ". En Redibujabarragenerica" & vbCrLf & ex.StackTrace)
End Try
End Sub
'Private Sub frmSeleccionInstalacion_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
' e.Cancel = Not bIdentificacionValida
'End Sub
Private Sub frmConfiguracionAplicacion_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
tbServidorLocal.Focus()
End Sub
End Class

120
InicioServicioYClientes/frmIdentificacion.resx Normal file
View File

@@ -0,0 +1,120 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.typeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

167
InicioServicioYClientes/frmIdentificacion.vb Normal file
View File

@@ -0,0 +1,167 @@
Public Class frmIdentificacion
Inherits System.Windows.Forms.Form
#Region " C<>digo generado por el Dise<73>ador de Windows Forms "
Public Sub New()
MyBase.New()
'El Dise<73>ador de Windows Forms requiere esta llamada.
InitializeComponent()
'Agregar cualquier inicializaci<63>n despu<70>s de la llamada a InitializeComponent()
End Sub
'Form reemplaza a Dispose para limpiar la lista de componentes.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Requerido por el Dise<73>ador de Windows Forms
Private components As System.ComponentModel.IContainer
'NOTA: el Dise<73>ador de Windows Forms requiere el siguiente procedimiento
'Puede modificarse utilizando el Dise<73>ador de Windows Forms.
'No lo modifique con el editor de c<>digo.
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents tbClave As System.Windows.Forms.textBox
Friend WithEvents Label5 As System.Windows.Forms.Label
Friend WithEvents IniciarSesion As System.Windows.Forms.Button
Friend WithEvents Cancelar As System.Windows.Forms.Button
Friend WithEvents tbUsuario As System.Windows.Forms.textBox
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.Label1 = New System.Windows.Forms.Label()
Me.tbClave = New System.Windows.Forms.textBox()
Me.Label5 = New System.Windows.Forms.Label()
Me.tbUsuario = New System.Windows.Forms.textBox()
Me.IniciarSesion = New System.Windows.Forms.Button()
Me.Cancelar = New System.Windows.Forms.Button()
Me.SuspendLayout()
'
'Label1
'
Me.Label1.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.Label1.Location = New System.Drawing.Point(23, 49)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(144, 16)
Me.Label1.tabIndex = 28
Me.Label1.text = "Clave Acceso:"
'
'tbClave
'
Me.tbClave.Location = New System.Drawing.Point(136, 49)
Me.tbClave.Name = "tbClave"
Me.tbClave.PasswordChar = Global.Microsoft.VisualBasic.ChrW(42)
Me.tbClave.Size = New System.Drawing.Size(142, 20)
Me.tbClave.tabIndex = 1
Me.tbClave.tag = "IND:2|NBD:Clave_Acceso"
'
'Label5
'
Me.Label5.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.Label5.Location = New System.Drawing.Point(23, 23)
Me.Label5.Name = "Label5"
Me.Label5.Size = New System.Drawing.Size(107, 16)
Me.Label5.tabIndex = 46
Me.Label5.text = "C<EFBFBD>digo Usuario.:"
'
'tbUsuario
'
Me.tbUsuario.Location = New System.Drawing.Point(136, 20)
Me.tbUsuario.Name = "tbUsuario"
Me.tbUsuario.Size = New System.Drawing.Size(142, 20)
Me.tbUsuario.tabIndex = 0
Me.tbUsuario.tag = "IND:1|NBD:Codigo"
'
'IniciarSesion
'
Me.IniciarSesion.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.IniciarSesion.Location = New System.Drawing.Point(168, 85)
Me.IniciarSesion.Name = "IniciarSesion"
Me.IniciarSesion.Size = New System.Drawing.Size(110, 23)
Me.IniciarSesion.tabIndex = 2
Me.IniciarSesion.text = "&Iniciar Sesi<73>n"
Me.IniciarSesion.UseVisualStyleBackColor = True
'
'Cancelar
'
Me.Cancelar.DialogResult = System.Windows.Forms.DialogResult.Cancel
Me.Cancelar.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.Cancelar.Location = New System.Drawing.Point(26, 85)
Me.Cancelar.Name = "Cancelar"
Me.Cancelar.Size = New System.Drawing.Size(110, 23)
Me.Cancelar.tabIndex = 3
Me.Cancelar.text = "&Cancelar"
Me.Cancelar.UseVisualStyleBackColor = True
'
'frmIdentificacion
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.CancelButton = Me.Cancelar
Me.ClientSize = New System.Drawing.Size(302, 125)
Me.ControlBox = False
Me.Controls.Add(Me.Cancelar)
Me.Controls.Add(Me.IniciarSesion)
Me.Controls.Add(Me.Label5)
Me.Controls.Add(Me.tbUsuario)
Me.Controls.Add(Me.tbClave)
Me.Controls.Add(Me.Label1)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Fixed3D
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MinimizeBox = False
Me.Name = "frmIdentificacion"
Me.ShowInTaskbar = False
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent
Me.tag = ""
Me.text = "Identificaci<EFBFBD>n"
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
#End Region
Private Sub IniciarSesion_Click(sender As System.Object, e As System.EventArgs) Handles IniciarSesion.Click
Me.DialogResult = System.Windows.Forms.DialogResult.OK
End Sub
Private Sub frmIdentificacion_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
'If e.KeyCode = Keys.Enter Then
' If Not (tbUsuario.text <> "" And tbClave.text <> "") Then
' e.Handled = True
' If Me.ActiveControl Is tbClave Then
' tbUsuario.Focus()
' Else
' tbClave.Focus()
' End If
' Else
' Me.DialogResult = Windows.Forms.DialogResult.OK
' End If
'End If
End Sub
Private Sub frmIdentificacion_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
If Not (tbUsuario.text <> "" And tbClave.text <> "") Then
If Me.ActiveControl Is tbClave Then
tbUsuario.Focus()
Else
tbClave.Focus()
End If
Else
Me.DialogResult = System.Windows.Forms.DialogResult.OK
End If
End If
End Sub
End Class

1311
InicioServicioYClientes/ucBarraGenerica.resx Normal file
View File

File diff suppressed because it is too large Load Diff

342
InicioServicioYClientes/ucBarraGenerica.vb Normal file
View File

@@ -0,0 +1,342 @@
Public Class ucBarraGenerica
Inherits System.Windows.Forms.UserControl
Public Event ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.toolBarButtonClickEventArgs)
#Region " C<>digo generado por el Dise<73>ador de Windows Forms "
Public Sub New()
MyBase.New()
'El Dise<73>ador de Windows Forms requiere esta llamada.
InitializeComponent()
'Agregar cualquier inicializaci<63>n despu<70>s de la llamada a InitializeComponent()
End Sub
'UserControl reemplaza a Dispose para limpiar la lista de componentes.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Requerido por el Dise<73>ador de Windows Forms
Private components As System.ComponentModel.IContainer
'NOTA: el Dise<73>ador de Windows Forms requiere el siguiente procedimiento
'Puede modificarse utilizando el Dise<73>ador de Windows Forms.
'No lo modifique con el editor de c<>digo.
Friend WithEvents Botones As System.Windows.Forms.ImageList
Public WithEvents tlbSiguiente As System.Windows.Forms.toolBarButton
Public WithEvents TlbCrearPdf As System.Windows.Forms.toolBarButton
Public WithEvents tlbVisualizarPDF As System.Windows.Forms.toolBarButton
Public WithEvents tlbLimpiarPantalla As System.Windows.Forms.toolBarButton
Public WithEvents tlbAlmacenar As System.Windows.Forms.toolBarButton
Public WithEvents tlbEliminaFicha As System.Windows.Forms.toolBarButton
Public WithEvents tlbAyuda As System.Windows.Forms.toolBarButton
Public WithEvents tlbEnviar As System.Windows.Forms.toolBarButton
Public WithEvents tlbRecibir As System.Windows.Forms.toolBarButton
Public WithEvents tlbCancelar As System.Windows.Forms.toolBarButton
Public WithEvents tlbGrabar As System.Windows.Forms.toolBarButton
Public WithEvents tlbCopiar As System.Windows.Forms.toolBarButton
Public WithEvents tlbSalir As System.Windows.Forms.toolBarButton
Public WithEvents tbGenerico As System.Windows.Forms.toolBar
Public WithEvents tlbRecibirdeDisco As System.Windows.Forms.toolBarButton
Friend WithEvents tlbSolicitarCertificado As System.Windows.Forms.toolBarButton
Friend WithEvents tlbVerCertificado As System.Windows.Forms.toolBarButton
Friend WithEvents tlbCambiarPIN As System.Windows.Forms.toolBarButton
Friend WithEvents tlbExportarCertificado As System.Windows.Forms.toolBarButton
Friend WithEvents tlbRestaurarCopia As System.Windows.Forms.toolBarButton
Friend WithEvents tlbImprimir As System.Windows.Forms.toolBarButton
Friend WithEvents tlbRevocarCertificado As System.Windows.Forms.toolBarButton
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim tlbAnterior As System.Windows.Forms.toolBarButton
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ucBarraGenerica))
Me.tbGenerico = New System.Windows.Forms.toolBar()
Me.tlbSiguiente = New System.Windows.Forms.toolBarButton()
Me.tlbCrearPdf = New System.Windows.Forms.toolBarButton()
Me.tlbVisualizarPDF = New System.Windows.Forms.toolBarButton()
Me.tlbAlmacenar = New System.Windows.Forms.toolBarButton()
Me.tlbLimpiarPantalla = New System.Windows.Forms.toolBarButton()
Me.tlbEliminaFicha = New System.Windows.Forms.toolBarButton()
Me.tlbEnviar = New System.Windows.Forms.toolBarButton()
Me.tlbGrabar = New System.Windows.Forms.toolBarButton()
Me.tlbCopiar = New System.Windows.Forms.toolBarButton()
Me.tlbRecibir = New System.Windows.Forms.toolBarButton()
Me.tlbRecibirdeDisco = New System.Windows.Forms.toolBarButton()
Me.tlbCancelar = New System.Windows.Forms.toolBarButton()
Me.tlbAyuda = New System.Windows.Forms.toolBarButton()
Me.tlbSolicitarCertificado = New System.Windows.Forms.toolBarButton()
Me.tlbVerCertificado = New System.Windows.Forms.toolBarButton()
Me.tlbCambiarPIN = New System.Windows.Forms.toolBarButton()
Me.tlbExportarCertificado = New System.Windows.Forms.toolBarButton()
Me.tlbRevocarCertificado = New System.Windows.Forms.toolBarButton()
Me.tlbRestaurarCopia = New System.Windows.Forms.toolBarButton()
Me.tlbImprimir = New System.Windows.Forms.toolBarButton()
Me.tlbSalir = New System.Windows.Forms.toolBarButton()
Me.Botones = New System.Windows.Forms.ImageList(Me.components)
tlbAnterior = New System.Windows.Forms.toolBarButton()
Me.SuspendLayout()
'
'tlbAnterior
'
tlbAnterior.Enabled = False
tlbAnterior.ImageIndex = 2
tlbAnterior.Name = "tlbAnterior"
tlbAnterior.tag = "NOM:ANTERIOR"
tlbAnterior.toolTipText = "Anterior (F4)"
tlbAnterior.Visible = False
'
'tbGenerico
'
Me.tbGenerico.AutoSize = False
Me.tbGenerico.Buttons.AddRange(New System.Windows.Forms.toolBarButton() {tlbAnterior, Me.tlbSiguiente, Me.tlbCrearPdf, Me.tlbVisualizarPDF, Me.tlbAlmacenar, Me.tlbLimpiarPantalla, Me.tlbEliminaFicha, Me.tlbEnviar, Me.tlbGrabar, Me.tlbCopiar, Me.tlbRecibir, Me.tlbRecibirdeDisco, Me.tlbCancelar, Me.tlbAyuda, Me.tlbSolicitarCertificado, Me.tlbVerCertificado, Me.tlbCambiarPIN, Me.tlbExportarCertificado, Me.tlbRevocarCertificado, Me.tlbRestaurarCopia, Me.tlbImprimir, Me.tlbSalir})
Me.tbGenerico.Dock = System.Windows.Forms.DockStyle.None
Me.tbGenerico.DropDownArrows = True
Me.tbGenerico.ImageList = Me.Botones
Me.tbGenerico.Location = New System.Drawing.Point(0, 0)
Me.tbGenerico.Name = "tbGenerico"
Me.tbGenerico.ShowToolTips = True
Me.tbGenerico.Size = New System.Drawing.Size(765, 44)
Me.tbGenerico.tabIndex = 46
Me.tbGenerico.tag = "FUN:S"
'
'tlbSiguiente
'
Me.tlbSiguiente.Enabled = False
Me.tlbSiguiente.ImageIndex = 0
Me.tlbSiguiente.Name = "tlbSiguiente"
Me.tlbSiguiente.tag = "NOM:SIGUIENTE|FUN:5"
Me.tlbSiguiente.toolTipText = "Siguiente (F5)"
Me.tlbSiguiente.Visible = False
'
'TlbCrearPdf
'
Me.tlbCrearPdf.Enabled = False
Me.tlbCrearPdf.ImageIndex = 4
Me.tlbCrearPdf.Name = "TlbCrearPdf"
Me.tlbCrearPdf.tag = "NOM:CREARPDF"
Me.tlbCrearPdf.toolTipText = "Crear PDF"
Me.tlbCrearPdf.Visible = False
'
'tlbVisualizarPDF
'
Me.tlbVisualizarPDF.Enabled = False
Me.tlbVisualizarPDF.ImageIndex = 7
Me.tlbVisualizarPDF.Name = "tlbVisualizarPDF"
Me.tlbVisualizarPDF.tag = "NOM:VISUALIZARPDF"
Me.tlbVisualizarPDF.toolTipText = "Visualizar PDF"
Me.tlbVisualizarPDF.Visible = False
'
'tlbAlmacenar
'
Me.tlbAlmacenar.Enabled = False
Me.tlbAlmacenar.ImageIndex = 5
Me.tlbAlmacenar.Name = "tlbAlmacenar"
Me.tlbAlmacenar.tag = "NOM:ALMCENAR|FUN:1|IMGN:26|IMGA:5"
Me.tlbAlmacenar.toolTipText = "Almacenar (F1)"
'
'tlbLimpiarPantalla
'
Me.tlbLimpiarPantalla.Enabled = False
Me.tlbLimpiarPantalla.ImageIndex = 13
Me.tlbLimpiarPantalla.Name = "tlbLimpiarPantalla"
Me.tlbLimpiarPantalla.tag = "NOM:LIMPIARPANTALLA|FUN:6"
Me.tlbLimpiarPantalla.toolTipText = "Limpiar Pantalla (F6)"
'
'tlbEliminaFicha
'
Me.tlbEliminaFicha.Enabled = False
Me.tlbEliminaFicha.ImageIndex = 11
Me.tlbEliminaFicha.Name = "tlbEliminaFicha"
Me.tlbEliminaFicha.tag = "NOM:ELIMINAFICHA|FUN:7"
Me.tlbEliminaFicha.toolTipText = "Elimina Ficha (F7)"
'
'tlbEnviar
'
Me.tlbEnviar.Enabled = False
Me.tlbEnviar.ImageIndex = 19
Me.tlbEnviar.Name = "tlbEnviar"
Me.tlbEnviar.tag = "NOM:ENVIAR"
Me.tlbEnviar.toolTipText = "Enviar por internet"
Me.tlbEnviar.Visible = False
'
'tlbGrabar
'
Me.tlbGrabar.Enabled = False
Me.tlbGrabar.ImageIndex = 16
Me.tlbGrabar.Name = "tlbGrabar"
Me.tlbGrabar.tag = "NOM:GRABAR"
Me.tlbGrabar.toolTipText = "Grabar en CD / DVD"
Me.tlbGrabar.Visible = False
'
'tlbCopiar
'
Me.tlbCopiar.Enabled = False
Me.tlbCopiar.ImageIndex = 17
Me.tlbCopiar.Name = "tlbCopiar"
Me.tlbCopiar.tag = "NOM:COPIAR|FUN:4"
Me.tlbCopiar.toolTipText = "Copiar (F4)"
Me.tlbCopiar.Visible = False
'
'tlbRecibir
'
Me.tlbRecibir.Enabled = False
Me.tlbRecibir.ImageIndex = 20
Me.tlbRecibir.Name = "tlbRecibir"
Me.tlbRecibir.tag = "NOM:RECIBIR"
Me.tlbRecibir.toolTipText = "Recibir de Internet"
Me.tlbRecibir.Visible = False
'
'tlbRecibirdeDisco
'
Me.tlbRecibirdeDisco.Enabled = False
Me.tlbRecibirdeDisco.ImageIndex = 18
Me.tlbRecibirdeDisco.Name = "tlbRecibirdeDisco"
Me.tlbRecibirdeDisco.tag = "NOM:RECIBIRDEDISCO"
Me.tlbRecibirdeDisco.toolTipText = "Incorporar datos desde disco"
Me.tlbRecibirdeDisco.Visible = False
'
'tlbCancelar
'
Me.tlbCancelar.Enabled = False
Me.tlbCancelar.ImageIndex = 6
Me.tlbCancelar.Name = "tlbCancelar"
Me.tlbCancelar.tag = "NOM:CANCELAR"
Me.tlbCancelar.toolTipText = "Cancelar"
Me.tlbCancelar.Visible = False
'
'tlbAyuda
'
Me.tlbAyuda.Enabled = False
Me.tlbAyuda.ImageIndex = 8
Me.tlbAyuda.Name = "tlbAyuda"
Me.tlbAyuda.tag = "NOM:AYUDA"
Me.tlbAyuda.toolTipText = "Ayuda"
Me.tlbAyuda.Visible = False
'
'tlbSolicitarCertificado
'
Me.tlbSolicitarCertificado.ImageIndex = 24
Me.tlbSolicitarCertificado.Name = "tlbSolicitarCertificado"
Me.tlbSolicitarCertificado.tag = "NOM:SolicitarCertificado|FUN:SOLICITARCERTIFICADO|VCO:S"
Me.tlbSolicitarCertificado.toolTipText = "Importar un certificado"
Me.tlbSolicitarCertificado.Visible = False
'
'tlbVerCertificado
'
Me.tlbVerCertificado.ImageIndex = 25
Me.tlbVerCertificado.Name = "tlbVerCertificado"
Me.tlbVerCertificado.tag = "NOM:VerCertificado"
Me.tlbVerCertificado.toolTipText = "Ver Certificado"
Me.tlbVerCertificado.Visible = False
'
'tlbCambiarPIN
'
Me.tlbCambiarPIN.ImageIndex = 21
Me.tlbCambiarPIN.Name = "tlbCambiarPIN"
Me.tlbCambiarPIN.tag = "NOM:CambiarPIN"
Me.tlbCambiarPIN.toolTipText = "Cambiar PIN del certificado"
Me.tlbCambiarPIN.Visible = False
'
'tlbExportarCertificado
'
Me.tlbExportarCertificado.ImageIndex = 22
Me.tlbExportarCertificado.Name = "tlbExportarCertificado"
Me.tlbExportarCertificado.tag = "NOM:ExportarCertificado"
Me.tlbExportarCertificado.toolTipText = "Exportar el certificado"
Me.tlbExportarCertificado.Visible = False
'
'tlbRevocarCertificado
'
Me.tlbRevocarCertificado.ImageIndex = 23
Me.tlbRevocarCertificado.Name = "tlbRevocarCertificado"
Me.tlbRevocarCertificado.tag = "NOM:RevocarCertificado"
Me.tlbRevocarCertificado.toolTipText = "Revocar el certificado"
Me.tlbRevocarCertificado.Visible = False
'
'tlbRestaurarCopia
'
Me.tlbRestaurarCopia.ImageIndex = 28
Me.tlbRestaurarCopia.Name = "tlbRestaurarCopia"
Me.tlbRestaurarCopia.tag = "NOM:RestaurarCopia"
Me.tlbRestaurarCopia.toolTipText = "Restaurar copia de seguridad"
Me.tlbRestaurarCopia.Visible = False
'
'tlbImprimir
'
Me.tlbImprimir.ImageIndex = 29
Me.tlbImprimir.Name = "tlbImprimir"
Me.tlbImprimir.tag = "NOM:IMPRIMIR|FUN:9"
Me.tlbImprimir.toolTipText = "Imprimir (F9)"
Me.tlbImprimir.Visible = False
'
'tlbSalir
'
Me.tlbSalir.Enabled = False
Me.tlbSalir.ImageIndex = 3
Me.tlbSalir.Name = "tlbSalir"
Me.tlbSalir.tag = "NOM:SALIR|FUN:8"
Me.tlbSalir.toolTipText = "Salir (F8)"
'
'Botones
'
Me.Botones.ImageStream = CType(resources.GetObject("Botones.ImageStream"), System.Windows.Forms.ImageListStreamer)
Me.Botones.transparentColor = System.Drawing.Color.Blue
Me.Botones.Images.SetKeyName(0, "")
Me.Botones.Images.SetKeyName(1, "")
Me.Botones.Images.SetKeyName(2, "")
Me.Botones.Images.SetKeyName(3, "")
Me.Botones.Images.SetKeyName(4, "")
Me.Botones.Images.SetKeyName(5, "")
Me.Botones.Images.SetKeyName(6, "")
Me.Botones.Images.SetKeyName(7, "")
Me.Botones.Images.SetKeyName(8, "")
Me.Botones.Images.SetKeyName(9, "")
Me.Botones.Images.SetKeyName(10, "")
Me.Botones.Images.SetKeyName(11, "")
Me.Botones.Images.SetKeyName(12, "")
Me.Botones.Images.SetKeyName(13, "")
Me.Botones.Images.SetKeyName(14, "")
Me.Botones.Images.SetKeyName(15, "")
Me.Botones.Images.SetKeyName(16, "")
Me.Botones.Images.SetKeyName(17, "")
Me.Botones.Images.SetKeyName(18, "")
Me.Botones.Images.SetKeyName(19, "")
Me.Botones.Images.SetKeyName(20, "")
Me.Botones.Images.SetKeyName(21, "")
Me.Botones.Images.SetKeyName(22, "")
Me.Botones.Images.SetKeyName(23, "")
Me.Botones.Images.SetKeyName(24, "")
Me.Botones.Images.SetKeyName(25, "")
Me.Botones.Images.SetKeyName(26, "")
Me.Botones.Images.SetKeyName(27, "folder_time.png")
Me.Botones.Images.SetKeyName(28, "data_time.png")
Me.Botones.Images.SetKeyName(29, "printer.png")
'
'ucBarraGenerica
'
Me.BackColor = System.Drawing.SystemColors.Control
Me.Controls.Add(Me.tbGenerico)
Me.Name = "ucBarraGenerica"
Me.Size = New System.Drawing.Size(768, 48)
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub tbGenerico_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.toolBarButtonClickEventArgs) Handles tbGenerico.ButtonClick
Try
RaiseEvent ButtonClick(sender, e)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error tbGenerico_ButtonClick")
End Try
End Sub
End Class

13
Interfaces.vb Normal file
View File

@@ -0,0 +1,13 @@
Imports tsl5.Datos
Imports tsl5.Enumeraciones
Namespace Interfaces
Public Interface IServicioNR
Function ObtieneDatosConexionCliente(Peticion As DatosConfiguracionCliente, idGrupoBD As Integer, ByRef ex As Exception) As DatosConexionCliente
Function IniciaSesion(Usuario As String, Contraseña As String, ByRef idGrupoBD As Integer, ByRef ex As Exception) As DatosSesionCliente
' Function CompruebaActualizacionesCliente(Aplicacion As String, ByRef Version As Datos.Actualizacion, ByRef ex As Exception) As TipoActualizacionEnum
End Interface
Public Interface IServiciotsl5
Sub IniciarServicio()
Sub DetenerServicio()
End Interface
End Namespace

13
My Project/Application.Designer.vb generated Normal file
View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Este código fue generado por una herramienta.
' Versión de runtime:4.0.30319.42000
'
' Los cambios en este archivo podrían causar un comportamiento incorrecto y se perderán si
' se vuelve a generar el código.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

10
My Project/Application.myapp Normal file
View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

39
My Project/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,39 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' La información general sobre un ensamblado se controla mediante el siguiente
' conjunto de atributos. Cambie estos atributos para modificar la información
' asociada con un ensamblado.
' Revisar los valores de los atributos del ensamblado
<Assembly: AssemblyTitle("tsl5")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("tsl5")>
<Assembly: AssemblyCopyright("Copyright © 2011")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'El siguiente GUID sirve como identificador de typelib si este proyecto se expone a COM
<Assembly: Guid("06b97226-f037-484a-aee7-fc355ef2510a")>
' La información de versión de un ensamblado consta de los cuatro valores siguientes:
'
' Versión principal
' Versión secundaria
' Número de compilación
' Revisión
'
' Puede especificar todos los valores o usar los valores predeterminados de número de compilación y de revisión
' mediante el asterisco ('*'), como se muestra a continuación:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("3.0.1")>
<Assembly: AssemblyFileVersion("3.0.1")>
' Modificaciones:
' ===============
' 06/05/2012 MANMOG Cambios en AñadeAzip

10
My Project/DataSources/Entities.datasource Normal file
View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<!--
This file is automatically generated by Visual Studio .Net. It is
used to store generic object data source configuration information.
Renaming the file extension or editing the content of this file may
cause the file to be unrecognizable by the program.
-->
<GenericObjectDataSource DisplayName="Entities" Identifier="tsl5.Entities" ProviderType="Microsoft.VisualStudio.DataDesign.DataSourceProviders.EntityDataModel.EdmDataSourceProvider" Version="1.0" xmlns="urn:schemas-microsoft-com:xml-msdatasource">
<TypeInfo>tsl5.Entities, tsl5Model.Designer.vb, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null</TypeInfo>
</GenericObjectDataSource>

10
My Project/DataSources/tsl5.tsl5Model.Entities.datasource Normal file
View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<!--
This file is automatically generated by Visual Studio .Net. It is
used to store generic object data source configuration information.
Renaming the file extension or editing the content of this file may
cause the file to be unrecognizable by the program.
-->
<GenericObjectDataSource DisplayName="Entities" Identifier="tsl5.tsl5Model.Entities" ProviderType="Microsoft.VisualStudio.DataDesign.DataSourceProviders.EntityDataModel.EdmDataSourceProvider" Version="1.0" xmlns="urn:schemas-microsoft-com:xml-msdatasource">
<TypeInfo>tsl5.tsl5Model.Entities, tsl5Model.Designer.vb, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null</TypeInfo>
</GenericObjectDataSource>

63
My Project/Resources.Designer.vb generated Normal file
View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Este código fue generado por una herramienta.
' Versión de runtime:4.0.30319.42000
'
' Los cambios en este archivo podrían causar un comportamiento incorrecto y se perderán si
' se vuelve a generar el código.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'StronglyTypedResourceBuilder generó automáticamente esta clase
'a través de una herramienta como ResGen o Visual Studio.
'Para agregar o quitar un miembro, edite el archivo .ResX y, a continuación, vuelva a ejecutar ResGen
'con la opción /str o recompile su proyecto de VS.
'''<summary>
''' Clase de recurso fuertemente tipado, para buscar cadenas traducidas, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "17.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Devuelve la instancia de ResourceManager almacenada en caché utilizada por esta clase.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("tsl5.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Reemplaza la propiedad CurrentUICulture del subproceso actual para todas las
''' búsquedas de recursos mediante esta clase de recurso fuertemente tipado.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

117
My Project/Resources.resx Normal file
View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.typeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

73
My Project/Settings.Designer.vb generated Normal file
View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Este código fue generado por una herramienta.
' Versión de runtime:4.0.30319.42000
'
' Los cambios en este archivo podrían causar un comportamiento incorrecto y se perderán si
' se vuelve a generar el código.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.7.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Funcionalidad para autoguardar My.Settings"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.tsl5.My.MySettings
Get
Return Global.tsl5.My.MySettings.Default
End Get
End Property
End Module
End Namespace

7
My Project/Settings.settings Normal file
View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

0
My Project/licenses.licx Normal file
View File

1
My Project/licenses.licx.bak Normal file
View File

@@ -0,0 +1 @@
C1.Win.C1TrueDBGrid.C1TrueDBGrid, C1.Win.C1TrueDBGrid, Version=1.3.20051.50128, Culture=neutral, PublicKeyToken=75ae3fb0e2b1e0da

15
NetRemoting.vb Normal file
View File

@@ -0,0 +1,15 @@
Imports System.Runtime.Remoting
Public Class NetRemoting
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
End Class

380
NumerosAPalabras.vb Normal file
View File

@@ -0,0 +1,380 @@
Imports System
Imports System.Text
Imports System.Globalization
''' <summary>
''' Convierte números en su expresión numérica a su numeral cardinal
''' </summary>
Public NotInheritable Class NumerosAPalabras
#Region "Miembros estáticos"
Private Const UNI As Integer = 0, DIECI As Integer = 1, DECENA As Integer = 2, CENTENA As Integer = 3
Private Shared _matriz As String(,) = New String(CENTENA, 9) {
{Nothing, " uno", " dos", " tres", " cuatro", " cinco", " seis", " siete", " ocho", " nueve"},
{" diez", " once", " doce", " trece", " catorce", " quince", " dieciséis", " diecisiete", " dieciocho", " diecinueve"},
{Nothing, Nothing, Nothing, " treinta", " cuarenta", " cincuenta", " sesenta", " setenta", " ochenta", " noventa"},
{Nothing, Nothing, Nothing, Nothing, Nothing, " quinientos", Nothing, " setecientos", Nothing, " novecientos"}}
Private Const [sub] As Char = CChar(ChrW(26))
'Cambiar acá si se quiere otro comportamiento en los métodos de clase
Public Const SeparadorDecimalSalidaDefault As String = "con"
Public Const MascaraSalidaDecimalDefault As String = "00'/100.-'"
Public Const DecimalesDefault As Int32 = 2
Public Const LetraCapitalDefault As Boolean = False
Public Const ConvertirDecimalesDefault As Boolean = True
Public Const ApocoparUnoParteEnteraDefault As Boolean = False
Public Const ApocoparUnoParteDecimalDefault As Boolean = False
#End Region
#Region "Propiedades"
Private _decimales As Int32 = DecimalesDefault
Private _cultureInfo As CultureInfo = Globalization.CultureInfo.CurrentCulture
Private _separadorDecimalSalida As String = SeparadorDecimalSalidaDefault
Private _posiciones As Int32 = DecimalesDefault
Private _mascaraSalidaDecimal As String, _mascaraSalidaDecimalInterna As String = MascaraSalidaDecimalDefault
Private _esMascaraNumerica As Boolean = True
Private _letraCapital As Boolean = LetraCapitalDefault
Private _convertirDecimales As Boolean = ConvertirDecimalesDefault
Private _apocoparUnoParteEntera As Boolean = False
Private _apocoparUnoParteDecimal As Boolean
''' <summary>
''' Indica la cantidad de decimales que se pasarán a entero para la conversión
''' </summary>
''' <remarks>Esta propiedad cambia al cambiar MascaraDecimal por un valor que empieze con '0'</remarks>
Public Property Decimales() As Int32
Get
Return _decimales
End Get
Set(ByVal value As Int32)
If value > 10 Then
Throw New ArgumentException(value.ToString() + " excede el número máximo de decimales admitidos, solo se admiten hasta 10.")
End If
_decimales = value
End Set
End Property
''' <summary>
''' Objeto CultureInfo utilizado para convertir las cadenas de entrada en números
''' </summary>
Public Property CultureInfo() As CultureInfo
Get
Return _cultureInfo
End Get
Set(ByVal value As CultureInfo)
_cultureInfo = value
End Set
End Property
''' <summary>
''' Indica la cadena a intercalar entre la parte entera y la decimal del número
''' </summary>
Public Property SeparadorDecimalSalida() As String
Get
Return _separadorDecimalSalida
End Get
Set(ByVal value As String)
_separadorDecimalSalida = value
'Si el separador decimal es compuesto, infiero que estoy cuantificando algo,
'por lo que apocopo el "uno" convirtiéndolo en "un"
If value.Trim().IndexOf(" ") > 0 Then
_apocoparUnoParteEntera = True
Else
_apocoparUnoParteEntera = False
End If
End Set
End Property
''' <summary>
''' Indica el formato que se le dara a la parte decimal del número
''' </summary>
Public Property MascaraSalidaDecimal() As String
Get
If Not [String].IsNullOrEmpty(_mascaraSalidaDecimal) Then
Return _mascaraSalidaDecimal
Else
Return ""
End If
End Get
Set(ByVal value As String)
'determino la cantidad de cifras a redondear a partir de la cantidad de '0' o ''
'que haya al principio de la cadena, y también si es una máscara numérica
Dim i As Integer = 0
While i < value.Length AndAlso (value(i) = "0"c OrElse value(i) = "#")
i += 1
End While
_posiciones = i
If i > 0 Then
_decimales = i
_esMascaraNumerica = True
Else
_esMascaraNumerica = False
End If
_mascaraSalidaDecimal = value
If _esMascaraNumerica Then
_mascaraSalidaDecimalInterna = value.Substring(0, _posiciones) + "'" + value.Substring(_posiciones).Replace("''", [sub].ToString()).Replace("'", [String].Empty).Replace([sub].ToString(), "'") + "'"
Else
_mascaraSalidaDecimalInterna = value.Replace("''", [sub].ToString()).Replace("'", [String].Empty).Replace([sub].ToString(), "'")
End If
End Set
End Property
''' <summary>
''' Indica si la primera letra del resultado debe estár en mayúscula
''' </summary>
Public Property LetraCapital() As Boolean
Get
Return _letraCapital
End Get
Set(ByVal value As Boolean)
_letraCapital = value
End Set
End Property
''' <summary>
''' Indica si se deben convertir los decimales a su expresión nominal
''' </summary>
Public Property ConvertirDecimales() As Boolean
Get
Return _convertirDecimales
End Get
Set(ByVal value As Boolean)
_convertirDecimales = value
_apocoparUnoParteDecimal = value
If value Then
' Si la máscara es la default, la borro
If _mascaraSalidaDecimal = MascaraSalidaDecimalDefault Then
MascaraSalidaDecimal = ""
End If
ElseIf [String].IsNullOrEmpty(_mascaraSalidaDecimal) Then
MascaraSalidaDecimal = MascaraSalidaDecimalDefault
'Si no hay máscara dejo la default
End If
End Set
End Property
''' <summary>
''' Indica si de debe cambiar "uno" por "un" en las unidades.
''' </summary>
Public Property ApocoparUnoParteEntera() As Boolean
Get
Return _apocoparUnoParteEntera
End Get
Set(ByVal value As Boolean)
_apocoparUnoParteEntera = value
End Set
End Property
''' <summary>
''' Determina si se debe apococopar el "uno" en la parte decimal
''' </summary>
''' <remarks>El valor de esta propiedad cambia al setear ConvertirDecimales</remarks>
Public Property ApocoparUnoParteDecimal() As Boolean
Get
Return _apocoparUnoParteDecimal
End Get
Set(ByVal value As Boolean)
_apocoparUnoParteDecimal = value
End Set
End Property
#End Region
#Region "Constructores"
Public Sub New()
MascaraSalidaDecimal = MascaraSalidaDecimalDefault
SeparadorDecimalSalida = SeparadorDecimalSalidaDefault
LetraCapital = LetraCapitalDefault
ConvertirDecimales = _convertirDecimales
End Sub
Public Sub New(ByVal ConvertirDecimales As Boolean, ByVal MascaraSalidaDecimal As String, ByVal SeparadorDecimalSalida As String, ByVal LetraCapital As Boolean)
If Not [String].IsNullOrEmpty(MascaraSalidaDecimal) Then
Me.MascaraSalidaDecimal = MascaraSalidaDecimal
End If
If Not [String].IsNullOrEmpty(SeparadorDecimalSalida) Then
_separadorDecimalSalida = SeparadorDecimalSalida
End If
_letraCapital = LetraCapital
_convertirDecimales = ConvertirDecimales
End Sub
#End Region
#Region "Conversores de instancia"
Public Function ToCustomCardinal(ByVal Numero As Double) As String
Return Convertir(Convert.ToDecimal(Numero), _decimales, _separadorDecimalSalida, _mascaraSalidaDecimalInterna, _esMascaraNumerica, _letraCapital,
_convertirDecimales, _apocoparUnoParteEntera, _apocoparUnoParteDecimal)
End Function
Public Function ToCustomCardinal(ByVal Numero As String) As String
Dim dNumero As Double
If Double.TryParse(Numero, NumberStyles.Float, _cultureInfo, dNumero) Then
Return ToCustomCardinal(dNumero)
Else
Throw New ArgumentException("'" + Numero + "' no es un número válido.")
End If
End Function
Public Function ToCustomCardinal(ByVal Numero As Decimal) As String
Return ToCardinal(Numero)
End Function
Public Function ToCustomCardinal(ByVal Numero As Int32) As String
Return Convertir(Convert.ToDecimal(Numero), 0, _separadorDecimalSalida, _mascaraSalidaDecimalInterna, _esMascaraNumerica, _letraCapital,
_convertirDecimales, _apocoparUnoParteEntera, False)
End Function
#End Region
#Region "Conversores estáticos"
Public Shared Function ToCardinal(ByVal Numero As Int32) As String
Return Convertir(Convert.ToDecimal(Numero), 0, Nothing, Nothing, True, LetraCapitalDefault,
ConvertirDecimalesDefault, ApocoparUnoParteEnteraDefault, ApocoparUnoParteDecimalDefault)
End Function
Public Shared Function ToCardinal(ByVal Numero As Double) As String
Return Convertir(Convert.ToDecimal(Numero), DecimalesDefault, SeparadorDecimalSalidaDefault, MascaraSalidaDecimalDefault, True, LetraCapitalDefault,
ConvertirDecimalesDefault, ApocoparUnoParteEnteraDefault, ApocoparUnoParteDecimalDefault)
End Function
Public Shared Function ToCardinal(ByVal Numero As String, ByVal ReferenciaCultural As CultureInfo) As String
Dim dNumero As Double
If Double.TryParse(Numero, NumberStyles.Float, ReferenciaCultural, dNumero) Then
Return ToCardinal(dNumero)
Else
Throw New ArgumentException("'" + Numero + "' no es un número válido.")
End If
End Function
Public Shared Function ToCardinal(ByVal Numero As String) As String
Return NumerosAPalabras.ToCardinal(Numero, CultureInfo.CurrentCulture)
End Function
Public Shared Function ToCardinal(ByVal Numero As Decimal) As String
Return ToCardinal(Convert.ToDouble(Numero))
End Function
#End Region
Private Shared Function Convertir(ByVal Numero As Decimal, ByVal Decimales As Int32, ByVal SeparadorDecimalSalida As String, ByVal MascaraSalidaDecimal As String, ByVal EsMascaraNumerica As Boolean, ByVal LetraCapital As Boolean,
ByVal ConvertirDecimales As Boolean, ByVal ApocoparUnoParteEntera As Boolean, ByVal ApocoparUnoParteDecimal As Boolean) As String
Dim Num As Int64
Dim terna As Int32, centenaTerna As Int32, decenaTerna As Int32, unidadTerna As Int32, iTerna As Int32
Dim cadTerna As String
Dim Resultado As New StringBuilder()
Num = Math.Floor(Math.Abs(Numero))
If Num >= 1000000000001 OrElse Num < 0 Then
Throw New ArgumentException("El número '" + Numero.ToString() + "' excedió los límites del conversor: [0;1.000.000.000.001]")
End If
If Num = 0 Then
Resultado.Append(" cero")
Else
iTerna = 0
Do Until Num = 0
iTerna += 1
cadTerna = String.Empty
terna = Num Mod 1000
centenaTerna = Int(terna / 100)
decenaTerna = terna - centenaTerna * 100 'Decena junto con la unidad
unidadTerna = (decenaTerna - Math.Floor(decenaTerna / 10) * 10)
Select Case decenaTerna
Case 1 To 9
cadTerna = _matriz(UNI, unidadTerna) + cadTerna
Case 10 To 19
cadTerna = cadTerna + _matriz(DIECI, unidadTerna)
Case 20
cadTerna = cadTerna + " veinte"
Case 21 To 29
cadTerna = " veinti" + _matriz(UNI, unidadTerna).Substring(1)
Case 30 To 99
If unidadTerna <> 0 Then
cadTerna = _matriz(DECENA, Int(decenaTerna / 10)) + " y" + _matriz(UNI, unidadTerna) + cadTerna
Else
cadTerna += _matriz(DECENA, Int(decenaTerna / 10))
End If
End Select
Select Case centenaTerna
Case 1
If decenaTerna > 0 Then
cadTerna = " ciento" + cadTerna
Else
cadTerna = " cien" + cadTerna
End If
Exit Select
Case 5, 7, 9
cadTerna = _matriz(CENTENA, Int(terna / 100)) + cadTerna
Exit Select
Case Else
If Int(terna / 100) > 1 Then
cadTerna = _matriz(UNI, Int(terna / 100)) + "cientos" + cadTerna
End If
Exit Select
End Select
'Reemplazo el 'uno' por 'un' si no es en las únidades o si se solicító apocopar
If (iTerna > 1 OrElse ApocoparUnoParteEntera) AndAlso decenaTerna = 21 Then
cadTerna = cadTerna.Replace("veintiuno", "veintiún")
ElseIf (iTerna > 1 OrElse ApocoparUnoParteEntera) AndAlso unidadTerna = 1 AndAlso decenaTerna <> 11 Then
cadTerna = cadTerna.Substring(0, cadTerna.Length - 1)
'Acentúo 'veintidós', 'veintitrés' y 'veintiséis'
ElseIf decenaTerna = 22 Then
cadTerna = cadTerna.Replace("veintidos", "veintidós")
ElseIf decenaTerna = 23 Then
cadTerna = cadTerna.Replace("veintitres", "veintitrés")
ElseIf decenaTerna = 26 Then
cadTerna = cadTerna.Replace("veintiseis", "veintiséis")
End If
'Completo miles y millones
Select Case iTerna
Case 3
If Numero < 2000000 Then
cadTerna += " millón"
Else
cadTerna += " millones"
End If
Case 2, 4
If terna > 0 Then cadTerna += " mil"
End Select
Resultado.Insert(0, cadTerna)
Num = Int(Num / 1000)
Loop
End If
'Se agregan los decimales si corresponde
If Decimales > 0 Then
Dim EnteroDecimal As Int32 = Int(Math.Round((Numero - Int(Numero)) * Math.Pow(10, Decimales)))
If EnteroDecimal > 0 Then
Resultado.Append(" " + SeparadorDecimalSalida + " ")
If ConvertirDecimales Then
Dim esMascaraDecimalDefault As Boolean = MascaraSalidaDecimal = MascaraSalidaDecimalDefault
Resultado.Append(Convertir(Convert.ToDecimal(EnteroDecimal), 0, Nothing, Nothing, EsMascaraNumerica, False,
False, (ApocoparUnoParteDecimal AndAlso Not EsMascaraNumerica), False) + " " + (IIf(EsMascaraNumerica, "", MascaraSalidaDecimal)))
ElseIf EsMascaraNumerica Then
Resultado.Append(EnteroDecimal.ToString(MascaraSalidaDecimal))
Else
Resultado.Append(EnteroDecimal.ToString() + " " + MascaraSalidaDecimal)
End If
End If
End If
'Se pone la primer letra en mayúscula si corresponde y se retorna el resultado
If LetraCapital Then
Return Resultado(1).ToString().ToUpper() + Resultado.ToString(2, Resultado.Length - 2)
Else
Return Resultado.ToString().Substring(1)
End If
End Function
End Class

29
RegistroLocal.vb Normal file
View File

@@ -0,0 +1,29 @@
Public Class RegistroLocal
Public Shared Sub AñadirAlRegistroLocal(ByVal rutaConNombreDeArchivo As String, ByVal textoQueSeAñade As String)
Dim i As Integer = 0
Dim hecho As Boolean = False
Dim carpeta As String = IO.Path.GetDirectoryName(rutaConNombreDeArchivo)
Dim archivo As String = IO.Path.GetFileNameWithoutExtension(rutaConNombreDeArchivo)
Dim extension As String = IO.Path.GetExtension(rutaConNombreDeArchivo)
Dim fechaHora As String
Dim nombreArchivoResultante As String
If Not IO.Directory.Exists(carpeta) Then
IO.Directory.CreateDirectory(carpeta)
End If
While i < 3 AndAlso Not hecho
i += 1
fechaHora = Now.ToString("yyyy-MM-dd--HH-mm-ss.fff")
nombreArchivoResultante = carpeta & "\" & archivo & "-" & fechaHora & extension
Try
Using escritor As IO.StreamWriter = IO.File.AppendText(nombreArchivoResultante)
escritor.WriteLine(String.Format("{0} {1} {2}{3}", Now.ToShortDateString, Now.ToShortTimeString, Environment.NewLine, textoQueSeAñade))
End Using
hecho = True
Catch ex As Exception
'Nada, a propósito, ya que está diseñado para usar otro nombre de archivo si hace falta. Siempre debería dejarse registro en archivo.
End Try
End While
End Sub
End Class

11
Settings.vb Normal file
View File

@@ -0,0 +1,11 @@

Namespace My
'Esta clase le permite controlar eventos específicos en la clase de configuración:
' El evento SettingChanging se desencadena antes de cambiar un valor de configuración.
' El evento PropertyChanged se desencadena después de cambiar el valor de configuración.
' El evento SettingsLoaded se desencadena después de cargar los valores de configuración.
' El evento SettingsSaving se desencadena antes de guardar los valores de configuración.
Partial Friend NotInheritable Class MySettings
End Class
End Namespace

236
TripleDES.vb Normal file
View File

@@ -0,0 +1,236 @@
Imports System.IO
Imports System.Text
Imports System.Security.Cryptography
Public Class TripleDES
Private TripleDes As New TripleDESCryptoServiceProvider
Private Function TruncateHash(
ByVal key As String,
ByVal length As Integer) As Byte()
Dim sha1 As New SHA1CryptoServiceProvider
' Hash the key.
Dim keyBytes() As Byte =
System.Text.Encoding.Unicode.GetBytes(key)
Dim hash() As Byte = sha1.ComputeHash(keyBytes)
' Truncate or pad the hash.
ReDim Preserve hash(length - 1)
Return hash
End Function
Sub New(ByVal key As String)
' Initialize the crypto provider.
TripleDes.Key = Encoding.ASCII.GetBytes(key) ' TruncateHash(key, TripleDes.KeySize \ 8)
Dim B As Byte() = New Byte() {0, 0, 0, 0, 0, 0, 0, 0}
TripleDes.IV = B
TripleDes.Padding = PaddingMode.None
TripleDes.Mode = CipherMode.CBC
End Sub
Public Function EncryptData(
ByVal plaintext As String) As String
' Convert the plaintext string to a byte array.
Dim plaintextBytes() As Byte = System.Text.Encoding.ASCII.GetBytes(plaintext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the encoder to write to the stream.
Dim encStream As New CryptoStream(ms,
TripleDes.CreateEncryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
encStream.FlushFinalBlock()
' Convert the encrypted stream to a printable string.
'Return Convert.ToBase64String(ms.ToArray)
'Return Convert.ToBase64String(ms.ToArray)
Return System.Text.Encoding.UTF8.GetString(ms.ToArray)
End Function
Public Function EncryptDataHex(ByVal plaintext As String) As String
' Convert the plaintext string to a byte array.
Dim plaintextBytes() As Byte = System.Text.Encoding.ASCII.GetBytes(plaintext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the encoder to write to the stream.
Dim encStream As New CryptoStream(ms,
TripleDes.CreateEncryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
encStream.FlushFinalBlock()
Return Utilidades.ByteArrayToHex(ms.ToArray)
End Function
Public Function DecryptData(
ByVal encryptedtext As String) As String
' Convert the encrypted text string to a byte array.
'Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
Dim encryptedBytes() As Byte = Encoding.ASCII.GetBytes(encryptedtext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the decoder to write to the stream.
Dim decStream As New CryptoStream(ms,
TripleDes.CreateDecryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
' Convert the plaintext stream to a string.
'Return System.Text.Encoding.UTF8.GetString(ms.ToArray)
Return Convert.ToBase64String(ms.ToArray)
End Function
Public Function DecryptData(ByVal Encriptado() As Byte) As String
' Convert the encrypted text string to a byte array.
'Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the decoder to write to the stream.
Dim decStream As New CryptoStream(ms,
TripleDes.CreateDecryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
decStream.Write(Encriptado, 0, Encriptado.Length)
decStream.FlushFinalBlock()
' Convert the plaintext stream to a string.
Return System.Text.Encoding.ASCII.GetString(ms.ToArray)
' Return Convert.ToBase64String(ms.ToArray)
End Function
End Class
'Public Class TripleDES
' ' define the triple des provider
' Private m_des As New TripleDESCryptoServiceProvider
' ' define the string handler
' Private m_utf8 As New UTF8Encoding
' ' define the local property arrays
' Private m_key() As Byte
' 'Private m_iv() As Byte
' Private Shared IV() As Byte = {&H12, &H34, &H56, &H78, &H90, &HAB, &HCD, &HEF}
' Public Sub New(ByVal key As String)
' Me.m_key = Encoding.ASCII.GetBytes(key)
' m_des.Mode = CipherMode.CBC
' m_des.Padding = PaddingMode.PKCS7
' m_des.BlockSize = 64
' ' m_des.Padding = PaddingMode.None
' ' m_des.Mode = CipherMode.ECB
' ' Me.m_iv = iv
' End Sub
' Public Sub New(ByVal key() As Byte, ByVal iv() As Byte)
' Me.m_key = key
' ' m_des.Padding = PaddingMode.None
' ' m_des.Mode = CipherMode.ECB
' ' Me.m_iv = iv
' End Sub
' Public Function EncryptData(ByVal input() As Byte) As Byte()
' Return Transform(input, m_des.CreateEncryptor(m_key, IV))
' End Function
' Public Function Decrypt(ByVal input() As Byte) As Byte()
' Return Transform(input, m_des.CreateDecryptor(m_key, IV))
' End Function
' Public Function EncryptData(ByVal text As String) As String
' Dim input() As Byte = m_utf8.GetBytes(text)
' Dim output() As Byte = Transform(input, _
' m_des.CreateEncryptor(m_key, IV))
' Return Convert.ToBase64String(output)
' End Function
' Public Function Decrypt(ByVal text As String) As String
' Dim input() As Byte = Convert.FromBase64String(text)
' Dim output() As Byte = Transform(input, _
' m_des.CreateDecryptor(m_key, IV))
' Return m_utf8.GetString(output)
' End Function
' Private Function Transform(ByVal input() As Byte, _
' ByVal CryptoTransform As ICryptoTransform) As Byte()
' ' create the necessary streams
' Dim memStream As MemoryStream = New MemoryStream
' Dim cryptStream As CryptoStream = New _
' CryptoStream(memStream, CryptoTransform, _
' CryptoStreamMode.Write)
' ' transform the bytes as requested
' cryptStream.Write(input, 0, input.Length)
' cryptStream.FlushFinalBlock()
' ' Read the memory stream and convert it back into byte array
' memStream.Position = 0
' Dim result(CType(memStream.Length - 1, System.Int32)) As Byte
' memStream.Read(result, 0, CType(result.Length, System.Int32))
' ' close and release the streams
' memStream.Close()
' cryptStream.Close()
' ' hand back the encrypted buffer
' Return result
' End Function
' Public Shared Function DESEncrypt(ByVal Data As String, ByVal Key As String) As Byte()
' Try
' Dim bykey() As Byte = System.Text.Encoding.UTF8.GetBytes(Left(Key, 24))
' If String.IsNullOrEmpty(Data) Then
' Throw New ArgumentException("No data passed", "input")
' ElseIf bykey Is Nothing OrElse bykey.Length <> 24 Then
' Throw New ArgumentException("Invalid Key. Key must be 24 bytes length", "key")
' End If
' Dim InputByteArray() As Byte = System.Text.Encoding.UTF8.GetBytes(Data)
' Using ms As New IO.MemoryStream
' Using des As New Security.Cryptography.TripleDESCryptoServiceProvider
' Using cs As New Security.Cryptography.CryptoStream(ms, des.CreateEncryptor(bykey, IV), Security.Cryptography.CryptoStreamMode.Write)
' cs.Write(InputByteArray, 0, InputByteArray.Length)
' cs.FlushFinalBlock()
' Return ms.ToArray()
' End Using
' End Using
' End Using
' Catch ex As Exception
' Throw
' End Try
' End Function
'End Class

218
TsLogger.vb Normal file
View File

@@ -0,0 +1,218 @@
Imports System.Net.Http
Imports System.IO
Imports Microsoft.Extensions.Logging
Imports System.Threading.Tasks
Imports System.Configuration
'// Ejemplo de uso de la extensión LogVariable():
'//
'// ' Registrar información de una variable
'// Dim peassoVariable As String = "Hello, World!"
'// logger.LogVariable("peassoVariable", peassoVariable, LogLevel.Debug)
'// El uso del destino Pushover está limitado a danmun.
Public NotInheritable Class TsLoggerConfiguration
'// Identificador del evento a registrar (0 para todos).
Public Property EventId As Integer = 0
'// Nivel mínimo de registro.
Private Property _minimumLogLevel As LogLevel = LogLevel.Trace
Public Property MinimumLogLevel As String
Get
Return _minimumLogLevel
End Get
Set(logLevelString As String)
If Not [Enum].TryParse(logLevelString, True, _minimumLogLevel) Then
'// Valor predeterminado en caso de que no se pueda
'// interpretar la configuración.
_minimumLogLevel = LogLevel.Trace
End If
End Set
End Property
'// Indica si se debe registrar en la consola.
Public Property LogToConsole As Boolean = False
'// Indica si se debe registrar en la salida de depuración.
Public Property LogToDebug As Boolean = True
'// Indica si se debe registrar en un archivo.
Public Property LogToFile As Boolean = False
'// Ruta base para los archivos de registro (debe ser válida y accesible).
Public Property LogFilePath As String
Public Property LogToPushover As Boolean = False
Public Property PushoverMinimumLogLevel As LogLevel = LogLevel.Error
Public Property LogToSlack As Boolean = False
Public Property SlackDestination As String = "#notificaciones"
Public Property NetworkInSeparateThread As Boolean = False
Public Property IncludeSourceInfo As Boolean = False
'// Mapeo entre los niveles de registro y los colores de la consola.
Friend ReadOnly Property LogLevelToColorMap As Dictionary(Of LogLevel, ConsoleColor) = New Dictionary(Of LogLevel, ConsoleColor) From {
{LogLevel.Trace, ConsoleColor.DarkCyan},
{LogLevel.Debug, ConsoleColor.Cyan},
{LogLevel.Information, ConsoleColor.Green},
{LogLevel.Warning, ConsoleColor.DarkYellow},
{LogLevel.Error, ConsoleColor.Red},
{LogLevel.Critical, ConsoleColor.Magenta}
}
End Class
Public NotInheritable Class TsLogger
Implements ILogger
Private ReadOnly _name As String
Private ReadOnly _getCurrentConfig As Func(Of TsLoggerConfiguration)
Private ReadOnly _config As TsLoggerConfiguration
'// Constructor con nombre y función para obtener la configuración actual.
Public Sub New(name As String, getCurrentConfig As Func(Of TsLoggerConfiguration))
If String.IsNullOrEmpty(name) Then Throw New ArgumentException("El nombre no puede estar vacío", NameOf(name))
If getCurrentConfig Is Nothing Then Throw New ArgumentNullException(NameOf(getCurrentConfig))
_name = name
_getCurrentConfig = getCurrentConfig
End Sub
'// Constructor con nombre y configuración directa.
Public Sub New(name As String, config As TsLoggerConfiguration)
If String.IsNullOrEmpty(name) Then Throw New ArgumentException("El nombre no puede estar vacío", NameOf(name))
If config Is Nothing Then Throw New ArgumentNullException(NameOf(config))
_name = name
_config = config
End Sub
'// Obtener la configuración actual.
Private Function GetCurrentConfiguration() As TsLoggerConfiguration
Return If(_getCurrentConfig IsNot Nothing, _getCurrentConfig.Invoke(), _config)
End Function
'// Verifica si el nivel de registro está habilitado.
Public Function IsEnabled(logLevel As LogLevel) As Boolean Implements ILogger.IsEnabled
Return logLevel >= GetCurrentConfiguration().MinimumLogLevel
End Function
'// Registra un mensaje con la configuración dada.
Public Sub Log(Of TState)(logLevel As LogLevel, eventId As EventId, state As TState, exception As Exception, formatter As Func(Of TState, Exception, String)) Implements ILogger.Log
Try
Dim config As TsLoggerConfiguration = GetCurrentConfiguration() '// Obtener la configuración.
If Not IsEnabled(logLevel) Then Return
'// Obtener la información del archivo de código fuente si está habilitado.
Dim sourceInfo As String = ""
If config.IncludeSourceInfo Then
Dim stackTrace As New Diagnostics.StackTrace(True)
Dim frame As Diagnostics.StackFrame = stackTrace.GetFrame(1)
Dim fileName As String = frame.GetFileName()
Dim method As String = frame.GetMethod().Name
Dim line As Integer = frame.GetFileLineNumber()
sourceInfo = $" [Archivo: {fileName}, Método: {method}, Línea: {line}]"
End If
'// Mensaje básico sin la fecha y hora.
Dim basicMessage As String = $"[{eventId.Id,2}: {logLevel,-12}] {_name} - {formatter(state, exception)}{sourceInfo}"
'// Agregar la fecha y hora actual al inicio del mensaje para consola y archivo.
Dim timestamp As String = DateTime.Now.ToString("yyyy-MM-dd_HH·mm·sszz")
Dim messageWithTimestamp As String = $"{timestamp} {basicMessage}"
'// Registrar en la consola si está habilitado.
If config.LogToConsole Then
Console.ForegroundColor = config.LogLevelToColorMap(logLevel)
Console.WriteLine(messageWithTimestamp)
End If
'// Registrar en la salida de depuración si está habilitado.
If config.LogToDebug Then
Debug.WriteLine(basicMessage)
End If
'// Registrar en un archivo si está habilitado.
If config.LogToFile Then
If String.IsNullOrEmpty(config.LogFilePath) Then
Debug.WriteLine($"La ruta del archivo de registro no está especificada. Se omite el registro en archivos para el mensaje: {basicMessage}")
Else
Try
'// Intentar crear el directorio si no existe.
Directory.CreateDirectory(config.LogFilePath)
Dim folderPath As String = Path.Combine(config.LogFilePath, DateTime.Now.ToString("yyyy\\MM"))
Directory.CreateDirectory(folderPath)
Dim fileName As String = $"{DateTime.Now:yyyy-MM-dd_HH·mm·sszz}_{_name}.log"
Dim filePath As String = Path.Combine(folderPath, fileName)
Using writer As New StreamWriter(filePath, append:=True)
writer.WriteLine(messageWithTimestamp)
End Using
Catch ex As IOException
Debug.WriteLine($"Error al intentar crear o acceder a la ruta del archivo de registro '{config.LogFilePath}'. Error: {ex}")
End Try
End If
End If
'// Enviar notificación a Pushover si está habilitado.
If config.LogToPushover AndAlso logLevel >= config.PushoverMinimumLogLevel Then
Dim parameters As New Dictionary(Of String, String) From {
{"token", "a42g7oaz2t4u7unbdg5nm7qaqocht6"},
{"user", "uxzAV6NcPoxkAGLSNWSsZX9SfPeUo5"},
{"message", basicMessage},
{"title", $"{_name}"}, '// Utilizar el nombre del registrador como título.
{"priority", GetPushoverPriority(logLevel)} '// Establecer la prioridad en función del nivel de registro.
}
If config.NetworkInSeparateThread Then
Task.Run(Sub()
Using client As New HttpClient()
Dim response = client.PostAsync("https://api.pushover.net/1/messages.json", New FormUrlEncodedContent(parameters)).Result
Debug.WriteLine(response.ToString)
End Using
End Sub)
Else
Using client As New HttpClient()
Dim response = client.PostAsync("https://api.pushover.net/1/messages.json", New FormUrlEncodedContent(parameters)).Result
Debug.WriteLine(response.ToString)
End Using
End If
End If
'// Enviar notificación a Slack si está habilitado.
If config.LogToSlack Then
If config.NetworkInSeparateThread Then
Task.Run(Sub()
tsl5.Utilidades.EnviarNotificacionSlack(basicMessage, otroTexto:=timestamp, descripcionRemitente:=$"TsLogger {_name}", destinatario:=config.SlackDestination)
End Sub)
Else
tsl5.Utilidades.EnviarNotificacionSlack(basicMessage, otroTexto:=timestamp, descripcionRemitente:=$"TsLogger {_name}", destinatario:=config.SlackDestination)
End If
End If
Catch ex As Exception
Debug.WriteLine($"Excepción en TsLogger: {ex}")
End Try
End Sub
'// Implementación básica de BeginScope (no se necesita un manejo detallado de alcance en esta implementación).
Private Function ILogger_BeginScope(Of TState)(state As TState) As IDisposable Implements ILogger.BeginScope
Return New EmptyDisposable()
End Function
'// Clase auxiliar para cumplir con la interfaz IDisposable requerida por BeginScope.
Private Class EmptyDisposable
Implements IDisposable
Public Sub Dispose() Implements IDisposable.Dispose
'// No se requiere ninguna acción aquí.
End Sub
End Class
' Método auxiliar para convertir el nivel de registro en una prioridad para Pushover.
Private Function GetPushoverPriority(logLevel As LogLevel) As String
Select Case logLevel
Case LogLevel.Critical
Return "1" ' Prioridad alta
Case LogLevel.Error
Return "1" ' Prioridad alta
Case LogLevel.Warning
Return "0" ' Prioridad normal
Case LogLevel.Information
Return "-1" ' Prioridad baja
Case LogLevel.Debug
Return "-1" ' Prioridad baja
Case LogLevel.Trace
Return "-2" ' Prioridad mínima
Case Else
Return "0" ' Prioridad normal
End Select
End Function
End Class

56
UrlDetector.vb Normal file
View File

@@ -0,0 +1,56 @@
Imports System.Text.RegularExpressions
Public Class UrlDetector
'// Lista de protocolos compatibles
Private Shared ReadOnly Protocols As String = "https?|ftps?|sftp|file|mailto|data|rtsp|rtmp|mms|jdbc|telnet|ssh|ws|wss|svn|git|vnc|irc|sip|bitcoin|ethereum|magnet|news|nntp|ldap"
'// Patrón de nombres de dominio
Private Shared ReadOnly DomainPattern As String = "(?:[a-zA-Z0-9-]+\.)+[a-zA-Z]{2,6}"
'// Patrón para direcciones IPv4
Private Shared ReadOnly IPv4Pattern As String = "(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)"
'// Patrón para direcciones IPv6
Private Shared ReadOnly IPv6Pattern As String = "\[(?:[0-9a-fA-F]{1,4}:){7}[0-9a-fA-F]{1,4}\]"
'// Patrón para localhost
Private Shared ReadOnly LocalhostPattern As String = "localhost"
'// Número de puerto y ruta opcionales
Private Shared ReadOnly PortAndPathPattern As String = "(?::\d{1,5})?(?:/\S*)?"
'// Compilar los patrones regex para mejorar el rendimiento
Private Shared ReadOnly UrlContainsRegex As New Regex(
$"({Protocols})://(?:{DomainPattern}|{IPv4Pattern}|{IPv6Pattern}|{LocalhostPattern}){PortAndPathPattern}",
RegexOptions.Compiled Or RegexOptions.IgnoreCase)
Private Shared ReadOnly UrlIsRegex As New Regex(
$"^({Protocols})://(?:{DomainPattern}|{IPv4Pattern}|{IPv6Pattern}|{LocalhostPattern}){PortAndPathPattern}$",
RegexOptions.Compiled Or RegexOptions.IgnoreCase)
''' <summary>
''' Determina si el mensaje dado contiene una URL.
''' </summary>
''' <param name="message">El mensaje a verificar.</param>
''' <returns>True si el mensaje contiene una URL, en caso contrario False.</returns>
Public Shared Function ContainsUrl(message As String) As Boolean
If String.IsNullOrWhiteSpace(message) Then
Return False
End If
Return UrlContainsRegex.IsMatch(message)
End Function
''' <summary>
''' Determina si el mensaje dado es una URL.
''' </summary>
''' <param name="message">El mensaje a verificar.</param>
''' <returns>True si el mensaje contiene una URL, en caso contrario False.</returns>
Public Shared Function IsUrl(message As String) As Boolean
If String.IsNullOrWhiteSpace(message) Then
Return False
End If
Return UrlIsRegex.IsMatch(message)
End Function
End Class

1214
Utilidades.vb Normal file
View File

File diff suppressed because it is too large Load Diff

8
Validaciones.vb Normal file
View File

@@ -0,0 +1,8 @@
'Imports System.Text.RegularExpressions
'Public Class Validaciones
' Public Shared Function EsEmail(ByVal email As String) As Boolean
' Static emailExpression As New Regex("^[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})$")
' Return emailExpression.IsMatch(email)
' End Function
'End Class

407
ValidarDocumentoIdentidad.vb Normal file
View File

@@ -0,0 +1,407 @@

Imports System.Linq.Expressions
Imports System.Text.RegularExpressions
''' <summary>
''' Representa un número. En la clase se desglosan las distintas opciones que se puedan
''' encontrar
''' </summary>
Public Class ValidarDocumentoIdentidad
''' <summary>
''' Tipos de Códigos.
''' </summary>
''' <remarks>Aunque actualmente no se utilice el término CIF, se usa en la enumeración
''' por comodidad</remarks>
Public Enum TiposDocumentosEnum
NIF
NIE
CIF
End Enum
' Número tal cual lo introduce el usuario
Private m_numero As String
Private tipo As TiposDocumentosEnum
Public ReadOnly Property TipoDocumento As TiposDocumentosEnum
Get
Return tipo
End Get
End Property
''' <summary>
''' Parte de Nif: En caso de ser un Nif intracomunitario, permite obtener el cógido del país
''' </summary>
Public Property CodigoIntracomunitario() As String
Get
Return m_CodigoIntracomunitario
End Get
Friend Set(value As String)
m_CodigoIntracomunitario = value
End Set
End Property
Private m_CodigoIntracomunitario As String
Friend Property EsIntraComunitario() As Boolean
Get
Return m_EsIntraComunitario
End Get
Set(value As Boolean)
m_EsIntraComunitario = value
End Set
End Property
Private m_EsIntraComunitario As Boolean
''' <summary>
''' Parte de Nif: Letra inicial del Nif, en caso de tenerla
''' </summary>
Public Property LetraInicial() As String
Get
Return m_LetraInicial
End Get
Friend Set(value As String)
m_LetraInicial = value
End Set
End Property
Private m_LetraInicial As String
''' <summary>
''' Parte de Nif: Bloque numérico del NIF. En el caso de un NIF de persona física,
''' corresponderá al DNI
''' </summary>
Public Property Identificador() As Integer
Get
Return m_numero
End Get
Friend Set(value As Integer)
m_numero = value
End Set
End Property
Private m_Identificador As Integer
''' <summary>
''' Parte de Nif: Dígito de control. Puede ser número o letra
''' </summary>
Public Property DigitoControl() As String
Get
Return m_DigitoControl
End Get
Friend Set(value As String)
m_DigitoControl = value
End Set
End Property
Private m_DigitoControl As String
''' <summary>
''' Valor que representa si el Nif introducido es correcto
''' </summary>
Public Property EsCorrecto() As Boolean
Get
Return m_EsCorrecto
End Get
Friend Set(value As Boolean)
m_EsCorrecto = value
End Set
End Property
Private m_EsCorrecto As Boolean
''' <summary>
''' Cadena que representa el tipo de Nif comprobado:
''' - NIF : Número de identificación fiscal de persona física
''' - NIE : Número de identificación fiscal extranjería
''' - CIF : Código de identificación fiscal (Entidad jurídica)
''' </summary>
Public ReadOnly Property TipoNif() As String
Get
Return tipo.ToString()
End Get
End Property
''' <summary>
''' Constructor. Al instanciar la clase se realizan todos los cálculos
''' </summary>
''' <param name="numero">Cadena de 9 u 11 caracteres que contiene el DNI/NIF
''' tal cual lo ha introducido el usuario para su verificación</param>
Public Sub New(numero As String)
' Se eliminan los carácteres sobrantes
Try
' numero = EliminaCaracteres(numero)
' numero = numero.ToUpper()
' Comprobación básica de la cadena introducida por el usuario
If numero.Length <> 9 AndAlso numero.Length <> 11 Then
Me.EsCorrecto = False
Else
Me.m_numero = numero
Desglosa()
Select Case tipo
Case TiposDocumentosEnum.NIF, TiposDocumentosEnum.NIE
Me.EsCorrecto = CompruebaNif()
Exit Select
Case TiposDocumentosEnum.CIF
Me.EsCorrecto = validateCif(numero)
' Me.EsCorrecto = CompruebaCif()
Exit Select
End Select
End If
Catch ex As Exception
Me.EsCorrecto = False
End Try
End Sub
#Region "Preparación del número (desglose)"
''' <summary>
''' Realiza un desglose del número introducido por el usuario en las propiedades
''' de la clase
''' </summary>
Private Sub Desglosa()
Dim n As Int32
If m_numero.Length = 11 Then
' Nif Intracomunitario
EsIntraComunitario = True
CodigoIntracomunitario = m_numero.Substring(0, 2)
LetraInicial = m_numero.Substring(2, 1)
Int32.TryParse(m_numero.Substring(3, 7), n)
DigitoControl = m_numero.Substring(10, 1)
tipo = GetTipoDocumento(LetraInicial(0))
Else
' Nif español
tipo = GetTipoDocumento(m_numero(0))
EsIntraComunitario = False
If tipo = TiposDocumentosEnum.NIF Then
LetraInicial = String.Empty
Int32.TryParse(m_numero.Substring(0, 8), n)
Else
LetraInicial = m_numero.Substring(0, 1)
Dim listaLetrasNIE As Char() = {"X", "Y", "Z"}
If listaLetrasNIE.Contains(LetraInicial) Then
'// Las letras por las que comienza el NIE deben ser reemplazadas por números antes de realizar
'// la operación Int32.TryParse, que además deberá incluir ese número reemplazado.
'// X = 0
'// Y = 1
'// Z = 2
Select Case LetraInicial
Case "X"
m_numero = 0 & m_numero.Substring(1, m_numero.Length - 1)
Case "Y"
m_numero = 1 & m_numero.Substring(1, m_numero.Length - 1)
Case "Z"
m_numero = 2 & m_numero.Substring(1, m_numero.Length - 1)
End Select
Int32.TryParse(m_numero.Substring(0, 8), n)
Else
'// El curso normal, cuando la letra inicial no es X, Y o Z.
Int32.TryParse(m_numero.Substring(1, 7), n)
End If
End If
DigitoControl = m_numero.Substring(8, 1)
End If
Identificador = n
End Sub
''' <summary>
''' En base al primer carácter del código, se obtiene el tipo de documento que se intenta
''' comprobar
''' </summary>
''' <param name="letra">Primer carácter del número pasado</param>
''' <returns>Tipo de documento</returns>
Private Function GetTipoDocumento(letra As Char) As TiposDocumentosEnum
Dim regexIdentificadors As New Regex("[0-9]")
If regexIdentificadors.IsMatch(letra.ToString()) Then
Return TiposDocumentosEnum.NIF
End If
Dim regexLetrasNIE As New Regex("[LKMXYZ]")
If regexLetrasNIE.IsMatch(letra.ToString()) Then
Return TiposDocumentosEnum.NIE
End If
Dim regexLetrasCIF As New Regex("[ABCDEFGHJPQRSUVNW]")
If regexLetrasCIF.IsMatch(letra.ToString()) Then
Return TiposDocumentosEnum.CIF
End If
Throw New ApplicationException("El código no es reconocible")
End Function
''' <summary>
''' Eliminación de todos los carácteres no numéricos o de texto de la cadena
''' </summary>
''' <param name="numero">Número tal cual lo escribe el usuario</param>
''' <returns>Cadena de 9 u 11 carácteres sin signos</returns>
Private Function EliminaCaracteres(numero As String) As String
' Todos los carácteres que no sean números o letras
Dim caracteres As String = "[^\w]"
Dim regex As New Regex(caracteres)
Return regex.Replace(numero, "")
End Function
#End Region
#Region "Cálculos"
Private Function CompruebaNif() As Boolean
Return DigitoControl = GetLetraNif()
End Function
Public Shared Function validateCif(ByVal cif As String) As Boolean
If String.IsNullOrEmpty(cif) Then Return False
cif = cif.Trim().ToUpper()
If cif.Length <> 9 Then Return False
Dim firstChar As String = cif.Substring(0, 1)
Dim cadena As String = "ABCDEFGHJNPQRSUVW"
If cadena.IndexOf(firstChar) = -1 Then Return False
Try
Dim sumaPar As Int32 = Nothing
Dim sumaImpar As Int32 = Nothing
Dim cif_sinControl As String = cif.Substring(0, 8)
Dim digits As String = cif_sinControl.Substring(1, 7)
For n As Int32 = 0 To digits.Length - 1 Step 2
If n < 6 Then
sumaPar += Convert.ToInt32(digits(n + 1).ToString())
End If
Dim dobleImpar As Int32 = 2 * Convert.ToInt32(digits(n).ToString())
sumaImpar += (dobleImpar Mod 10) + (dobleImpar \ 10)
Next
Dim sumaTotal As Int32 = sumaPar + sumaImpar
sumaTotal = (10 - (sumaTotal Mod 10)) Mod 10
Dim digitoControl As String = ""
Select Case firstChar
Case "N", "P", "Q", "R", "S", "W"
Dim characters As Char() = {"J"c, "A"c, "B"c, "C"c, "D"c, "E"c, "F"c, "G"c, "H"c, "I"c}
digitoControl = characters(sumaTotal).ToString()
Case Else
digitoControl = sumaTotal.ToString()
End Select
Return digitoControl.Equals(cif.Substring(8, 1))
Catch __unusedException1__ As Exception
Return False
End Try
End Function
''' <summary>
''' Cálculos para la comprobación del Cif (Entidad jurídica)
''' </summary>
'Private Function CompruebaCif() As Boolean
' Dim letrasCodigo As String() = {"J", "A", "B", "C", "D", "E", _
' "F", "G", "H", "I"}
' Dim n As String = Identificador.ToString()
' Dim sumaPares As Int32 = 0
' Dim sumaImpares As Int32 = 0
' Dim sumaTotal As Int32 = 0
' Dim i As Int32 = 0
' Dim digitoCalculado As String
' Dim retVal As Boolean = False
' ' Recorrido por todos los dígitos del número
' For i = 0 To n.Length - 1
' Dim aux As Int32
' Int32.TryParse(n(i).ToString(), aux)
' If (i + 1) Mod 2 = 0 Then
' ' Si es una posición par, se suman los dígitos
' sumaPares += aux
' Else
' ' Si es una posición impar, se multiplican los dígitos por 2
' aux = aux * 2
' ' se suman los dígitos de la suma
' sumaImpares += SumaDigitos(aux)
' End If
' Next
' ' Se suman los resultados de los números pares e impares
' sumaTotal += sumaPares + sumaImpares
' ' Se obtiene el dígito de las unidades
' Dim unidades As Int32 = sumaTotal Mod 10
' ' Si las unidades son distintas de 0, se restan de 10
' If unidades <> 0 Then
' unidades = 10 - unidades
' End If
' Select Case LetraInicial
' ' Sólo números
' Case "A", "B", "E", "H"
' retVal = DigitoControl = unidades.ToString()
' Exit Select
' ' Sólo letras
' Case "K", "P", "Q", "S"
' retVal = DigitoControl = letrasCodigo(unidades)
' Exit Select
' Case Else
' retVal = (DigitoControl = unidades.ToString()) OrElse (DigitoControl = letrasCodigo(unidades))
' Exit Select
' End Select
' Return retVal
'End Function
''' <summary>
''' Obtiene la suma de todos los dígitos
''' </summary>
''' <returns>de 23, devuelve la suma de 2 + 3</returns>
Private Function SumaDigitos(digitos As Int32) As Int32
Dim sIdentificador As String = digitos.ToString()
Dim suma As Int32 = 0
For i As Int32 = 0 To sIdentificador.Length - 1
Dim aux As Int32
Int32.TryParse(sIdentificador(i).ToString(), aux)
suma += aux
Next
Return suma
End Function
''' <summary>
''' Obtiene la letra correspondiente al Dni
''' </summary>
Private Function GetLetraNif() As String
Dim indice As Integer = Identificador Mod 23
Return "TRWAGMYFPDXBNJZSQVHLCKET"(indice).ToString()
End Function
''' <summary>
''' Obtiene una cadena con el número de identificación completo
''' </summary>
Public Overrides Function ToString() As String
Dim nif As String
nif = If(EsIntraComunitario, CodigoIntracomunitario, Convert.ToString(String.Empty + LetraInicial & Identificador) & DigitoControl)
Return nif
End Function
#End Region
''' <summary>
''' Comprobación de un número de identificación fiscal español
''' </summary>
''' <param name="numero">Identificador a analizar</param>
''' <returns>Instancia de <see cref="IdentificadorNif"/> con los datos del número.
''' Destacable la propiedad <seealso cref="IdentificadorNif.EsCorrecto"/>, que contiene la verificación
''' </returns>
Public Shared Function CompruebaNif(numero As String) As ValidarDocumentoIdentidad
Return New ValidarDocumentoIdentidad(numero)
End Function
End Class

774
bbdd.vb Normal file
View File

@@ -0,0 +1,774 @@
Imports MySql.Data.MySqlClient
Imports System.Data.OleDb
Imports System.Data.EntityClient
Imports System.Data.SqlClient
Imports Oracle.ManagedDataAccess.Client
Imports System.Data.Objects
Public Class bbdd
Public Shared Function SQLADatarow(ByVal Conexion As System.Data.Common.DbConnection, ByVal ClausulaSQL As String) As DataRow
If Conexion.GetType Is GetType(OleDbConnection) Then
Throw New Exception("Tipo no soportado")
ElseIf Conexion.GetType Is GetType(MySqlConnection) Then
Return SQLADatarowMysql(Conexion, ClausulaSQL)
ElseIf Conexion.GetType Is GetType(OracleConnection) Then
Return SQLADatarowOracle(Conexion, ClausulaSQL)
Else
Throw New Exception("Tipo no soportado")
End If
End Function
Private Shared Function SQLADatarowOracle(ByVal Conexion As OracleConnection, ByVal ClausulaSQL As String) As DataRow
Try
Dim ad As OracleDataAdapter, dsDatos As New DataSet
ad = New OracleDataAdapter(ClausulaSQL, Conexion)
ad.Fill(dsDatos)
If dsDatos.Tables(0).Rows.Count > 0 Then
SQLADatarowOracle = dsDatos.Tables(0).Rows(0)
Else
SQLADatarowOracle = Nothing
End If
Catch ex As Exception
Throw New Exception(ex.Message & vbCrLf & "SQL: " & ClausulaSQL)
End Try
End Function
Private Shared Function SQLADatarowMysql(ByVal Conexion As MySqlConnection, ByVal ClausulaSQL As String) As DataRow
Try
Dim ad As MySqlDataAdapter, dsDatos As New DataSet
ad = New MySqlDataAdapter(ClausulaSQL, Conexion)
ad.Fill(dsDatos)
If dsDatos.Tables(0).Rows.Count > 0 Then
SQLADatarowMysql = dsDatos.Tables(0).Rows(0)
Else
SQLADatarowMysql = Nothing
End If
Catch ex As Exception
Throw New Exception(ex.Message & vbCrLf & "SQL: " & ClausulaSQL)
End Try
End Function
Public Shared Function EjecutaComandoMysql(ByVal Conexion As MySqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As Integer
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
'ClausulaSQL = ClausulaSQL.Replace("?", "@")
Dim mc As New MySqlCommand(ClausulaSQL, Conexion)
Dim mp As MySqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
Select Case Parametros(i).GetType
Case GetType(DateTime)
mp = New MySqlParameter("?" & i.ToString, MySqlDbType.DateTime)
mp.Value = Parametros(i)
mc.Parameters.Add(mp)
Case GetType(Boolean)
mp = New MySqlParameter("?" & i.ToString, MySqlDbType.Bit)
mp.Value = Parametros(i)
mc.Parameters.Add(mp)
Case Else
mp = New MySqlParameter("?" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
End Select
Next
End If
Return mc.ExecuteNonQuery()
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Public Shared Function EjecutaComandoSql(ByVal Conexion As SqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As Integer
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
'ClausulaSQL = ClausulaSQL.Replace("?", "@")
Dim mc As New SqlCommand(ClausulaSQL, Conexion)
Dim mp As SqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
Select Case Parametros(i).GetType
Case GetType(DateTime)
mp = New SqlParameter("?" & i.ToString, MySqlDbType.DateTime)
mp.Value = Parametros(i)
mc.Parameters.Add(mp)
Case GetType(Boolean)
mp = New SqlParameter("?" & i.ToString, MySqlDbType.Bit)
mp.Value = Parametros(i)
mc.Parameters.Add(mp)
Case Else
mp = New SqlParameter("?" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
End Select
Next
End If
Return mc.ExecuteNonQuery()
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Public Shared Function ObtienePrimeraFilaMysql(ByVal Conexion As MySqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As DataRow
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
Dim mc As New MySqlCommand(ClausulaSQL, Conexion)
Dim mp As MySqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
mp = New MySqlParameter("?" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
Next
End If
Dim dr As MySql.Data.MySqlClient.MySqlDataReader = mc.ExecuteReader()
Dim dt As New DataTable
dt.Load(dr)
If dt.Rows.Count > 0 Then
Return dt(0)
Else
Return Nothing
End If
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Public Shared Function ObtienePrimeraFilaSQLServer(ByVal Conexion As Data.SqlClient.SqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As DataRow
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Dim mc As New Data.SqlClient.SqlCommand(ClausulaSQL, Conexion)
Dim mp As SqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
mp = New SqlParameter("@" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
Next
End If
Dim dr As SqlDataReader = mc.ExecuteReader()
Dim dt As New DataTable
dt.Load(dr)
If dt.Rows.Count > 0 Then
Return dt(0)
Else
Return Nothing
End If
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Public Shared Function ObtieneTablaMysql(ByVal Conexion As MySqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As DataTable
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
Dim mc As New MySqlCommand(ClausulaSQL, Conexion)
Dim mp As MySqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
mp = New MySqlParameter("?" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
Next
End If
Dim dr As MySql.Data.MySqlClient.MySqlDataReader = mc.ExecuteReader()
Dim dt As New DataTable
' dt.BeginLoadData()
dt.Load(dr)
' dt.EndLoadData()
Return dt
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Public Shared Function ObtieneTablaSqlServer(ByVal Conexion As SqlConnection, ClausulaSQL As String, Optional Parametros() As Object = Nothing) As DataTable
Dim bCerrar As Boolean
Try
If Conexion.State = ConnectionState.Closed Then
bCerrar = True
Conexion.Open()
End If
Dim i As Integer
ClausulaSQL = ClausulaSQL.Replace("?", "@")
Do While ClausulaSQL.Contains("@")
ClausulaSQL = ClausulaSQL.Split("@")(0) & "?" & i.ToString & ClausulaSQL.Split("@", 2, StringSplitOptions.None)(1)
i += 1
Loop
Dim mc As New SqlCommand(ClausulaSQL, Conexion)
Dim mp As SqlParameter
mc.Prepare()
If Not Parametros Is Nothing Then
For i = 0 To Parametros.Length - 1
mp = New SqlParameter("?" & i.ToString, Parametros(i))
mc.Parameters.Add(mp)
Next
End If
Dim dr As SqlDataReader = mc.ExecuteReader()
Dim dt As New DataTable
' dt.BeginLoadData()
dt.Load(dr)
' dt.EndLoadData()
Return dt
Catch ex As Exception
Throw ex
Finally
Try
If bCerrar Then
Conexion.Close()
End If
Catch ex As Exception
End Try
End Try
End Function
Private Shared Function ObtienePrimeraFilaMysql(ByVal Conexion As MySqlConnection, ClausulaSQL As String, Parametros() As MySql.Data.MySqlClient.MySqlParameter) As DataRow
Try
Dim ad As New MySqlDataAdapter(ClausulaSQL, Conexion)
Dim ds As New DataSet
ad.FillSchema(ds, SchemaType.Mapped)
For Each par In Parametros
ad.SelectCommand.Parameters.Add(par)
Next
ad.Fill(ds)
Return ds.Tables(0).Rows(0)
Catch ex As Exception
Throw ex
End Try
End Function
Public Shared Function GetMySQLType(ByVal sysType As Type) As MySqlDbType
If sysType Is GetType(String) Then
Return MySqlDbType.VarChar
ElseIf sysType Is GetType(Integer) Then
Return MySqlDbType.Int64
ElseIf sysType Is GetType(Boolean) Then
Return MySqlDbType.Byte
ElseIf sysType Is GetType(Date) Then
Return MySqlDbType.Date
ElseIf sysType Is GetType(Char) Then
Return MySqlDbType.Byte
ElseIf sysType Is GetType(Decimal) Then
Return MySqlDbType.Decimal
ElseIf sysType Is GetType(Double) Then
Return MySqlDbType.Double
ElseIf sysType Is GetType(Single) Then
Return MySqlDbType.LongBlob
ElseIf sysType Is GetType(Byte()) Then
Return MySqlDbType.Binary
ElseIf sysType Is GetType(Guid) Then
Return MySqlDbType.Guid
Else
Throw New Exception("Tipo no soportado")
End If
End Function
Public Shared Function GeneraConnectionStringMySQLPasswordClara(Servidor As String, Esquema As String, usuario As String, password As String, Optional Puerto As Integer = 13306, Optional SegundosTimeout As Integer = 60, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As String
Dim sCadenaDeConexion As String
sCadenaDeConexion = "server=" & Servidor &
";database=" & Esquema &
";user=" & usuario &
";Password=" & password &
";port=" & Puerto.ToString &
";default command Timeout=" & SegundosTimeout.ToString & ";" &
";Connection Timeout=" & SegundosTimeout.ToString & ";"
If Pooling Then sCadenaDeConexion &= "Pooling=True;"
If SSL Then sCadenaDeConexion &= "SSL Mode=Required;"
If FicheroCertificado <> "" Then sCadenaDeConexion &= "CertificateFile=" & FicheroCertificado & ";"
If FicheroCertificado <> "" Then sCadenaDeConexion &= "CertificateFile=" & FicheroCertificado & ";"
If ContraseñaCertificado <> "" Then sCadenaDeConexion &= "CertificatePassword=" & ContraseñaCertificado & ";"
Return sCadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringMySQL(Servidor As String, Esquema As String, usuario As String, passwordEnc As String, Optional Puerto As Integer = 13306, Optional SegundosTimeout As Integer = 60, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As String
Dim cadenaDeConexion As String = ""
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim spassword As String = crypt.FEncS(passwordEnc, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
cadenaDeConexion = "server=" & Servidor &
";database=" & Esquema &
";user=" & usuario &
";Password=" & spassword &
";port=" & Puerto.ToString &
";default command Timeout=" & SegundosTimeout.ToString & ";" &
";Connection Timeout=" & SegundosTimeout.ToString & ";"
If Pooling Then cadenaDeConexion &= "Pooling=True;"
If SSL Then cadenaDeConexion &= "SSL Mode=Required;"
If FicheroCertificado <> "" Then cadenaDeConexion &= "CertificateFile=" & FicheroCertificado & ";"
If FicheroCertificado <> "" Then cadenaDeConexion &= "CertificateFile=" & FicheroCertificado & ";"
If ContraseñaCertificado <> "" Then cadenaDeConexion &= "CertificatePassword=" & ContraseñaCertificado & ";"
Return cadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringOraclePasswordClara(Servidor As String, Esquema As String, usuario As String, password As String, Optional Puerto As Integer = 13306, Optional SegundosTimeout As Integer = 60, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As String
Dim cadenaDeConexion As String
If Pooling Then
cadenaDeConexion = "DATA SOURCE=" & Servidor &
":" & Puerto.ToString &
"/" & Esquema &
";USER ID=" & usuario &
";PASSWORD=" & password &
";PERSIST SECURITY INFO=True;"
Else
cadenaDeConexion = "DATA SOURCE=" & Servidor &
":" & Puerto.ToString &
"/" & Esquema &
";USER ID=" & usuario &
";PASSWORD=" & password &
";POOLING=False" &
";PERSIST SECURITY INFO=True;"
End If
Return cadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringOracle(Servidor As String, Esquema As String, usuario As String, passwordEnc As String, Optional Puerto As Integer = 13306, Optional SegundosTimeout As Integer = 60, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As String
Dim cadenaDeConexion As String = ""
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim spassword As String = crypt.FEncS(passwordEnc, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
If Pooling Then
cadenaDeConexion = "DATA SOURCE=" & Servidor &
":" & Puerto.ToString &
"/" & Esquema &
";USER ID=" & usuario &
";PASSWORD=" & spassword &
";PERSIST SECURITY INFO=True;"
Else
cadenaDeConexion = "DATA SOURCE=" & Servidor &
":" & Puerto.ToString &
"/" & Esquema &
";USER ID=" & usuario &
";PASSWORD=" & spassword &
";POOLING=False" &
";PERSIST SECURITY INFO=True;"
End If
Return cadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringLocalDB(Servidor As String, FicheroMDF As String) As String
Return "Server=" & Servidor & ";Integrated Security=true;AttachDbFileName=" & FicheroMDF & ";"
End Function
Public Shared Function GeneraConnectionStringSQLServer(Servidor As String, DataBase As String, usuario As String, passwordEnc As String, Optional Puerto As Integer = 1433) As String
Dim cadenaDeConexion As String = ""
'Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
'Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim spassword As String = crypt.FEncS(passwordEnc, "[JO1]", "[JD1]", -875421649)
cadenaDeConexion = "Server=" & Servidor & ", " & Puerto.ToString &
";Database=" & DataBase &
";User Id=" & usuario &
";Password=" & spassword & ";"
Return cadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringSQLServer(Servidor As String, DataBase As String, usuario As String, passwordEnc As String, Optional Puerto As Integer = 1433, Optional JuegoCaracteresOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-", Optional JuegoCaracteresDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-") As String
Dim cadenaDeConexion As String = ""
' Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
' Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim spassword As String = crypt.FEncS(passwordEnc, JuegoCaracteresOrigen, JuegoCaracteresDestino, -875421649)
cadenaDeConexion = "Server=" & Servidor & ", " & Puerto.ToString &
";Database=" & DataBase &
";User Id=" & usuario &
";Password=" & spassword & ";"
Return cadenaDeConexion
End Function
Public Shared Function GeneraConnectionStringSQLServerPasswordClara(Servidor As String, DataBase As String, usuario As String, password As String, Optional Puerto As Integer = 1433) As String
Dim cadenaDeConexion As String = ""
cadenaDeConexion = "Server=" & Servidor & ", " & Puerto.ToString &
";Database=" & DataBase &
";User Id=" & usuario &
";Password=" & password & ";"
Return cadenaDeConexion
End Function
'Public Shared Function ConectarTsl5EntitySQLServer(ByVal DataSource As String, InitialCatalog As String, ByVal user As String, ByVal password As String, NombreMetadata As String) As tsl5Entities
' Return New tsl5Entities(ObtieneEntityConnectionStringSQLServer(DataSource, InitialCatalog, user, password, NombreMetadata))
'End Function
'Public Shared Function ConectarTsl5EntityMySQL(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal password As String, NombreMetadata As String, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As tsl5Entities
' Return New tsl5Entities(ObtieneEntityConnectionStringMysql(server, database, port, user, password, NombreMetadata, Pooling, SSL, FicheroCertificado, ContraseñaCertificado))
'End Function
'Public Shared Function ConectarTsl5EntityLocalDB(ByVal Datasource As String, ByVal Fichero As String, ByVal Database As String, NombreMetaData As String, Optional IntegratedSecurity As Boolean = True) As tsl5Entities
' Return New tsl5Entities(ObtieneEntityConnectionStringLocalDB(Datasource, Fichero, Database, NombreMetaData, IntegratedSecurity))
'End Function
Public Shared Function ObtieneEntityConnectionStringSQLServer(ByVal DataSource As String, InitialCatalog As String, ByVal user As String, ByVal password As String, NombreMetadata As String, Optional passwordclara As Boolean = False, Optional Puerto As Integer = 1433, Optional ConnectionTimeout As Integer = 60) As String
' Initialize the connection string builder for the underlying provider.
Dim sqlBuilder As New Data.SqlClient.SqlConnectionStringBuilder
' Set the properties for the data source.
sqlBuilder.DataSource = DataSource & "," & Puerto.ToString
sqlBuilder.InitialCatalog = InitialCatalog
sqlBuilder.PersistSecurityInfo = True
sqlBuilder.MultipleActiveResultSets = True
sqlBuilder.IntegratedSecurity = False
sqlBuilder.ConnectTimeout = ConnectionTimeout
If passwordclara Then
sqlBuilder.Password = password
Else
sqlBuilder.Password = crypt.FEncS(password, "[JO1]", "[JD1]", -875421649)
End If
sqlBuilder.UserID = user
' Build the SqlConnection connection string.
Dim providerString As String = sqlBuilder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "System.Data.SqlClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
entityBuilder.Metadata = "res://*/" & NombreMetadata & ".csdl|res://*/" & NombreMetadata & ".ssdl|res://*/" & NombreMetadata & ".msl"
Return entityBuilder.ToString
End Function
Public Shared Function ObtieneEntityConnectionStringLocalDB(ByVal Datasource As String, ByVal Fichero As String, ByVal Database As String, NombreMetaData As String, Optional IntegratedSecurity As Boolean = True, Optional ConnectionTimeout As Integer = 60) As String
Dim SqlBuilder As New Data.SqlClient.SqlConnectionStringBuilder
SqlBuilder.DataSource = Datasource
SqlBuilder.AttachDBFilename = Fichero
SqlBuilder.InitialCatalog = Database
SqlBuilder.IntegratedSecurity = IntegratedSecurity
SqlBuilder.Enlist = True ' tsl5.cryp.FEncS(password, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
SqlBuilder.MultipleActiveResultSets = True
SqlBuilder.ConnectTimeout = ConnectionTimeout
' Build the SqlConnection connection string.
Dim providerString As String = SqlBuilder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New System.Data.EntityClient.EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "System.Data.SqlClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
entityBuilder.Metadata = "res://*/" & NombreMetaData & ".csdl|res://*/" & NombreMetaData & ".ssdl|res://*/" & NombreMetaData & ".msl"
Return entityBuilder.ToString()
End Function
Public Shared Function ObtieneEntityConnectionStringMysql(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal passwordEnc As String, NombreMetadata As String, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "", Optional ConnectionTimeout As UInteger = 60) As String
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
' Initialize the connection string builder for the underlying provider.
Dim mySqlBuilder As New MySqlConnectionStringBuilder
' Set the properties for the data source.
mySqlBuilder.Server = server
mySqlBuilder.Port = port
mySqlBuilder.Database = database
mySqlBuilder.Password = crypt.FEncS(passwordEnc, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
mySqlBuilder.UserID = user
mySqlBuilder.ConnectionTimeout = ConnectionTimeout
mySqlBuilder.Pooling = Pooling
mySqlBuilder.ConvertZeroDateTime = True
mySqlBuilder.SslMode = If(SSL, MySqlSslMode.Required, MySqlSslMode.None)
If FicheroCertificado <> "" Then mySqlBuilder.CertificateFile = FicheroCertificado
If ContraseñaCertificado <> "" Then mySqlBuilder.CertificatePassword = ContraseñaCertificado
' Build the SqlConnection connection string.
Dim providerString As String = mySqlBuilder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "MySql.Data.MySqlClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
If NombreMetadata <> "" Then
entityBuilder.Metadata = "res://*/" & NombreMetadata & ".csdl|res://*/" & NombreMetadata & ".ssdl|res://*/" & NombreMetadata & ".msl"
End If
Return entityBuilder.ToString
End Function
Public Shared Function ObtieneEntityConnectionStringMysqlReducido(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal passwordEnc As String, Optional Pooling As Boolean = False, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "", Optional ConnectionTimeout As UInteger = 60) As String
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
' Initialize the connection string builder for the underlying provider.
Dim mySqlBuilder As New MySqlConnectionStringBuilder
' Set the properties for the data source.
mySqlBuilder.Server = server
mySqlBuilder.Port = port
mySqlBuilder.Database = database
mySqlBuilder.Password = crypt.FEncS(passwordEnc, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
mySqlBuilder.UserID = user
mySqlBuilder.ConnectionTimeout = ConnectionTimeout
mySqlBuilder.Pooling = Pooling
mySqlBuilder.SslMode = If(SSL, MySqlSslMode.Required, MySqlSslMode.None)
If FicheroCertificado <> "" Then mySqlBuilder.CertificateFile = FicheroCertificado
If ContraseñaCertificado <> "" Then mySqlBuilder.CertificatePassword = ContraseñaCertificado
Dim providerString As String = mySqlBuilder.ToString()
Return providerString
End Function
Public Shared Function ObtieneEntityConnectionStringOracle(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal passwordEnc As String, NombreMetadata As String, Optional Pooling As Boolean = True, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "", Optional ConnectionTimeOut As Integer = 60) As String
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
' Initialize the connection string builder for the underlying provider.
Dim Builder As New OracleConnectionStringBuilder
' Set the properties for the data source.
Builder.DataSource = server & ":" & port & "/" & database
Builder.Password = crypt.FEncS(passwordEnc, juegoDeCaracteresDeOrigen, juegoDeCaracteresDeDestino, -875421649)
Builder.UserID = user
Builder.ConnectionTimeout = ConnectionTimeOut
Builder.Pooling = Pooling
' Builder.SslMode = If(SSL, MySqlSslMode.Required, MySqlSslMode.None)
' If FicheroCertificado <> "" Then Builder.CertificateFile = FicheroCertificado
' If ContraseñaCertificado <> "" Then Builder.CertificatePassword = ContraseñaCertificado
' Build the SqlConnection connection string.
Dim providerString As String = Builder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "Oracle.ManagedDataAccess.Client" '"System.Data.EntityClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
entityBuilder.Metadata = "res://*/" & NombreMetadata & ".csdl|res://*/" & NombreMetadata & ".ssdl|res://*/" & NombreMetadata & ".msl"
Return entityBuilder.ToString
End Function
Public Shared Function ObtieneEntityConnectionStringOraclePasswordClara(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal password As String, NombreMetadata As String, Optional Pooling As Boolean = True, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "", Optional ConnectionTimeOut As Integer = 60) As String
Dim juegoDeCaracteresDeOrigen As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
Dim juegoDeCaracteresDeDestino As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.:/\-"
' Initialize the connection string builder for the underlying provider.
Dim Builder As New OracleConnectionStringBuilder
' Set the properties for the data source.
Builder.DataSource = server & ":" & port & "/" & database
Builder.Password = password
Builder.UserID = user
Builder.ConnectionTimeout = ConnectionTimeOut
Builder.Pooling = Pooling
' Builder.SslMode = If(SSL, MySqlSslMode.Required, MySqlSslMode.None)
' If FicheroCertificado <> "" Then Builder.CertificateFile = FicheroCertificado
' If ContraseñaCertificado <> "" Then Builder.CertificatePassword = ContraseñaCertificado
' Build the SqlConnection connection string.
Dim providerString As String = Builder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "Oracle.ManagedDataAccess.Client" '"System.Data.EntityClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
entityBuilder.Metadata = "res://*/" & NombreMetadata & ".csdl|res://*/" & NombreMetadata & ".ssdl|res://*/" & NombreMetadata & ".msl"
Return entityBuilder.ToString
End Function
Public Shared Function ObtieneEntityConnectionStringMysqlPasswordClara(ByVal server As String, ByVal database As String, ByVal port As String, ByVal user As String, ByVal password As String, NombreMetadata As String, Optional Pooling As Boolean = True, Optional SSL As Boolean = False, Optional FicheroCertificado As String = "", Optional ContraseñaCertificado As String = "") As String
' Initialize the connection string builder for the underlying provider.
Dim mySqlBuilder As New MySqlConnectionStringBuilder
' Set the properties for the data source.
mySqlBuilder.Server = server
mySqlBuilder.Port = port
mySqlBuilder.Database = database
mySqlBuilder.Password = password
mySqlBuilder.UserID = user
mySqlBuilder.ConnectionTimeout = 60
mySqlBuilder.Pooling = Pooling
mySqlBuilder.SslMode = If(SSL, MySqlSslMode.Required, MySqlSslMode.None)
If FicheroCertificado <> "" Then mySqlBuilder.CertificateFile = FicheroCertificado
If ContraseñaCertificado <> "" Then mySqlBuilder.CertificatePassword = ContraseñaCertificado
' Build the SqlConnection connection string.
Dim providerString As String = mySqlBuilder.ToString()
' Initialize the EntityConnectionStringBuilder.
Dim entityBuilder As New EntityConnectionStringBuilder()
'Set the provider name.
entityBuilder.Provider = "MySql.Data.MySqlClient"
' Set the provider-specific connection string.
entityBuilder.ProviderConnectionString = providerString
' Set the Metadata location.
entityBuilder.Metadata = "res://*/" & NombreMetadata & ".csdl|res://*/" & NombreMetadata & ".ssdl|res://*/" & NombreMetadata & ".msl"
Return entityBuilder.ToString
End Function
Public Shared Function FechaHoraMySQL(ByVal FechaHora As Date) As String
Return FechaHora.Year.ToString & FechaHora.Month.ToString.PadLeft(2, "0") & FechaHora.Day.ToString.PadLeft(2, "0") & FechaHora.Hour.ToString.PadLeft(2, "0") & FechaHora.Minute.ToString.PadLeft(2, "0") & FechaHora.Second.ToString.PadLeft(2, "0")
End Function
Public Shared Function FechaMySQL(ByVal FechaHora As Date) As String
Return FechaHora.Year.ToString & FechaHora.Month.ToString.PadLeft(2, "0") & FechaHora.Day.ToString.PadLeft(2, "0")
End Function
Public Shared Function AhoraMysql(bd As System.Data.Objects.ObjectContext) As DateTime
Try
Dim FechaServidor As DateTime = bd.ExecuteStoreQuery(Of DateTime)("select now() as Ahora").First
Return FechaServidor
Catch ex As Exception
Return Now
End Try
End Function
Public Shared Function ObtieneIPMysql(bd As System.Data.Objects.ObjectContext) As String
Dim sConexion As String = bd.ExecuteStoreQuery(Of String)("select host from information_schema.processlist WHERE ID=connection_id()").First
Dim sIP As String = sConexion.Split(":")(0)
Return sIP
End Function
Public Shared Function ObtieneIPSqlServer(bd As System.Data.Objects.ObjectContext) As String
Dim sConexion As String = bd.ExecuteStoreQuery(Of String)("SELECT client_net_address FROM sys.dm_exec_connections WHERE session_id = @@SPID").First
Return sConexion
End Function
Public Shared Function AhoraSqlServer(bd As ObjectContext) As DateTime
Try
Dim FechaServidor As DateTime = bd.ExecuteStoreQuery(Of DateTime)("select SYSDATETIME() as Ahora").First
Return FechaServidor
Catch ex As Exception
Return Now
End Try
End Function
End Class

3885
clFuncionesGenericas.vb Normal file
View File

File diff suppressed because it is too large Load Diff

585
crypt.vb Normal file
View File

@@ -0,0 +1,585 @@
Imports System.IO
Imports System.Security.Cryptography
Imports System.Text
Public Class crypt
Public Shared Function FEncS$(ByVal X$, ByVal Jco0$, ByVal Jcd0$, ByVal Xs0 As Long)
Dim T$, Resultado$, Jco$, Jcd$, Cd$, Co$
Dim R, F, Lo0, Ld0, Lx, Ld, Xs, Po, Lo, Pd, Px, Spac As Long
Dim SEncDes, I As Integer
Resultado$ = ""
If Xs0 = 0 Then ' Traduccion de tokens <xx>
T$ = X$
Do
F = 0
If Left$(T$, 3) = "[V]" Then Resultado$ = Resultado$ + "" : T$ = Mid$(T$, 4) : F = 1
If Left$(T$, 4) = "[AM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" : T$ = Mid$(T$, 5) : F = 1
If Left$(T$, 4) = "[Am]" Then Resultado$ = Resultado$ + "abcdefghijklmnopqrstuvwxyz" : T$ = Mid$(T$, 5) : F = 1
If Left$(T$, 3) = "[N]" Then Resultado$ = Resultado$ + "0123456789" : T$ = Mid$(T$, 4) : F = 1
If Left$(T$, 4) = "[AN]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" : T$ = Mid$(T$, 5) : F = 1
'If Left$(T$, 5) = "[ANM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" : T$ = Mid$(T$, 6) : F = 1
If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
' If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
' If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
Loop Until F = 0
FEncS$ = Resultado$ + T$
Exit Function
End If
If Math.Abs(Xs0) < 100000000.0 Then Error 11
SEncDes = Math.Sign(Xs0) ' +1 o -1
If SEncDes > 0 Then ' inversion de parametros si Desencriptacion
Jco$ = Jco0$ : Jcd$ = Jcd0$
Else
Jco$ = Jcd0$ : Jcd$ = Jco0$
End If
Jco$ = FEncS$(Jco$, "", "", 0)
Jcd$ = FEncS$(Jcd$, "", "", 0)
Lo0 = Len(Jco$) : Ld0 = Len(Jcd$)
Lo = Lo0 + -256 * (Lo0 = 0) : Ld = Ld0 + -256 * (Ld0 = 0)
If SEncDes > 0 Then Lx = Ld Else Lx = Lo
Xs = Math.Abs(Xs0) + 611957 * (Len(X$) Mod 1000) ' ????
' R = FRndL(-(ABS(Xs0) + 1000000 * (LEN(X$) MOD 1000)))
Spac = Math.Abs(Xs0) Mod Lx
For I = 1 To Len(X$)
Co$ = Mid$(X$, I, 1)
If Lo0 <> 0 Then Po = InStr(Jco$, Co$) Else Po = Asc(Co$) + 1
If Po = 0 Then Resultado$ = "" : Error 11
Xs = 16807 * (Xs Mod 127773) - 2836 * (Xs \ 127773)
If Xs < 0 Then Xs = Xs + 2147483647
R = Int((Xs / 2147483647.0#) * Lx)
' R1 = INT(FRndL(0) * Lx)
' IF R <> R1 THEN STOP
Pd = ((Po - 1) + SEncDes * (R + Spac) + 2 * Lx) Mod Lx + 1
If SEncDes > 0 Then Px = Po Else Px = Pd
Spac = (Spac + Px * 17) Mod Lx
If Ld0 <> 0 Then Cd$ = Mid$(Jcd$, Pd, 1) Else Cd$ = Chr(Pd - 1)
Resultado$ = Resultado$ + Cd$
Next I
FEncS$ = Resultado$
End Function
Public Shared Function SHA1ASCII(ByVal strToHash As String) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA1(ByVal strToHash As String) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.Unicode.GetBytes(strToHash)
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA1(ByVal Datos() As Byte) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = Datos
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA256(ByVal Datos() As Byte) As String
Dim sha256Obj As New Security.Cryptography.SHA256CryptoServiceProvider
Dim bytesToHash() As Byte = Datos
bytesToHash = sha256Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA256(ByVal Cadena As String) As String
Dim sha256Obj As New Security.Cryptography.SHA256CryptoServiceProvider
Dim Datos() As Byte = System.Text.Encoding.Unicode.GetBytes(Cadena)
Dim bytesToHash() As Byte = Datos
bytesToHash = sha256Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function ObtenerCadenaHashSHA256AportandoSal(ByVal cadenaQueQuieroHashear As String, ByVal sal As String)
Dim sb As Text.StringBuilder = New Text.StringBuilder()
For Each b As Byte In GetHashSHA256(cadenaQueQuieroHashear, sal)
sb.Append(b.ToString("X2"))
Next
Return sb.ToString()
End Function
Private Shared Function GetHashSHA256(ByVal cadenaQueQuieroHashear As String, ByVal sal As String) As Byte()
Using ha As Security.Cryptography.HashAlgorithm = Security.Cryptography.SHA256.Create()
Return ha.ComputeHash(Text.Encoding.UTF8.GetBytes(String.Format("{0}{1}", cadenaQueQuieroHashear.Trim(), sal.Trim())))
End Using
End Function
Public Shared Function AES(ByVal streamOrigen As Stream,
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
ByVal streamDestino As Stream,
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Long
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de AES() para streams.
'-------------------------------------------------------------------------------------------
' streamOrigen: Fuente de los datos. Se encripta/desencripta 'streamOrigen' AL COMPLETO,
' independientemente de la posición de su cabeza lectora.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta AES (128 bits, 192 bits o 256 bits).
' IV: Vector de inicialización (16 bytes).
'
' streamDestino: Destino de los datos encriptados/desencriptados.
' Los datos encriptados/desencriptados se escriben A PARTIR DE LA POSICIÓN
' EN LA QUE SE ENCUENTRE LA CABEZA ESCRITORA de'streamDestino'.
'
' padding: Modo de padding. Por defecto padding PKCS #7.
'
' VALOR DEVUELTO: Número de bytes escritos en 'streamDestino'.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase AesCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
' Tamaño del buffer de lectura/escritura (en bytes).
' Se lee/escribe en bloques de TAM_BUFFER bytes.
Const TAM_BUFFER As Integer = 4 * 1024
Try
If streamOrigen Is Nothing Then Throw New Exception("'streamOrigen' es Nothing.")
If clave Is Nothing Then Throw New Exception("'clave' es Nothing.")
If IV Is Nothing Then Throw New Exception("'IV' es Nothing.")
If streamDestino Is Nothing Then Throw New Exception("'streamDestino' es Nothing.")
'---------------
Dim aesCSP As New AesCryptoServiceProvider()
aesCSP.Padding = padding
aesCSP.Mode = CipherMode.CBC
aesCSP.Key = clave
aesCSP.IV = IV
'---------------
Dim ctransform As ICryptoTransform
If encriptar Then
ctransform = aesCSP.CreateEncryptor()
Else
ctransform = aesCSP.CreateDecryptor()
End If
'---------------
Dim cstream As New CryptoStream(streamDestino, ctransform, CryptoStreamMode.Write)
'-------------------------------------------------------------------
' Leemos datos desde 'streamOrigen' y los escribimos en 'cstream',
' que a su vez los escribe en 'streamDestino' previa aplicación de
' la transformación de encriptación/desencriptación.
'-------------------------------------------------------------------
' Leemos 'streamOrigen' desde el principio:
streamOrigen.Position = 0
Dim buffer(TAM_BUFFER - 1) As Byte
Dim n As Integer ' Número de bytes leídos en la iteración actual.
Dim posInicialDestino As Long = streamDestino.Position
While True
n = streamOrigen.Read(buffer, 0, TAM_BUFFER)
If n = 0 Then
' Fin del stream
Exit While
End If
cstream.Write(buffer, 0, n)
End While
cstream.FlushFinalBlock()
Dim posFinalDestino As Long = streamDestino.Position
' Se devuelve el número de bytes escritos en 'streamDestino':
Return posFinalDestino - posInicialDestino
Catch ex As Exception
Throw New Exception("Calculando AES." & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function AES(ByVal bytesOrigen As Byte(),
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Byte()
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de AES() para arrays de bytes.
'-------------------------------------------------------------------------------------------
' bytesOrigen: Fuente de los datos para la encriptación/desencriptación.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta AES (128 bits, 192 bits o 256 bits).
' IV: Vector de inicialización (16 bytes).
'
' padding: Modo de padding. Por defecto padding PKCS #7.
'
' VALOR DEVUELTO: Array de bytes resultado de la encriptación/desencriptación.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase AesCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
If bytesOrigen Is Nothing Then
Throw New Exception("Calculando AES: 'bytesOrigen' es Nothing.")
End If
Dim streamOrigen As New MemoryStream(bytesOrigen)
Dim streamDestino As New MemoryStream()
AES(streamOrigen, encriptar, clave, IV, streamDestino, padding)
Return streamDestino.ToArray()
End Function
''' <summary>
''' Utilizado por Arquia para las traspasos en el COAS.
''' </summary>
''' <param name="toEncrypt"></param>
''' <param name="securityKey"></param>
''' <returns></returns>
Public Shared Function TripleDES_Cifrar(ByVal toEncrypt As String,
ByVal securityKey As String) As String
Dim resultado As String = String.Empty
Try
Dim keyArray As Byte()
Dim toEncryptArray As Byte() = UTF8Encoding.UTF8.GetBytes(toEncrypt)
Dim hashmd5 As MD5CryptoServiceProvider = New MD5CryptoServiceProvider()
keyArray = hashmd5.ComputeHash(UTF8Encoding.UTF8.GetBytes(securityKey))
hashmd5.Clear()
Dim tdes As TripleDESCryptoServiceProvider = New TripleDESCryptoServiceProvider()
tdes.Key = keyArray
tdes.Mode = CipherMode.ECB
tdes.Padding = PaddingMode.PKCS7
Dim cTransform As ICryptoTransform = tdes.CreateEncryptor()
Dim resultArray As Byte() = cTransform.TransformFinalBlock(toEncryptArray, 0, toEncryptArray.Length)
tdes.Clear()
resultado = Convert.ToBase64String(resultArray, 0, resultArray.Length)
Catch ex As Exception
'// TODO: danmun, excepción calculando
Throw ex
End Try
Return resultado
End Function
''' <summary>
''' Utilizado por Arquia para las traspasos en el COAS.
''' </summary>
''' <param name="cipherString"></param>
''' <param name="securityKey"></param>
''' <returns></returns>
Public Shared Function TripleDES_Descifrar(ByVal cipherString As String, ByVal securityKey As String) As String
Dim resultado As String = ""
Try
Dim keyArray As Byte()
Dim toEncryptArray As Byte() = Convert.FromBase64String(cipherString)
Dim hashmd5 As MD5CryptoServiceProvider = New MD5CryptoServiceProvider()
keyArray = hashmd5.ComputeHash(UTF8Encoding.UTF8.GetBytes(securityKey))
hashmd5.Clear()
Dim tdes As TripleDESCryptoServiceProvider = New TripleDESCryptoServiceProvider()
tdes.Key = keyArray
tdes.Mode = CipherMode.ECB
tdes.Padding = PaddingMode.PKCS7
Dim cTransform As ICryptoTransform = tdes.CreateDecryptor()
Dim resultArray As Byte() = cTransform.TransformFinalBlock(toEncryptArray, 0, toEncryptArray.Length)
tdes.Clear()
resultado = UTF8Encoding.UTF8.GetString(resultArray)
Catch ex As Exception
'// TODO: danmun, excepción calculando
Throw New Exception(ex.Message, ex)
End Try
Return resultado
End Function
Public Shared Function TripleDES(ByVal streamOrigen As Stream,
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
ByVal streamDestino As Stream,
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Long
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de TripleDES() para streams.
'-------------------------------------------------------------------------------------------
' streamOrigen: Fuente de los datos. Se encripta/desencripta 'streamOrigen' AL COMPLETO,
' independientemente de la posición de su cabeza lectora.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta TripleDES (128 bits o 192 bits).
' IV: Vector de inicialización (8 bytes).
'
' streamDestino: Destino de los datos encriptados/desencriptados.
' Los datos encriptados/desencriptados se escriben A PARTIR DE LA POSICIÓN
' EN LA QUE SE ENCUENTRE LA CABEZA ESCRITORA de'streamDestino'.
'
' padding: Modo de padding. Por defecto padding PKCS #7 (= padding PKCS #5).
'
' VALOR DEVUELTO: Número de bytes escritos en 'streamDestino'.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase TripleDESCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
' Tamaño del buffer de lectura/escritura (en bytes).
' Se lee/escribe en bloques de TAM_BUFFER bytes.
Const TAM_BUFFER As Integer = 4 * 1024
Try
If streamOrigen Is Nothing Then Throw New Exception("'streamOrigen' es Nothing.")
If clave Is Nothing Then Throw New Exception("'clave' es Nothing.")
If IV Is Nothing Then Throw New Exception("'IV' es Nothing.")
If streamDestino Is Nothing Then Throw New Exception("'streamDestino' es Nothing.")
'---------------
Dim tdesCSP As New TripleDESCryptoServiceProvider()
tdesCSP.Padding = padding
tdesCSP.Mode = CipherMode.CBC
tdesCSP.Key = clave
tdesCSP.IV = IV
'---------------
Dim ctransform As ICryptoTransform
If encriptar Then
ctransform = tdesCSP.CreateEncryptor()
Else
ctransform = tdesCSP.CreateDecryptor()
End If
'---------------
Dim cstream As New CryptoStream(streamDestino, ctransform, CryptoStreamMode.Write)
'-------------------------------------------------------------------
' Leemos datos desde 'streamOrigen' y los escribimos en 'cstream',
' que a su vez los escribe en 'streamDestino' previa aplicación de
' la transformación de encriptación/desencriptación.
'-------------------------------------------------------------------
' Leemos 'streamOrigen' desde el principio:
streamOrigen.Position = 0
Dim buffer(TAM_BUFFER - 1) As Byte
Dim n As Integer ' Número de bytes leídos en la iteración actual.
Dim posInicialDestino As Long = streamDestino.Position
While True
n = streamOrigen.Read(buffer, 0, TAM_BUFFER)
If n = 0 Then
' Fin del stream
Exit While
End If
cstream.Write(buffer, 0, n)
End While
cstream.FlushFinalBlock()
Dim posFinalDestino As Long = streamDestino.Position
' Se devuelve el número de bytes escritos en 'streamDestino':
Return posFinalDestino - posInicialDestino
Catch ex As Exception
Throw New Exception("Calculando TripleDES." & vbCrLf & ex.Message, ex)
End Try
End Function
''' <summary>
''' Utilizado para la comunicación con ADA SURNET en TsBUS.
''' </summary>
''' <param name="bytesOrigen"></param>
''' <param name="encriptar"></param>
''' <param name="clave"></param>
''' <param name="IV"></param>
''' <param name="padding"></param>
''' <returns></returns>
Public Shared Function TripleDES(ByVal bytesOrigen As Byte(),
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Byte()
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de TripleDES() para arrays de bytes.
'-------------------------------------------------------------------------------------------
' bytesOrigen: Fuente de los datos para la encriptación/desencriptación.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta TripleDES (128 bits o 192 bits).
' IV: Vector de inicialización (8 bytes).
'
' padding: Modo de padding. Por defecto padding PKCS #7 (= padding PKCS #5).
'
' VALOR DEVUELTO: Array de bytes resultado de la encriptación/desencriptación.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase TripleDESCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
If bytesOrigen Is Nothing Then
Throw New Exception("Calculando TripleDES: 'bytesOrigen' es Nothing.")
End If
Dim streamOrigen As New MemoryStream(bytesOrigen)
Dim streamDestino As New MemoryStream()
TripleDES(streamOrigen, encriptar, clave, IV, streamDestino, padding)
Return streamDestino.ToArray()
End Function
'------------------------
Public Shared Function ArrayAleatorio(ByVal numBytes As Integer) As Byte()
'----------------------------------------------------
' Devuelve un array de bytes de longitud 'numBytes'.
' Los bytes son rellenados con valores aleatorios
' generados de manera criptográficamente sólida.
'----------------------------------------------------
Dim rng As New RNGCryptoServiceProvider()
Dim a(numBytes - 1) As Byte
rng.GetBytes(a)
Return a
End Function
Public Shared Function ArraysIguales(ByVal a1 As Byte(), ByVal a2 As Byte(),
Optional ByVal longitudMin As Integer = -1) As Boolean
'-------------------------------------------------------------------------------------
' Devuelve True si los dos arrays de bytes 'a1' y 'a2' coinciden; False en otro caso.
'-------------------------------------------------------------------------------------
' 'longitudMin' indica la longitud mínima exigida de los arrays para ser considerados
' iguales; si NO se cumple, se devuelve FALSE. Casos:
'
' longitudMin = -1 --> Permite TODO (se considera que Nothing = Nothing es True)
' = 0 --> NO PERMITE Nothings, SÍ PERMITE VACÍOS.
' > 0 --> Requiere que 'a1' y 'a2' tengan al menos esa longitud.
'
'-------------------------------------------------------------------------------------
If longitudMin < -1 Then
Throw New Exception("ArraysIguales(): Parámetro longitudMin < -1")
End If
'------
If (a1 Is Nothing) Or (a2 Is Nothing) Then
Return (longitudMin = -1) And (a1 Is Nothing) And (a2 Is Nothing)
End If
If a1.Length <> a2.Length Then Return False
If a1.Length < longitudMin Then Return False
Dim i As Integer
For i = 0 To (a1.Length - 1)
If a1(i) <> a2(i) Then Return False
Next
Return True
End Function
Public Shared Function ArrayToHex(ByVal a As Byte(), Optional ByVal separador As String = "") As String
'--------------------------------------------------------------------------------------------------
' Transforma un array de bytes a un string en hexadecimal (cada byte se representa en hexadecimal).
' Los caracteres alfabéticos hexadecimales SIEMPRE SE REPRESENTAN EN MAYÚSCULAS (ABCDEF).
'--------------------------------------------------------------------------------------------------
' 'separador' es el string separador de bytes (POR DEFECTO VACÍO).
'--------------------------------------------------------------------------------------------------
Dim res As String = ""
If (a IsNot Nothing) AndAlso (a.Length > 0) Then
Dim i As Integer
For i = 0 To (a.Length - 2)
res &= [String].Format("{0:X2}", a(i)) & separador
Next
res &= [String].Format("{0:X2}", a(a.Length - 1))
End If
Return res
End Function
Public Shared Function RandomString(minCharacters As Integer, maxCharacters As Integer) As String
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç"
Static r As New Random
Dim chactersInString As Integer = r.Next(minCharacters, maxCharacters)
Dim sb As New StringBuilder
For i As Integer = 1 To chactersInString
Dim idx As Integer = r.Next(0, s.Length)
sb.Append(s.Substring(idx, 1))
Next
Return sb.ToString()
End Function
End Class

94
http.vb Normal file
View File

@@ -0,0 +1,94 @@
Imports System.IO
Public Class http
Public Shared Function EjecutaURL(ByVal fullUrl As String,
Optional ByVal bAllowAutoRedirect As Boolean = True,
Optional ByVal iTimeout As Integer = 120000, Optional Codificacion As System.Text.Encoding = Nothing) As String
If Codificacion Is Nothing Then
Return EjecutaURL(fullUrl, System.Text.Encoding.UTF8, bAllowAutoRedirect, iTimeout)
Else
Return EjecutaURL(fullUrl, Codificacion, bAllowAutoRedirect, iTimeout)
End If
End Function
Public Shared Function EjecutaURL(ByVal fullUrl As String, _
ByVal Codificacion As System.Text.Encoding, _
Optional ByVal bAllowAutoRedirect As Boolean = True, _
Optional ByVal iTimeout As Integer = 120000) As String
Dim webRequest As System.Net.HttpWebRequest = Nothing
Dim webResponse As System.Net.HttpWebResponse = Nothing
Try
'Creamos un HttpWebRequest con la URL especificada.
webRequest = CType(System.Net.WebRequest.Create(fullUrl), System.Net.HttpWebRequest)
webRequest.AllowAutoRedirect = bAllowAutoRedirect
'webRequest.MaximumAutomaticRedirections = 50
webRequest.Timeout = iTimeout
'Enviamos la peticion y esperamos una respuesta.
Try
webResponse = CType(webRequest.GetResponse(), System.Net.HttpWebResponse)
Select Case (webResponse.StatusCode)
Case System.Net.HttpStatusCode.OK
'Leemos el contenido de la respuesta
Dim responseStream As System.IO.Stream = _
webResponse.GetResponseStream()
' Dim responseEncoding As System.text.Encoding = _
'System.text.Encoding.Default
'Mandamos la respuesta a un stream reader con su codificacion correspondiente
Dim responseReader As New StreamReader(responseStream, Codificacion)
Dim responseContent As String = _
responseReader.ReadToEnd()
Return responseContent.Trim
Case System.Net.HttpStatusCode.Redirect, System.Net.HttpStatusCode.MovedPermanently
Throw New System.Exception(String.Format( _
"No ha sido posible leer el contenido de la respuesta. La URL ha sido movida." & _
" StatusCode={0}.", webResponse.StatusCode))
Case System.Net.HttpStatusCode.NotFound
Throw New System.Exception(String.Format( _
"No ha sido posible leer el contenido de la respuesta. La URL no se encuentra." & _
" StatusCode={0}.", webResponse.StatusCode))
Case Else
Throw New System.Exception(String.Format( _
"No ha sido posible leer el contenido de la respuesta. StatusCode={0}.", _
webResponse.StatusCode))
End Select
Catch we As System.Net.WebException
If (we.Status = Net.WebExceptionStatus.Timeout) Then
'Return False
Throw New System.Exception("No ha sido posible ejecutar la URL (TIMEOUT).", we)
End If
Throw New System.Exception("No ha sido posible ejecutar la URL (webException).", we)
Finally
If (Not IsNothing(webResponse)) Then
webResponse.Close()
End If
End Try
Catch e As System.Exception
Throw New System.Exception("No ha sido posible ejecutar la URL (systemException).", e)
End Try
End Function
Public Shared Function EjemacHP(ByVal UrlCGIBIN As String, ByVal Macro As String, Optional ByVal Parametros As String = "", Optional Codificacion As System.Text.Encoding = Nothing) As String
Try
Dim sUrl As String
If Parametros <> "" Then
Parametros = Parametros.Replace("¡", "?")
sUrl = UrlCGIBIN & "?" & Macro & "=" & Parametros
Else
sUrl = UrlCGIBIN & "?" & Macro
'sUrl = UrlCGIBIN & "?" & Macro & "=" & Parametros & "?" & Macro
End If
' Dim sRespuesta As String = EjecutaURL(sUrl, System.Text.Encoding.Default, , 500000)
If Codificacion Is Nothing Then
Dim sRespuesta As String = EjecutaURL(sUrl, System.Text.Encoding.Default, , 500000)
Return sRespuesta
Else
Dim sRespuesta As String = EjecutaURL(sUrl, Codificacion, , 500000)
Return sRespuesta
End If
Catch EX As Exception
Throw New Exception(EX.Message, EX)
End Try
End Function
End Class

2
licenses.licx Normal file
View File

@@ -0,0 +1,2 @@

60
red.vb Normal file
View File

@@ -0,0 +1,60 @@
Imports System.Net
Imports System.Management.ManagementClass
Imports System.Management
Public Class red
Public Shared Function Ping(Servidor As String) As String
Try
Dim sRespuesta As String = ""
Dim eco As New System.Net.NetworkInformation.Ping
Dim res As System.Net.NetworkInformation.PingReply
Dim ip As IPAddress
Dim myIPAddresses() As IPAddress = Dns.GetHostAddresses(Servidor)
For Each ip In myIPAddresses
res = eco.Send(ip)
If res.Status = NetworkInformation.IPStatus.Success Then
sRespuesta &= Servidor & ": Respuesta desde " & res.Address.ToString & vbNewLine
Else
sRespuesta &= Servidor & ": Sin Respuesta desde " & res.Address.ToString & vbNewLine
End If
Next
Return sRespuesta
Catch ex As Exception
Return ex.StackTrace
End Try
End Function
Public Shared Sub SetIP(nicName As String, IpAddresses As String, SubnetMask As String, Gateway As String, DnsSearchOrder As String)
Dim mc As New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim moc As ManagementObjectCollection = mc.GetInstances()
For Each mo As ManagementObject In moc
' Make sure this is a IP enabled device.
' Not something like memory card or VM Ware
If DirectCast(mo("IPEnabled"), Boolean) Then
If mo("Caption").Equals(nicName) Then
Dim newIP As ManagementBaseObject = mo.GetMethodParameters("EnableStatic")
Dim newGate As ManagementBaseObject = mo.GetMethodParameters("SetGateways")
Dim newDNS As ManagementBaseObject = mo.GetMethodParameters("SetDNSServerSearchOrder")
newGate("DefaultIPGateway") = New String() {Gateway}
newGate("GatewayCostMetric") = New Integer() {1}
newIP("IPAddress") = IpAddresses.Split(","c)
newIP("SubnetMask") = New String() {SubnetMask}
newDNS("DNSServerSearchOrder") = DnsSearchOrder.Split(","c)
Dim setIP__1 As ManagementBaseObject = mo.InvokeMethod("EnableStatic", newIP, Nothing)
Dim setGateways As ManagementBaseObject = mo.InvokeMethod("SetGateways", newGate, Nothing)
Dim setDNS As ManagementBaseObject = mo.InvokeMethod("SetDNSServerSearchOrder", newDNS, Nothing)
Exit For
End If
End If
Next
End Sub
End Class

364
serv_u.vb Normal file
View File

@@ -0,0 +1,364 @@
Imports System.IO
Public Class serv_u
Public Shared Sub FTPuserEdit(ByVal Accion As String, ByVal RutaIni As String, ByVal Usuario As String,
ByVal Passwd As String, ByVal HomeDir As String, ByVal IP As String,
ByVal Puerto As String, ByVal Permisos As String,
ByVal RutaActualizaciones As String,
ByVal ConfiguracionAdicional() As String)
Try
If RutaActualizaciones = "" Then RutaActualizaciones = "C:\TECNOSIS\BIN\ACTUALIZACIONES"
Dim SW As StreamWriter
Dim SR As StreamReader
Dim separadores() As Char = {"=", "|"}
Dim linea, p(), dominio(), PassCrypt As String
Dim nomdom As String = ""
Dim numdom As String = ""
Dim encDom, encUser As Boolean
Dim i As Integer
'Comprobamos que se nos proporciona una accion valida
If Accion = "" Then
Throw New Exception("Acción no especificada: Por favor, indique una " &
"de las posibles acciones (ALTA/BAJA).")
Exit Sub
End If
'Permisos es una cadena entre 0 y 9 letras en el siguiente orden: RWAMELCDP
'Las 5 primeras son los acceso a ficheros: Read(R), Write(W), Append(A), Delete(M), Execute(E)
'Las 3 siguientes son los acceso al directorio: List(L), Create(C), Remove(D)
'La ultima es el acceso a subdirectorios: Inherit(P)
If Permisos = "" Then
Permisos = "RWAMLCP"
End If
'Buscamos el dominio al que pertenece el usuario
SR = File.OpenText(RutaIni & "\ServUDaemon.ini")
encDom = False
Do
linea = SR.ReadLine
If linea Is Nothing Then
Exit Do
End If
'<Etiqueta_Dominio>=<IP_Dominio>|<IP_FTP_Pasiva>|<Puerto>|<Nombre_Dominio>|<Nº_Dominio>|<Tipo_Conexion=0,1,2>|0
'dominio(0)=dominio(1)|dominio(2)|dominio(3)|dominio(4)|dominio(5)|dominio(6)|dominio(7)
'En dominio(0) tendremos la etiqueta del dominio, en dominio(1) tendremos la IP,
'en dominio(3) el puerto y en dominio(5) el numero de dominio
dominio = linea.Split(separadores)
If dominio.Length > 5 Then
If Not encDom And dominio(1) = IP And dominio(3) = Puerto Then
nomdom = dominio(0)
numdom = dominio(5)
encDom = True
End If
End If
Loop Until encDom
SR.Close()
'Si hemos encontrado el dominio, copiamos el contenido del fichero hasta llegar
'a la etiqueta del dominio buscado (si es que existe)
If encDom Then
SR = File.OpenText(RutaIni & "\ServUDaemon.ini")
SW = File.CreateText(RutaIni & "\ServUDaemon.txt")
SW.AutoFlush = True
'Copiamos lineas hasta llegar a la etiqueta del dominio buscado
encDom = True
Do
linea = SR.ReadLine
'Si llegamos al final del fichero y no hemos encontrado la etiqueta
'salimos del bucle e indicamos que no se ha encontrado dicha etiqueta
If IsNothing(linea) Then
encDom = False
Exit Do
End If
SW.WriteLine(linea)
Loop Until linea = "[" & nomdom & "]"
Select Case Accion.ToUpper
Case "ALTA"
'Comprobamos que el usuario y la password no estan vacios
If Usuario = "" Or Passwd = "" Then
SR.Close()
SW.Close()
Throw New Exception("Datos incompletos: El usuario o la clave están " &
"vacíos. Por favor, complete ambos campos.")
Exit Sub
End If
'Si no hemos encontrado la etiqueta del dominio la escribimos,
'ya que eso significa que aun no hay datos sobre el dominio,
'y procedemos a dar de alta al nuevo usuario (que es el primero)
If Not encDom Then
SW.WriteLine("[" & nomdom & "]")
SW.WriteLine("User1=" & Usuario & "|1|0")
Else
'Buscamos el numero de usuarios existentes en el dominio
i = 1
Do
linea = SR.ReadLine
If IsNothing(linea) Then
'Si llegamos al final del fichero nos salimos del bucle
Exit Do
ElseIf linea.Substring(0, 1) = "[" Then
'Si encontramos otra etiqueta nos salimos del bucle
Exit Do
End If
SW.WriteLine(linea)
p = linea.Split(separadores)
'Comprobamos que el usuario a dar de alta no exista en el dominio
If p(0).Substring(0, 4) = "User" Then
If p(1) = Usuario Then
'Si existe abortamos el proceso y nos salimos
SR.Close()
SW.Close()
Throw New Exception("Usuario existente: El usuario ya " &
"existe en el dominio actual.")
Exit Sub
Else
'Si no coincide el nombre incrementamos el contador
i += 1
End If
End If
Loop
'Añadimos el nuevo usuario al final de la lista
SW.WriteLine("User" & i & "=" & Usuario & "|1|0")
'Y si la linea leida no es Nothing la copiamos al fichero destino
If Not IsNothing(linea) Then
SW.WriteLine(linea)
End If
End If
'Copiamos el resto del fichero
linea = SR.ReadToEnd
SW.Write(linea)
'Añadimos al final del fichero los datos del nuevo usuario
'PassCrypt = GeneraMD5(Passwd, False)
PassCrypt = GeneraMD5(Passwd)
SW.WriteLine("[USER=" & Usuario & "|" & numdom & "]")
SW.WriteLine("Password=" & PassCrypt)
SW.WriteLine("HomeDir=" & HomeDir)
SW.WriteLine("NeedSecure=1")
SW.WriteLine("RelPaths=1")
SW.WriteLine("TimeOut=600")
SW.WriteLine("Access1=" & HomeDir & "|" & Permisos.ToUpper)
SW.WriteLine("Access2=" & RutaActualizaciones & "|REL")
For i = 0 To ConfiguracionAdicional.Length - 1
SW.WriteLine(ConfiguracionAdicional(i))
Next
Case "BAJA"
'Comprobamos que el usuario no esta vacio
If Usuario = "" Then
SR.Close()
SW.Close()
Throw New Exception("Datos incompletos: El usuario está vacío. " &
"Por favor, complete el campo.")
Exit Sub
End If
'Si no hemos encontrado la etiqueta del dominio es que no habia ningun usuario
'para ese dominio,por tanto, anulamos el proceso de la baja
If Not encDom Then
SR.Close()
SW.Close()
Throw New Exception("Usuario no encontrado: El dominio no tiene ningún " &
"usuario. El proceso de baja se anulará.")
Exit Sub
Else
'Buscamos el usuario a dar de baja
encUser = False
Do
linea = SR.ReadLine
'Si llegamos al final del fichero sin encontrar al usuario,
'es que este no existia y asi lo indicamos
If IsNothing(linea) Then
SR.Close()
SW.Close()
Throw New Exception("Usuario no encontrado: El usuario especificado " &
"no existe en el dominio. El proceso de baja se " &
"anulará.")
Exit Sub
ElseIf linea.Substring(0, 1) = "[" Then
'Si encontramos otra etiqueta es que no hemos encontrado al usuario
'en el dominio, avisamos de ello y salimos de la rutina
SR.Close()
SW.Close()
Throw New Exception("Usuario no encontrado: El usuario especificado " &
"no existe en el dominio. El proceso de baja se " &
"anulará.")
Exit Sub
End If
p = linea.Split(separadores)
If p(0).Substring(0, 4) = "User" Then
'Si es el usuario buscado lo indicamos y no copiamos la linea,
'en otro caso, copiamos la linea leida
If p(1) = Usuario Then
encUser = True
Else
SW.WriteLine(linea)
End If
Else
SW.WriteLine(linea)
End If
Loop Until encUser
'Guardo el numero del usuario que damos de baja
i = CInt(p(0).Substring(4))
'Reenumeramos al resto de usuarios
Do
linea = SR.ReadLine
p = linea.Split("=")
If IsNothing(linea) Then
'Si llegamos al final del fichero nos salimos del bucle
Exit Do
ElseIf linea.Substring(0, 1) = "[" Then
'Si encontramos otra etiqueta nos salimos del bucle
Exit Do
ElseIf p(0).Substring(0, 4) = "User" Then
linea = "User" & i & "=" & p(1)
i += 1
End If
SW.WriteLine(linea)
Loop
'Si la ultima linea leida no es Nothing copiamos dicha linea
'a menos que sea la etiqueta del usuario a dar de baja
If IsNothing(linea) Then
Exit Select
Else
'Escribo todas las lineas del fichero original hasta encontrar la etiqueta
'del usuario a dar de baja
Do Until linea = "[USER=" & Usuario & "|" & numdom & "]"
SW.WriteLine(linea)
linea = SR.ReadLine
Loop
'Leo todas las lineas del bloque correspondiente al usuario a dar de baja
Do
linea = SR.ReadLine
If IsNothing(linea) Then
'Si llego al final del fichero salgo del bucle
Exit Do
End If
Loop Until linea.Substring(0, 1) = "["
End If
'Si la ultima linea leida no es Nothing la copiamos al fichero destino
If Not IsNothing(linea) Then
SW.WriteLine(linea)
End If
'Copiamos el resto del fichero
linea = SR.ReadToEnd
SW.Write(linea)
End If
Case "MODIFICA"
'De momento sin uso
SR.Close()
SW.Close()
Throw New Exception("Acción no implementada: Por favor, indique una de " &
"las posibles acciones (ALTA/BAJA).")
Exit Sub
Case Else
SR.Close()
SW.Close()
Throw New Exception("Acción no válida: Por favor, indique una de " &
"las posibles acciones (ALTA/BAJA).")
Exit Sub
End Select
SR.Close()
SW.Close()
File.Copy(RutaIni & "\ServUDaemon.ini", RutaIni & "\ServUDaemon.bak", True)
File.Copy(RutaIni & "\ServUDaemon.txt", RutaIni & "\ServUDaemon.ini", True)
Else
'Si no hemos encontrado el dominio
Throw New Exception("Dominio no encontrado: No se ha encontrado el dominio " &
"buscado. Verifique los datos de IP y puerto.")
End If
Catch ex As Exception
Throw New Exception("Error: rutina FTPuserEdit" & Chr(10) & Chr(13) & ex.Message)
End Try
End Sub
Public Shared Function GeneraMD5(ByVal SourceText As String,
ByVal CtrlErrores As Boolean) As String
Try
Dim oMD5, sHashedStr As Object
Dim salt As String
' create the object
oMD5 = CreateObject("MD5.WSC")
' The calcMD5 method will hash the given string using MD5.
' NOTE: The password given by the user in this example would
' be "test". The two characters prepended to the
' password ("yy") are the salt. The salt is created
' by choosing two random characters from a..z.
' sHashedStr contains the hashed string.
salt = GeneraSalt(CtrlErrores)
sHashedStr = oMD5.calcMD5(salt & SourceText)
' clean up
oMD5 = Nothing
Return salt & sHashedStr
Catch EX As Exception
If CtrlErrores Then
MsgBox(EX.Message, MsgBoxStyle.Critical, "Error en la rutina GeneraMD5")
Else
Throw New Exception("Error: rutina GeneraMD5" & Chr(10) & Chr(13) & EX.Message)
End If
Return ""
End Try
End Function
Public Shared Function GeneraMD5(ByVal strToHash As String) As String
Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
Dim salt As String = GeneraSalt(False)
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(salt & strToHash)
bytesToHash = md5Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return salt & strResult.ToUpper
End Function
Public Shared Function getMD5HashANT(ByVal strToHash As String) As String
Try
Dim oMD5, sHashedStr As Object
oMD5 = CreateObject("MD5.WSC")
sHashedStr = oMD5.calcMD5(strToHash)
oMD5 = Nothing
Return sHashedStr
Catch EX As Exception
Throw New Exception("Error: rutina GeneraMD5" & Chr(10) & Chr(13) & EX.Message)
End Try
End Function
Public Shared Function getMD5Hash(ByVal strToHash As String) As String
Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
bytesToHash = md5Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Private Shared Function GeneraSalt(Optional ByVal CtrlErrores As Boolean = False) As String
Try
Dim p1, p2, li, ls As Integer
Dim s1, s2 As String
Dim cadena As String = "abcdefghijklmnopqrstuvwxyz"
li = 0
ls = cadena.Length - 1
p1 = CInt(Int((ls - li + 1) * Rnd() + li))
p2 = CInt(Int((ls - li + 1) * Rnd() + li))
s1 = cadena.Substring(p1, 1)
s2 = cadena.Substring(p2, 1)
Return s1 & s2
Catch ex As Exception
If CtrlErrores Then
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error en la rutina GeneraSalt")
Else
Throw New Exception("Error: rutina GeneraSalt" & Chr(10) & Chr(13) & ex.Message)
End If
Return ""
End Try
End Function
End Class

26
sistema.vb Normal file
View File

@@ -0,0 +1,26 @@
Imports System.Windows.Forms
Imports System.Reflection
Public Class sistema
Public Shared Function EstadoBateria() As String
Try
Dim t As Type = GetType(System.Windows.Forms.PowerStatus)
Dim pi As PropertyInfo() = t.GetProperties()
Dim i As Integer
Dim sEstado As String = ""
For i = 0 To pi.Length - 1
Dim propval As Object = pi(i).GetValue(SystemInformation.PowerStatus, Nothing)
sEstado &= pi(i).Name & " = " & propval.ToString & vbCrLf
Next i
Return sEstado
Catch ex As Exception
Throw
End Try
End Function
Public Shared Function PorcentajeBateria() As Integer
Dim power As PowerStatus = SystemInformation.PowerStatus
Dim percent As Single = power.BatteryLifePercent * 100
Return percent
End Function
End Class

23
tsBloqueo.vb Normal file
View File

@@ -0,0 +1,23 @@
Public Class tsBloqueo
Public Enum TipoBloqueoEnum As Integer
SIN_AVISOS = 0
CON_AVISOS = 1
SOLO_LECTURA_SI_EXISTEN_BLOQUEOS = 2
End Enum
Public Enum AccionBloqueEnum As Integer
BLOQUEAR = 0
DESBLOQUEAR = 1
COMPRUEBABLOQUEO = 2
ACTUALIZAVERSION = 3
End Enum
Public Property Bloqueo As Object
Public Property idSesion As Integer
Public Property Usuario As String
Public Property ip As String
Public Property ExistenOtrosBloqueos As Boolean
Public Property Tipobloqueo As TipoBloqueoEnum
Public Property PermitirGuardarConCambios As Boolean
Public Property Version As Integer
End Class

130
tsNotificacionesClient.vb Normal file
View File

@@ -0,0 +1,130 @@
Imports System.Configuration
Imports System.Diagnostics
Imports System.IO
Imports System.Net
Imports System.Net.Http
Imports System.Net.Http.Headers
Imports System.Threading.Tasks
Imports Newtonsoft.Json
Public Class TsNotificacionesClient
Private ReadOnly _http As HttpClient
Private ReadOnly _idAplicacion As Integer
Public Sub New(baseUrl As String, idAplicacion As Integer, apiKey As String)
_idAplicacion = idAplicacion
ServicePointManager.ServerCertificateValidationCallback = Function(s, c, ch, e) True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 Or SecurityProtocolType.Tls11
_http = New HttpClient() With {.BaseAddress = New Uri(baseUrl)}
_http.DefaultRequestHeaders.Add("X-Api-Key", apiKey)
End Sub
Public Shared Async Function RegistrarAsync(titulo As String, descripcion As String, tipo As TipoNotificacionEnum, Optional fichero As Byte() = Nothing, Optional incluirEnEventLog As Boolean = True) As Task
Try
' ============================
' CARGAR CONFIGURACIÓN
' ============================
Dim apiUrl As String = ConfigurationManager.AppSettings("TsNotificaciones.ApiUrl")
Dim idAplicacion As Integer = Integer.Parse(ConfigurationManager.AppSettings("TsNotificaciones.IdAplicacion"))
Dim aplicacion As String = ConfigurationManager.AppSettings("TsNotificaciones.Aplicacion")
If aplicacion = "" Then aplicacion = "Tecnosis idAplicacion:" & idAplicacion.ToString
Dim apiKey As String = ConfigurationManager.AppSettings("TsNotificaciones.ApiKey")
Dim nombreServidor As String = Environment.MachineName
If String.IsNullOrEmpty(apiUrl) Then apiUrl = "http://localhost:7159"
' ============================
' LOG EN EVENT VIEWER
' ============================
If incluirEnEventLog Then
Dim ele As EventLogEntryType
Select Case tipo
Case TipoNotificacionEnum.INFO
ele = EventLogEntryType.Information
Case TipoNotificacionEnum.ADVERTENCIA
ele = EventLogEntryType.Warning
Case TipoNotificacionEnum.ERROR, TipoNotificacionEnum.CRÍTICO
ele = EventLogEntryType.Error
End Select
' EventID ≠ 0 para evitar el mensaje de descripción faltante
Dim eventId As Integer = 1000 + CInt(tipo)
EventLog.WriteEntry("Application", $"{aplicacion} {titulo} {descripcion}", ele, eventId)
End If
' ============================
' LLAMADA A LA API
' ============================
Dim http = New HttpClient() With {.BaseAddress = New Uri(apiUrl)}
http.DefaultRequestHeaders.Add("X-Api-Key", apiKey)
Dim payload = New With {
.idAplicacion = idAplicacion,
.nombreServidor = nombreServidor,
.ipServidor = ObtenerIp(),
.titulo = titulo,
.descripcion = descripcion,
.tipoNotificacion = CInt(tipo)
}
Dim json As String = JsonConvert.SerializeObject(payload)
Dim content As New StringContent(json, System.Text.Encoding.UTF8, "application/json")
Dim response = Await http.PostAsync("/api/alertas/registrar", content)
Dim body As String = Await response.Content.ReadAsStringAsync()
Dim jsonObj = JsonConvert.DeserializeObject(Of Dictionary(Of String, Object))(body)
Dim id As Integer = Convert.ToInt32(jsonObj("id"))
If fichero IsNot Nothing Then
Await SubirFichero(http, apiKey, id, fichero)
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Private Shared Async Function SubirFichero(http As HttpClient, apiKey As String, alertaId As Integer, datos As Byte()) As Task
Try
Dim fileContent = New ByteArrayContent(datos)
fileContent.Headers.ContentType = New MediaTypeHeaderValue("image/png")
Dim multipart = New MultipartFormDataContent()
multipart.Add(fileContent, "archivo", "Imagen.png")
Dim request = New HttpRequestMessage(HttpMethod.Post, $"/api/alertas/{alertaId}/archivo")
request.Headers.Add("X-Api-Key", apiKey)
request.Content = multipart
Dim response = Await http.SendAsync(request)
If Not response.IsSuccessStatusCode Then
Throw New Exception($"Subida fallida ({response.StatusCode}): {Await response.Content.ReadAsStringAsync()}")
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Private Shared Function ObtenerIp() As String
For Each addr In Dns.GetHostAddresses(Dns.GetHostName())
If addr.AddressFamily = Sockets.AddressFamily.InterNetwork Then Return addr.ToString()
Next
Return "127.0.0.1"
End Function
Public Enum TipoNotificacionEnum
INFO = 0
ADVERTENCIA = 1
[ERROR] = 2
CRÍTICO = 3
End Enum
End Class

35
tsl5.sln Normal file
View File

@@ -0,0 +1,35 @@

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.11.35431.28
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "tsl5", "tsl5.vbproj", "{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}.Debug|Any CPU.Build.0 = Debug|Any CPU
{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}.Release|Any CPU.ActiveCfg = Release|Any CPU
{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {1637BF19-DBA7-45E3-935F-A07C0E51E817}
EndGlobalSection
GlobalSection(TeamFoundationVersionControl) = preSolution
SccNumberOfProjects = 1
SccEnterpriseProvider = {4CA58AB2-18FA-4F8D-95D4-32DDF27D184C}
SccTeamFoundationServer = http://ts-devopss:81/tecnosiscollection
SccProjectUniqueName0 = tsl5.vbproj
SccProjectName0 = .
SccAuxPath0 = http://ts-devopss:81/tecnosiscollection
SccLocalPath0 = .
SccProvider0 = {4CA58AB2-18FA-4F8D-95D4-32DDF27D184C}
EndGlobalSection
EndGlobal

298
tsl5.vbproj Normal file
View File

@@ -0,0 +1,298 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="12.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>
</ProductVersion>
<SchemaVersion>
</SchemaVersion>
<ProjectGuid>{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>tsl5</RootNamespace>
<AssemblyName>tsl5</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.8</TargetFrameworkVersion>
<SccProjectName>SAK</SccProjectName>
<SccLocalPath>SAK</SccLocalPath>
<SccAuxPath>SAK</SccAuxPath>
<SccProvider>SAK</SccProvider>
<TargetFrameworkProfile />
<PublishUrl>publicar\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
<UpdateEnabled>false</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
<NuGetPackageImportStamp>
</NuGetPackageImportStamp>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>tsl5.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<PlatformTarget>AnyCPU</PlatformTarget>
<Prefer32Bit>false</Prefer32Bit>
<UseVSHostingProcess>false</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>tsl5.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<PlatformTarget>AnyCPU</PlatformTarget>
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
</ItemGroup>
<ItemGroup>
<Compile Include="Bancos\pain_001_001_03.vb" />
<Compile Include="Bancos\pain_002_001_03.vb" />
<Compile Include="Bancos\pain_008_001_02.vb" />
<Compile Include="Bancos\SEPA1914xml.vb" />
<Compile Include="Bancos\SEPA3414.vb" />
<Compile Include="clFuncionesGenericas.vb" />
<Compile Include="Compresion.vb" />
<Compile Include="Correo.vb" />
<Compile Include="CorreoOAuth2.vb" />
<Compile Include="Datos.vb" />
<Compile Include="Extensiones\BinaryReaderExtensions.vb" />
<Compile Include="Extensiones\DateTimeExtensions.vb" />
<Compile Include="Extensiones\IntegerExtensions.vb" />
<Compile Include="Extensiones\DoubleExtensions.vb" />
<Compile Include="Extensiones\Dynamic.vb" />
<Compile Include="Extensiones\EntityExtensions.vb" />
<Compile Include="Extensiones\IEnumerable.vb" />
<Compile Include="Extensiones\NameValueCollection.vb" />
<Compile Include="Extensiones\ObjetExtensions.vb" />
<Compile Include="Extensiones\SerializableDictionary.vb" />
<Compile Include="Extensiones\StringExtensions.vb" />
<Compile Include="Extensiones\TimeSpanExtensions.vb" />
<Compile Include="Ficheros.vb" />
<Compile Include="Hacienda\Modelo190.vb" />
<Compile Include="http.vb" />
<Compile Include="HttpUserAgentEndpointBehavior.vb" />
<Compile Include="Imagen.vb" />
<Compile Include="Bancos\Bancos.vb" />
<Compile Include="bbdd.vb" />
<Compile Include="crypt.vb" />
<Compile Include="InicioServicioYClientes\frmIdentificacion.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="InicioServicioYClientes\ucBarraGenerica.vb">
<SubType>UserControl</SubType>
</Compile>
<Compile Include="Interfaces.vb" />
<Compile Include="NetRemoting.vb" />
<Compile Include="NumerosAPalabras.vb" />
<Compile Include="red.vb" />
<Compile Include="RegistroLocal.vb" />
<Compile Include="serv_u.vb" />
<Compile Include="Settings.vb" />
<Compile Include="sistema.vb" />
<Compile Include="TripleDES.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="tsBloqueo.vb" />
<Compile Include="tsNotificacionesClient.vb" />
<Compile Include="UrlDetector.vb" />
<Compile Include="Utilidades.vb" />
<Compile Include="ClienteServicioWeb.vb" />
<Compile Include="Validaciones.vb" />
<Compile Include="ValidarDocumentoIdentidad.vb" />
<Compile Include="xhtml.vb" />
<Compile Include="zip.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="InicioServicioYClientes\frmIdentificacion.resx">
<DependentUpon>frmIdentificacion.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="InicioServicioYClientes\ucBarraGenerica.resx">
<DependentUpon>ucBarraGenerica.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="licenses.licx" />
<EmbeddedResource Include="My Project\licenses.licx" />
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="App.Config">
<SubType>Designer</SubType>
</None>
<None Include="bin\Debug\tsl5v2.nuspec" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\DataSources\Entities.datasource" />
<None Include="My Project\DataSources\tsl5.tsl5Model.Entities.datasource" />
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="tsl5Model.edmx.sqlce" />
<None Include="Baget\tsl5v2.nuspec" />
</ItemGroup>
<ItemGroup>
<Service Include="{508349B6-6B84-4DF5-91F0-309BEEBAD82D}" />
<Service Include="{94E38DFF-614B-4CBD-B67C-F211BB35CE8B}" />
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include=".NETFramework,Version=v4.0">
<Visible>False</Visible>
<ProductName>Microsoft .NET Framework 4 %28x86 y x64%29</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1 Client Profile</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5.SP1">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.SQL.Server.Compact.4.0">
<Visible>False</Visible>
<ProductName>SQL Server Compact 4.0 SP1</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Windows.Installer.4.5">
<Visible>False</Visible>
<ProductName>Windows Installer 4.5</ProductName>
<Install>true</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup>
<PackageReference Include="Google.Protobuf">
<Version>3.24.4</Version>
</PackageReference>
<PackageReference Include="IbanNet">
<Version>5.9.0</Version>
</PackageReference>
<PackageReference Include="Microsoft.Extensions.DependencyInjection">
<Version>10.0.7</Version>
</PackageReference>
<PackageReference Include="Microsoft.Extensions.Options">
<Version>10.0.7</Version>
</PackageReference>
<PackageReference Include="Microsoft.Identity.Client">
<Version>4.72.1</Version>
</PackageReference>
<PackageReference Include="Microsoft.IdentityModel.Abstractions">
<Version>7.0.2</Version>
</PackageReference>
<PackageReference Include="Newtonsoft.Json">
<Version>13.0.3</Version>
</PackageReference>
<PackageReference Include="SSH.NET">
<Version>2020.0.2</Version>
</PackageReference>
<PackageReference Include="System.Diagnostics.DiagnosticSource">
<Version>10.0.7</Version>
</PackageReference>
<PackageReference Include="System.Net.Http.Json">
<Version>10.0.5</Version>
</PackageReference>
</ItemGroup>
<ItemGroup>
<Reference Include="Microsoft.CSharp" />
<Reference Include="MySql.Data, Version=6.8.3.0, Culture=neutral, PublicKeyToken=c5687fc88969c44d, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\MySQL Connector Net 6.8.3\Assemblies\v4.5\MySql.Data.dll</HintPath>
</Reference>
<Reference Include="MySql.Data.Entity.EF5, Version=6.8.3.0, Culture=neutral, PublicKeyToken=c5687fc88969c44d, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\MySQL Connector Net 6.8.3\Assemblies\v4.5\MySql.Data.Entity.EF5.dll</HintPath>
</Reference>
<Reference Include="Oracle.ManagedDataAccess, Version=4.122.1.0, Culture=neutral, PublicKeyToken=89b483f429c47342, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\oracle\bin\Oracle.ManagedDataAccess.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.ComponentModel.DataAnnotations" />
<Reference Include="System.Configuration" />
<Reference Include="System.Configuration.Install" />
<Reference Include="System.Data" />
<Reference Include="System.Data.Entity" />
<Reference Include="System.Data.Entity.Design" />
<Reference Include="System.Drawing" />
<Reference Include="System.Drawing.Design" />
<Reference Include="System.IdentityModel" />
<Reference Include="System.IO.Compression" />
<Reference Include="System.IO.Compression.FileSystem" />
<Reference Include="System.Management" />
<Reference Include="System.Net.Http" />
<Reference Include="System.Numerics" />
<Reference Include="System.Runtime.Remoting" />
<Reference Include="System.Runtime.Serialization" />
<Reference Include="System.Security" />
<Reference Include="System.ServiceModel" />
<Reference Include="System.ServiceModel.Channels" />
<Reference Include="System.Transactions" />
<Reference Include="System.Web" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Xml.Linq" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

271
tsl5.vbproj.bak Normal file
View File

@@ -0,0 +1,271 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>
</ProductVersion>
<SchemaVersion>
</SchemaVersion>
<ProjectGuid>{5D8119B9-DFA0-44F7-A1E3-CBB871A305E2}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>tsl5</RootNamespace>
<AssemblyName>tsl5</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
<SccProjectName>SAK</SccProjectName>
<SccLocalPath>SAK</SccLocalPath>
<SccAuxPath>SAK</SccAuxPath>
<SccProvider>SAK</SccProvider>
<TargetFrameworkProfile />
<PublishUrl>publicar\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
<UpdateEnabled>false</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>tsl5.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<PlatformTarget>AnyCPU</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>tsl5.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<PlatformTarget>AnyCPU</PlatformTarget>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="Dart.PowerTCP.SecureFtp, Version=2.3.3.0, Culture=neutral, PublicKeyToken=5966291b8955e4bb">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\PowerTCP\Dart.PowerTCP.SecureFtp.DLL</HintPath>
</Reference>
<Reference Include="Dart.PowerTCP.SecureFtp.Forms, Version=2.3.3.0, Culture=neutral">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\PowerTCP\Dart.PowerTCP.SecureFtp.Forms.dll</HintPath>
</Reference>
<Reference Include="DevExpress.Data.v13.2, Version=13.2.5.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a, processorArchitecture=MSIL" />
<Reference Include="DevExpress.Docs.v13.2, Version=13.2.5.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a, processorArchitecture=MSIL" />
<Reference Include="DevExpress.Office.v13.2.Core, Version=13.2.5.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a, processorArchitecture=MSIL" />
<Reference Include="DevExpress.Printing.v13.2.Core, Version=13.2.5.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a, processorArchitecture=MSIL" />
<Reference Include="DevExpress.RichEdit.v13.2.Core, Version=13.2.5.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a, processorArchitecture=MSIL" />
<Reference Include="MySql.Data, Version=6.8.3.0, Culture=neutral, PublicKeyToken=c5687fc88969c44d, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\MySQL Connector Net 6.8.3\Assemblies\v4.0\MySql.Data.dll</HintPath>
<Private>True</Private>
</Reference>
<Reference Include="O2S.Components.PDF4NET">
<HintPath>..\..\Controles\Binarios\pdf4net\NET2.0\O2S.Components.PDF4NET.dll</HintPath>
</Reference>
<Reference Include="PKICOAATSE">
<HintPath>..\..\Clientes\COAATSE\PKICOAATSE\PKICOAATSE.dll</HintPath>
<Private>False</Private>
</Reference>
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Data.Entity" />
<Reference Include="System.Drawing" />
<Reference Include="System.Runtime.Remoting" />
<Reference Include="System.Runtime.Serialization" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="tsPDF, Version=2.1.0.0, Culture=neutral, PublicKeyToken=8354ae6d2174ddca, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\..\Controles\Binarios\tsPDF\tsPDF.dll</HintPath>
</Reference>
<Reference Include="ZipForge">
<HintPath>..\..\Controles\Binarios\ZipForge.NET\Framework 2.0\ZipForge.dll</HintPath>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
</ItemGroup>
<ItemGroup>
<Compile Include="Bancos\pain_001_001_03.vb" />
<Compile Include="Bancos\SEPA3414.vb" />
<Compile Include="Correo.vb" />
<Compile Include="Docx.vb" />
<Compile Include="Extensiones\DateTimeExtensions.vb" />
<Compile Include="Extensiones\Dynamic.vb" />
<Compile Include="Extensiones\EntityExtensions.vb" />
<Compile Include="Extensiones\SerializableDictionary.vb" />
<Compile Include="Extensiones\StringExtensions.vb" />
<Compile Include="Ficheros.vb" />
<Compile Include="ftp.vb" />
<Compile Include="http.vb" />
<Compile Include="Informes.vb" />
<Compile Include="Bancos\Bancos.vb" />
<Compile Include="bbdd.vb" />
<Compile Include="cryp.vb" />
<Compile Include="Datos.vb" />
<Compile Include="InicioServicioYClientes\frmConfiguracionAplicacion.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="InicioServicioYClientes\frmIdentificacion.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="InicioServicioYClientes\ucBarraGenerica.vb">
<SubType>UserControl</SubType>
</Compile>
<Compile Include="Interfaces.vb" />
<Compile Include="pdf.vb" />
<Compile Include="red.vb" />
<Compile Include="RegistroLocal.vb" />
<Compile Include="Settings.vb" />
<Compile Include="tsl5Model.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>tsl5Model.edmx</DependentUpon>
</Compile>
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="InicioServicioYClientes\Rutinas.vb" />
<Compile Include="Utilidades.vb" />
<Compile Include="zip.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="InicioServicioYClientes\frmConfiguracionAplicacion.resx">
<DependentUpon>frmConfiguracionAplicacion.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="InicioServicioYClientes\frmIdentificacion.resx">
<DependentUpon>frmIdentificacion.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="InicioServicioYClientes\ucBarraGenerica.resx">
<DependentUpon>ucBarraGenerica.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="My Project\licenses.licx" />
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<EntityDeploy Include="tsl5Model.edmx">
<Generator>EntityModelCodeGenerator</Generator>
<LastGenOutput>tsl5Model.Designer.vb</LastGenOutput>
</EntityDeploy>
<None Include="App.Config">
<SubType>Designer</SubType>
</None>
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\DataSources\Entities.datasource" />
<None Include="My Project\DataSources\tsl5.tsl5Model.Entities.datasource" />
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="pain.008.001.02.xsd">
<SubType>Designer</SubType>
</None>
<None Include="tsl5Model.edmx.sqlce" />
</ItemGroup>
<ItemGroup>
<Service Include="{508349B6-6B84-4DF5-91F0-309BEEBAD82D}" />
<Service Include="{94E38DFF-614B-4CBD-B67C-F211BB35CE8B}" />
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include=".NETFramework,Version=v4.0">
<Visible>False</Visible>
<ProductName>Microsoft .NET Framework 4 %28x86 y x64%29</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1 Client Profile</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5.SP1">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.SQL.Server.Compact.4.0">
<Visible>False</Visible>
<ProductName>SQL Server Compact 4.0 SP1</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Windows.Installer.4.5">
<Visible>False</Visible>
<ProductName>Windows Installer 4.5</ProductName>
<Install>true</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\cablin4\cablin4.vbproj">
<Project>{A7FEA864-066A-4D8B-938D-87006D6CBE69}</Project>
<Name>cablin4</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>

1090
tsl5Model.Designer.vb generated Normal file
View File

File diff suppressed because it is too large Load Diff

375
tsl5Model.edmx Normal file
View File

@@ -0,0 +1,375 @@
<?xml version="1.0" encoding="utf-8"?>
<edmx:Edmx Version="3.0" xmlns:edmx="http://schemas.microsoft.com/ado/2009/11/edmx">
<!-- EF Runtime content -->
<edmx:Runtime>
<!-- SSDL content -->
<edmx:StorageModels>
<Schema Namespace="tsl5Model.Store" Alias="Self" Provider="MySql.Data.MySqlClient" ProviderManifestToken="5.1" xmlns="http://schemas.microsoft.com/ado/2009/11/edm/ssdl">
<EntityContainer Name="tsl5ModelStoreContainer">
<EntitySet Name="excepcionesmenus" EntityType="tsl5Model.Store.excepcionesmenus" store:Type="Tables" Schema="emtusahuelva" xmlns:store="http://schemas.microsoft.com/ado/2007/12/edm/EntityStoreSchemaGenerator" />
<EntitySet Name="grupobd" EntityType="tsl5Model.Store.grupobd" store:Type="Tables" Schema="emtusahuelva" xmlns:store="http://schemas.microsoft.com/ado/2007/12/edm/EntityStoreSchemaGenerator" />
<EntitySet Name="gruposmenus" EntityType="tsl5Model.Store.gruposmenus" store:Type="Tables" Schema="emtusahuelva" xmlns:store="http://schemas.microsoft.com/ado/2007/12/edm/EntityStoreSchemaGenerator" />
<EntitySet Name="menus" EntityType="tsl5Model.Store.menus" store:Type="Tables" Schema="emtusahuelva" xmlns:store="http://schemas.microsoft.com/ado/2007/12/edm/EntityStoreSchemaGenerator" />
<EntitySet Name="usuarios" EntityType="tsl5Model.Store.usuarios" store:Type="Tables" Schema="emtusahuelva" xmlns:store="http://schemas.microsoft.com/ado/2007/12/edm/EntityStoreSchemaGenerator" />
<AssociationSet Name="excepcionesmenus_menus" Association="tsl5Model.Store.excepcionesmenus_menus">
<End Role="menus" EntitySet="menus" />
<End Role="excepcionesmenus" EntitySet="excepcionesmenus" />
</AssociationSet>
<AssociationSet Name="excepcionesmenus_usuarios" Association="tsl5Model.Store.excepcionesmenus_usuarios">
<End Role="usuarios" EntitySet="usuarios" />
<End Role="excepcionesmenus" EntitySet="excepcionesmenus" />
</AssociationSet>
<AssociationSet Name="Menus_GruposMenus" Association="tsl5Model.Store.Menus_GruposMenus">
<End Role="gruposmenus" EntitySet="gruposmenus" />
<End Role="menus" EntitySet="menus" />
</AssociationSet>
<AssociationSet Name="Usuarios_Grupobd" Association="tsl5Model.Store.Usuarios_Grupobd">
<End Role="grupobd" EntitySet="grupobd" />
<End Role="usuarios" EntitySet="usuarios" />
</AssociationSet>
<AssociationSet Name="usuarios_gruposmenus" Association="tsl5Model.Store.usuarios_gruposmenus">
<End Role="gruposmenus" EntitySet="gruposmenus" />
<End Role="usuarios" EntitySet="usuarios" />
</AssociationSet>
</EntityContainer>
<EntityType Name="excepcionesmenus">
<Key>
<PropertyRef Name="idExcepcionesMenus" />
</Key>
<Property Name="idExcepcionesMenus" Type="int" Nullable="false" />
<Property Name="idMenu" Type="int" />
<Property Name="idUsuario" Type="int" />
</EntityType>
<EntityType Name="grupobd">
<Key>
<PropertyRef Name="idGrupoBD" />
</Key>
<Property Name="idGrupoBD" Type="int" Nullable="false" StoreGeneratedPattern="Identity" />
<Property Name="Descripcion" Type="varchar" MaxLength="45" />
</EntityType>
<EntityType Name="gruposmenus">
<Key>
<PropertyRef Name="idGruposMenus" />
</Key>
<Property Name="idGruposMenus" Type="int" Nullable="false" StoreGeneratedPattern="Identity" />
<Property Name="Descripcion" Type="varchar" MaxLength="45" />
</EntityType>
<EntityType Name="menus">
<Key>
<PropertyRef Name="idMenus" />
</Key>
<Property Name="idMenus" Type="int" Nullable="false" StoreGeneratedPattern="Identity" />
<Property Name="Texto" Type="varchar" MaxLength="60" />
<Property Name="Ayuda" Type="varchar" MaxLength="255" />
<Property Name="Accion" Type="varchar" MaxLength="500" />
<Property Name="Orden" Type="int" />
<Property Name="idMenuPadre" Type="int" />
<Property Name="idGrupoMenu" Type="int" />
</EntityType>
<EntityType Name="usuarios">
<Key>
<PropertyRef Name="idUsuarios" />
</Key>
<Property Name="idUsuarios" Type="int" Nullable="false" StoreGeneratedPattern="Identity" />
<Property Name="Usuario" Type="varchar" Nullable="false" MaxLength="30" />
<Property Name="SHA1Passwd" Type="varchar" MaxLength="40" />
<Property Name="idGrupobd" Type="int" Nullable="false" />
<Property Name="idGrupomenus" Type="int" />
</EntityType>
<Association Name="excepcionesmenus_menus">
<End Role="menus" Type="tsl5Model.Store.menus" Multiplicity="0..1" />
<End Role="excepcionesmenus" Type="tsl5Model.Store.excepcionesmenus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="menus">
<PropertyRef Name="idMenus" />
</Principal>
<Dependent Role="excepcionesmenus">
<PropertyRef Name="idMenu" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="excepcionesmenus_usuarios">
<End Role="usuarios" Type="tsl5Model.Store.usuarios" Multiplicity="0..1" />
<End Role="excepcionesmenus" Type="tsl5Model.Store.excepcionesmenus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="usuarios">
<PropertyRef Name="idUsuarios" />
</Principal>
<Dependent Role="excepcionesmenus">
<PropertyRef Name="idUsuario" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="Menus_GruposMenus">
<End Role="gruposmenus" Type="tsl5Model.Store.gruposmenus" Multiplicity="0..1" />
<End Role="menus" Type="tsl5Model.Store.menus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="gruposmenus">
<PropertyRef Name="idGruposMenus" />
</Principal>
<Dependent Role="menus">
<PropertyRef Name="idGrupoMenu" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="Usuarios_Grupobd">
<End Role="grupobd" Type="tsl5Model.Store.grupobd" Multiplicity="1" />
<End Role="usuarios" Type="tsl5Model.Store.usuarios" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="grupobd">
<PropertyRef Name="idGrupoBD" />
</Principal>
<Dependent Role="usuarios">
<PropertyRef Name="idGrupobd" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="usuarios_gruposmenus">
<End Role="gruposmenus" Type="tsl5Model.Store.gruposmenus" Multiplicity="0..1" />
<End Role="usuarios" Type="tsl5Model.Store.usuarios" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="gruposmenus">
<PropertyRef Name="idGruposMenus" />
</Principal>
<Dependent Role="usuarios">
<PropertyRef Name="idGrupomenus" />
</Dependent>
</ReferentialConstraint>
</Association>
</Schema>
</edmx:StorageModels>
<!-- CSDL content -->
<edmx:ConceptualModels>
<Schema Namespace="tsl5Model" Alias="Self" xmlns="http://schemas.microsoft.com/ado/2009/11/edm" annotation:UseStrongSpatialTypes="false" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation">
<EntityContainer Name="tsl5Entities" annotation:LazyLoadingEnabled="true" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation">
<EntitySet Name="excepcionesmenus" EntityType="tsl5Model.excepcionesmenus" />
<EntitySet Name="grupobd" EntityType="tsl5Model.grupobd" />
<EntitySet Name="gruposmenus" EntityType="tsl5Model.gruposmenus" />
<EntitySet Name="menus" EntityType="tsl5Model.menus" />
<EntitySet Name="usuarios" EntityType="tsl5Model.usuarios" />
<AssociationSet Name="excepcionesmenus_menus" Association="tsl5Model.excepcionesmenus_menus">
<End Role="menus" EntitySet="menus" />
<End Role="excepcionesmenus" EntitySet="excepcionesmenus" />
</AssociationSet>
<AssociationSet Name="excepcionesmenus_usuarios" Association="tsl5Model.excepcionesmenus_usuarios">
<End Role="usuarios" EntitySet="usuarios" />
<End Role="excepcionesmenus" EntitySet="excepcionesmenus" />
</AssociationSet>
<AssociationSet Name="Usuarios_Grupobd" Association="tsl5Model.Usuarios_Grupobd">
<End Role="grupobd" EntitySet="grupobd" />
<End Role="usuarios" EntitySet="usuarios" />
</AssociationSet>
<AssociationSet Name="Menus_GruposMenus" Association="tsl5Model.Menus_GruposMenus">
<End Role="gruposmenus" EntitySet="gruposmenus" />
<End Role="menus" EntitySet="menus" />
</AssociationSet>
<AssociationSet Name="usuarios_gruposmenus" Association="tsl5Model.usuarios_gruposmenus">
<End Role="gruposmenus" EntitySet="gruposmenus" />
<End Role="usuarios" EntitySet="usuarios" />
</AssociationSet>
</EntityContainer>
<EntityType Name="excepcionesmenus">
<Key>
<PropertyRef Name="idExcepcionesMenus" />
</Key>
<Property Name="idExcepcionesMenus" Type="Int32" Nullable="false" />
<Property Name="idMenu" Type="Int32" />
<Property Name="idUsuario" Type="Int32" />
<NavigationProperty Name="menus" Relationship="tsl5Model.excepcionesmenus_menus" FromRole="excepcionesmenus" ToRole="menus" />
<NavigationProperty Name="usuarios" Relationship="tsl5Model.excepcionesmenus_usuarios" FromRole="excepcionesmenus" ToRole="usuarios" />
</EntityType>
<EntityType Name="grupobd">
<Key>
<PropertyRef Name="idGrupoBD" />
</Key>
<Property Name="idGrupoBD" Type="Int32" Nullable="false" annotation:StoreGeneratedPattern="Identity" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation" />
<Property Name="Descripcion" Type="String" />
<NavigationProperty Name="usuarios" Relationship="tsl5Model.Usuarios_Grupobd" FromRole="grupobd" ToRole="usuarios" />
</EntityType>
<EntityType Name="gruposmenus">
<Key>
<PropertyRef Name="idGruposMenus" />
</Key>
<Property Name="idGruposMenus" Type="Int32" Nullable="false" annotation:StoreGeneratedPattern="Identity" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation" />
<Property Name="Descripcion" Type="String" />
<NavigationProperty Name="menus" Relationship="tsl5Model.Menus_GruposMenus" FromRole="gruposmenus" ToRole="menus" />
<NavigationProperty Name="usuarios" Relationship="tsl5Model.usuarios_gruposmenus" FromRole="gruposmenus" ToRole="usuarios" />
</EntityType>
<EntityType Name="menus">
<Key>
<PropertyRef Name="idMenus" />
</Key>
<Property Name="idMenus" Type="Int32" Nullable="false" annotation:StoreGeneratedPattern="Identity" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation" />
<Property Name="Texto" Type="String" />
<Property Name="Ayuda" Type="String" />
<Property Name="Accion" Type="String" />
<Property Name="Orden" Type="Int32" />
<Property Name="idMenuPadre" Type="Int32" />
<Property Name="idGrupoMenu" Type="Int32" />
<NavigationProperty Name="excepcionesmenus" Relationship="tsl5Model.excepcionesmenus_menus" FromRole="menus" ToRole="excepcionesmenus" />
<NavigationProperty Name="gruposmenus" Relationship="tsl5Model.Menus_GruposMenus" FromRole="menus" ToRole="gruposmenus" />
</EntityType>
<EntityType Name="usuarios">
<Key>
<PropertyRef Name="idUsuarios" />
</Key>
<Property Name="idUsuarios" Type="Int32" Nullable="false" annotation:StoreGeneratedPattern="Identity" xmlns:annotation="http://schemas.microsoft.com/ado/2009/02/edm/annotation" />
<Property Name="Usuario" Type="String" Nullable="false" />
<Property Name="SHA1Passwd" Type="String" />
<Property Name="idGrupobd" Type="Int32" Nullable="false" />
<Property Name="idGrupomenus" Type="Int32" />
<NavigationProperty Name="excepcionesmenus" Relationship="tsl5Model.excepcionesmenus_usuarios" FromRole="usuarios" ToRole="excepcionesmenus" />
<NavigationProperty Name="grupobd" Relationship="tsl5Model.Usuarios_Grupobd" FromRole="usuarios" ToRole="grupobd" />
<NavigationProperty Name="gruposmenus" Relationship="tsl5Model.usuarios_gruposmenus" FromRole="usuarios" ToRole="gruposmenus" />
</EntityType>
<Association Name="excepcionesmenus_menus">
<End Role="menus" Type="tsl5Model.menus" Multiplicity="0..1" />
<End Role="excepcionesmenus" Type="tsl5Model.excepcionesmenus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="menus">
<PropertyRef Name="idMenus" />
</Principal>
<Dependent Role="excepcionesmenus">
<PropertyRef Name="idMenu" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="excepcionesmenus_usuarios">
<End Role="usuarios" Type="tsl5Model.usuarios" Multiplicity="0..1" />
<End Role="excepcionesmenus" Type="tsl5Model.excepcionesmenus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="usuarios">
<PropertyRef Name="idUsuarios" />
</Principal>
<Dependent Role="excepcionesmenus">
<PropertyRef Name="idUsuario" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="Usuarios_Grupobd">
<End Role="grupobd" Type="tsl5Model.grupobd" Multiplicity="1" />
<End Role="usuarios" Type="tsl5Model.usuarios" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="grupobd">
<PropertyRef Name="idGrupoBD" />
</Principal>
<Dependent Role="usuarios">
<PropertyRef Name="idGrupobd" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="Menus_GruposMenus">
<End Role="gruposmenus" Type="tsl5Model.gruposmenus" Multiplicity="0..1" />
<End Role="menus" Type="tsl5Model.menus" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="gruposmenus">
<PropertyRef Name="idGruposMenus" />
</Principal>
<Dependent Role="menus">
<PropertyRef Name="idGrupoMenu" />
</Dependent>
</ReferentialConstraint>
</Association>
<Association Name="usuarios_gruposmenus">
<End Role="gruposmenus" Type="tsl5Model.gruposmenus" Multiplicity="0..1" />
<End Role="usuarios" Type="tsl5Model.usuarios" Multiplicity="*" />
<ReferentialConstraint>
<Principal Role="gruposmenus">
<PropertyRef Name="idGruposMenus" />
</Principal>
<Dependent Role="usuarios">
<PropertyRef Name="idGrupomenus" />
</Dependent>
</ReferentialConstraint>
</Association>
</Schema>
</edmx:ConceptualModels>
<!-- C-S mapping content -->
<edmx:Mappings>
<Mapping Space="C-S" xmlns="http://schemas.microsoft.com/ado/2009/11/mapping/cs">
<EntityContainerMapping StorageEntityContainer="tsl5ModelStoreContainer" CdmEntityContainer="tsl5Entities">
<EntitySetMapping Name="excepcionesmenus"><EntityTypeMapping TypeName="tsl5Model.excepcionesmenus"><MappingFragment StoreEntitySet="excepcionesmenus">
<ScalarProperty Name="idExcepcionesMenus" ColumnName="idExcepcionesMenus" />
<ScalarProperty Name="idMenu" ColumnName="idMenu" />
<ScalarProperty Name="idUsuario" ColumnName="idUsuario" />
</MappingFragment></EntityTypeMapping></EntitySetMapping>
<EntitySetMapping Name="grupobd"><EntityTypeMapping TypeName="tsl5Model.grupobd"><MappingFragment StoreEntitySet="grupobd">
<ScalarProperty Name="idGrupoBD" ColumnName="idGrupoBD" />
<ScalarProperty Name="Descripcion" ColumnName="Descripcion" />
</MappingFragment></EntityTypeMapping></EntitySetMapping>
<EntitySetMapping Name="gruposmenus"><EntityTypeMapping TypeName="tsl5Model.gruposmenus"><MappingFragment StoreEntitySet="gruposmenus">
<ScalarProperty Name="idGruposMenus" ColumnName="idGruposMenus" />
<ScalarProperty Name="Descripcion" ColumnName="Descripcion" />
</MappingFragment></EntityTypeMapping></EntitySetMapping>
<EntitySetMapping Name="menus"><EntityTypeMapping TypeName="tsl5Model.menus"><MappingFragment StoreEntitySet="menus">
<ScalarProperty Name="idMenus" ColumnName="idMenus" />
<ScalarProperty Name="Texto" ColumnName="Texto" />
<ScalarProperty Name="Ayuda" ColumnName="Ayuda" />
<ScalarProperty Name="Accion" ColumnName="Accion" />
<ScalarProperty Name="Orden" ColumnName="Orden" />
<ScalarProperty Name="idMenuPadre" ColumnName="idMenuPadre" />
<ScalarProperty Name="idGrupoMenu" ColumnName="idGrupoMenu" />
</MappingFragment></EntityTypeMapping></EntitySetMapping>
<EntitySetMapping Name="usuarios"><EntityTypeMapping TypeName="tsl5Model.usuarios"><MappingFragment StoreEntitySet="usuarios">
<ScalarProperty Name="idUsuarios" ColumnName="idUsuarios" />
<ScalarProperty Name="Usuario" ColumnName="Usuario" />
<ScalarProperty Name="SHA1Passwd" ColumnName="SHA1Passwd" />
<ScalarProperty Name="idGrupobd" ColumnName="idGrupobd" />
<ScalarProperty Name="idGrupomenus" ColumnName="idGrupomenus" />
</MappingFragment></EntityTypeMapping></EntitySetMapping>
</EntityContainerMapping>
</Mapping>
</edmx:Mappings>
</edmx:Runtime>
<!-- EF Designer content (DO NOT EDIT MANUALLY BELOW HERE) -->
<Designer xmlns="http://schemas.microsoft.com/ado/2009/11/edmx">
<Connection>
<DesignerInfoPropertySet>
<DesignerProperty Name="MetadataArtifactProcessing" Value="EmbedInOutputAssembly" />
</DesignerInfoPropertySet>
</Connection>
<Options>
<DesignerInfoPropertySet>
<DesignerProperty Name="ValidateOnBuild" Value="true" />
<DesignerProperty Name="EnablePluralization" Value="False" />
<DesignerProperty Name="IncludeForeignKeysInModel" Value="True" />
</DesignerInfoPropertySet>
</Options>
<!-- Diagram content (shape and connector positions) -->
<Diagrams>
<Diagram Name="Model1" ZoomLevel="95">
<EntityTypeShape EntityType="tsl5Model.excepcionesmenus" Width="1.5" PointX="5.25" PointY="4" Height="1.9802864583333335" IsExpanded="true" />
<EntityTypeShape EntityType="tsl5Model.grupobd" Width="1.5" PointX="1.375" PointY="1.75" Height="1.5956835937499996" IsExpanded="true" />
<EntityTypeShape EntityType="tsl5Model.gruposmenus" Width="1.5" PointX="0.75" PointY="4.125" Height="1.7879850260416657" IsExpanded="true" />
<EntityTypeShape EntityType="tsl5Model.menus" Width="1.5" PointX="3" PointY="3.625" Height="2.7494921874999996" IsExpanded="true" />
<EntityTypeShape EntityType="tsl5Model.usuarios" Width="1.5" PointX="6" PointY="0.75" Height="2.5571907552083317" IsExpanded="true" />
<AssociationConnector Association="tsl5Model.excepcionesmenus_menus" ManuallyRouted="false">
<ConnectorPoint PointX="4.5" PointY="4.9901432291666667" />
<ConnectorPoint PointX="4.791666666666667" PointY="4.9901432291666659" />
<ConnectorPoint PointX="4.958333333333333" PointY="4.9901432291666667" />
<ConnectorPoint PointX="5.25" PointY="4.9901432291666667" />
</AssociationConnector>
<AssociationConnector Association="tsl5Model.excepcionesmenus_usuarios" ManuallyRouted="false">
<ConnectorPoint PointX="6.375" PointY="3.3071907552083317" />
<ConnectorPoint PointX="6.375" PointY="4" />
</AssociationConnector>
<AssociationConnector Association="tsl5Model.Usuarios_Grupobd" ManuallyRouted="false">
<ConnectorPoint PointX="4.875" PointY="7.375" />
<ConnectorPoint PointX="4.875" PointY="2.0285953776041659" />
<ConnectorPoint PointX="6" PointY="2.0285953776041659" />
</AssociationConnector>
<AssociationConnector Association="tsl5Model.Menus_GruposMenus" ManuallyRouted="false">
<ConnectorPoint PointX="2.25" PointY="5.0189925130208328" />
<ConnectorPoint PointX="3" PointY="5.0189925130208328" />
</AssociationConnector>
<AssociationConnector Association="tsl5Model.usuarios_gruposmenus" ManuallyRouted="false">
<ConnectorPoint PointX="1.5" PointY="4.125" />
<ConnectorPoint PointX="1.5" PointY="2.6991455664062496" />
<ConnectorPoint PointX="4.791666666666667" PointY="2.6991455664062491" />
<ConnectorPoint PointX="4.958333333333333" PointY="2.6991455664062496" />
<ConnectorPoint PointX="6" PointY="2.6991455664062496" />
</AssociationConnector>
</Diagram>
</Diagrams>
</Designer>
</edmx:Edmx>

200
tsl5Model.edmx.sqlce Normal file
View File

@@ -0,0 +1,200 @@
-- --------------------------------------------------
-- Entity Designer DDL Script for SQL Server Compact Edition
-- --------------------------------------------------
-- Date Created: 02/25/2013 12:31:59
-- Generated from EDMX file: C:\tecnosis.tfs\Comun\tsl5\tsl5Model.edmx
-- --------------------------------------------------
-- --------------------------------------------------
-- Dropping existing FOREIGN KEY constraints
-- NOTE: if the constraint does not exist, an ignorable error will be reported.
-- --------------------------------------------------
ALTER TABLE [excepcionesmenus] DROP CONSTRAINT [FK_excepcionesmenus_menus];
GO
ALTER TABLE [excepcionesmenus] DROP CONSTRAINT [FK_excepcionesmenus_usuarios];
GO
ALTER TABLE [menus] DROP CONSTRAINT [FK_Menus_GruposMenus];
GO
ALTER TABLE [usuarios] DROP CONSTRAINT [FK_Usuarios_Grupobd];
GO
ALTER TABLE [usuarios] DROP CONSTRAINT [FK_usuarios_gruposmenus];
GO
-- --------------------------------------------------
-- Dropping existing tables
-- NOTE: if the table does not exist, an ignorable error will be reported.
-- --------------------------------------------------
DROP TABLE [excepcionesmenus];
GO
DROP TABLE [grupobd];
GO
DROP TABLE [gruposmenus];
GO
DROP TABLE [menus];
GO
DROP TABLE [usuarios];
GO
-- --------------------------------------------------
-- Creating all tables
-- --------------------------------------------------
-- Creating table 'excepcionesmenus'
CREATE TABLE [excepcionesmenus] (
[idExcepcionesMenus] int NOT NULL,
[idMenu] int NULL,
[idUsuario] int NULL
);
GO
-- Creating table 'grupobd'
CREATE TABLE [grupobd] (
[idGrupoBD] int IDENTITY(1,1) NOT NULL,
[Descripcion] nvarchar(4000) NULL
);
GO
-- Creating table 'gruposmenus'
CREATE TABLE [gruposmenus] (
[idGruposMenus] int IDENTITY(1,1) NOT NULL,
[Descripcion] nvarchar(4000) NULL
);
GO
-- Creating table 'menus'
CREATE TABLE [menus] (
[idMenus] int IDENTITY(1,1) NOT NULL,
[Texto] nvarchar(4000) NULL,
[Ayuda] nvarchar(4000) NULL,
[Accion] nvarchar(4000) NULL,
[Orden] int NULL,
[idMenuPadre] int NULL,
[idGrupoMenu] int NULL
);
GO
-- Creating table 'usuarios'
CREATE TABLE [usuarios] (
[idUsuarios] int IDENTITY(1,1) NOT NULL,
[Usuario] nvarchar(4000) NOT NULL,
[SHA1Passwd] nvarchar(4000) NULL,
[idGrupobd] int NOT NULL,
[idGrupomenus] int NULL
);
GO
-- --------------------------------------------------
-- Creating all PRIMARY KEY constraints
-- --------------------------------------------------
-- Creating primary key on [idExcepcionesMenus] in table 'excepcionesmenus'
ALTER TABLE [excepcionesmenus]
ADD CONSTRAINT [PK_excepcionesmenus]
PRIMARY KEY ([idExcepcionesMenus] );
GO
-- Creating primary key on [idGrupoBD] in table 'grupobd'
ALTER TABLE [grupobd]
ADD CONSTRAINT [PK_grupobd]
PRIMARY KEY ([idGrupoBD] );
GO
-- Creating primary key on [idGruposMenus] in table 'gruposmenus'
ALTER TABLE [gruposmenus]
ADD CONSTRAINT [PK_gruposmenus]
PRIMARY KEY ([idGruposMenus] );
GO
-- Creating primary key on [idMenus] in table 'menus'
ALTER TABLE [menus]
ADD CONSTRAINT [PK_menus]
PRIMARY KEY ([idMenus] );
GO
-- Creating primary key on [idUsuarios] in table 'usuarios'
ALTER TABLE [usuarios]
ADD CONSTRAINT [PK_usuarios]
PRIMARY KEY ([idUsuarios] );
GO
-- --------------------------------------------------
-- Creating all FOREIGN KEY constraints
-- --------------------------------------------------
-- Creating foreign key on [idMenu] in table 'excepcionesmenus'
ALTER TABLE [excepcionesmenus]
ADD CONSTRAINT [FK_excepcionesmenus_menus]
FOREIGN KEY ([idMenu])
REFERENCES [menus]
([idMenus])
ON DELETE NO ACTION ON UPDATE NO ACTION;
-- Creating non-clustered index for FOREIGN KEY 'FK_excepcionesmenus_menus'
CREATE INDEX [IX_FK_excepcionesmenus_menus]
ON [excepcionesmenus]
([idMenu]);
GO
-- Creating foreign key on [idUsuario] in table 'excepcionesmenus'
ALTER TABLE [excepcionesmenus]
ADD CONSTRAINT [FK_excepcionesmenus_usuarios]
FOREIGN KEY ([idUsuario])
REFERENCES [usuarios]
([idUsuarios])
ON DELETE NO ACTION ON UPDATE NO ACTION;
-- Creating non-clustered index for FOREIGN KEY 'FK_excepcionesmenus_usuarios'
CREATE INDEX [IX_FK_excepcionesmenus_usuarios]
ON [excepcionesmenus]
([idUsuario]);
GO
-- Creating foreign key on [idGrupobd] in table 'usuarios'
ALTER TABLE [usuarios]
ADD CONSTRAINT [FK_Usuarios_Grupobd]
FOREIGN KEY ([idGrupobd])
REFERENCES [grupobd]
([idGrupoBD])
ON DELETE NO ACTION ON UPDATE NO ACTION;
-- Creating non-clustered index for FOREIGN KEY 'FK_Usuarios_Grupobd'
CREATE INDEX [IX_FK_Usuarios_Grupobd]
ON [usuarios]
([idGrupobd]);
GO
-- Creating foreign key on [idGrupoMenu] in table 'menus'
ALTER TABLE [menus]
ADD CONSTRAINT [FK_Menus_GruposMenus]
FOREIGN KEY ([idGrupoMenu])
REFERENCES [gruposmenus]
([idGruposMenus])
ON DELETE NO ACTION ON UPDATE NO ACTION;
-- Creating non-clustered index for FOREIGN KEY 'FK_Menus_GruposMenus'
CREATE INDEX [IX_FK_Menus_GruposMenus]
ON [menus]
([idGrupoMenu]);
GO
-- Creating foreign key on [idGrupomenus] in table 'usuarios'
ALTER TABLE [usuarios]
ADD CONSTRAINT [FK_usuarios_gruposmenus]
FOREIGN KEY ([idGrupomenus])
REFERENCES [gruposmenus]
([idGruposMenus])
ON DELETE NO ACTION ON UPDATE NO ACTION;
-- Creating non-clustered index for FOREIGN KEY 'FK_usuarios_gruposmenus'
CREATE INDEX [IX_FK_usuarios_gruposmenus]
ON [usuarios]
([idGrupomenus]);
GO
-- --------------------------------------------------
-- Script has ended
-- --------------------------------------------------

71
xhtml.vb Normal file
View File

@@ -0,0 +1,71 @@
Imports System.IO
Public Class xhtml
Public Shared Sub CrearXHTML(FicheroPlantilla As Byte(), FicheroDestino As String, Bloques() As BloquesXHTML)
Dim tr As System.IO.TextReader = New IO.StreamReader(New MemoryStream(FicheroPlantilla))
CrearXHTML(tr, FicheroDestino, Bloques)
tr.Close()
End Sub
Public Shared Sub CrearXHTML(FicheroPlantilla As String, FicheroDestino As String, Bloques() As BloquesXHTML)
Dim tr As System.IO.TextReader = System.IO.File.OpenText(FicheroPlantilla)
CrearXHTML(tr, FicheroDestino, Bloques)
tr.Close()
End Sub
Public Shared Sub CrearXHTML(tr As System.IO.TextReader, FicheroDestino As String, Bloques() As BloquesXHTML)
Try
'Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroPlantilla)
Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestino)
Dim blqs As New Hashtable
Dim sLinea As String = tr.ReadLine() & vbCrLf
' CABECERA
Dim sBloqueCabecera As String = ""
While Not sLinea.Contains("<!--TSL4:#")
sBloqueCabecera &= sLinea
sLinea = tr.ReadLine() & vbCrLf
End While
clsWriter.Write(sBloqueCabecera)
Do
Dim sNombreBloque As String = sLinea.Trim.Substring(10, sLinea.Trim.Length - 14)
Dim sBloque As String = ""
Do
sBloque &= sLinea
sLinea = tr.ReadLine() & vbCrLf
Loop Until sLinea.Contains("<!--TSL4:FIN-#")
sBloque &= sLinea
blqs.Add(sNombreBloque, sBloque)
sLinea = tr.ReadLine() & vbCrLf
Loop Until Not sLinea.Contains("<!--TSL4:#")
Dim sBloquePie As String = sLinea
sBloquePie &= tr.ReadToEnd
For i = 0 To Bloques.Count - 1
Dim BloqueReemplazado As BloquesXHTML = Bloques(i)
Dim Bloque As String = blqs(BloqueReemplazado.NombreBloque)
For j = 0 To BloqueReemplazado.Parametros.Length - 1
Dim p = BloqueReemplazado.Parametros(j)
If p.Codigo = "" Then p.Codigo = "$" & (j + 1).ToString.PadLeft(3, "0")
Bloque = Bloque.Replace(p.Codigo, p.Valor)
Next
For Np = 1 To 300
Bloque = Bloque.Replace("$" & Np.ToString.PadLeft(3, "0"), " ")
Next
clsWriter.Write(Bloque)
Next
clsWriter.Write(sBloquePie)
clsWriter.Close()
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Sub
End Class
Public Class BloquesXHTML
Public NombreBloque As String
Public Parametros() As ParametroXHTML
End Class
Public Class ParametroXHTML
Public Codigo As String
Public Valor As String
End Class

91
zip.vb Normal file
View File

@@ -0,0 +1,91 @@
Imports System.IO
Imports System.IO.Compression
Public Class zip
Shared Sub ExtraeTodoDeZip(FicheroZIP As IO.MemoryStream, RutaDestino As String, Optional EliminaDirectorioDestino As Boolean = False)
If RutaDestino.EndsWith("\") = False Then RutaDestino &= "\"
If IO.Directory.Exists(RutaDestino) And EliminaDirectorioDestino Then
IO.Directory.Delete(RutaDestino, True)
End If
If Not IO.Directory.Exists(RutaDestino) Then tsl5.Utilidades.CreaEstructuraDirectorio(RutaDestino)
Dim fzip As New ZipArchive(FicheroZIP, ZipArchiveMode.Read)
For Each entry In fzip.Entries
Dim sDestino As String = RutaDestino & entry.FullName.Replace("/", "\")
If Not IO.Directory.Exists(IO.Path.GetDirectoryName(sDestino)) Then
tsl5.Utilidades.CreaEstructuraDirectorio(IO.Path.GetDirectoryName(sDestino))
End If
If entry.FullName.EndsWith("/") = False Then entry.ExtractToFile(sDestino)
Next
End Sub
''' <summary>
''' Esta función extrae el único fichero que hay dentro de un fichero zip, lo devuelve como array de bytes como retorno de la función, e indica su nombre en un parámetro por referencia.
''' </summary>
''' <param name="ficheroZip">Array de bytes conteniendo el fichero zip.</param>
''' <param name="nombreArchivoDentroZip">Cadena donde se guardará el nombre del fichero que está dentro del fichero zip.</param>
''' <returns>Para que este método funcione correctamente es imprescindible que el archivo zip tenga dentro un único fichero.</returns>
Public Shared Function ExtraerFicheroUnicoDeZip(ficheroZip As Byte(), ByRef nombreArchivoDentroZip As String) As Byte()
Dim sFichero As IO.Stream
Dim za As ZipArchive = New ZipArchive(New IO.MemoryStream(ficheroZip))
If za.Entries.Count = 1 Then
nombreArchivoDentroZip = za.Entries.First.Name
sFichero = za.Entries.First.Open()
Else
Throw New Exception("Se esperaba que el archivo zip tuviera un único fichero dentro, pero la cantidad es distinta. Se aborta la operación.")
End If
Dim ms As New IO.MemoryStream
sFichero.CopyTo(ms)
sFichero.Dispose()
Return ms.ToArray
End Function
''' <summary>
''' Esta función extrae todos los ficheros que haya en un zip y los devuelve como un diccionario.
''' </summary>
''' <param name="ficheroZip">Array de bytes conteniendo el fichero zip.</param>
''' <returns>Como todo es en memoria, hay que tener cuidado de que los ficheros extraídos quepan en memoria adecuadamente, teniendo en cuenta las posibles restricciones de memoria que el sistema operativo pueda tener para procesos individuales.</returns>
Public Shared Function ExtraerFicherosDeZip(ficheroZip As Byte()) As Dictionary(Of String, IO.MemoryStream)
Dim resultado As New Dictionary(Of String, IO.MemoryStream)
Dim za As ZipArchive = New ZipArchive(New IO.MemoryStream(ficheroZip))
For Each e In za.Entries
resultado.Add(e.FullName, e.Open())
Next
Return resultado
End Function
Public Shared Function ComprimirArchivos(nombresFicheros As List(Of String), rutasFicheros As List(Of String), rutaZip As String) As Boolean
Try
' Validar que ambas listas tengan el mismo número de elementos
If nombresFicheros.Count <> rutasFicheros.Count Then
Throw New ArgumentException("Las listas de nombres y rutas no tienen la misma longitud.")
End If
' Crear el archivo ZIP
Using zipStream As FileStream = New FileStream(rutaZip, FileMode.Create)
Using zipArchive As ZipArchive = New ZipArchive(zipStream, ZipArchiveMode.Create)
For i As Integer = 0 To nombresFicheros.Count - 1
' Agregar cada archivo al ZIP
Dim rutaArchivo As String = rutasFicheros(i)
Dim nombreEnZip As String = nombresFicheros(i)
If File.Exists(rutaArchivo) Then
zipArchive.CreateEntryFromFile(rutaArchivo, nombreEnZip)
Else
Console.WriteLine($"Advertencia: El archivo {rutaArchivo} no existe.")
End If
Next
End Using
End Using
Console.WriteLine($"Archivo ZIP creado correctamente en: {rutaZip}")
Return True
Catch ex As Exception
Console.WriteLine($"Error al crear el ZIP: {ex.Message}")
Return False
End Try
End Function
'prueba
End Class