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

Versión Copiada del tfs

Browse Source
This commit is contained in:
Manuel Moguer
2025-05-29 17:58:18 +02:00
commit 857f247df5
69 changed files with 22831 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
.editorconfig Normal file
View File

@@ -0,0 +1,4 @@
[*.vb]
# BC42309: El comentario XML tiene una etiqueta con un atributo 'cref' que no se pudo resolver
dotnet_diagnostic.BC42309.severity = silent

63
.gitattributes vendored Normal file
View File

@@ -0,0 +1,63 @@
###############################################################################
# Set default behavior to automatically normalize line endings.
###############################################################################
* text=auto
###############################################################################
# Set default behavior for command prompt diff.
#
# This is need for earlier builds of msysgit that does not have it on by
# default for csharp files.
# Note: This is only used by command line
###############################################################################
#*.cs diff=csharp
###############################################################################
# Set the merge driver for project and solution files
#
# Merging from the command prompt will add diff markers to the files if there
# are conflicts (Merging from VS is not affected by the settings below, in VS
# the diff markers are never inserted). Diff markers may cause the following
# file extensions to fail to load in VS. An alternative would be to treat
# these files as binary and thus will always conflict and require user
# intervention with every merge. To do so, just uncomment the entries below
###############################################################################
#*.sln merge=binary
#*.csproj merge=binary
#*.vbproj merge=binary
#*.vcxproj merge=binary
#*.vcproj merge=binary
#*.dbproj merge=binary
#*.fsproj merge=binary
#*.lsproj merge=binary
#*.wixproj merge=binary
#*.modelproj merge=binary
#*.sqlproj merge=binary
#*.wwaproj merge=binary
###############################################################################
# behavior for image files
#
# image files are treated as binary by default.
###############################################################################
#*.jpg binary
#*.png binary
#*.gif binary
###############################################################################
# diff behavior for common document formats
#
# Convert binary document formats to text before diffing them. This feature
# is only available from the command line. Turn it on by uncommenting the
# entries below.
###############################################################################
#*.doc diff=astextplain
#*.DOC diff=astextplain
#*.docx diff=astextplain
#*.DOCX diff=astextplain
#*.dot diff=astextplain
#*.DOT diff=astextplain
#*.pdf diff=astextplain
#*.PDF diff=astextplain
#*.rtf diff=astextplain
#*.RTF diff=astextplain

363
.gitignore vendored Normal file
View File

@@ -0,0 +1,363 @@
## Ignore Visual Studio temporary files, build results, and
## files generated by popular Visual Studio add-ons.
##
## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore
# User-specific files
*.rsuser
*.suo
*.user
*.userosscache
*.sln.docstates
# User-specific files (MonoDevelop/Xamarin Studio)
*.userprefs
# Mono auto generated files
mono_crash.*
# Build results
[Dd]ebug/
[Dd]ebugPublic/
[Rr]elease/
[Rr]eleases/
x64/
x86/
[Ww][Ii][Nn]32/
[Aa][Rr][Mm]/
[Aa][Rr][Mm]64/
bld/
[Bb]in/
[Oo]bj/
[Oo]ut/
[Ll]og/
[Ll]ogs/
# Visual Studio 2015/2017 cache/options directory
.vs/
# Uncomment if you have tasks that create the project's static files in wwwroot
#wwwroot/
# Visual Studio 2017 auto generated files
Generated\ Files/
# MSTest test Results
[Tt]est[Rr]esult*/
[Bb]uild[Ll]og.*
# NUnit
*.VisualState.xml
TestResult.xml
nunit-*.xml
# Build Results of an ATL Project
[Dd]ebugPS/
[Rr]eleasePS/
dlldata.c
# Benchmark Results
BenchmarkDotNet.Artifacts/
# .NET Core
project.lock.json
project.fragment.lock.json
artifacts/
# ASP.NET Scaffolding
ScaffoldingReadMe.txt
# StyleCop
StyleCopReport.xml
# Files built by Visual Studio
*_i.c
*_p.c
*_h.h
*.ilk
*.meta
*.obj
*.iobj
*.pch
*.pdb
*.ipdb
*.pgc
*.pgd
*.rsp
*.sbr
*.tlb
*.tli
*.tlh
*.tmp
*.tmp_proj
*_wpftmp.csproj
*.log
*.vspscc
*.vssscc
.builds
*.pidb
*.svclog
*.scc
# Chutzpah Test files
_Chutzpah*
# Visual C++ cache files
ipch/
*.aps
*.ncb
*.opendb
*.opensdf
*.sdf
*.cachefile
*.VC.db
*.VC.VC.opendb
# Visual Studio profiler
*.psess
*.vsp
*.vspx
*.sap
# Visual Studio Trace Files
*.e2e
# TFS 2012 Local Workspace
$tf/
# Guidance Automation Toolkit
*.gpState
# ReSharper is a .NET coding add-in
_ReSharper*/
*.[Rr]e[Ss]harper
*.DotSettings.user
# TeamCity is a build add-in
_TeamCity*
# DotCover is a Code Coverage Tool
*.dotCover
# AxoCover is a Code Coverage Tool
.axoCover/*
!.axoCover/settings.json
# Coverlet is a free, cross platform Code Coverage Tool
coverage*.json
coverage*.xml
coverage*.info
# Visual Studio code coverage results
*.coverage
*.coveragexml
# NCrunch
_NCrunch_*
.*crunch*.local.xml
nCrunchTemp_*
# MightyMoose
*.mm.*
AutoTest.Net/
# Web workbench (sass)
.sass-cache/
# Installshield output folder
[Ee]xpress/
# DocProject is a documentation generator add-in
DocProject/buildhelp/
DocProject/Help/*.HxT
DocProject/Help/*.HxC
DocProject/Help/*.hhc
DocProject/Help/*.hhk
DocProject/Help/*.hhp
DocProject/Help/Html2
DocProject/Help/html
# Click-Once directory
publish/
# Publish Web Output
*.[Pp]ublish.xml
*.azurePubxml
# Note: Comment the next line if you want to checkin your web deploy settings,
# but database connection strings (with potential passwords) will be unencrypted
*.pubxml
*.publishproj
# Microsoft Azure Web App publish settings. Comment the next line if you want to
# checkin your Azure Web App publish settings, but sensitive information contained
# in these scripts will be unencrypted
PublishScripts/
# NuGet Packages
*.nupkg
# NuGet Symbol Packages
*.snupkg
# The packages folder can be ignored because of Package Restore
**/[Pp]ackages/*
# except build/, which is used as an MSBuild target.
!**/[Pp]ackages/build/
# Uncomment if necessary however generally it will be regenerated when needed
#!**/[Pp]ackages/repositories.config
# NuGet v3's project.json files produces more ignorable files
*.nuget.props
*.nuget.targets
# Microsoft Azure Build Output
csx/
*.build.csdef
# Microsoft Azure Emulator
ecf/
rcf/
# Windows Store app package directories and files
AppPackages/
BundleArtifacts/
Package.StoreAssociation.xml
_pkginfo.txt
*.appx
*.appxbundle
*.appxupload
# Visual Studio cache files
# files ending in .cache can be ignored
*.[Cc]ache
# but keep track of directories ending in .cache
!?*.[Cc]ache/
# Others
ClientBin/
~$*
*~
*.dbmdl
*.dbproj.schemaview
*.jfm
*.pfx
*.publishsettings
orleans.codegen.cs
# Including strong name files can present a security risk
# (https://github.com/github/gitignore/pull/2483#issue-259490424)
#*.snk
# Since there are multiple workflows, uncomment next line to ignore bower_components
# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622)
#bower_components/
# RIA/Silverlight projects
Generated_Code/
# Backup & report files from converting an old project file
# to a newer Visual Studio version. Backup files are not needed,
# because we have git ;-)
_UpgradeReport_Files/
Backup*/
UpgradeLog*.XML
UpgradeLog*.htm
ServiceFabricBackup/
*.rptproj.bak
# SQL Server files
*.mdf
*.ldf
*.ndf
# Business Intelligence projects
*.rdl.data
*.bim.layout
*.bim_*.settings
*.rptproj.rsuser
*- [Bb]ackup.rdl
*- [Bb]ackup ([0-9]).rdl
*- [Bb]ackup ([0-9][0-9]).rdl
# Microsoft Fakes
FakesAssemblies/
# GhostDoc plugin setting file
*.GhostDoc.xml
# Node.js Tools for Visual Studio
.ntvs_analysis.dat
node_modules/
# Visual Studio 6 build log
*.plg
# Visual Studio 6 workspace options file
*.opt
# Visual Studio 6 auto-generated workspace file (contains which files were open etc.)
*.vbw
# Visual Studio LightSwitch build output
**/*.HTMLClient/GeneratedArtifacts
**/*.DesktopClient/GeneratedArtifacts
**/*.DesktopClient/ModelManifest.xml
**/*.Server/GeneratedArtifacts
**/*.Server/ModelManifest.xml
_Pvt_Extensions
# Paket dependency manager
.paket/paket.exe
paket-files/
# FAKE - F# Make
.fake/
# CodeRush personal settings
.cr/personal
# Python Tools for Visual Studio (PTVS)
__pycache__/
*.pyc
# Cake - Uncomment if you are using it
# tools/**
# !tools/packages.config
# Tabs Studio
*.tss
# Telerik's JustMock configuration file
*.jmconfig
# BizTalk build output
*.btp.cs
*.btm.cs
*.odx.cs
*.xsd.cs
# OpenCover UI analysis results
OpenCover/
# Azure Stream Analytics local run output
ASALocalRun/
# MSBuild Binary and Structured Log
*.binlog
# NVidia Nsight GPU debugger configuration file
*.nvuser
# MFractors (Xamarin productivity tool) working folder
.mfractor/
# Local History for Visual Studio
.localhistory/
# BeatPulse healthcheck temp database
healthchecksdb
# Backup folder for Package Reference Convert tool in Visual Studio 2017
MigrationBackup/
# Ionide (cross platform F# VS Code tools) working folder
.ionide/
# Fody - auto-generated XML schema
FodyWeavers.xsd

67
App.Config Normal file
View File

@@ -0,0 +1,67 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<configSections>
<section name="oracle.manageddataaccess.client" type="OracleInternal.Common.ODPMSectionHandler, Oracle.ManagedDataAccess, Version=4.122.19.1, Culture=neutral, PublicKeyToken=89b483f429c47342" />
</configSections>
<!-- system.diagnostics section is not supported on .NET 6 (see https://github.com/dotnet/runtime/issues/23937)-->
<!--<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.5.2" />
</startup>
<system.data>
<DbProviderFactories>
<remove invariant="Oracle.ManagedDataAccess.Client" />
<add name="ODP.NET, Managed Driver" invariant="Oracle.ManagedDataAccess.Client" description="Oracle Data Provider for .NET, Managed Driver" type="Oracle.ManagedDataAccess.Client.OracleClientFactory, Oracle.ManagedDataAccess, Version=4.122.19.1, Culture=neutral, PublicKeyToken=89b483f429c47342" />
</DbProviderFactories>
</system.data>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<publisherPolicy apply="no" />
<assemblyIdentity name="Oracle.ManagedDataAccess" publicKeyToken="89b483f429c47342" culture="neutral" />
<bindingRedirect oldVersion="4.121.0.0 - 4.65535.65535.65535" newVersion="4.122.19.1" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.0.5.0" newVersion="4.0.5.0" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0" />
</dependentAssembly>
</assemblyBinding>
</runtime>
<oracle.manageddataaccess.client>
<version number="*">
<dataSources>
<dataSource alias="SampleDataSource" descriptor="(DESCRIPTION=(ADDRESS=(PROTOCOL=tcp)(HOST=localhost)(PORT=1521))(CONNECT_DATA=(SERVICE_NAME=ORCL))) " />
</dataSources>
</version>
</oracle.manageddataaccess.client>
</configuration>

800
Bancos/Bancos.vb Normal file
View File

@@ -0,0 +1,800 @@
Imports System.Text
Imports tsUtilidades.Extensiones
Imports tsUtilidades.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 tsUtilidades.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 tsUtilidades.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 <> "" OrElse dr.CamposOpcionales.DomicilioTitularCuenta <> "" OrElse dr.CamposOpcionales.PlazaDomicilioTitularCuenta <> "" OrElse 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
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
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 tsUtilidades.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 tsUtilidades.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 tsUtilidades.Bancos.SEPA
Imports tsUtilidades.Bancos
Imports tsUtilidades.SEPA_1914XML
Imports tsUtilidades.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 tsUtilidades.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}
' tsUtilidades.Utilidades.Serializar(oprvtid, FicheroXML)
Dim dr As tsUtilidades.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
tsUtilidades.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 tsUtilidades.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) tsUtilidades.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 = ListaBeneficiarios.Where(Function(X) X.ImporteTransferencia > 0).Sum(Function(x) x.ImporteTransferencia)
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 = tsUtilidades.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
tsUtilidades.Utilidades.Serializar(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 tsUtilidades.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 OrElse 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 OrElse 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

804
Correo.vb Normal file
View File

@@ -0,0 +1,804 @@
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 tsUtilidades.Extensiones
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 = "")
If FicherosAdjuntos.Count = 1 AndAlso NombreFicherosAdjuntos(0).EndsWith(".html.zip") Then
Dim sDirectorioTMP As String = tsUtilidades.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)
IO.Directory.Delete(sDirectorioTMP, True)
Else
EnviaCorreo(ServidorSMTP, Remitente, Destinatario, Asunto, Cuerpo, FicherosAdjuntos, NombreFicherosAdjuntos, CC, BCC, CuentaCorreo, ContraseñaCorreo, Puerto, UsarSSL, CuerpoenHTML, ResponderA)
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 = "")
Try
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
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, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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.Tls12
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)
Try
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)
Dim sDestinatarios() As String = Nothing
sDestinatarios = Destinatario.Split(";")
For Each dest In sDestinatarios
dest = dest.Trim
If dest.Trim <> "" Then
myMessage.To.Add(dest)
End If
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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 OrElse SecurityProtocolType.Tls11 OrElse SecurityProtocolType.Tls12 OrElse SecurityProtocolType.Tls13
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
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 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 = "")
Try
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))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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.Tls12
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 = "")
Try
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(Remitente, Destinatario, Asunto, Cuerpo)
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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.Tls12
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 = "")
Try
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))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
myMessage.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(responderA, responderA))
myMessage.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
myMessage.Sender = New MailAddress(remitente, remitente)
myMessage.From = New MailAddress(remitente, remitente)
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.Tls12
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)
Try
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))
Next
myMessage.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, Remitente)
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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.UseDefaultCredentials = True
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw 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)
Try
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.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, Remitente)
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
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.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw 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 = "")
Try
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.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
mensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
mensaje.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
mensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
mensaje.Sender = New MailAddress(remitente, remitente)
mensaje.From = New MailAddress(remitente, remitente)
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.Tls12
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 = "")
Try
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, remitente), New MailAddress(destinatario, destinatario)) With {
.Subject = asunto,
.Body = cuerpo,
.BodyEncoding = Text.Encoding.UTF8
}
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
miMensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
miMensaje.ReplyToList.Add(New MailAddress(responderA, responderA))
miMensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
miMensaje.Sender = New MailAddress(remitente, remitente)
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.Tls12
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

180
Datos.vb Normal file
View File

@@ -0,0 +1,180 @@
Imports tsUtilidades.Enumeraciones
Imports System.Runtime.Serialization
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
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
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

65
Extensiones/DateOnlyExtensions.vb Normal file
View File

@@ -0,0 +1,65 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DateOnlyExtensions
<Extension()>
Public Function Minimo(Fecha1 As Nullable(Of DateOnly), Fecha2 As Nullable(Of DateOnly)) As Nullable(Of DateOnly)
Dim t1, t2 As DateOnly
If Fecha1.HasValue Then t1 = Fecha1.Value
If Fecha2.HasValue Then t2 = Fecha2.Value
If t1 < t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function Maximo(Fecha1 As Nullable(Of DateOnly), Fecha2 As Nullable(Of DateOnly)) As Nullable(Of DateOnly)
Dim t1, t2 As DateOnly
If Fecha1.HasValue Then t1 = Fecha1.Value
If Fecha2.HasValue Then t2 = Fecha2.Value
If t1 > t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function ValorNumerico(Fecha As Nullable(Of DateOnly)) 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 ToDateTime(Fecha As Nullable(Of DateOnly)) As DateTime
If Fecha Is Nothing Then
Return Nothing
Else
Return New DateTime(Fecha.Value.Year, Fecha.Value.Month, Fecha.Value.Day)
End If
End Function
<Extension()>
Public Function ToDateTime(Fecha As DateOnly) As DateTime
Return New DateTime(Fecha.Year, Fecha.Month, Fecha.Day)
End Function
<Extension()>
Public Function ToDate(Fecha As Nullable(Of DateOnly)) As DateTime
If Fecha Is Nothing Then
Return Nothing
Else
Return New Date(Fecha.Value.Year, Fecha.Value.Month, Fecha.Value.Day)
End If
End Function
<Extension()>
Public Function ToDate(Fecha As DateOnly) As DateTime
Return New Date(Fecha.Year, Fecha.Month, Fecha.Day)
End Function
End Module
End Namespace

152
Extensiones/DateTimeExtensions.vb Normal file
View File

@@ -0,0 +1,152 @@
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 OrElse 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
'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

104
Extensiones/DbContextExtensions.vb Normal file
View File

@@ -0,0 +1,104 @@
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports Microsoft.EntityFrameworkCore
Imports Microsoft.EntityFrameworkCore.Internal
Imports System.Linq.Dynamic.Core
Namespace Extensiones
Public Module DbContextExtensions
<Extension()>
Public Function Query(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal entityName As String) As IQueryable
Return context.Query(context.Model.FindEntityType(entityName).ClrType)
End Function
<Extension()>
Public Function Query(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal entityType As Type) As IQueryable
Return CType((CType(context, IDbSetCache)).GetOrAddSet(context.GetDependencies().SetSource, entityType), IQueryable)
End Function
<Extension()>
Public Function ObtieneCampoIndice(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal Entidad As Object) As String
Dim entry = context.Entry(Entidad)
Dim pk = entry.Metadata.FindPrimaryKey()
Return pk.Properties.FirstOrDefault()?.Name
End Function
<Extension()>
Public Function ObtieneMaximaLongitudCampo(bd As Microsoft.EntityFrameworkCore.DbContext, ByVal EspacioNombres As String, ByVal NombreTablaBase As String, ByVal NombreCampo As String) As Integer
Try
If Not NombreCampo.Contains(".") Then
Dim Tabla = bd.Model.FindEntityType(EspacioNombres & "." & NombreTablaBase)
If Tabla Is Nothing Then Throw New Exception("Tabla " & NombreTablaBase & " no encontrada")
Dim Campo = Tabla.FindProperty(NombreCampo)
If Campo Is Nothing Then
Return -1 ' Throw New Exception("No existe el campo " & NombreCampo & " en la tabla " & NombreTablaBase)
Else
Dim LongitudCampo As Integer? = Campo.GetMaxLength()
If LongitudCampo.HasValue Then
Return LongitudCampo.Value
Else
Return -1
End If
End If
Else
Return -1
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
<Extension()>
Public Function ExecSQL(Of T)(dbc As Microsoft.EntityFrameworkCore.DbContext, ByVal query As String) As List(Of T)
Dim Command = dbc.Database.GetDbConnection().CreateCommand()
Command.CommandText = query
Command.CommandType = Data.CommandType.Text
dbc.Database.OpenConnection()
Dim list As List(Of T) = New List(Of T)()
Dim result = Command.ExecuteReader()
Dim obj As T = Nothing
While result.Read()
obj = Activator.CreateInstance(Of T)()
For Each prop As PropertyInfo In obj.[GetType]().GetProperties()
If Not Object.Equals(result(prop.Name), DBNull.Value) Then
prop.SetValue(obj, result(prop.Name), Nothing)
End If
Next
list.Add(obj)
End While
dbc.Database.CloseConnection()
Return list
End Function
<Extension()>
Public Function CompruebaRegistroUnico(bd As Microsoft.EntityFrameworkCore.DbContext, CompruebaIndice As Boolean, EspacioNombres As String, NombreTabla As String, NombreCampo As String, Valor As Object, Entidad As Object) As Boolean
Dim Busqueda As String = NombreCampo & "==""" & CStr(Valor) & """"
If CompruebaIndice Then
Dim CampoIndice As String = bd.ObtieneCampoIndice(Entidad)
Dim ValorCampoIndice As String = CStr(bd.Entry(Entidad).[Property](CampoIndice).CurrentValue.ToString())
Busqueda += " && " & CampoIndice & "!=" & ValorCampoIndice
End If
Dim resp As Boolean = bd.Query(EspacioNombres & "." & NombreTabla).Any(Busqueda)
Return Not resp
End Function
<Extension()>
Public Function AhoraMySql(ByVal context As Microsoft.EntityFrameworkCore.DbContext) As DateTime
Dim cn = context.Database.GetDbConnection
Dim cmd = cn.CreateCommand
cmd.CommandText = "select now() as Ahora"
cn.Open()
Dim Hora As DateTime = cmd.ExecuteScalar
cn.Close()
Return Hora
End Function
End Module
End Namespace

27
Extensiones/DoubleExtensions.vb Normal file
View File

@@ -0,0 +1,27 @@
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
Dim Doble = If(Valor.HasValue, Valor.Value, 0)
Return Doble
End Function
End Module
End Namespace

150
Extensiones/IEnumerable.vb Normal file
View File

@@ -0,0 +1,150 @@
Imports System.Runtime.CompilerServices
Imports System.Reflection
Imports System.Data
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") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse 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") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse x.PropertyType.BaseType.Name = "EntityObject"))
For Each p As PropertyInfo In Propiedades
If Not _ordinalMap.ContainsKey(p.Name) Then
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(Boolean?) Then
propiedad = GetType(Boolean)
ElseIf propiedad Is GetType(DateTime?) Then
propiedad = GetType(DateTime)
ElseIf propiedad Is GetType(Date?) Then
propiedad = GetType(Date)
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)
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") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse 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

13
Extensiones/IntegerExtensions.vb Normal file
View File

@@ -0,0 +1,13 @@
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
End Module
End Namespace

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

72
Extensiones/ObjetExtensions.vb Normal file
View File

@@ -0,0 +1,72 @@
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Imports Microsoft.EntityFrameworkCore
Imports System.Data.Entity.Core.Objects
Imports System.Data.Entity.Core
Imports System.Reflection
Imports Microsoft.EntityFrameworkCore.Infrastructure
Imports Newtonsoft.Json
Imports System.Formats
'Imports System.Data.Entity.Core.Objects
'Imports System.Data.Entity.Core.Objects
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
'<Extension>
'Public Function GetDbContextFromEntity(ByVal entity As Object) As Data.Entity.DbContext
' Dim object_context = GetObjectContextFromEntity(entity)
' If object_context Is Nothing OrElse object_context.TransactionHandler Is Nothing Then Return Nothing
' Return object_context.TransactionHandler.DbContext
'End Function
'Private Function GetObjectContextFromEntity(ByVal entity As Object) As ObjectContext
' Dim field = entity.[GetType]().GetField("_entityWrapper")
' If field Is Nothing Then Return Nothing
' Dim wrapper = field.GetValue(entity)
' Dim [property] = wrapper.[GetType]().GetProperty("Context")
' Dim context = CType([property].GetValue(wrapper, Nothing), ObjectContext)
' Return context
'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
<Extension()>
Function GetDbContext(Of T As Class)(ByVal dbSet As DbSet(Of T)) As DbContext
Dim infrastructure = TryCast(dbSet, IInfrastructure(Of IServiceProvider))
Dim serviceProvider = infrastructure.Instance
Dim currentDbContext = TryCast(serviceProvider.GetService(GetType(ICurrentDbContext)), ICurrentDbContext)
Return currentDbContext.Context
End Function
<Extension()>
Function Clonar(Of T)(ByVal self As T) As T
Dim serialized = JsonConvert.SerializeObject(self)
Return JsonConvert.DeserializeObject(Of T)(serialized)
End Function
<Extension()>
Sub CopiarPropiedadesDe(Of T)(ByVal Destino As T, ByVal Origen As T)
Dim props = Destino.GetType.GetProperties.Where(Function(x) x.CanWrite).ToList
For Each p In props
p.SetValue(Destino, Origen.GetType.GetProperty(p.Name).GetValue(Origen))
Next
End Sub
'<Extension()>
'Function ObtieneContexto(Of T As Class)(ByVal Objeto As T) As DbContext
' Dim infrastructure = TryCast(Objeto, IInfrastructure(Of IServiceProvider))
' Dim serviceProvider = infrastructure.Instance
' Dim currentDbContext = TryCast(serviceProvider.GetService(GetType(ICurrentDbContext)), ICurrentDbContext)
' Return currentDbContext.Context
'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

715
Extensiones/StringExtensions.vb Normal file
View File

@@ -0,0 +1,715 @@
Option Strict Off
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Imports System.Text.RegularExpressions
Imports tsUtilidades.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 TipoDocumentoIdentidad(ByVal DNI As String) As TiposDocumentosEnum
Try
Dim v As New ValidarDocumentoIdentidad(DNI)
Return v.TipoDocumento
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsEmailValido(ByVal email As String) As Boolean
Try
email = email.NothingAVacio.Trim.ToLower
Dim addr = New System.Net.Mail.MailAddress(email)
Return addr.Address = email
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") OrElse 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") OrElse Telefono.StartsWith("7") OrElse Telefono.StartsWith("8") OrElse 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 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
<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)
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.WINDOWS, codificacion.Caracteres.JuegoCaracteres.ROMAN8)
End Function
<Extension()>
Public Function ConvierteDeWindowsARoman8SinAcentos(ByVal CadenaAconvertir 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)
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 = "0.0000" 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.Contains(".") Then
Dim HoraMinutos = CInt(Fecha.Split(".")(1).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
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
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw ex
End If
End Try
End Function
<Extension()>
Public Function FechaStringADateTime(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateTime?
Try
If Fecha = "0" 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(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New DateTime(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)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New DateTime(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New DateTime(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
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
If Fecha = "0" 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(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse 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)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
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
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 FechaStringADateOnly(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateOnly?
Try
If Fecha = "0" 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(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New DateOnly(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)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New DateOnly(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New DateOnly(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
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
Return s.First().ToString().ToUpper() + [String].Join("", s.Skip(1)).ToLower
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
<Extension()>
Public Function HexToString(ByVal hex As String) As String
Dim text As New System.Text.StringBuilder(hex.Length \ 2)
For i As Integer = 0 To hex.Length - 2 Step 2
text.Append(Chr(Convert.ToByte(hex.Substring(i, 2), 16)))
Next
Return text.ToString
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

122
Ficheros.vb Normal file
View File

@@ -0,0 +1,122 @@
Imports System.IO
Imports System.Text.RegularExpressions
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 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
End Class

223
Hacienda/Modelo190.cs Normal file
View File

@@ -0,0 +1,223 @@
using System;
using System.Collections.Generic;
using Microsoft.VisualBasic.CompilerServices;
namespace tsUtilidades.Modelo190
{
public class DatosModelo190
{
public RegistroDeclarante Declarante { get; set; }
public List<RegistroPerceptor> Perceptores { get; set; }
}
public class RegistroDeclarante
{
public string TipoRegistro { get; set; } = "1"; // 1
public string ModeloDeclaracion { get; set; } = "190"; // 2-4
public string Ejercicio { get; set; } = ""; // 5-8
public string NifDeclarante { get; set; } = ""; // 9-17
public string ApeNombreRsoDeclarante { get; set; } = ""; // 18-57
public string TipodeSoporte { get; set; } = "T"; // 58
public string PerConQuienRelacionarseTlf { get; set; } = ""; // 59-67
public string PerConQuienRelacionarseNom { get; set; } = ""; // 68-107
public string NumIdenDecla { get; set; } = ""; // 108-120
public string DeclComploSust { get; set; } = ""; // 121-122
public string NumIdenDeclaAnt { get; set; } = ""; // 123-135
public string NumTotaldePercepciones { get; set; } = ""; // 136-144
public string ImpTotPercepcionesSigno { get; set; } = ""; // 145
// Public Property ImpTotPercepciones As String = "" ' 146-160 146-158 parte entera 159-160 parte decimal
public string ImpTotPercepcionesParEnt { get; set; } = ""; // 146-158
public string ImpTotPercepcionesParDec { get; set; } = ""; // 159-160
public string ImpTotRetencionesParEnt { get; set; } = ""; // 161-173
public string ImpTotRetencionesParDec { get; set; } = ""; // 174-175
// Public Property ImpTotRetenciones As String = "" ' 161-175 161-173 parte entera 174-175 parte decimal
public string CorreoElectronicoPerConQuienRelacionarse { get; set; } = ""; // 176-225
public string Blancos { get; set; } = " ".PadRight(262, ' '); // 226-487
public string SelloElectronico { get; set; } = " ".PadRight(13, ' '); // 488-500
}
public class RegistroPerceptor
{
public string TipoRegistro { get; set; }
public string ModeloDeclaracion { get; set; } = "190";
public string Ejercicio { get; set; } = ""; // 5-8
public string NifDeclarante { get; set; } = ""; // 9-17
public string NifPerceptor { get; set; } = ""; // 18-26
public string NifRepresentateLegal { get; set; } = ""; // 27-35
public string ApeNombreRsoPerceptor { get; set; } = ""; // 36-75
public string CodigoProvincial { get; set; } = "41"; // 76-77
public string ClavePercepcion { get; set; } = ""; // 78
public string SubClave { get; set; } = ""; // 79-80
public string PerDineNoIncaLabSigno { get; set; } = ""; // 81
public double PerDineNoIncaLabPerint { get; set; } = 0d;
public string PerDineNoIncaLabPerintParEnt { get; set; } = ""; // 82-92
public string PerDineNoIncaLabPerintParDec { get; set; } = ""; // 93-94
public double PerDineNoIncaLabRetPra { get; set; } = 0d;
public string PerDineNoIncaLabRetPraParEnt { get; set; } = ""; // 95-105
public string PerDineNoIncaLabRetPraParDec { get; set; } = ""; // 106-107
public string PerEspNoIncaLabSigno { get; set; } = ""; // 108
public double PerEspNoIncaLabPerint { get; set; } = 0d;
public string PerEspNoIncaLabPerintParEnt { get; set; } = ""; // 109-119
public string PerEspNoIncaLabPerintParDec { get; set; } = ""; // 120-121
public double PerEspNoIncaLabRetPra { get; set; } = 0d; // 122-132
public string PerEspNoIncaLabRetPraParEnt { get; set; } = ""; // 122-132
public string PerEspNoIncaLabRetPraParDec { get; set; } = ""; // 133-134
public double PerEspNoIncaLabRetRep { get; set; } = 0d;
public string PerEspNoIncaLabRetRepParEnt { get; set; } = ""; // 135-145
public string PerEspNoIncaLabRetRepParDec { get; set; } = ""; // 146-147
public string EjercicioDevengo { get; set; } = "0000"; // 148-151
public string CeutaOMelilla { get; set; } = ""; // 152
public string AñoNacimiento { get; set; } = ""; // 153-156
public string SituacionFamilia { get; set; } = ""; // 157
public string NifConyuge { get; set; } = ""; // 158-166
public string Discapacidad { get; set; } = ""; // 167
public string ContratoRelacion { get; set; } = ""; // 168
public string Guion { get; set; } = ""; // 169
public string MovilidadGeografica { get; set; } = ""; // 170
public string ReduccionesAplicable { get; set; } = ""; // 171-181 parte entera 182-183 parte decimal
public double GastosDeducibles { get; set; } = 0d;
public string GastosDeduciblesEnt { get; set; } = ""; // 184-194 parte entera
public string GastosDeduciblesDec { get; set; } = ""; // 195-196 parte decimal
public double PensionCompensatoria { get; set; } = 0d;
public string PensionCompensatoriaEnt { get; set; } = ""; // 197-207 parte entera
public string PensionCompensatoriaDec { get; set; } = ""; // 208-209 parte decimal
public double AnualidadporAlimentos { get; set; } = 0d;
public string AnualidadporAlimentosEnt { get; set; } = ""; // 210-220 parte entera
public string AnualidadporAlimentosDec { get; set; } = ""; // 221-222 parte decimal
public string HijosyOtrosDecendientes { get; set; } = ""; // 223-228
public string HijosyOtrosDecendientesConDiscapacidad { get; set; } = ""; // 229-240
public string Ascendientes { get; set; } = ""; // 241-244
public string AscendientesConDiscapacidad { get; set; } = ""; // 245-250
public string Com3PrimerosHijos { get; set; } = ""; // 251-253
public string ComuPresVivHab { get; set; } = ""; // 254
public string PerDineDerIncaLabSigno { get; set; } = ""; // 255
public double PerDineIncaLabPerint { get; set; } = 0d;
public string PerDineIncaLabPerintParEnt { get; set; } = ""; // 256-266
public string PerDineIncaLabPerintParDec { get; set; } = ""; // 267-268
public double PerDineIncaLabRetPra { get; set; } = 0d;
public string PerDineIncaLabRetPraParEnt { get; set; } = ""; // 269-279
public string PerDineIncaLabRetPraParDec { get; set; } = ""; // 280-281
public string PerEspDerIncaLabSigno { get; set; } = ""; // 282
public double PerEspIncaLabPerint { get; set; } = 0d;
public string PerEspIncaLabPerintParEnt { get; set; } = ""; // 283-293
public string PerEspIncaLabPerintParDec { get; set; } = ""; // 294-295
public double PerEspIncaLabRetPra { get; set; } = 0d;
public string PerEspIncaLabRetPraParEnt { get; set; } = ""; // 296-306
public string PerEspIncaLabRetPraParDec { get; set; } = ""; // 307-308
public double PerEspIncaLabRetRep { get; set; } = 0d;
public string PerEspIncaLabRetRepParEnt { get; set; } = ""; // 309-319
public string PerEspIncaLabRetRepParDec { get; set; } = ""; // 320-321
public double TotalPercepcionesIntegras { get; set; } = 0d;
public double TotalRetencionesIntegras { get; set; } = 0d;
public string Blancos { get; set; } = " ".PadRight(179, ' '); // 322-500
}
public class Utilidades
{
public static void GeneraFichero(DatosModelo190 Datos, string Fichero)
{
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"))
var sw = new System.IO.StreamWriter(Fichero, false, System.Text.Encoding.GetEncoding("iso-8859-1"));
string RegDeclarante;
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);
foreach (var p in Datos.Perceptores)
{
string RegPerceptor;
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, Conversions.ToChar("00"));
RegPerceptor += p.ClavePercepcion.PadLeft(1, ' ');
RegPerceptor += p.SubClave.PadLeft(2, Conversions.ToChar("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');
RegPerceptor += p.CeutaOMelilla.PadLeft(1, '0');
RegPerceptor += p.AñoNacimiento.PadLeft(4, '0');
RegPerceptor += p.SituacionFamilia.PadLeft(1, '0');
RegPerceptor += p.NifConyuge.PadLeft(9, ' ');
RegPerceptor += p.Discapacidad.PadLeft(1, '0');
RegPerceptor += p.ContratoRelacion.PadLeft(1, '0');
RegPerceptor += p.Guion.PadLeft(1, ' ');
RegPerceptor += p.MovilidadGeografica.PadLeft(1, '0');
RegPerceptor += p.ReduccionesAplicable.PadLeft(13, '0');
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.Blancos.PadRight(179, ' ');
sw.WriteLine(RegPerceptor);
}
sw.Close();
}
// fs.Close()
catch (Exception ex)
{
throw new Exception(ex.Message, ex);
}
}
}
}

209
Hacienda/Modelo190.vb Normal file
View File

@@ -0,0 +1,209 @@
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 TotalPercepcionesIntegras As Double = 0
Public Property TotalRetencionesIntegras As Double = 0
Public Property Blancos As String = " ".PadRight(179, " ") '322-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
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")
RegPerceptor &= p.CeutaOMelilla.PadLeft(1, "0")
RegPerceptor &= p.AñoNacimiento.PadLeft(4, "0")
RegPerceptor &= p.SituacionFamilia.PadLeft(1, "0")
RegPerceptor &= p.NifConyuge.PadLeft(9, " ")
RegPerceptor &= p.Discapacidad.PadLeft(1, "0")
RegPerceptor &= p.ContratoRelacion.PadLeft(1, "0")
RegPerceptor &= p.Guion.PadLeft(1, " ")
RegPerceptor &= p.MovilidadGeografica.PadLeft(1, "0")
RegPerceptor &= p.ReduccionesAplicable.PadLeft(13, "0")
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.Blancos.PadRight(179, " ")
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.ClientMessageInspectors.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

32
Imagen.vb Normal file
View File

@@ -0,0 +1,32 @@
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
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
End Class

27
ItsContexto.vb Normal file
View File

@@ -0,0 +1,27 @@
Public Interface ItsContexto
Function GuardarCambios() As Integer
Function ObtieneLongitudCampo(NombreTablaBase As String, NombreCampo As String) As Integer
Sub EliminaObjeto(DataContext As Object)
Sub AñadeObjeto(Entidad As Object)
'Event GuardandoCambios(sender As Object, e As EventArgs)
Function CompruebaUnico(estado As EstadosAplicacion, NombreCampo As String, valor As Object, NombreTablaBase As String, DataContext As Object) As Boolean
Function HayModificaciones() As Boolean
End Interface
Public Enum EstadosAplicacion
SinDatos = 0
Nuevo = 1
ModificandoRegistro = 2
AplicacionSinIndice = 3
Cancelado = 100
End Enum
Public Class Permisos
Property Consultar As Boolean
Property Nuevos As Boolean
Property Eliminar As Boolean
Property Modificar As Boolean
Property Impresion As Boolean
Property Otros As Boolean
Property Exportar As Boolean
End Class

11
My Project/Application.Designer.cs generated Normal file
View File

@@ -0,0 +1,11 @@
// ------------------------------------------------------------------------------
// <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>
// ------------------------------------------------------------------------------

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.cs Normal file
View File

@@ -0,0 +1,39 @@
using System;
using System.Reflection;
using 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("tsUtilidades")]
[assembly: AssemblyDescription("")]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("tsUtilidades")]
[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.0")]
[assembly: AssemblyFileVersion("3.0.0")]
// Modificaciones:
// ===============
// 06/05/2012 MANMOG Cambios en AñadeAzip

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("tsUtilidades")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("tsUtilidades")>
<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.0")>
<Assembly: AssemblyFileVersion("3.0.0")>
' 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 OrElse editing the content of this file may
cause the file to be unrecognizable by the program.
-->
<GenericObjectDataSource DisplayName="Entities" Identifier="tsUtilidades.Entities" ProviderType="Microsoft.VisualStudio.DataDesign.DataSourceProviders.EntityDataModel.EdmDataSourceProvider" Version="1.0" xmlns="urn:schemas-microsoft-com:xml-msdatasource">
<TypeInfo>tsUtilidades.Entities, tsUtilidadesModel.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 OrElse editing the content of this file may
cause the file to be unrecognizable by the program.
-->
<GenericObjectDataSource DisplayName="Entities" Identifier="tsUtilidades.tsUtilidadesModel.Entities" ProviderType="Microsoft.VisualStudio.DataDesign.DataSourceProviders.EntityDataModel.EdmDataSourceProvider" Version="1.0" xmlns="urn:schemas-microsoft-com:xml-msdatasource">
<TypeInfo>tsUtilidades.tsUtilidadesModel.Entities, tsUtilidadesModel.Designer.vb, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null</TypeInfo>
</GenericObjectDataSource>

385
My Project/MyNamespace.Static.1.Designer.cs generated Normal file
View File

@@ -0,0 +1,385 @@
// Licensed to the .NET Foundation under one or more agreements.
// The .NET Foundation licenses this file to you under the MIT license.
// See the LICENSE file in the project root for more information.
/* TODO ERROR: Skipped IfDirectiveTrivia
#If TARGET = "module" AndAlso _MYTYPE = "" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYTYPE="Empty"
*//* TODO ERROR: Skipped EndIfDirectiveTrivia
#End If
*/
/* TODO ERROR: Skipped IfDirectiveTrivia
#If _MYTYPE = "WindowsForms" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYFORMS = True
#Const _MYWEBSERVICES = True
#Const _MYUSERTYPE = "Windows"
#Const _MYCOMPUTERTYPE = "Windows"
#Const _MYAPPLICATIONTYPE = "WindowsForms"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "WindowsFormsWithCustomSubMain" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYFORMS = True
#Const _MYWEBSERVICES = True
#Const _MYUSERTYPE = "Windows"
#Const _MYCOMPUTERTYPE = "Windows"
#Const _MYAPPLICATIONTYPE = "Console"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "Windows" OrElse _MYTYPE = "" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYWEBSERVICES = True
#Const _MYUSERTYPE = "Windows"
#Const _MYCOMPUTERTYPE = "Windows"
#Const _MYAPPLICATIONTYPE = "Windows"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "Console" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYWEBSERVICES = True
#Const _MYUSERTYPE = "Windows"
#Const _MYCOMPUTERTYPE = "Windows"
#Const _MYAPPLICATIONTYPE = "Console"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "Web" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYFORMS = False
#Const _MYWEBSERVICES = False
#Const _MYUSERTYPE = "Web"
#Const _MYCOMPUTERTYPE = "Web"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "WebControl" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYFORMS = False
#Const _MYWEBSERVICES = True
#Const _MYUSERTYPE = "Web"
#Const _MYCOMPUTERTYPE = "Web"
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE = "Custom" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
*//* TODO ERROR: Skipped ElifDirectiveTrivia
#ElseIf _MYTYPE <> "Empty" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
#Const _MYTYPE = "Empty"
*//* TODO ERROR: Skipped EndIfDirectiveTrivia
#End If
*/
/* TODO ERROR: Skipped IfDirectiveTrivia
#If _MYTYPE <> "Empty" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
Namespace MergedMyNamespace50E26D7D27174AAEABCA70DEBD52E2FA
#If _MYAPPLICATIONTYPE = "WindowsForms" OrElse _MYAPPLICATIONTYPE = "Windows" OrElse _MYAPPLICATIONTYPE = "Console" Then
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("MyTemplate", "11.0.0.0")> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> Partial Friend Class MyApplication
#If _MYAPPLICATIONTYPE = "WindowsForms" Then
Inherits Global.Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase
#If TARGET = "winexe" Then
<Global.System.STAThread(), Global.System.Diagnostics.DebuggerHidden(), Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Shared Sub Main(ByVal Args As String())
Try
Global.System.Windows.Forms.Application.SetCompatibleTextRenderingDefault(MyApplication.UseCompatibleTextRendering())
Finally
End Try
My.Application.Run(Args)
End Sub
#End If
#ElseIf _MYAPPLICATIONTYPE = "Windows" Then
Inherits Global.Microsoft.VisualBasic.ApplicationServices.ApplicationBase
#ElseIf _MYAPPLICATIONTYPE = "Console" Then
Inherits Global.Microsoft.VisualBasic.ApplicationServices.ConsoleApplicationBase
#End If '_MYAPPLICATIONTYPE = "WindowsForms"
End Class
#End If '#If _MYAPPLICATIONTYPE = "WindowsForms" Or _MYAPPLICATIONTYPE = "Windows" or _MYAPPLICATIONTYPE = "Console"
#If _MYCOMPUTERTYPE <> "" Then
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("MyTemplate", "11.0.0.0")> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> Partial Friend Class MyComputer
#If _MYCOMPUTERTYPE = "Windows" Then
Inherits Global.Microsoft.VisualBasic.Devices.Computer
#ElseIf _MYCOMPUTERTYPE = "Web" Then
Inherits Global.Microsoft.VisualBasic.Devices.ServerComputer
#End If
<Global.System.Diagnostics.DebuggerHidden()> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
Public Sub New()
MyBase.New()
End Sub
End Class
#End If
<Global.Microsoft.VisualBasic.HideModuleName()> _
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("MyTemplate", "11.0.0.0")> _
Friend Module MyProject
#If _MYCOMPUTERTYPE <> "" Then
<Global.System.ComponentModel.Design.HelpKeyword("My.Computer")> _
Friend ReadOnly Property Computer() As MyComputer
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_ComputerObjectProvider.GetInstance()
End Get
End Property
Private ReadOnly m_ComputerObjectProvider As New ThreadSafeObjectProvider(Of MyComputer)
#End If
#If _MYAPPLICATIONTYPE = "Windows" Or _MYAPPLICATIONTYPE = "WindowsForms" Or _MYAPPLICATIONTYPE = "Console" Then
<Global.System.ComponentModel.Design.HelpKeyword("My.Application")> _
Friend ReadOnly Property Application() As MyApplication
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_AppObjectProvider.GetInstance()
End Get
End Property
Private ReadOnly m_AppObjectProvider As New ThreadSafeObjectProvider(Of MyApplication)
#End If
#If _MYUSERTYPE = "Windows" Then
<Global.System.ComponentModel.Design.HelpKeyword("My.User")> _
Friend ReadOnly Property User() As Global.Microsoft.VisualBasic.ApplicationServices.User
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_UserObjectProvider.GetInstance()
End Get
End Property
Private ReadOnly m_UserObjectProvider As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.ApplicationServices.User)
#ElseIf _MYUSERTYPE = "Web" Then
<Global.System.ComponentModel.Design.HelpKeyword("My.User")> _
Friend ReadOnly Property User() As Global.Microsoft.VisualBasic.ApplicationServices.WebUser
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_UserObjectProvider.GetInstance()
End Get
End Property
Private ReadOnly m_UserObjectProvider As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.ApplicationServices.WebUser)
#End If
#If _MYFORMS = True Then
#Const STARTUP_MY_FORM_FACTORY = "My.MyProject.Forms"
<Global.System.ComponentModel.Design.HelpKeyword("My.Forms")> _
Friend ReadOnly Property Forms() As MyForms
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_MyFormsObjectProvider.GetInstance()
End Get
End Property
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
<Global.Microsoft.VisualBasic.MyGroupCollection("System.Windows.Forms.Form", "Create__Instance__", "Dispose__Instance__", "My.MyProject.Forms")> _
Friend NotInheritable Class MyForms
<Global.System.Diagnostics.DebuggerHidden()> _
Private Shared Function Create__Instance__(Of T As {New, Global.System.Windows.Forms.Form})(ByVal Instance As T) As T
If Instance Is Nothing OrElse Instance.IsDisposed Then
If m_FormBeingCreated IsNot Nothing Then
If m_FormBeingCreated.ContainsKey(GetType(T)) = True Then
Throw New Global.System.InvalidOperationException(Global.Microsoft.VisualBasic.CompilerServices.Utils.GetResourceString("WinForms_RecursiveFormCreate"))
End If
Else
m_FormBeingCreated = New Global.System.Collections.Hashtable()
End If
m_FormBeingCreated.Add(GetType(T), Nothing)
Try
Return New T()
Catch ex As Global.System.Reflection.TargetInvocationException When ex.InnerException IsNot Nothing
Dim BetterMessage As String = Global.Microsoft.VisualBasic.CompilerServices.Utils.GetResourceString("WinForms_SeeInnerException", ex.InnerException.Message)
Throw New Global.System.InvalidOperationException(BetterMessage, ex.InnerException)
Finally
m_FormBeingCreated.Remove(GetType(T))
End Try
Else
Return Instance
End If
End Function
<Global.System.Diagnostics.DebuggerHidden()> _
Private Sub Dispose__Instance__(Of T As Global.System.Windows.Forms.Form)(ByRef instance As T)
instance.Dispose()
instance = Nothing
End Sub
<Global.System.Diagnostics.DebuggerHidden()> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
Public Sub New()
MyBase.New()
End Sub
<Global.System.ThreadStatic()> Private Shared m_FormBeingCreated As Global.System.Collections.Hashtable
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)> Public Overrides Function Equals(ByVal o As Object) As Boolean
Return MyBase.Equals(o)
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)> Public Overrides Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)> _
Friend Overloads Function [GetType]() As Global.System.Type
Return GetType(MyForms)
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)> Public Overrides Function ToString() As String
Return MyBase.ToString
End Function
End Class
Private m_MyFormsObjectProvider As New ThreadSafeObjectProvider(Of MyForms)
#End If
#If _MYWEBSERVICES = True Then
<Global.System.ComponentModel.Design.HelpKeyword("My.WebServices")> _
Friend ReadOnly Property WebServices() As MyWebServices
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_MyWebServicesObjectProvider.GetInstance()
End Get
End Property
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
<Global.Microsoft.VisualBasic.MyGroupCollection("System.Web.Services.Protocols.SoapHttpClientProtocol", "Create__Instance__", "Dispose__Instance__", "")> _
Friend NotInheritable Class MyWebServices
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never), Global.System.Diagnostics.DebuggerHidden()> _
Public Overrides Function Equals(ByVal o As Object) As Boolean
Return MyBase.Equals(o)
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never), Global.System.Diagnostics.DebuggerHidden()> _
Public Overrides Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never), Global.System.Diagnostics.DebuggerHidden()> _
Friend Overloads Function [GetType]() As Global.System.Type
Return GetType(MyWebServices)
End Function
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never), Global.System.Diagnostics.DebuggerHidden()> _
Public Overrides Function ToString() As String
Return MyBase.ToString
End Function
<Global.System.Diagnostics.DebuggerHidden()> _
Private Shared Function Create__Instance__(Of T As {New})(ByVal instance As T) As T
If instance Is Nothing Then
Return New T()
Else
Return instance
End If
End Function
<Global.System.Diagnostics.DebuggerHidden()> _
Private Sub Dispose__Instance__(Of T)(ByRef instance As T)
instance = Nothing
End Sub
<Global.System.Diagnostics.DebuggerHidden()> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
Public Sub New()
MyBase.New()
End Sub
End Class
Private ReadOnly m_MyWebServicesObjectProvider As New ThreadSafeObjectProvider(Of MyWebServices)
#End If
#If _MYTYPE = "Web" Then
<Global.System.ComponentModel.Design.HelpKeyword("My.Request")> _
Friend ReadOnly Property Request() As Global.System.Web.HttpRequest
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Dim CurrentContext As Global.System.Web.HttpContext = Global.System.Web.HttpContext.Current
If CurrentContext IsNot Nothing Then
Return CurrentContext.Request
End If
Return Nothing
End Get
End Property
<Global.System.ComponentModel.Design.HelpKeyword("My.Response")> _
Friend ReadOnly Property Response() As Global.System.Web.HttpResponse
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Dim CurrentContext As Global.System.Web.HttpContext = Global.System.Web.HttpContext.Current
If CurrentContext IsNot Nothing Then
Return CurrentContext.Response
End If
Return Nothing
End Get
End Property
<Global.System.ComponentModel.Design.HelpKeyword("My.Application.Log")> _
Friend ReadOnly Property Log() As Global.Microsoft.VisualBasic.Logging.AspLog
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Return m_LogObjectProvider.GetInstance()
End Get
End Property
Private ReadOnly m_LogObjectProvider As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.Logging.AspLog)
#End If '_MYTYPE="Web"
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
<Global.System.Runtime.InteropServices.ComVisible(False)> _
Friend NotInheritable Class ThreadSafeObjectProvider(Of T As New)
Friend ReadOnly Property GetInstance() As T
#If TARGET = "library" Then
<Global.System.Diagnostics.DebuggerHidden()> _
Get
Dim Value As T = m_Context.Value
If Value Is Nothing Then
Value = New T
m_Context.Value() = Value
End If
Return Value
End Get
#Else
<Global.System.Diagnostics.DebuggerHidden()> _
Get
If m_ThreadStaticValue Is Nothing Then m_ThreadStaticValue = New T
Return m_ThreadStaticValue
End Get
#End If
End Property
<Global.System.Diagnostics.DebuggerHidden()> _
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Never)> _
Public Sub New()
MyBase.New()
End Sub
#If TARGET = "library" Then
Private ReadOnly m_Context As New Global.Microsoft.VisualBasic.MyServices.Internal.ContextValue(Of T)
#Else
<Global.System.Runtime.CompilerServices.CompilerGenerated(), Global.System.ThreadStatic()> Private Shared m_ThreadStaticValue As T
#End If
End Class
End Module
End Namespace
*//* TODO ERROR: Skipped EndIfDirectiveTrivia
#End If
*/

241
My Project/MyNamespace.Static.2.Designer.cs generated Normal file
View File

@@ -0,0 +1,241 @@
using System.Collections;
using System.Collections.Generic;
using System.Diagnostics;
using System.Linq;
using System.Xml.Linq;
using Microsoft.VisualBasic;
// Licensed to the .NET Foundation under one or more agreements.
// The .NET Foundation licenses this file to you under the MIT license.
// See the LICENSE file in the project root for more information.
// See Compiler::LoadXmlSolutionExtension
namespace tsUtilidades.My
{
[Embedded()]
[DebuggerNonUserCode()]
[System.Runtime.CompilerServices.CompilerGenerated()]
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
internal sealed class InternalXmlHelper
{
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
private InternalXmlHelper()
{
}
public static string get_Value(IEnumerable<XElement> source)
{
foreach (XElement item in source)
return item.Value;
return null;
}
public static void set_Value(IEnumerable<XElement> source, string value)
{
foreach (XElement item in source)
{
item.Value = value;
break;
}
}
public static string get_AttributeValue(IEnumerable<XElement> source, XName name)
{
foreach (XElement item in source)
return (string)item.Attribute(name);
return null;
}
public static void set_AttributeValue(IEnumerable<XElement> source, XName name, string value)
{
foreach (XElement item in source)
{
item.SetAttributeValue(name, value);
break;
}
}
public static string get_AttributeValue(XElement source, XName name)
{
return (string)source.Attribute(name);
}
public static void set_AttributeValue(XElement source, XName name, string value)
{
source.SetAttributeValue(name, value);
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
public static XAttribute CreateAttribute(XName name, object value)
{
if (value is null)
{
return null;
}
return new XAttribute(name, value);
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
public static XAttribute CreateNamespaceAttribute(XName name, XNamespace ns)
{
var a = new XAttribute(name, ns.NamespaceName);
a.AddAnnotation(ns);
return a;
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
public static object RemoveNamespaceAttributes(string[] inScopePrefixes, XNamespace[] inScopeNs, List<XAttribute> attributes, object obj)
{
if (obj is not null)
{
XElement elem = obj as XElement;
if (elem is not null)
{
return RemoveNamespaceAttributes(inScopePrefixes, inScopeNs, attributes, elem);
}
else
{
IEnumerable elems = obj as IEnumerable;
if (elems is not null)
{
return RemoveNamespaceAttributes(inScopePrefixes, inScopeNs, attributes, elems);
}
}
}
return obj;
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
public static IEnumerable RemoveNamespaceAttributes(string[] inScopePrefixes, XNamespace[] inScopeNs, List<XAttribute> attributes, IEnumerable obj)
{
if (obj is not null)
{
IEnumerable<XElement> elems = obj as IEnumerable<XElement>;
if (elems is not null)
{
return elems.Select(new RemoveNamespaceAttributesClosure(inScopePrefixes, inScopeNs, attributes).ProcessXElement);
}
else
{
return obj.Cast<object>().Select(new RemoveNamespaceAttributesClosure(inScopePrefixes, inScopeNs, attributes).ProcessObject);
}
}
return obj;
}
[DebuggerNonUserCode()]
[System.Runtime.CompilerServices.CompilerGenerated()]
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
private sealed class RemoveNamespaceAttributesClosure
{
private readonly string[] m_inScopePrefixes;
private readonly XNamespace[] m_inScopeNs;
private readonly List<XAttribute> m_attributes;
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
internal RemoveNamespaceAttributesClosure(string[] inScopePrefixes, XNamespace[] inScopeNs, List<XAttribute> attributes)
{
m_inScopePrefixes = inScopePrefixes;
m_inScopeNs = inScopeNs;
m_attributes = attributes;
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
internal XElement ProcessXElement(XElement elem)
{
return RemoveNamespaceAttributes(m_inScopePrefixes, m_inScopeNs, m_attributes, elem);
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
internal object ProcessObject(object obj)
{
XElement elem = obj as XElement;
if (elem is not null)
{
return RemoveNamespaceAttributes(m_inScopePrefixes, m_inScopeNs, m_attributes, elem);
}
else
{
return obj;
}
}
}
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
public static XElement RemoveNamespaceAttributes(string[] inScopePrefixes, XNamespace[] inScopeNs, List<XAttribute> attributes, XElement e)
{
if (e is not null)
{
var a = e.FirstAttribute;
while (a is not null)
{
var nextA = a.NextAttribute;
if (a.IsNamespaceDeclaration)
{
var ns = a.Annotation<XNamespace>();
string prefix = a.Name.LocalName;
if (ns is not null)
{
if (inScopePrefixes is not null && inScopeNs is not null)
{
int lastIndex = inScopePrefixes.Length - 1;
for (int i = 0, loopTo = lastIndex; i <= loopTo; i++)
{
string currentInScopePrefix = inScopePrefixes[i];
var currentInScopeNs = inScopeNs[i];
if (prefix.Equals(currentInScopePrefix))
{
if (ns == currentInScopeNs)
{
// prefix and namespace match. Remove the unneeded ns attribute
a.Remove();
}
// prefix is in scope but refers to something else. Leave the ns attribute.
a = null;
break;
}
}
}
if (a is not null)
{
// Prefix is not in scope
// Now check whether it's going to be in scope because it is in the attributes list
if (attributes is not null)
{
int lastIndex = attributes.Count - 1;
for (int i = 0, loopTo1 = lastIndex; i <= loopTo1; i++)
{
var currentA = attributes[i];
string currentInScopePrefix = currentA.Name.LocalName;
var currentInScopeNs = currentA.Annotation<XNamespace>();
if (currentInScopeNs is not null)
{
if (prefix.Equals(currentInScopePrefix))
{
if (ns == currentInScopeNs)
{
// prefix and namespace match. Remove the unneeded ns attribute
a.Remove();
}
// prefix is in scope but refers to something else. Leave the ns attribute.
a = null;
break;
}
}
}
}
if (a is not null)
{
// Prefix is definitely not in scope
a.Remove();
// namespace is not defined either. Add this attributes list
attributes.Add(a);
}
}
}
}
a = nextA;
}
}
return e;
}
}
}

16
My Project/MyNamespace.Static.3.Designer.cs generated Normal file
View File

@@ -0,0 +1,16 @@
// Licensed to the .NET Foundation under one or more agreements.
// The .NET Foundation licenses this file to you under the MIT license.
// See the LICENSE file in the project root for more information.
using System;
namespace Microsoft.VisualBasic
{
[Embedded()]
[AttributeUsage(AttributeTargets.Class | AttributeTargets.Module | AttributeTargets.Assembly, Inherited = false)]
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)]
[System.Runtime.CompilerServices.CompilerGenerated()]
internal sealed class Embedded : Attribute
{
}
}

70
My Project/Resources.Designer.cs generated Normal file
View File

@@ -0,0 +1,70 @@
// ------------------------------------------------------------------------------
// <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>
// ------------------------------------------------------------------------------
using System.Diagnostics;
using Microsoft.VisualBasic;
namespace tsUtilidades.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>
[System.CodeDom.Compiler.GeneratedCode("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0")]
[DebuggerNonUserCode()]
[System.Runtime.CompilerServices.CompilerGenerated()]
[HideModuleName()]
internal static class Resources
{
private static System.Resources.ResourceManager resourceMan;
private static System.Globalization.CultureInfo resourceCulture;
/// <summary>
/// Devuelve la instancia de ResourceManager almacenada en caché utilizada por esta clase.
/// </summary>
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)]
internal static System.Resources.ResourceManager ResourceManager
{
get
{
if (ReferenceEquals(resourceMan, null))
{
var temp = new System.Resources.ResourceManager("tsUtilidades.Resources", typeof(Resources).Assembly);
resourceMan = temp;
}
return resourceMan;
}
}
/// <summary>
/// Reemplaza la propiedad CurrentUICulture del subproceso actual para todas las
/// búsquedas de recursos mediante esta clase de recurso fuertemente tipado.
/// </summary>
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)]
internal static System.Globalization.CultureInfo Culture
{
get
{
return resourceCulture;
}
set
{
resourceCulture = value;
}
}
}
}

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", "15.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("tsUtilidades.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 OrElse 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>

88
My Project/Settings.Designer.cs generated Normal file
View File

@@ -0,0 +1,88 @@
// ------------------------------------------------------------------------------
// <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>
// ------------------------------------------------------------------------------
using System.Diagnostics;
using Microsoft.VisualBasic;
namespace tsUtilidades.My
{
[System.Runtime.CompilerServices.CompilerGenerated()]
[System.CodeDom.Compiler.GeneratedCode("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "15.9.0.0")]
[System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)]
internal sealed partial class MySettings : System.Configuration.ApplicationSettingsBase
{
private static MySettings defaultInstance = (MySettings)Synchronized(new MySettings());
#region Funcionalidad para autoguardar My.Settings
/* TODO ERROR: Skipped IfDirectiveTrivia
#If _MyType = "WindowsForms" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
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
*//* TODO ERROR: Skipped EndIfDirectiveTrivia
#End If
*/
#endregion
public static MySettings Default
{
get
{
/* TODO ERROR: Skipped IfDirectiveTrivia
#If _MyType = "WindowsForms" Then
*//* TODO ERROR: Skipped DisabledTextTrivia
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
*//* TODO ERROR: Skipped EndIfDirectiveTrivia
#End If
*/
return defaultInstance;
}
}
}
}
namespace tsUtilidades.My
{
[HideModuleName()]
[DebuggerNonUserCode()]
[System.Runtime.CompilerServices.CompilerGenerated()]
internal static class MySettingsProperty
{
[System.ComponentModel.Design.HelpKeyword("My.Settings")]
internal static MySettings Settings
{
get
{
return MySettings.Default;
}
}
}
}

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", "15.9.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.tsUtilidades.My.MySettings
Get
Return Global.tsUtilidades.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>

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

6
Operadores.vb Normal file
View File

@@ -0,0 +1,6 @@
Public Class Operadores
'Public Shared Widening Operator CType(ByVal p1 As DateTime) As DateOnly
' Return DateOnly.FromDateTime(p1)
'End Operator
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

8
Sistema.vb Normal file
View File

@@ -0,0 +1,8 @@
Public Class Sistema
Public Shared Sub EjecutaFichero(Fichero As String)
Dim p As New Process
p.StartInfo = New ProcessStartInfo(Fichero)
p.StartInfo.UseShellExecute = True
p.Start()
End Sub
End Class

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 OrElse 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

839
Utilidades.vb Normal file
View File

@@ -0,0 +1,839 @@
Imports System.IO
Imports System.Xml
Imports System.Xml.Serialization
Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Net
Imports System.Net.Security
Imports System.Security.Cryptography.X509Certificates
Imports System.Data
Public Enum FormatoFechasEnum As Integer
FECHA_HORA = 0
FECHA_SEPARADO_POR_BARRAS = 1
FECHA_ESPACIADO_GRANDE = 2
FECHA_ESPACIADO_PEQUEÑO = 3
End Enum
Public Class Utilidades
Public Shared Function CodificarBase64(texto As String) As String
Dim stringbytes As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(texto)
Return System.Convert.ToBase64String(stringbytes).TrimEnd("=").Replace("+", "-").Replace("/", "_")
End Function
Public Shared Function DecodificarBase64(texto As String) As String
Dim bytes As Byte() = Convert.FromBase64String(texto)
Return Encoding.ASCII.GetString(bytes)
End Function
Public Shared Sub EliminaDirectorioTemporal(Subdirectorio As String)
Dim sDir As String = System.IO.Path.GetTempPath & "\" & Subdirectorio & "\"
If IO.Directory.Exists(sDir) Then
Try
IO.Directory.Delete(sDir, True)
Catch ex As Exception
End Try
End If
End Sub
Public Shared Function ObtieneMensajeExcepcionCompleto(ex As Exception) As String
Dim sMensaje As String = "Tipo excepción: " & ex.ToString & vbCrLf
Dim exError As Exception = ex
Do
sMensaje &= exError.StackTrace & vbCrLf
exError = exError.InnerException
Loop Until IsNothing(exError)
Return sMensaje
End Function
Public Shared Function IntervalosFechasCoincidentes(FechaInicio1 As DateTime, FechaFin1 As DateTime, FechaInicio2 As DateTime, FechaFin2 As DateTime) As Boolean
Return (FechaInicio1 <= FechaInicio2 And FechaInicio2 < FechaFin1) OrElse (FechaInicio2 <= FechaInicio1 And FechaFin2 > FechaInicio1)
End Function
Public Shared Function IntervalosFechasCoincidentes(FechaInicio1 As DateOnly, FechaFin1 As DateOnly, FechaInicio2 As DateOnly, FechaFin2 As DateOnly) As Boolean
Return (FechaInicio1 <= FechaInicio2 And FechaInicio2 < FechaFin1) OrElse (FechaInicio2 <= FechaInicio1 And FechaFin2 > FechaInicio1)
End Function
Public Shared Sub CreaEstructuraDirectorio(ByVal Ruta As String)
Dim sDirectorios() As String = Ruta.Split("\")
Dim sDirectorio As String = ""
Dim i As Integer
For i = 0 To sDirectorios.Length - 1
Try
sDirectorio &= sDirectorios(i) & "\"
If Not IO.Directory.Exists(sDirectorio) Then IO.Directory.CreateDirectory(sDirectorio)
Catch ex As Exception
End Try
Next
End Sub
Public Shared Function DeserializarSinErrores(ByVal cadena As String, ByVal tipo As System.Type) As Object
Return deserializar(cadena, tipo, True)
End Function
Public Shared Function deserializar(ByVal cadena As String, ByVal tipo As System.Type, Optional SinErrores As Boolean = True) As Object
Dim xs As New System.Xml.Serialization.XmlSerializer(tipo)
If SinErrores Then
AddHandler xs.UnknownElement, AddressOf ElementoDesconocido
AddHandler xs.UnknownNode, AddressOf NodoDesconocido
AddHandler xs.UnknownAttribute, AddressOf AtributoDesconocido
AddHandler xs.UnreferencedObject, AddressOf ObjetoNoReferenciado
End If
Dim sr As New StringReader(cadena)
Dim xr As New System.Xml.XmlTextReader(sr)
Dim obj As Object = xs.Deserialize(xr)
xr.Close()
sr.Close()
Return obj
End Function
Private Shared Sub ObjetoNoReferenciado(sender As Object, e As UnreferencedObjectEventArgs)
End Sub
Private Shared Sub AtributoDesconocido(sender As Object, e As XmlAttributeEventArgs)
End Sub
Private Shared Sub NodoDesconocido(sender As Object, e As XmlNodeEventArgs)
End Sub
Private Shared Sub ElementoDesconocido(sender As Object, e As XmlElementEventArgs)
End Sub
Public Shared Function Deserializa(ByVal BA As Byte(), ByVal tipo As System.Type) As Object
Dim xs As New System.Xml.Serialization.XmlSerializer(tipo)
'Dim fs As New FileStream(Fichero, FileMode.Open, FileAccess.Read)
Dim ms As New MemoryStream(BA)
Dim obj As Object = xs.Deserialize(ms)
'.Close()
Return obj
End Function
Public Shared Function DeserializaFichero(ByVal Fichero As String, ByVal tipo As System.Type) As Object
Dim xs As New System.Xml.Serialization.XmlSerializer(tipo)
Dim fs As New FileStream(Fichero, FileMode.Open, FileAccess.Read)
Dim obj As Object = xs.Deserialize(fs)
fs.Close()
Return obj
End Function
Public Shared Function serializar(ByVal obj As Object) As String
Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType)
Dim sw As New StringWriter
se.Serialize(sw, obj)
Return sw.ToString
End Function
Public Shared Sub serializar(ByVal obj As Object, FicheroDestino As String)
Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType)
If IO.File.Exists(FicheroDestino) Then IO.File.Delete(FicheroDestino)
Dim fs As New IO.FileStream(FicheroDestino, FileMode.CreateNew)
se.Serialize(fs, obj)
fs.Close()
End Sub
Public Shared Function serializarsindeclaracion(ByVal obj As Object) As String
Dim ms As New MemoryStream
Dim settings As New XmlWriterSettings
Dim utf8 As New System.Text.UTF8Encoding
settings.OmitXmlDeclaration = True
settings.Indent = True
settings.Encoding = utf8
Dim xw As XmlWriter = XmlWriter.Create(ms, settings)
Dim ns As New XmlSerializerNamespaces()
ns.Add("", "")
Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType)
se.Serialize(xw, obj, ns)
Return utf8.GetString(ms.ToArray)
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 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 Function deserializar(ByVal cadena As String, ByVal tipo As System.Type) As Object
Dim xs As New System.Xml.Serialization.XmlSerializer(tipo)
Dim sr As New StringReader(cadena)
Dim xr As New System.Xml.XmlTextReader(sr)
Dim obj As Object = xs.Deserialize(xr)
xr.Close()
sr.Close()
Return obj
End Function
Public Shared Function ObtieneFicheroNoExistente(DirectorioInicial As String, Nombre As String, ByVal Extension As String) As String
If Not IO.Directory.Exists(DirectorioInicial) Then IO.Directory.CreateDirectory(DirectorioInicial)
Dim sFichero As String = DirectorioInicial & Nombre & "." & Extension
Dim i As Integer = 0
Do While IO.File.Exists(sFichero)
i += 1
sFichero = DirectorioInicial & Nombre & "_" & i.ToString & "." & Extension
Loop
Return sFichero
End Function
Public Shared Function ObtieneFicheroAleatorio(DirectorioInicial As String, ByVal Extension As String) As String
If Not IO.Directory.Exists(DirectorioInicial) Then IO.Directory.CreateDirectory(DirectorioInicial)
Dim sFichero As String = DirectorioInicial & System.IO.Path.GetRandomFileName & "." & Extension
Do While IO.File.Exists(sFichero)
'Try
' IO.File.Delete(sFichero)
'Catch ex As Exception
sFichero = DirectorioInicial & System.IO.Path.GetRandomFileName & "." & Extension
' End Try
Loop
Return sFichero
End Function
Public Shared Function ObtieneFicheroAleatorio(ByVal Extension As String) As String
Dim sFichero As String = System.IO.Path.GetTempPath & System.IO.Path.GetRandomFileName & "." & Extension
Do While IO.File.Exists(sFichero)
'Try
' IO.File.Delete(sFichero)
'Catch ex As Exception
sFichero = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName & "." & Extension
' End Try
Loop
Return sFichero
End Function
Public Shared Function ObtieneDirectorioAleatorio() As String
Dim sDir As String = System.IO.Path.GetTempPath & System.IO.Path.GetRandomFileName
Do While IO.Directory.Exists(sDir)
sDir = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName
Loop
IO.Directory.CreateDirectory(sDir)
Return sDir
End Function
Public Shared Function ObtieneDirectorioAleatorio(Subdirectorio As String) As String
If Not IO.Directory.Exists(System.IO.Path.GetTempPath & "\" & Subdirectorio & "\") Then IO.Directory.CreateDirectory(System.IO.Path.GetTempPath & "\" & Subdirectorio & "\")
Dim sDir As String = System.IO.Path.GetTempPath & "\" & Subdirectorio & "\" & System.IO.Path.GetRandomFileName
Do While IO.Directory.Exists(sDir) Or IO.File.Exists(sDir)
sDir = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName
Loop
IO.Directory.CreateDirectory(sDir)
Return sDir
End Function
Public Shared Function ObtieneNumeroFicheros(ByVal Directory As String) As Integer
Dim FileCount As Integer = 0
Dim SubDirectory() As String
Dim i As Integer
FileCount = System.IO.Directory.GetFiles(Directory).Length
SubDirectory = System.IO.Directory.GetDirectories(Directory)
For i = 0 To SubDirectory.Length - 1
FileCount = ObtieneNumeroFicheros(SubDirectory(i)) + FileCount
Next
Return FileCount
End Function
Public Shared Sub ObtieneFicherosRecursivo(ByVal Ruta As String, ByRef Ficheros() As String)
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
sDirectorios = IO.Directory.GetDirectories(Ruta)
For Each sDirectorio In sDirectorios
ObtieneFicherosRecursivo(sDirectorio, Ficheros)
Next
End Sub
Public Shared Function FechaEnCastellano(ByVal Fecha As Date, ByVal Formato As FormatoFechasEnum) As String
Dim sMeses(11) As String
sMeses(0) = "Enero"
sMeses(1) = "Febrero"
sMeses(2) = "Marzo"
sMeses(3) = "Abril"
sMeses(4) = "Mayo"
sMeses(5) = "Junio"
sMeses(6) = "Julio"
sMeses(7) = "Agosto"
sMeses(8) = "Septiembre"
sMeses(9) = "Octubre"
sMeses(10) = "Noviembre"
sMeses(11) = "Diciembre"
Dim sDia As String, sMes As String, sAño As String
sDia = Fecha.Day.ToString
sMes = sMeses(Fecha.Month - 1)
sAño = Fecha.Year
Select Case Formato
Case FormatoFechasEnum.FECHA_ESPACIADO_GRANDE
FechaEnCastellano = sDia & " de " & sMes & " de " & sAño
Case FormatoFechasEnum.FECHA_HORA
FechaEnCastellano = Fecha.Day.ToString.PadLeft(2, "0") & "/" & Fecha.Month.ToString.PadLeft(2, "0") & "/" & Fecha.Year.ToString & " " & Fecha.Hour.ToString.PadLeft(2, "0") & ":" & Fecha.Minute.ToString.PadLeft(2, "0") & ":" & Fecha.Second.ToString.PadLeft(2, "0")
Case FormatoFechasEnum.FECHA_ESPACIADO_PEQUEÑO
FechaEnCastellano = sDia & " de " & sMes & " de " & sAño
Case FormatoFechasEnum.FECHA_SEPARADO_POR_BARRAS
FechaEnCastellano = Fecha.Day.ToString.PadLeft(2, "0") & "/" & Fecha.Month.ToString.PadLeft(2, "0") & "/" & Fecha.Year.ToString
Case Else
Throw New Exception("Formato no reconocido")
End Select
End Function
Public Shared Function MesCastellano(Mes As Integer) As String
Dim sMeses(11) As String
sMeses(0) = "Enero"
sMeses(1) = "Febrero"
sMeses(2) = "Marzo"
sMeses(3) = "Abril"
sMeses(4) = "Mayo"
sMeses(5) = "Junio"
sMeses(6) = "Julio"
sMeses(7) = "Agosto"
sMeses(8) = "Septiembre"
sMeses(9) = "Octubre"
sMeses(10) = "Noviembre"
sMeses(11) = "Diciembre"
Return sMeses(Mes - 1)
End Function
Public Shared Function ObtenerRutaDelEnsamblado() As String
Return IO.Path.GetDirectoryName(IO.Path.GetFullPath(New System.Uri(System.Reflection.Assembly.GetExecutingAssembly().CodeBase).AbsolutePath))
End Function
Public Class Mes
Property NumeroMes As Integer
Property Mes As String
End Class
Public Shared Function Meses() As List(Of Mes)
Dim listadoMeses As New List(Of Mes)
Dim m As Mes
m = New Mes
m.NumeroMes = 1
m.Mes = "Enero"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 2
m.Mes = "Febrero"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 3
m.Mes = "Marzo"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 4
m.Mes = "Abril"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 5
m.Mes = "Mayo"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 6
m.Mes = "Junio"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 7
m.Mes = "Julio"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 8
m.Mes = "Agosto"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 9
m.Mes = "Septiembre"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 10
m.Mes = "Octubre"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 11
m.Mes = "Noviembre"
listadoMeses.Add(m)
m = New Mes
m.NumeroMes = 12
m.Mes = "Diciembre"
listadoMeses.Add(m)
Return listadoMeses
End Function
Public Shared Function CalculoLetraCif(ByVal DNI As String) As String
' Dim sResultado As String = "", iTamanoDNI As Integer, sLetrasNif As String, i As Integer, Cdd0 As Integer, V1 As String = ""
Dim sResultado As String = "", iTamanoDNI As Integer, sLetrasNif As String, i As Integer, V1 As String = ""
sLetrasNif = "TRWAGMYFPDXBNJZSQVHLCKE"
iTamanoDNI = Len(DNI)
If iTamanoDNI = 0 Or iTamanoDNI > 10 Then Return DNI
DNI = DNI.ToUpper
For i = 1 To iTamanoDNI
If Asc(Mid(DNI, i, 1)) >= 48 And Asc(Mid(DNI, i, 1)) <= 57 Or Asc(Mid(DNI, i, 1)) >= 65 And Asc(Mid(DNI, i, 1)) <= 90 Then sResultado = sResultado & Mid(DNI, i, 1)
Next i
iTamanoDNI = Len(sResultado)
If iTamanoDNI = 0 Then
Return sResultado
End If
If Asc(Mid(sResultado, 1, 1)) < 48 Or Asc(Mid(sResultado, 1, 1)) > 57 Or Asc(Mid(sResultado, iTamanoDNI, 1)) < 48 Or Asc(Mid(sResultado, iTamanoDNI, 1)) > 57 Then
Return sResultado
End If
' Cdd0 = 0
For i = 1 To iTamanoDNI
' If Cdd0 Or (Asc(Mid(sResultado, i, 1)) <> 48) Then
If Asc(Mid(sResultado, i, 1)) >= 48 And Asc(Mid(sResultado, i, 1)) <= 57 Then V1 = V1 & Mid(sResultado, i, 1)
' Cdd0 = 1
' End If
Next i
If Trim(V1) = "" Then Return V1
If V1.Length < 9 Then V1 = V1.PadLeft(8, "0")
Return V1 & Mid(sLetrasNif, Val(V1) Mod 23 + 1, 1)
End Function
Public Shared Function ValidateNif(ByRef nif As String) As Boolean
'*******************************************************************
' Nombre: ValidateNif
' por Enrique Martínez Montejo
'
' Finalidad: Validar el NIF/NIE pasado a la función.
'
' Entradas:
' NIF: String. El NIF/NIE que se desea verificar. El número
' será devuelto formateado y con el NIF/NIE correcto.
' Resultados:
' Boolean: True/False
'
'*******************************************************************
nif = nif.Trim()
Dim nifTemp As String = nif.Trim().ToUpper()
If (nifTemp.Length > 9) Then Return False
' Guardamos el dígito de control.
Dim dcTemp As Char = nifTemp.Chars(nif.Length - 1)
' Compruebo si el dígito de control es un número.
If (Char.IsDigit(dcTemp)) Then Return Nothing
' Nos quedamos con los caracteres, sin el dígito de control.
nifTemp = nifTemp.Substring(0, nif.Length - 1)
If (nifTemp.Length < 8) Then
Dim paddingChar As String = New String("0"c, 8 - nifTemp.Length)
nifTemp = nifTemp.Insert(nifTemp.Length, paddingChar)
End If
' Obtengo el dígito de control correspondiente, utilizando
' para ello una llamada a la función GetDcNif.
'
Dim dc As Char = GetDcNif(nif)
If (Not (dc = Nothing)) Then
nif = nifTemp & dc
End If
Return (dc = dcTemp)
End Function
Public Shared Function GetDcNif(ByVal nif As String) As Char
'*******************************************************************
' Nombre: GetDcNif
' por Enrique Martínez Montejo
'
' Finalidad: Devuelve la letra correspondiente al NIF o al NIE
' (Número de Identificación de Extranjero)
'
' Entradas:
' NIF: String. La cadena del NIF cuya letra final se desea
' obtener.
'
' Resultados:
' String: La letra del NIF/NIE.
'
'*******************************************************************
' Pasamos el NIF a mayúscula a la vez que eliminamos los
' espacios en blanco al comienzo y al final de la cadena.
'
nif = nif.Trim().ToUpper()
' El NIF está formado de uno a nueve números seguido de una letra.
'
' El NIF de otros colectivos de personas físicas, está
' formato por una letra (K, L, M), seguido de 7 números
' y de una letra final.
'
' El NIE está formado de una letra inicial (X, Y, Z),
' seguido de 7 números y de una letra final.
'
' En el patrón de la expresión regular, defino cuatro grupos en el
' siguiente orden:
'
' 1º) 1 a 8 dígitos.
' 2º) 1 a 8 dígitos + 1 letra.
' 3º) 1 letra + 1 a 7 dígitos.
' 4º) 1 letra + 1 a 7 dígitos + 1 letra.
'
Try
Dim re As New Regex(
"(^\d{1,8}$)|(^\d{1,8}[A-Z]$)|(^[K-MX-Z]\d{1,7}$)|(^[K-MX-Z]\d{1,7}[A-Z]$)",
RegexOptions.IgnoreCase)
If (Not (re.IsMatch(nif))) Then Return Nothing
' Nos quedamos únicamente con los números del NIF, y
' los formateamos con ceros a la izquierda si su
' longitud es inferior a siete caracteres.
'
re = New Regex("(\d{1,8})")
Dim numeros As String = re.Match(nif).Value.PadLeft(7, "0"c)
' Primer carácter del NIF.
'
Dim firstChar As Char = nif.Chars(0)
' Si procede, reemplazamos la letra del NIE por el peso que le corresponde.
'
If (firstChar = "X"c) Then
numeros = "0" & numeros
ElseIf (firstChar = "Y"c) Then
numeros = "1" & numeros
ElseIf (firstChar = "Z"c) Then
numeros = "2" & numeros
End If
' Tabla del NIF
'
' 0T 1R 2W 3A 4G 5M 6Y 7F 8P 9D
' 10X 11B 12N 13J 14Z 15S 16Q 17V 18H 19L
' 20C 21K 22E 23T
'
' Procedo a calcular el NIF/NIE
'
Dim dni As Integer = CInt(numeros)
' La operación consiste en calcular el resto de dividir el DNI
' entre 23 (sin decimales). Dicho resto (que estará entre 0 y 22),
' se busca en la tabla y nos da la letra del NIF.
'
' Obtenemos el resto de la división.
'
Dim r As Integer = dni Mod 23
' Obtenemos el dígito de control del NIF
'
Dim dc As Char = CChar("TRWAGMYFPDXBNJZSQVHLCKE".Substring(r, 1))
Return dc
Catch
' Cualquier excepción producida, devolverá el valor Nothing.
'
Return Nothing
End Try
End Function
Public Shared Function RecalculaNIF(ByVal nif As String) As Char
'*******************************************************************
' Nombre: GetDcNif
' por Enrique Martínez Montejo
'
' Finalidad: Devuelve la letra correspondiente al NIF o al NIE
' (Número de Identificación de Extranjero)
'
' Entradas:
' NIF: String. La cadena del NIF cuya letra final se desea
' obtener.
'
' Resultados:
' String: La letra del NIF/NIE.
'
'*******************************************************************
' Pasamos el NIF a mayúscula a la vez que eliminamos los
' espacios en blanco al comienzo y al final de la cadena.
'
nif = nif.Trim().ToUpper()
' El NIF está formado de uno a nueve números seguido de una letra.
'
' El NIF de otros colectivos de personas físicas, está
' formato por una letra (K, L, M), seguido de 7 números
' y de una letra final.
'
' El NIE está formado de una letra inicial (X, Y, Z),
' seguido de 7 números y de una letra final.
'
' En el patrón de la expresión regular, defino cuatro grupos en el
' siguiente orden:
'
' 1º) 1 a 8 dígitos.
' 2º) 1 a 8 dígitos + 1 letra.
' 3º) 1 letra + 1 a 7 dígitos.
' 4º) 1 letra + 1 a 7 dígitos + 1 letra.
'
Try
Dim re As New Regex(
"(^\d{1,8}$)|(^\d{1,8}[A-Z]$)|(^[K-MX-Z]\d{1,7}$)|(^[K-MX-Z]\d{1,7}[A-Z]$)",
RegexOptions.IgnoreCase)
If (Not (re.IsMatch(nif))) Then Return Nothing
' Nos quedamos únicamente con los números del NIF, y
' los formateamos con ceros a la izquierda si su
' longitud es inferior a siete caracteres.
'
re = New Regex("(\d{1,8})")
Dim numeros As String = re.Match(nif).Value.PadLeft(7, "0"c)
' Primer carácter del NIF.
'
Dim firstChar As Char = nif.Chars(0)
' Si procede, reemplazamos la letra del NIE por el peso que le corresponde.
'
If (firstChar = "X"c) Then
numeros = "0" & numeros
ElseIf (firstChar = "Y"c) Then
numeros = "1" & numeros
ElseIf (firstChar = "Z"c) Then
numeros = "2" & numeros
End If
' Tabla del NIF
'
' 0T 1R 2W 3A 4G 5M 6Y 7F 8P 9D
' 10X 11B 12N 13J 14Z 15S 16Q 17V 18H 19L
' 20C 21K 22E 23T
'
' Procedo a calcular el NIF/NIE
'
Dim dni As Integer = CInt(numeros)
' La operación consiste en calcular el resto de dividir el DNI
' entre 23 (sin decimales). Dicho resto (que estará entre 0 y 22),
' se busca en la tabla y nos da la letra del NIF.
'
' Obtenemos el resto de la división.
'
Dim r As Integer = dni Mod 23
' Obtenemos el dígito de control del NIF
'
Dim dc As Char = CChar("TRWAGMYFPDXBNJZSQVHLCKE".Substring(r, 1))
Dim NifCorregido As String = numeros & dc
Return NifCorregido
Catch
' Cualquier excepción producida, devolverá el valor Nothing.
'
Return Nothing
End Try
End Function
Public Shared Function ConvertirTiempoUnixADateTime(ByVal tiempoUnix As Long)
Dim fecha As New DateTime(1970, 1, 1, 0, 0, 0, 0, System.DateTimeKind.Utc)
System.Diagnostics.Debug.WriteLine(fecha.AddSeconds(tiempoUnix).ToLocalTime.ToString)
System.Diagnostics.Debug.WriteLine(fecha.AddSeconds(tiempoUnix).ToLocalTime.ToUniversalTime)
Return fecha.AddSeconds(tiempoUnix).ToUniversalTime
End Function
Public Shared Function UpCast(Of B, S As {New, B})(ByVal baseObj As B) As S
Dim superObj As S = New S()
Dim superProp As System.Reflection.PropertyInfo = Nothing
For Each baseProp As System.Reflection.PropertyInfo In baseObj.GetType().GetProperties()
superProp = superObj.GetType().GetProperty(baseProp.Name)
superProp.SetValue(superObj, baseProp.GetValue(baseObj, Nothing), Nothing)
Next
Return superObj
End Function
Public Shared Function StringToHex(ByVal text As String) As String
Dim shex As String = ""
For i As Integer = 0 To text.Length - 1
shex &= Asc(text.Substring(i, 1)).ToString("x").ToUpper
Next
Return shex
End Function
Public Shared Function HexToString(ByVal hex As String) As String
Dim text As New System.Text.StringBuilder(hex.Length \ 2)
For i As Integer = 0 To hex.Length - 2 Step 2
text.Append(Chr(Convert.ToByte(hex.Substring(i, 2), 16)))
Next
Return text.ToString
End Function
Public Shared Function HexToArray(ByVal hex As String) As Byte()
Dim raw As Byte() = New Byte((hex.Length / 2) - 1) {}
Dim i As Integer
For i = 0 To raw.Length - 1
raw(i) = Convert.ToByte(hex.Substring((i * 2), 2), &H10)
Next i
Return raw
End Function
Public Shared Function GetUnixTimestamp() As Integer
Return GetUnixTime(DateTime.UtcNow)
End Function
Public Shared Function GetUnixTime(ByVal dt As DateTime) As Integer
Dim span As TimeSpan = (dt - New DateTime(1970, 1, 1, 0, 0, 0, 0).ToLocalTime())
Return span.TotalSeconds
End Function
Public Shared Function ByteArrayToHex(ByVal bytes_Input As Byte()) As String
Dim strTemp As New StringBuilder(bytes_Input.Length * 2)
For Each b As Byte In bytes_Input
strTemp.Append(Conversion.Hex(b).PadLeft(2, "0"))
Next
Return strTemp.ToString()
End Function
<System.Diagnostics.DebuggerStepThrough()> Public Shared Function ExtraeValorCadena(ByVal Cadena As String, ByVal VariableBuscada As String, Optional Separador As String = ",", Optional SeparadorIgualdad As String = "=") As String
Try
Dim valores = Cadena.Split(Separador)
Dim ValorBuscado = valores.FirstOrDefault(Function(x) x.Split(SeparadorIgualdad)(0).Trim.ToLower = VariableBuscada.ToLower)
If ValorBuscado IsNot Nothing Then
Return ValorBuscado.Split(SeparadorIgualdad)(1).Trim
Else
Return ""
End If
Catch ex As Exception
Return ""
End Try
End Function
<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 New Exception(ex.Message, 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 Function StringAFechaHora(ByVal Fecha As String) As DateTime
Dim sValores() As String = Fecha.Split("_")
Dim dFecha As DateTime
dFecha = New DateTime(sValores(0), sValores(1), sValores(2), sValores(3), sValores(4), sValores(5))
Return dFecha
End Function
Public Shared Function EnviarNotificacionSlack(ByVal mensaje As String, Optional ByVal otroTexto As String = "", Optional ByVal destinatario As String = "", Optional ByVal descripcionRemitente As String = "") As String
Dim resultado As String = ""
Try
'// Escapar las cadenas para compatibilizaras con JSON.
mensaje = Web.HttpUtility.JavaScriptStringEncode(mensaje)
otroTexto = Web.HttpUtility.JavaScriptStringEncode(otroTexto)
destinatario = Web.HttpUtility.JavaScriptStringEncode(destinatario)
descripcionRemitente = Web.HttpUtility.JavaScriptStringEncode(descripcionRemitente)
Dim mensajeJSON As String = ""
If String.IsNullOrWhiteSpace(destinatario) Then
destinatario = "#sevilla"
End If
If Environment.MachineName.ToUpper = "INTI" Then
destinatario = "@danmun"
End If
If String.IsNullOrWhiteSpace(descripcionRemitente) Then
'descripcionRemitente = String.Format(".NET {0}@{1}, {2}", Environment.UserName, Environment.MachineName, Environment.OSVersion)
descripcionRemitente = String.Format(".NET {0}@{1}", Environment.UserName, Environment.MachineName)
End If
If String.IsNullOrWhiteSpace(otroTexto) Then
mensajeJSON = String.Format("{{""channel"": ""{0}"", ""username"": ""notificaciones"", ""text"": ""*{1}* — {2}""}}", destinatario.Trim, descripcionRemitente.Trim, mensaje.Trim)
Else
mensajeJSON = String.Format("{{""channel"": ""{0}"", ""username"": ""notificaciones"", ""text"": ""*{1}* — {2} — _{3}_""}}", destinatario.Trim, descripcionRemitente.Trim, mensaje.Trim, otroTexto.Trim)
End If
Using client As New Net.WebClient()
ServicePointManager.ServerCertificateValidationCallback = AddressOf AcceptAllCertifications
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim response As Byte() = client.UploadValues("https://hooks.slack.com/services/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", New Specialized.NameValueCollection() From {
{"payload", mensajeJSON}
})
resultado = System.Text.Encoding.UTF8.GetString(response)
Console.WriteLine(resultado)
End Using
Catch ex As Exception
'Nada. No quiero que esto ocasiones problemas allá donde sea utilizado.
End Try
Return resultado
End Function
Private Shared Function AcceptAllCertifications(sender As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) As Boolean
Return True
End Function
Public Shared Function GenerarCsvDesdeDataTable(dt As DataTable, Optional ByVal separador As Char = ";") As String
Dim sb As New Text.StringBuilder()
For i As Integer = 0 To dt.Columns.Count - 1
sb.Append("""" & dt.Columns(i).ToString & """")
If i < dt.Columns.Count - 1 Then
sb.Append(separador)
End If
Next
sb.AppendLine()
For Each dr As DataRow In dt.Rows
For i As Integer = 0 To dt.Columns.Count - 1
sb.Append("""" & dr(i).ToString() & """")
If i < dt.Columns.Count - 1 Then
sb.Append(separador)
End If
Next
sb.AppendLine()
Next
Return sb.ToString()
End Function
End Class
Public Class DescripcionValor
Property Descripcion As String
Property Valor As Integer
Public Shared Function EnumADescripcionValor(Enumeracion As Type) As List(Of DescripcionValor)
Dim values As Array = [Enum].GetValues(Enumeracion)
Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion)
'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length)
Dim lista As New List(Of DescripcionValor)
For i As Integer = 0 To values.Length - 1
Dim dv As New DescripcionValor
dv.Valor = values.GetValue(i)
dv.Descripcion = values(i).ToString.Replace("_", " ")
lista.Add(dv)
Next
Return lista
End Function
Public Shared Function EnumADescripcionValorAmpliado(Enumeracion As Type) As List(Of DescripcionValor)
Dim values As Array = [Enum].GetValues(Enumeracion)
Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion)
'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length)
Dim lista As New List(Of DescripcionValor)
For i As Integer = 0 To values.Length - 1
Dim dv As New DescripcionValor
dv.Valor = values.GetValue(i)
dv.Descripcion = values(i).ToString.Replace("_", " ") & " (" & dv.Valor.ToString & ")"
lista.Add(dv)
Next
Return lista
End Function
End Class

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

402
ValidarDocumentoIdentidad.vb Normal file
View File

@@ -0,0 +1,402 @@

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
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
Throw New ArgumentException("El NIF no tiene un número de caracteres válidos")
End If
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 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

205
bbdd.vb Normal file
View File

@@ -0,0 +1,205 @@

Imports System.Data
Imports System.Data.Common
Imports System.Data.SqlClient
Imports System.Globalization
Imports System.IO
Public Class bbdd
Public Shared Function EjeMySqlHex(BD As DbConnection, sqlh As String) As String
Try
Dim sSQL = Extensiones.StringExtensions.ConvierteDeRoman8AWindows(Extensiones.HexToString(sqlh))
BD.Open()
Dim mc As New SqlCommand(sSQL, BD)
Return "Nº Registros afectados: " & mc.ExecuteNonQuery.ToString
Catch ex As Exception
Throw New Exception(ex.Message, ex)
Finally
Try
BD.Close()
Catch
End Try
End Try
End Function
Public Shared Function ObtieneDataTable(ByVal dbConnection As DbConnection, ByVal sqlQuery As String) As DataTable
' Crear el objeto DataTable para almacenar los resultados
Dim ds As New DataSet
Try
' Crear un objeto DbCommand con la instrucción SQL y la conexión proporcionada
Using dbCommand As DbCommand = dbConnection.CreateCommand()
dbCommand.CommandText = sqlQuery
' Abrir la conexión si no está abierta
If dbConnection.State <> ConnectionState.Open Then
dbConnection.Open()
End If
' Crear un DbDataAdapter para llenar el DataTable
Using dbDataAdapter As DbDataAdapter = DbProviderFactories.GetFactory(dbConnection).CreateDataAdapter()
dbDataAdapter.SelectCommand = dbCommand
dbDataAdapter.FillSchema(ds, SchemaType.Mapped, "TABLA")
dbDataAdapter.Fill(ds, "TABLA")
End Using
End Using
Catch ex As Exception
' Manejar cualquier excepción que pueda ocurrir
Console.WriteLine("Error: " & ex.Message)
Finally
' Asegurarse de cerrar la conexión si está abierta
If dbConnection.State = ConnectionState.Open Then
dbConnection.Close()
End If
End Try
' Devolver el DataTable con los resultados
Return ds.Tables("TABLA")
End Function
Public Shared Function LeeMysql(ByVal bd As DbConnection, ByVal sqlQuery As String) As String
Try
Dim sw As New System.Text.StringBuilder
Dim sSQL As String = ""
Dim i As Integer
sSQL = Extensiones.StringExtensions.ConvierteDeRoman8AWindows(Extensiones.HexToString(sqlQuery))
Dim dt As DataTable = ObtieneDataTable(bd, sSQL)
Dim dr As DataRow
Dim dc As DataColumn
Dim iInicioBuffer As Integer = 1
Dim sLinea As String = "NUMREG=" & dt.Rows.Count & "|"
Dim Tipo As String
Dim Tamaño As Integer
For Each dc In dt.Columns
Select Case dc.DataType
Case GetType(String)
Tipo = "X"
Tamaño = dc.MaxLength
Case GetType(DateTime), GetType(Date)
Tipo = "F"
Tamaño = 20
Case Else
Tipo = "N"
Tamaño = 20
End Select
If Tamaño <= 1024 Then
sLinea &= dc.ColumnName & "(" & Tipo & iInicioBuffer.ToString & ";" & Tamaño.ToString & ")|"
iInicioBuffer += Tamaño
End If
Next
sw.AppendLine(sLinea)
For Each dr In dt.Rows
sLinea = ""
For Each dc In dt.Columns
Select Case dc.DataType
Case GetType(String)
If Not dr(dc) Is DBNull.Value Then
sLinea &= dr(dc).ToString.PadRight(dc.MaxLength, " ")
Else
sLinea &= "".PadRight(dc.MaxLength, " ")
End If
Case GetType(DateTime), GetType(Date)
Dim sFecha As String = "null"
Dim dfecha As DateTime
If Not dr(dc) Is DBNull.Value AndAlso DirectCast(dr(dc), DateTime) <> DateTime.MinValue Then
dfecha = dr(dc)
sFecha = dfecha.ToString("yyyy-MM-dd HH:mm:ss")
End If
sLinea &= sFecha.PadRight(20, " ")
Case GetType(Byte())
Case GetType(Double)
If Not dr(dc) Is DBNull.Value Then
Dim doble As Double = dr(dc)
sLinea &= doble.ToString(CultureInfo.InvariantCulture).PadRight(20, " ")
Else
sLinea &= "null".PadRight(20, " ")
End If
Case Else
If Not dr(dc) Is DBNull.Value Then
sLinea &= dr(dc).ToString.PadRight(20, " ")
Else
sLinea &= "null".PadRight(20, " ")
End If
End Select
Next
sw.AppendLine(sLinea)
Next
Return sw.ToString
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Public Shared Function LeeMysqlByteArray(ByVal bd As DbConnection, ByVal sqlQuery As String) As Byte()
Try
Dim ms As New MemoryStream
Dim sw As New IO.StreamWriter(ms)
Dim sSQL As String = ""
Dim i As Integer
sSQL = Extensiones.StringExtensions.ConvierteDeRoman8AWindows(Extensiones.HexToString(sqlQuery))
Dim dt As DataTable = ObtieneDataTable(bd, sSQL)
Dim dr As DataRow
Dim dc As DataColumn
Dim iInicioBuffer As Integer = 1
Dim sLinea As String = "NUMREG=" & dt.Rows.Count & "|"
Dim Tipo As String
Dim Tamaño As Integer
For Each dc In dt.Columns
Select Case dc.DataType
Case GetType(String)
Tipo = "X"
Tamaño = dc.MaxLength
Case GetType(DateTime), GetType(Date)
Tipo = "F"
Tamaño = 20
Case Else
Tipo = "N"
Tamaño = 20
End Select
If Tamaño <= 1024 Then
sLinea &= dc.ColumnName & "(" & Tipo & iInicioBuffer.ToString & ";" & Tamaño.ToString & ")|"
iInicioBuffer += Tamaño
End If
Next
sw.WriteLine(sLinea)
For Each dr In dt.Rows
sLinea = ""
For Each dc In dt.Columns
Select Case dc.DataType
Case GetType(String)
If Not dr(dc) Is DBNull.Value Then
sLinea &= dr(dc).ToString.PadRight(dc.MaxLength, " ")
Else
sLinea &= "".PadRight(dc.MaxLength, " ")
End If
Case GetType(DateTime), GetType(Date)
Dim sFecha As String = "null"
Dim dfecha As DateTime
If Not dr(dc) Is DBNull.Value AndAlso DirectCast(dr(dc), DateTime) <> DateTime.MinValue Then
dfecha = dr(dc)
sFecha = dfecha.ToString("yyyy-MM-dd HH:mm:ss")
End If
sLinea &= sFecha.PadRight(20, " ")
Case GetType(Byte())
Case GetType(Double)
If Not dr(dc) Is DBNull.Value Then
Dim doble As Double = dr(dc)
sLinea &= doble.ToString(CultureInfo.InvariantCulture).PadRight(20, " ")
Else
sLinea &= "null".PadRight(20, " ")
End If
Case Else
If Not dr(dc) Is DBNull.Value Then
sLinea &= dr(dc).ToString.PadRight(20, " ")
Else
sLinea &= "null".PadRight(20, " ")
End If
End Select
Next
sw.WriteLine(sLinea)
Next
sw.Close()
Return ms.ToArray
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
End Class

18
clFuncionesGenericas.vb Normal file
View File

@@ -0,0 +1,18 @@
Public Class clFuncionesGenericas
Public Shared Function MesEnCastellano(ByVal Fecha As Date) As String
Dim sMeses(11) As String
sMeses(0) = "Enero"
sMeses(1) = "Febrero"
sMeses(2) = "Marzo"
sMeses(3) = "Abril"
sMeses(4) = "Mayo"
sMeses(5) = "Junio"
sMeses(6) = "Julio"
sMeses(7) = "Agosto"
sMeses(8) = "Septiembre"
sMeses(9) = "Octubre"
sMeses(10) = "Noviembre"
sMeses(11) = "Diciembre"
MesEnCastellano = sMeses(Now.Month - 1)
End Function
End Class

505
crypt.vb Normal file
View File

@@ -0,0 +1,505 @@
Imports System.IO
Imports System.Security.Cryptography
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
'------------------------
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
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) OrElse (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
End Class

90
http.vb Normal file
View File

@@ -0,0 +1,90 @@
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) As String
Return EjecutaURL(fullUrl, System.Text.Encoding.UTF8, bAllowAutoRedirect, iTimeout)
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("¡", "?").Replace("#", "%23")
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 & vbCrLf
Else
sRespuesta &= Servidor & ": Sin Respuesta desde " & res.Address.ToString & vbCrLf
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 OrElse 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 = "" OrElse 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

107
tsExcepcion.vb Normal file
View File

@@ -0,0 +1,107 @@
Imports System
Imports System.Runtime.Serialization
Imports Microsoft.VisualBasic
Imports Microsoft.VisualBasic.CompilerServices
<Serializable>
Public Class tsExcepcion
Inherits ApplicationException
Public Enum ModoBusquedaEnum As Long
EnTodaLaCadena
DesdeExcepcionSiguiente
SoloEnExcepcionActual
End Enum
Private pCodigo As String
Private pDatosExtra As String
Public ReadOnly Property Codigo As String
Get
Return pCodigo
End Get
End Property
Public ReadOnly Property DatosExtra As String
Get
Return pDatosExtra
End Get
End Property
Public Sub New(message As String, Optional argCodigo As String = Nothing, Optional argDatosExtra As String = Nothing)
MyBase.New(message)
pCodigo = argCodigo
pDatosExtra = argDatosExtra
End Sub
Public Sub New(message As String, innerException As Exception, Optional argCodigo As String = Nothing, Optional argDatosExtra As String = Nothing)
MyBase.New(message, innerException)
pCodigo = argCodigo
pDatosExtra = argDatosExtra
End Sub
Protected Sub New(info As SerializationInfo, context As StreamingContext)
MyBase.New(info, context)
pCodigo = info.GetString("pCodigo")
pDatosExtra = info.GetString("pDatosExtra")
End Sub
Public Overrides Sub GetObjectData(info As SerializationInfo, context As StreamingContext)
MyBase.GetObjectData(info, context)
info.AddValue("pCodigo", pCodigo)
info.AddValue("pDatosExtra", pDatosExtra)
End Sub
Public Shared Function Buscar(excepcion As Exception, patronCodigo As String, Optional modoBusqueda As ModoBusquedaEnum = ModoBusquedaEnum.EnTodaLaCadena) As tsExcepcion
Try
If excepcion Is Nothing Then
Throw New tsExcepcion("'excepcion' es Nothing.")
End If
If Not [Enum].IsDefined(GetType(ModoBusquedaEnum), modoBusqueda) Then
Throw New tsExcepcion("Modo de búsqueda incorrecto: " & Conversions.ToString(modoBusqueda))
End If
Dim ex = excepcion
If modoBusqueda = ModoBusquedaEnum.DesdeExcepcionSiguiente Then
ex = ex.InnerException
End If
Dim num = 1
Do
If ex Is Nothing Then
Return Nothing
End If
If TypeOf ex Is tsExcepcion Then
Dim text = CType(ex, tsExcepcion).Codigo
If Equals(text, Nothing) Then
text = ""
End If
If LikeOperator.LikeString(text, patronCodigo, CompareMethod.Binary) Then
Return CType(ex, tsExcepcion)
End If
End If
ex = ex.InnerException
If modoBusqueda = ModoBusquedaEnum.SoloEnExcepcionActual Then
Return Nothing
End If
num = num + 1
Loop While num <= 1000000
Throw New tsExcepcion("Bucle cuasi-infinito.")
Catch ex2 As Exception
ProjectData.SetProjectError(ex2)
Dim ex3 = ex2
Throw New tsExcepcion("Buscando tsExcepcion con código: " & patronCodigo & vbCrLf & ex3.Message, ex3)
End Try
End Function
Public Shared Function Es(excepcion As Exception, patronCodigo As String, Optional modoBusqueda As ModoBusquedaEnum = ModoBusquedaEnum.EnTodaLaCadena) As Boolean
Return Buscar(excepcion, patronCodigo, modoBusqueda) IsNot Nothing
End Function
End Class

33
tsUtilidades.sln Normal file
View File

@@ -0,0 +1,33 @@

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.4.33213.308
MinimumVisualStudioVersion = 10.0.40219.1
Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "tsUtilidades", "tsUtilidades.vbproj", "{A665C529-8D34-46CE-B7F4-1FBDA93687B1}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{A665C529-8D34-46CE-B7F4-1FBDA93687B1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{A665C529-8D34-46CE-B7F4-1FBDA93687B1}.Debug|Any CPU.Build.0 = Debug|Any CPU
{A665C529-8D34-46CE-B7F4-1FBDA93687B1}.Release|Any CPU.ActiveCfg = Release|Any CPU
{A665C529-8D34-46CE-B7F4-1FBDA93687B1}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {8834271C-ABA8-4089-9AE0-3416A8F93659}
EndGlobalSection
GlobalSection(TeamFoundationVersionControl) = preSolution
SccNumberOfProjects = 2
SccEnterpriseProvider = {4CA58AB2-18FA-4F8D-95D4-32DDF27D184C}
SccTeamFoundationServer = http://ts-devopss:81/tecnosiscollection
SccProjectUniqueName0 = tsUtilidades.vbproj
SccLocalPath0 = .
SccLocalPath1 = .
EndGlobalSection
EndGlobal

54
tsUtilidades.vbproj Normal file
View File

@@ -0,0 +1,54 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<GenerateAssemblyInfo>false</GenerateAssemblyInfo>
</PropertyGroup>
<PropertyGroup Label="Globals">
<SccProjectName>SAK</SccProjectName>
<SccProvider>SAK</SccProvider>
<SccAuxPath>SAK</SccAuxPath>
<SccLocalPath>SAK</SccLocalPath>
</PropertyGroup>
<PropertyGroup>
<OutputType>Library</OutputType>
<RootNamespace>tsUtilidades</RootNamespace>
<TargetFramework>net8.0</TargetFramework>
<PackageId>tsUtilidades</PackageId>
<PackageTags>net8.0, libreria</PackageTags>
<Version>1.0.1</Version>
<Authors>Manuel</Authors>
<Company>Tecnosis S.A</Company>
<Description>Utilidades varias Entity Framework compatibles con EF Core 8.</Description>
<PackageReleaseNotes>
- Se incluye clase tsExcepcion.
</PackageReleaseNotes>
<ImplicitUsings>enable</ImplicitUsings>
<Nullable>enable</Nullable>
</PropertyGroup>
<ItemGroup>
<Compile Remove="Extensiones\DbContextExtensions.vb" />
<Compile Remove="Extensiones\ObjetExtensions.vb" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Google.Protobuf" Version="3.28.3" />
<PackageReference Include="IbanNet" Version="5.16.1" />
<PackageReference Include="K4os.Compression.LZ4.Streams" Version="1.3.8" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="SSH.NET" Version="2024.2.0" />
<PackageReference Include="System.Buffers" Version="4.6.0" />
<PackageReference Include="System.ComponentModel.Annotations" Version="5.0.0" />
<PackageReference Include="System.Data.DataSetExtensions" Version="4.5.0" />
<PackageReference Include="System.Linq.Dynamic.Core" Version="1.6.0.2" />
<PackageReference Include="System.ServiceModel.Federation" Version="8.1.0" />
<PackageReference Include="Microsoft.DotNet.UpgradeAssistant.Extensions.Default.Analyzers" Version="0.4.421302">
<PrivateAssets>all</PrivateAssets>
</PackageReference>
<PackageReference Include="Microsoft.Windows.Compatibility" Version="9.0.0" />
</ItemGroup>
<ItemGroup>
<FrameworkReference Include="Microsoft.AspNetCore.App" />
</ItemGroup>
</Project>

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

94
zip.vb Normal file
View File

@@ -0,0 +1,94 @@
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 tsUtilidades.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
tsUtilidades.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
'Shared Function ComprimeStream(streamAComprimir As IO.Stream, NombreFicheroAcomprimir As String) As IO.MemoryStream
' Dim ms As New IO.MemoryStream
' Dim fzip As New ZipArchive(ms, ZipArchiveMode.Create)
' Dim entry As ZipArchiveEntry = fzip.CreateEntryFromFile(NombreFicheroAcomprimir, streamAComprimir)
' Dim entry As ZipArchiveEntry = fzip.CreateEntry((NombreFicheroAcomprimir, streamAComprimir)
'End Function
'Public Shared Function ComprimirArchivos(dArchivos As Dictionary(Of String, Byte())) As Byte() ' NO ESTÁ PROBADA
' Dim ms As New MemoryStream
' Dim za As New ZipArchive(ms, ZipArchiveMode.Create, True)
' For Each f In dArchivos
' Dim nf = za.CreateEntry(f.Key)
' Dim es = nf.Open
' Dim msa As New MemoryStream(f.Value)
' msa.CopyTo(es)
' es.Close()
' Next
' Return ms.ToArray
'End Function
Public Shared Function ComprimirArchivos(fileContents As Dictionary(Of String, Byte())) As Byte()
Using memoryStream As New MemoryStream()
Using archive As New ZipArchive(memoryStream, ZipArchiveMode.Create, True)
For Each entry In fileContents
Dim fileName As String = entry.Key
Dim fileData As Byte() = entry.Value
Dim zipEntry As ZipArchiveEntry = archive.CreateEntry(fileName)
Using entryStream As Stream = zipEntry.Open()
entryStream.Write(fileData, 0, fileData.Length)
End Using
Next
End Using
Return memoryStream.ToArray()
End Using
End Function
End Class