%@ WebHandler Language="VB" Class="TareasProgramadas" %>
Imports System
Imports System.Web
Imports System.Data
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Imports Extensiones
Imports System.IO
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Imports Microsoft.Reporting.WebForms
Imports System.Threading
Imports System.Threading.Tasks
Imports System.Net.Http
Imports System.Net.Http.Headers
Imports SharpCompress.Archive.Rar
Imports SharpCompress.Common
Imports SharpCompress.Reader
Imports ADS.TareasProgramdas
Imports System.Xml
'Imports ADSistemaLibrary.SatXml
'Imports ADSistemaLibrary.SatXml.XmlSatCFDI
Imports System.Diagnostics
Imports System.Drawing
Imports System.Drawing.Imaging
Public Class TareasProgramadas : Implements IHttpHandler, IReadOnlySessionState
Private ReadOnly Property GlobalDTUsuariosE140(Optional CveUsuario As Integer = -1, Optional CveCliente As Integer = -1, Optional CveProveedor As Integer = -1) As DataTable
Get
Dim CveEmpresa As Integer = 140
Dim Str As New StringBuilder
If CveUsuario <> -1 Then Str.AppendFormat("CveUsuario = {0}", CveUsuario)
If CveEmpresa <> -1 Then Str.AppendFormat(" {0} CveEmpresa = {1}", If(Str.Length > 0, "AND", ""), CveEmpresa)
If CveCliente <> -1 Then Str.AppendFormat(" {0} CveCliente = {1}", If(Str.Length > 0, "AND", ""), CveCliente)
If CveProveedor <> -1 Then Str.AppendFormat(" {0} CveProveedor = {1}", If(Str.Length > 0, "AND", ""), CveProveedor)
If CveUsuario <> -1 OrElse CveEmpresa <> -1 Then
Dim Dv As New DataView(DirectCast(HttpContext.Current.Application("GlobalDTUsuarios"), DataTable), Str.ToString, "", DataViewRowState.CurrentRows)
GlobalDTUsuariosE140 = Dv.ToTable
Dv.Dispose()
Else
GlobalDTUsuariosE140 = DirectCast(HttpContext.Current.Application("GlobalDTUsuarios"), DataTable)
End If
End Get
End Property
Public Shared ReadOnly Property GlobalDTSubProyectosE140(CveProyecto As Integer, Optional CveSubProyecto As Integer = -1, Optional Estatus As Integer = 1) As DataTable
Get
Dim CveEmpresa As Integer = 140
Dim AppNombre As String = String.Format("GlobalDTSubProyectos-{0}", CveEmpresa)
'sino existe, recarga los datos
If DirectCast(HttpContext.Current.Application(AppNombre), DataTable) Is Nothing Or (DirectCast(HttpContext.Current.Application(AppNombre), DataTable) IsNot Nothing AndAlso DirectCast(HttpContext.Current.Application(AppNombre), DataTable).Rows.Count = 0) Then
Dim P As New ClsSubProyectos
If P.GetSubProyectos(CveEmpresa:=CveEmpresa) Then HttpContext.Current.Application(AppNombre) = P.DtResultados
P.Dispose()
End If
If CveProyecto <> -1 OrElse CveSubProyecto <> -1 OrElse CveEmpresa <> -1 OrElse Estatus <> -1 Then
Dim StrSQL As New StringBuilder
If CveProyecto <> -1 Then StrSQL.AppendFormat(" AND CveProyecto = {0}", CveProyecto)
If CveSubProyecto <> -1 Then StrSQL.AppendFormat(" AND CveSubProyecto = {0}", CveSubProyecto)
If Estatus <> -1 Then StrSQL.AppendFormat(" AND CveEstatus = {0}", Estatus)
If CveEmpresa <> -1 Then StrSQL.AppendFormat(" AND CveEmpresa = {0}", CveEmpresa)
Dim Dv As New DataView(DirectCast(HttpContext.Current.Application(AppNombre), DataTable), StrSQL.ToString.Trim.TrimStart("A"c, "N"c, "D"c), "", DataViewRowState.CurrentRows)
GlobalDTSubProyectosE140 = Dv.ToTable
Dv.Dispose()
Else
GlobalDTSubProyectosE140 = DirectCast(HttpContext.Current.Application(AppNombre), DataTable)
End If
End Get
End Property
Private currentcontext As HttpContext
Private URLParametros As New Hashtable
Public Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
context.Response.ContentType = "text/plain"
currentcontext = context
Dim retorno As String = "no se encontro la variable"
Try
Dim metodo As String = ""
Dim FechaActual As DateTime = ClsPaginas.NowADS()
Dim FechaEnvio As DateTime = FechaActual
If context.Request("var") IsNot Nothing Then
URLParametros = Parametros(context.Request("var"))
metodo = URLParametros("metodo").ToString
'SI TRAE UN JSON COMO PARAMETRO
ElseIf context.Request("metodo") IsNot Nothing Then
metodo = context.Request("metodo").ToString()
If context.Request("FechaEnvio") IsNot Nothing Then
FechaEnvio = context.Request("FechaEnvio").ToString().ToDateTime()
End If
End If
Select Case metodo
Case "TimbrarNomina"
retorno = "Error Timbrado Nomina"
retorno = timbrarNomina()
retorno = ""
context.Response.Write(retorno)
Case "EstadosCuenta"
'CargaEstadosCuenta(context, 119, 227774)
'CargaEstadosCuenta(context, 119, -1, FechaEnvio, FechaActual)
Dim tCveEmpresa As Integer = context.Request("CveEmpresa").ToString.ToEntero
CargaEstadosCuenta(context, tCveEmpresa, -1, FechaEnvio, FechaActual)
Case "ScoreCard"
CargaScoreCard(context, 140, FechaEnvio)
Case "EjecutaReporteDiario"
Dim tCveEmpresa As Integer = context.Request("CveEmpresa").ToString.ToEntero
retorno = If(ReporteDiario(tCveEmpresa, context), "True", "false")
context.Response.Write(retorno)
Case "DescargaSAT"
Dim tCveEmpresa As Integer = context.Request("CveEmpresa").ToString.ToEntero
retorno = If(DescargaSAT(tCveEmpresa, context), "True", "false")
context.Response.Write(retorno)
Case "ValidaDescargaSAT"
Dim tCveEmpresa As Integer = context.Request("CveEmpresa").ToString.ToEntero
retorno = If(ValidaDescargaSAT(tCveEmpresa, context), "True", "false")
context.Response.Write(retorno)
'Case "TmpFacturas"
' TmpFacturas()
End Select
Catch ex As Exception
ex.GuardaLog(ex.ToString())
context.Response.Write(retorno)
End Try
End Sub
Public Sub timbrarNominab()
Dim cveEmpresa As Integer = 5
Dim Dv As New DataView(DirectCast(currentcontext.Application("GlobalDTUsuarios"), DataTable), $"CveUsuario = 100 AND CveEmpresa ={cveEmpresa}", "", DataViewRowState.CurrentRows)
Dim GlobalDTUsuarios As DataTable = Dv.ToTable
Dv.Dispose()
Dim usuario As Usuario = Nothing
'Dim UsuarioAsignaciones As Usuario
If GlobalDTUsuarios.Rows.Count > 0 Then
Dim dtrow As DataRow = GlobalDTUsuarios.Rows(0)
Dim NombreCadena As String = ClsPaginas.GlobalNombreCadenaConexion(cveEmpresa)
Dim ObjUsuario As New ClsSisUsuarioAutenticacion(NombreCadena:=NombreCadena)
usuario = ObjUsuario.ValidaUsuario(dtrow("Usuario").ToString, dtrow("Contraseña").ToString, CveEmpresa:=cveEmpresa)
ObjUsuario.Dispose()
Dim ObjEmpresa As New ClsSisEmpresas()
If ObjEmpresa.GetEmpresas(cveEmpresa, "-1", "-1", "-1", "-1") Then
If ObjEmpresa.GetEmpresasFuncionalidades(cveEmpresa) Then
Dim dttmp As Data.DataTable = ObjEmpresa.DtResultados
Dim EmpresasFuncionalidades As New HybridDictionary
For Each Row As Data.DataRow In dttmp.Rows
EmpresasFuncionalidades.Add(Convert.ToInt32(Row("CveFuncionalidad")), Row("Valor").ToString)
Next
ObjEmpresa.Empresa.SetFuncionalidades(EmpresasFuncionalidades)
End If
usuario.Empresa = ObjEmpresa.Empresa
usuario.CveEmpresa = ObjEmpresa.Empresa.CveEmpresa
ADSSession.ADSSessionConfig.SessionManager(ADSSession.OpcionSession.CambiarEmpresa, Nothing, ObjEmpresa.Empresa.CveEmpresa)
Else
End If
ObjEmpresa.Dispose()
Dim StrErrores As New StringBuilder
Dim Msg As String = String.Empty
Dim CvePeriodo As Integer
Dim CveNomina As Integer
Dim CvePersonal As Integer
Dim SerieFolio As String
Dim DtNominas As New DataTable
Dim objnom As New ClsNominas
objnom.GetNom_porTimbrar(usuario.CveEmpresa)
DtNominas = objnom.DtResultados
'DtNominas = New DataTable
Dim noCiclos As Integer = 0
Dim noTotal As Integer = DtNominas.Rows.Count
Dim lognom As New LogicNominas
For Each Row As DataRow In DtNominas.Rows
'If noCiclos < 4 Then
noCiclos = noCiclos + 1
CveNomina = Row("CveNomina").ToString().ToEntero()
CvePersonal = Row("CvePersonal").ToString().ToEntero()
SerieFolio = Row("SerieFolio").ToString()
CvePeriodo = Row("CvePeriodo").ToString.ToEntero
If CveNomina > 0 Then
Msg = lognom.TimbrarNomina(CveNomina, CvePersonal, CvePeriodo, usuario)
If Msg.Trim <> String.Empty Then StrErrores.Append(Msg & "
")
End If
'Else
' Exit For
'End If
Next
GC.Collect()
StrErrores.ToString().GuardaLog()
If StrErrores.ToString().Length > 0 And CvePeriodo > 0 Then
Dim ObjPeriodo As New ClsNominas()
ObjPeriodo.CambiaEstatusPeriodo(CvePeriodo, enumNominasEstatus.Timbrada, usuario.CveUsuario, usuario.CveEmpresa)
ObjPeriodo.Dispose()
'EnvioMasivoCorreo()
'Dim temp As String = DdlPeriodo.SelectedValue
'CargaPeriodos()
'BtnEmitir.Visible = False
'DdlPeriodo.SelectedValue = temp
End If
End If
End Sub
Private Function GetUsuario(CveEmpresa As Integer, Optional CveUsuario As Integer = -1, Optional username As String = "", Optional pass As String = "") As Usuario
Dim usuario As Usuario = Nothing
#Region "Valido que los campos usuario contraseña no sean nulos"
If IsNothing(username) Then
username = ""
End If
If IsNothing(pass) Then
pass = ""
End If
#End Region
#Region "Si el CveUsuario es mayor que cero asigno el username y pass la de la CveUsuario"
If CveUsuario > 0 Then
Using Dv As New DataView(DirectCast(currentcontext.Application("GlobalDTUsuarios"), DataTable), $"CveUsuario = 100 AND CveEmpresa ={CveEmpresa}", "", DataViewRowState.CurrentRows)
Using GlobalDTUsuarios As DataTable = Dv.ToTable()
If GlobalDTUsuarios.Rows.Count > 0 Then
Dim dtrow As DataRow = GlobalDTUsuarios.Rows(0)
username = dtrow("Usuario").ToString
pass = dtrow("Contraseña").ToString
End If
End Using
End Using
End If
#End Region
#Region "obtengo el usuario con el username y la pass"
'Dim tGrupoEmpresa As String = ClsPaginas.GlobalGrupoEmpresa(Request.Url.Host.ToUpper())
Dim NombreCadena As String = ClsPaginas.GlobalNombreCadenaConexion(CveEmpresa)
Using ObjUsuario As New ClsSisUsuarioAutenticacion(NombreCadena:=NombreCadena)
usuario = ObjUsuario.ValidaUsuario(username, pass, CveEmpresa:=CveEmpresa)
End Using
#End Region
#Region "Asigno la empresa al usuario"
If Not IsNothing(usuario) Then
Using ObjEmpresa As New ClsSisEmpresas()
If ObjEmpresa.GetEmpresas(CveEmpresa, "-1", "-1", "-1", "-1") Then
If ObjEmpresa.GetEmpresasFuncionalidades(CveEmpresa) Then
Dim dttmp As Data.DataTable = ObjEmpresa.DtResultados
Dim EmpresasFuncionalidades As New HybridDictionary
For Each Row As Data.DataRow In dttmp.Rows
EmpresasFuncionalidades.Add(Convert.ToInt32(Row("CveFuncionalidad")), Row("Valor").ToString)
Next
ObjEmpresa.Empresa.SetFuncionalidades(EmpresasFuncionalidades)
End If
usuario.Empresa = ObjEmpresa.Empresa
usuario.CveEmpresa = ObjEmpresa.Empresa.CveEmpresa
Else
End If
End Using
End If
#End Region
Return usuario
End Function
Public Function timbrarNomina() As String
Dim retorno As String = ""
Dim cveEmpresa As Integer = URLParametros("CveEmpresa").ToString().ToEntero()
Dim CvePeriodo As Integer = URLParametros("CvePeriodo").ToString().ToEntero()
Dim CveNomina As Integer = URLParametros("CveNomina").ToString().ToEntero()
Dim CvePersonal As Integer = URLParametros("CvePersonal").ToString().ToEntero()
Dim usuario As Usuario = GetUsuario(cveEmpresa, 100)
If Not IsNothing(usuario) Then
Dim StrErrores As New StringBuilder
Dim Msg As String = String.Empty
Dim lognom As New LogicNominas
If CveNomina > 0 Then
Msg = lognom.TimbrarNomina(CveNomina, CvePersonal, CvePeriodo, usuario)
If Msg.Trim() <> String.Empty Then StrErrores.Append(Msg)
retorno = Msg.Trim()
Else
retorno = "Nomina invalida periodo timbrar"
End If
'Using ObjPeriodo As New ClsNominas()
' If StrErrores.ToString().Length > 0 Then
' ObjPeriodo.CambiaEstatusPeriodo(CvePeriodo, enumNominasEstatus.ErrorEnTimbrado, usuario.CveUsuario, usuario.CveEmpresa)
' Else
' ObjPeriodo.CambiaEstatusPeriodo(CvePeriodo, enumNominasEstatus.Timbrada, usuario.CveUsuario, usuario.CveEmpresa)
' End If
'End Using
Else
retorno = "No se encontro el usuario"
Me.GuardaLog(String.Format("Error Timbrado Nomina CveEmpresa:{0} ", usuario.CveEmpresa))
End If
Return retorno
End Function
Private Function Parametros(Cadena As String) As Hashtable
Cadena = Decripta(Cadena)
Dim P1() As String = Cadena.Split("&"c)
Dim Tmp As String
Dim P2() As String
Dim URLParametros As New Hashtable
For Each Tmp In P1
P2 = Tmp.Replace("%26%", "&").Split("="c)
URLParametros.Add(P2(0).ToString(), P2(1))
Next
Return URLParametros
End Function
Public ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return False
End Get
End Property
#Region "E S T A D O S D E C U E N T A"
Private Sub CargaEstadosCuenta(ByVal context As HttpContext, pCveEmpresa As Integer, pCveCliente As Integer, FechaEnvio As DateTime, FechaActual As DateTime)
Dim Usuario As Usuario = ValidaUsuarioSistema(100, pCveEmpresa)
Dim Retorno As New JArray()
Dim DtEmpresas As DataTable = Nothing
Using ObjEmpresas As New ClsSisEmpresas()
If ObjEmpresas.GetEmpresas(pCveEmpresa, "-1", "-1", "-1", "-1") Then
DtEmpresas = ObjEmpresas.DtResultados.FiltraParametros("", "", {"CveEmpresa"})
End If
End Using
If DtEmpresas IsNot Nothing Then
For Each Row As DataRow In DtEmpresas.Rows
'Dim Usuario As Usuario = ValidaUsuarioSistema(100, Row("CveEmpresa").ToString().ToEntero())
Dim obj As JObject = EjecutarEnvioEstadoCuenta(Usuario, FechaEnvio, FechaActual, pCveCliente:=pCveCliente)
Retorno.Add(obj)
Next
DtEmpresas.Dispose()
End If
GuardaLogEdoCuenta(Retorno.ToString())
context.Response.Write("True")
End Sub
Private Function ValidaUsuarioSistema(CveUsuario As Integer, CveEmpresa As Integer) As Usuario
Dim UsuarioActual As Usuario = Nothing
Dim NombreCadena As String = ClsPaginas.GlobalNombreCadenaConexion(CveEmpresa)
Dim ObjUsuarios As New ClsSisUsuarioAutenticacion(NombreCadena:=NombreCadena)
UsuarioActual = ObjUsuarios.GetUsuarioDetalle(CveUsuario, CveEmpresa)
If UsuarioActual IsNot Nothing Then
HttpContext.Current.Session("UsuarioSIG") = UsuarioActual
'CreaObjetoEmpresa(UsuarioActual)
End If
ObjUsuarios.Dispose()
Return UsuarioActual
End Function
Private Function EjecutarEnvioEstadoCuenta(UsuarioActual As Usuario, FechaEnvio As DateTime, FechaActual As DateTime, Optional pCveCliente As Integer = -1) As JObject
Dim ClientesSinEnviar As New JArray()
Dim ClientesEdoEnviado As New JArray()
Dim Json As New JObject(
New JProperty("Empresa", UsuarioActual.Empresa.Empresa),
New JProperty("Usuario", UsuarioActual.Usuario),
New JProperty("Fecha", ClsPaginas.NowADS().ToString("dd/MM/yyy HH:mm:ss"))
)
Dim DTClientes As DataTable = Nothing
Dim EnviarPendientes As Boolean = False
If FechaActual <> FechaEnvio Then
EnviarPendientes = True
End If
If Not EnviarPendientes Then
Using ObjMov As New ClsMovimientos
Dim FechaI As String = "-1"
Dim FechaF As String = "-1"
Dim FechaVI As String = "-1"
Dim FechaVF As String = "-1"
Dim TCEspecifico As Decimal = -1
Dim CveCobranzaEstatus As Integer = -1
Dim CveClienteClasificacion As Integer = -1
Dim CveCliente As Integer = -1
Dim AplicaAnticipos As Integer = 0
Dim CveSubProyecto As Integer = -1
Dim CveVendedor As Integer = -1
Dim Grupo As Integer = 5
Dim TipoCambio As Integer = 1
Dim TipoDocto As String = "Ing"
Dim FechaCorte As DateTime = New DateTime(ClsPaginas.NowADS().Year, 12, 31)
If ObjMov.GetCxC(FechaI, FechaF, CveCliente, CveSubProyecto, CveVendedor, -1, -1, "-1", UsuarioActual.CveEmpresa, Grupo, -1, TipoCambio, TCEspecifico, TipoDocto, FechaVI, FechaVF, FechaCorte:=FechaCorte,
EstatusCliente:=1, CveUsuarioConsulta:=UsuarioActual.CveUsuario, CveCobranzaEstatus:=CveCobranzaEstatus, CveClienteClasificacion:=-1, TipoCliente:=-1) Then
DTClientes = ObjMov.DtResultados.FiltraParametros("CveCliente > 0", DistinctColumns:={"CveCliente"})
End If
End Using
End If
If DTClientes IsNot Nothing OrElse EnviarPendientes Then
DTClientes = DTClientes.FiltraParametros("CveCliente NOT IN (228080,228565,228910,233126,231465,232730,232697,227338)")
Dim DtNotificaciones As DataTable = Nothing
Dim TieneErrorRegistro As Boolean = False
Dim ObjMovimientos As New ClsMovimientos
ObjMovimientos.IniciaTransacSQL()
If Not EnviarPendientes Then
Try
For Each RowCliente As DataRow In DTClientes.Rows
If Not ObjMovimientos.AddNotificacionEdoCuentaCliente(RowCliente("CveCliente").ToString().ToEntero(), FechaEnvio) Then
GuardaLog("Ocurrio un error al agregar las notificaciones de edo cuenta. CveCliente: " + RowCliente("CveCliente").ToString())
TieneErrorRegistro = True
Exit For
End If
Next
Catch ex As Exception
GuardaLog("Ocurrio un error al agregar las notificaciones de edo cuenta" + ex.ToString())
TieneErrorRegistro = True
End Try
End If
If Not TieneErrorRegistro Then
If ObjMovimientos.GetNotificacionEdoCuentaCliente(UsuarioActual.CveEmpresa, -1, FechaEnvio) Then
DtNotificaciones = ObjMovimientos.DtResultados.Copy()
Else
TieneErrorRegistro = True
End If
End If
If Not TieneErrorRegistro Then
ObjMovimientos.Commit()
Else
ObjMovimientos.RollBack()
If DtNotificaciones IsNot Nothing Then
DtNotificaciones.Clear()
DtNotificaciones = Nothing
End If
End If
ObjMovimientos.Dispose()
If DTClientes IsNot Nothing Then
DTClientes.Dispose()
End If
Try
If DtNotificaciones IsNot Nothing Then
For Each Row As DataRow In DtNotificaciones.Rows
Dim CveCliente As Integer = Row("CveCliente").ToString().ToEntero()
Dim Cliente As New Modelos.ClienteModel(CveCliente, UsuarioActual.CveEmpresa)
If Cliente IsNot Nothing Then
Dim Correo As String = Cliente.CobranzaCorreo
Dim Envio As Boolean = False
If Not String.IsNullOrEmpty(Correo) Then
'Correo = "oscar.irigoyen@adssistemas.mx"
Envio = EnviarEstadoCuenta(UsuarioActual, Correo, Cliente)
GuardaLog($"Log envio Estados Cuenta correo {If(Envio, "Enviado", "Error")} CveCliente {CveCliente} ")
End If
If Envio Then
Using ObjMov As New ClsMovimientos
ObjMov.UpdateNotificacionEdoCuentaCliente(Row("CveNotificacionBitacora").ToString().ToEntero(), Notifico:=True)
End Using
ClientesEdoEnviado.Add(New JObject(
New JProperty("CveCliente", Cliente.CveCliente),
New JProperty("Cliente", Cliente.Nombre)
))
Using ObjBitacora As New ClsOIEventos
ObjBitacora.AddEventoBitacora("Se envió correo con el estado de cuenta del cliente", "", UsuarioActual.CveUsuario, UsuarioActual.CveEmpresa, CveCliente:=Cliente.CveCliente)
End Using
Else
ClientesSinEnviar.Add(New JObject(
New JProperty("CveCliente", Cliente.CveCliente),
New JProperty("Cliente", Cliente.Nombre)
))
End If
End If
Next
End If
Catch ex As Exception
GuardaLog("Ocurrio un error al agregar las notificaciones de edo cuenta. " + ex.ToString())
End Try
If DtNotificaciones IsNot Nothing Then
DtNotificaciones.Dispose()
End If
End If
Json.Add(New JProperty("ClientesSinEnviar", ClientesSinEnviar))
Json.Add(New JProperty("ClientesEdoEnviado", ClientesEdoEnviado))
Return Json
End Function
Private Function EnviarEstadoCuenta(UsuarioActual As Usuario, Correo As String, Cliente As Modelos.ClienteModel) As Boolean
Dim Retorno As Boolean = True
Try
Dim ArchivoPDF As Byte() = Nothing
Dim Formato As String = "PDF"
Dim Archivo As New System.IO.FileInfo(String.Format("{0}Formatos/RepClientesCxC.rpt", UsuarioActual.Empresa.Ruta))
Dim Imagen As New System.IO.FileInfo(String.Format("{0}/Logo.png", UsuarioActual.Empresa.Ruta))
Dim logouri As String = String.Format("{0}://{1}:{2}/Empresas/{3}/Logo.png", HttpContext.Current.Request.Url.Scheme, HttpContext.Current.Request.Url.Host, HttpContext.Current.Request.Url.Port, UsuarioActual.CveEmpresa)
'OBTENEMOS LOS DATOS
Dim DtCxCFact As DataTable = Nothing
Dim SaldoIngDolares As Double = 0
Dim SaldoIngPesos As Double = 0
Dim SaldoIngDolaresPesos As Double = 0
Dim TotalIng As Double = 0
Dim SaldoAntDolares As Double = 0
Dim SaldoAntPesos As Double = 0
Dim SaldoAntDolaresPesos As Double = 0
Dim TotalAnt As Double = 0
Dim ContaIng As Integer = 0
Dim ContaAnt As Integer = 0
Dim FechaCorte As Date = ("9999/01/01").ToDate
Dim TipoDocto2 As String = "'Ing'"
Dim FechaVencimientoI As String = "-1"
Dim FechaVencimientoF As String = "-1"
Dim FI As String = "-1"
Dim FF As String = "-1"
Dim dtt As DataTable = Nothing
Try
Using ObjMovtos As New ClsMovimientos()
If ObjMovtos.GetCxCClienteDetalle(Cliente.CveCliente, "-1", "-1", -1, -1, UsuarioActual.CveEmpresa, CveClienteSucursal:=-1) Then
DtCxCFact = ObjMovtos.DtResultados.FiltraParametros("Tipo = 'Act'", "TipoDocto")
'cargo los anticipos NC
DtCxCFact.Columns.Add("SaldoAnticipo", GetType(Decimal))
If ObjMovtos.GetAnticiposNCIxCCliente(Cliente.CveCliente, -1, -1) Then
dtt = ObjMovtos.DtResultados.FiltraParametros("Saldo > 0 AND SaldoVentaAnticipo = 0 AND ((Tipo = 'IxC' AND CveIE > 0) OR (Tipo = 'Ant' AND CveVenta > 0) OR (Tipo = 'NC' AND CveVenta > 0) OR (Tipo = 'Egs' AND CveVenta > 0) )")
End If
End If
End Using
Catch ex As Exception
Retorno = False
dtt = Nothing
GuardaLog("Ocurrió un erro al obtener el CxC. " + ex.ToString())
End Try
If Not Retorno Then
Return Retorno
End If
Try
If dtt IsNot Nothing AndAlso dtt.Rows.Count > 0 Then
For Each drt As DataRow In dtt.Rows
Dim drr As DataRow = DtCxCFact.NewRow
drr("TipoDocto") = drt("Tipo")
drr("SerieFolio") = drt("Folio")
drr("Original") = drt("Original")
drr("TipoCambio") = drt("TipoCambio")
drr("Saldo") = 0
drr("SaldoAnticipo") = drt("Saldo")
drr("Fecha") = drt("Fecha")
drr("Moneda") = drt("Moneda")
drr("CveMoneda") = drt("CveMoneda")
DtCxCFact.Rows.Add(drr)
Next
End If
If DtCxCFact IsNot Nothing Then
For Each Row As DataRow In DtCxCFact.FiltraParametros($"TipoDocto IN ({TipoDocto2})").Rows
If Row("TipoDocto").ToString = "Ing" Or Row("TipoDocto").ToString = "Rem" Or (Row("TipoDocto").ToString = "Ant" And Row("Saldo").ToString.ToDouble > 0) Then 'Ingresos
ContaIng = ContaIng + 1
If Row("CveMoneda").ToString.ToEntero = 1 Then
SaldoIngPesos = SaldoIngPesos + Row("Saldo").ToString.ToDouble
ElseIf Row("CveMoneda").ToString.ToEntero = 2 Then
SaldoIngDolares = SaldoIngDolares + Row("Saldo").ToString.ToDouble
SaldoIngDolaresPesos = SaldoIngDolaresPesos + (Row("Saldo").ToString.ToDouble * Row("TipoCambio").ToString.ToDouble)
End If
ElseIf (Row("TipoDocto").ToString = "Ant" And Row("Saldo").ToString.ToDouble = 0) Or Row("TipoDocto").ToString = "IxC" Or Row("TipoDocto").ToString = "NC" Or Row("TipoDocto").ToString = "Dev" Then 'Anticipos, NC, IxC
ContaAnt = ContaAnt + 1
If Row("CveMoneda").ToString.ToEntero = 1 Then
If Row("TipoDocto").ToString = "Dev" Then
SaldoAntPesos = SaldoAntPesos + Row("Saldo").ToString.ToDouble
Else
SaldoAntPesos = SaldoAntPesos + Row("SaldoAnticipo").ToString.ToDouble
End If
ElseIf Row("CveMoneda").ToString.ToEntero = 2 Then
SaldoAntDolares = SaldoAntDolares + Row("Saldo").ToString.ToDouble
SaldoAntDolaresPesos = SaldoAntDolaresPesos + (Row("SaldoAnticipo").ToString.ToDouble * Row("TipoCambio").ToString.ToDouble)
End If
End If
Next
End If
TotalIng = SaldoIngPesos + SaldoIngDolaresPesos
TotalAnt = SaldoAntPesos + SaldoAntDolaresPesos
If TotalIng.RoundSQL(2) = 0 AndAlso TotalAnt.RoundSQL(2) = 0 Then
Retorno = False
Return Retorno
End If
Dim DtCxCFact2 As DataTable = DtCxCFact.FiltraParametros($"TipoDocto IN ({TipoDocto2})")
'INGRESOS
If SaldoIngPesos > 0 Then
Dim drr As DataRow = DtCxCFact2.NewRow
drr("SerieFolio") = "Total Ing Pesos"
drr("Original") = DtCxCFact2.FiltraParametros("CveMoneda = 1").SUM("Original", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Abonado") = DtCxCFact2.FiltraParametros("CveMoneda = 1").SUM("Abonado", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Saldo") = SaldoIngPesos
drr("CveMoneda") = 1
DtCxCFact2.Rows.Add(drr)
End If
If SaldoIngDolares > 0 Then
Dim drr As DataRow = DtCxCFact2.NewRow
drr("SerieFolio") = "Total Ing Dólares"
drr("Original") = DtCxCFact2.FiltraParametros("CveMoneda = 2").SUM("Original", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Abonado") = DtCxCFact2.FiltraParametros("CveMoneda = 2").SUM("Abonado", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Saldo") = SaldoIngDolares
drr("CveMoneda") = 2
DtCxCFact2.Rows.Add(drr)
End If
'ANTICIPOS
If SaldoAntPesos > 0 Then
Dim drr As DataRow = DtCxCFact2.NewRow
drr("SerieFolio") = "Total Pesos"
drr("SaldoAnticipo") = SaldoAntPesos
drr("CveMoneda") = 1
DtCxCFact2.Rows.Add(drr)
End If
If SaldoAntDolares > 0 Then
Dim drr As DataRow = DtCxCFact2.NewRow
drr("SerieFolio") = "Total Dólares"
drr("SaldoAnticipo") = SaldoAntDolares
drr("CveMoneda") = 2
DtCxCFact2.Rows.Add(drr)
End If
If DtCxCFact2 IsNot Nothing AndAlso DtCxCFact2.Rows.Count > 0 Then
Dim dr As DataRow = DtCxCFact2.Rows(0)
Dim lista As New List(Of CrystalParametro)
lista.Add(New CrystalParametro("Empresa", UsuarioActual.Empresa.Empresa))
lista.Add(New CrystalParametro("TipoCuentas", "Con Saldo"))
lista.Add(New CrystalParametro("NombreCliente", Cliente.Nombre))
lista.Add(New CrystalParametro("FechaInicio", If(FI = "-1", "-", FI)))
lista.Add(New CrystalParametro("FechaFin", If(FF = "-1", ClsPaginas.NowADS().ToShortDateString, FF)))
lista.Add(New CrystalParametro("UsuarioImprimio", UsuarioActual.Nombre))
lista.Add(New CrystalParametro("DireccionCliente", String.Format("Calle {0} #{1} Colonia {2}", Cliente.Direccion, If(Cliente.NoExt = "", "S/N", Cliente.NoExt), Cliente.Colonia)))
lista.Add(New CrystalParametro("ClienteCP", Cliente.CP))
lista.Add(New CrystalParametro("ClienteCiudad", Cliente.Ciudad))
lista.Add(New CrystalParametro("ClienteRFC", Cliente.RFC))
lista.Add(New CrystalParametro("ClienteTelefono", Cliente.Telefono))
lista.Add(New CrystalParametro("DiasCredito", Cliente.PlazoCobranza))
lista.Add(New CrystalParametro("LimiteCredito", Cliente.LimiteCredito))
lista.Add(New CrystalParametro("SaldoDisponible", (Cliente.LimiteCredito - DtCxCFact2(0)("Saldo").ToString.ToDouble).FormatoNumero))
lista.Add(New CrystalParametro("SaldoIngDolares", SaldoIngDolares.FormatoNumero))
lista.Add(New CrystalParametro("SaldoIngPesos", SaldoIngPesos.FormatoNumero))
lista.Add(New CrystalParametro("TotalIng", TotalIng.FormatoNumero))
lista.Add(New CrystalParametro("SaldoAntDolares", SaldoAntDolares.FormatoNumero))
lista.Add(New CrystalParametro("SaldoAntPesos", SaldoAntPesos.FormatoNumero))
lista.Add(New CrystalParametro("TotalAnt", TotalAnt.FormatoNumero))
lista.Add(New CrystalParametro("ContaIng", ContaIng))
lista.Add(New CrystalParametro("ContaAnt", ContaAnt))
If Imagen.Exists Then
lista.Add(New CrystalParametro("LogoPath", logouri))
Else
lista.Add(New CrystalParametro("LogoPath", ""))
End If
Try
If Archivo.Exists Then
ArchivoPDF = ImprimirPDFCrystal($"{UsuarioActual.Empresa.Ruta}Formatos/RepClientesCxC.rpt", DtCxCFact2.FiltraParametros("", "CveMoneda,Fecha"), lista, "Estado de cuenta", Formato)
Else
ArchivoPDF = ImprimirPDFCrystal(HttpContext.Current.Server.MapPath("~/Empresas/Grales/Formatos/RepClientesCxC.rpt"), DtCxCFact2.FiltraParametros("", "CveMoneda,Fecha"), lista, "Estado de cuenta", Formato)
End If
Catch ex As Exception
ArchivoPDF = Nothing
GuardaLog("Ocurrió un erro al obtener el CxC" + ex.ToString())
End Try
Else
Dim lista As New List(Of CrystalParametro)
lista.Add(New CrystalParametro("Empresa", UsuarioActual.Empresa.Empresa))
lista.Add(New CrystalParametro("TipoCuentas", "Con Saldo"))
lista.Add(New CrystalParametro("NombreCliente", Cliente.Nombre))
lista.Add(New CrystalParametro("FechaInicio", If(FI = "-1", "-", FI)))
lista.Add(New CrystalParametro("FechaFin", If(FF = "-1", ClsPaginas.NowADS().ToShortDateString, FF)))
lista.Add(New CrystalParametro("UsuarioImprimio", UsuarioActual.Nombre))
lista.Add(New CrystalParametro("DireccionCliente", String.Format("Calle {0} #{1} Colonia {2}", Cliente.Direccion, If(Cliente.NoExt = "", "S/N", Cliente.NoExt), Cliente.Colonia)))
lista.Add(New CrystalParametro("ClienteCP", Cliente.CP))
lista.Add(New CrystalParametro("ClienteCiudad", Cliente.Ciudad))
lista.Add(New CrystalParametro("ClienteRFC", Cliente.RFC))
lista.Add(New CrystalParametro("ClienteTelefono", Cliente.Telefono))
lista.Add(New CrystalParametro("DiasCredito", Cliente.PlazoCobranza))
lista.Add(New CrystalParametro("LimiteCredito", Cliente.LimiteCredito))
lista.Add(New CrystalParametro("SaldoDisponible", (Cliente.LimiteCredito).FormatoNumero))
lista.Add(New CrystalParametro("SaldoIngDolares", SaldoIngDolares.FormatoNumero))
lista.Add(New CrystalParametro("SaldoIngPesos", SaldoIngPesos.FormatoNumero))
lista.Add(New CrystalParametro("TotalIng", TotalIng.FormatoNumero))
lista.Add(New CrystalParametro("SaldoAntDolares", SaldoAntDolares.FormatoNumero))
lista.Add(New CrystalParametro("SaldoAntPesos", SaldoAntPesos.FormatoNumero))
lista.Add(New CrystalParametro("TotalAnt", TotalAnt.FormatoNumero))
lista.Add(New CrystalParametro("ContaIng", ContaIng))
lista.Add(New CrystalParametro("ContaAnt", ContaAnt))
If Imagen.Exists Then
lista.Add(New CrystalParametro("LogoPath", logouri))
Else
lista.Add(New CrystalParametro("LogoPath", ""))
End If
Dim drr As DataRow = DtCxCFact2.NewRow
drr("SerieFolio") = "Total Ing Pesos"
drr("Original") = DtCxCFact2.FiltraParametros("CveMoneda = 1").SUM("Original", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Abonado") = DtCxCFact2.FiltraParametros("CveMoneda = 1").SUM("Abonado", "TipoDocto IN ('Ing','Rem') OR (TipoDocto = 'Ant' AND Saldo > 0)")
drr("Saldo") = 0
drr("SaldoAnticipo") = 0
drr("CveMoneda") = 1
DtCxCFact2.Rows.Add(drr)
If Archivo.Exists Then
ArchivoPDF = ImprimirPDFCrystal($"{UsuarioActual.Empresa.Ruta}Formatos/RepClientesCxC.rpt", DtCxCFact2.FiltraParametros("", "CveMoneda,Fecha"), lista, "Estado de cuenta", Formato)
Else
ArchivoPDF = ImprimirPDFCrystal(HttpContext.Current.Server.MapPath("~/Empresas/Grales/Formatos/RepClientesCxC.rpt"), DtCxCFact2.FiltraParametros("", "CveMoneda,Fecha"), lista, "Estado de cuenta", Formato)
End If
End If
Catch ex As Exception
GuardaLog("Ocurrió un error al generar el pdf" + ex.ToString())
ArchivoPDF = Nothing
End Try
If ArchivoPDF IsNot Nothing Then
Try
Dim Cuerpo As String = String.Format("Estimado cliente {0}, al presente del correo se anexa su estado actual de cartera en {1}.
Quedamos a sus ordenes para cualquier duda o aclaración con su agente de Ventas.
Gracias por la atención brindada al presente.
Reciba un cordial saludo.
ESTE CORREO SE GENERO EN FORMA AUTOMATICA.", Cliente.NombreComercial, UsuarioActual.Empresa.Empresa)
Retorno = MandaCorreo(ArchivoPDF, Correo, $"Estado Actual de Cartera {UsuarioActual.Empresa.Empresa}", Cuerpo)
Catch ex As Exception
Retorno = False
GuardaLog("Ocurrió error al mandar el correo de estado de cuenta. " + ex.ToString())
End Try
Else
Retorno = False
End If
Catch ex As Exception
Retorno = False
GuardaLog("Ocurrió error al mandar el correo de estado de cuenta" + ex.ToString())
End Try
Return Retorno
End Function
Public Function ImprimirPDFCrystal(RutaReporte As String, DataSource As DataTable, Parametros As List(Of CrystalParametro), Optional NombreArchivo As String = "Reporte", Optional Formato As String = "PDF", Optional MR As ReportDocument = Nothing) As Byte()
'limpio ReportViwer
Dim sw As New System.Diagnostics.Stopwatch()
sw.Start()
If IsNothing(MR) Then MR = New ReportDocument()
Dim Bytes As Byte() = Nothing
Dim formatType As ExportFormatType = ExportFormatType.NoFormat
Try
MR.Load(RutaReporte)
MR.SetDataSource(DataSource)
For Each item As CrystalParametro In Parametros
MR.SetParameterValue(item.Nombre, item.Valor)
Next
Select Case Formato
Case "PDF"
formatType = ExportFormatType.PortableDocFormat
'Format = "Application/pdf"
Case "EXCEL"
formatType = ExportFormatType.Excel
'Format = "application/ms-excel"
End Select
Dim Stream As IO.Stream = MR.ExportToStream(formatType)
Dim BD As New BinaryReader(MR.ExportToStream(formatType))
Bytes = BD.ReadBytes(CInt(MR.ExportToStream(formatType).Length))
BD.Dispose()
Stream.Dispose()
'Dim Buffer(CInt(Stream.Length)) As Byte
'Bytes = Buffer
'MR.ExportToHttpResponse(formatType, Response, True, NombreArchivo)
Catch ex As CrystalReportsException
GuardaLog(If(ex.InnerException IsNot Nothing AndAlso ex.Message IsNot Nothing,
$"Error: {If(ex.InnerException.Message, ex.Message)} | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing,
ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} Ruta {RutaReporte}", $"Sin descripción - Ruta {RutaReporte}"))
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
Catch ex As Exception
GuardaLog(If(ex.InnerException IsNot Nothing AndAlso ex.Message IsNot Nothing,
$"Error: {If(ex.InnerException.Message, ex.Message)} | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing,
ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} Ruta {RutaReporte}", $"Sin descripción - Ruta {RutaReporte}"))
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
End Try
sw.Stop()
If sw.Elapsed.TotalSeconds > 10 Then
GuardaLog($"Reporte:{RutaReporte} | Tiempo Renderizado Milisegundos: {sw.ElapsedMilliseconds},Total Segundos: {sw.Elapsed.TotalSeconds} ")
End If
If MR IsNot Nothing Then
'MR.Close()
MR.Dispose()
End If
Return Bytes
End Function
Private Function MandaCorreo(File As Byte(), Para As String, Asunto As String, Body As String) As Boolean
'Para = "japmx95@gmail.com"
Try
Dim a As String = String.Format("{0} -- {1} ---- -->", Asunto, Para)
'a.GuardaLog()
Dim Mail As New ClsSisMail()
Dim LSRutasMail As New List(Of ClsSisMail.ArchivoMail)
LSRutasMail.Add(New ClsSisMail.ArchivoMail With {.ArchivoBinario = File, .NombreArchivo = "EstadoDeCuenta.pdf"})
Return Mail.SendMail(ClsPaginas.EmpresaNotificaciones, Para, Asunto, Body, Archivos:=LSRutasMail)
Catch ex As Exception
GuardaLog("Ocurrió error al mandar el correo de estado de cuenta. " + ex.ToString())
Return False
End Try
End Function
Public Sub GuardaLogEdoCuenta(Str As String)
Dim ArchivoW As StreamWriter
Dim strLineaTMP As String
' strLineaTMP = Chr(13) & Chr(10) & Day(NowADS()) & "/" & Month(NowADS()) & "/" & Year(NowADS()) & " " & Hour(NowADS()) & ":" & Minuto & ". " & Str & Chr(13) & Chr(10)
strLineaTMP = String.Format("{0}{1}Log: {2}{3}:{4}", Chr(13), Chr(10), Str, ClsPaginas.NowADS().ToShortDateString, ClsPaginas.NowADS().ToShortTimeString)
Try
ArchivoW = New StreamWriter(String.Format("{0}\Log\LogEdoCuenta.txt", ModExtensiones.DirectorioBaseEmpresas), True, System.Text.Encoding.UTF8)
Catch ex As UnauthorizedAccessException
'Alert("No hay permisos para guardar en el Log.", Extensiones.TipoMensaje.MsgError)
Exit Sub
Catch ex As Exception
Exit Sub
End Try
Try
ArchivoW.WriteLine(strLineaTMP)
Catch
End Try
ArchivoW.Close()
ArchivoW.Dispose()
End Sub
#End Region
#Region "S C O R E C A R D"
Private Sub CargaScoreCard(ByVal context As HttpContext, pCveEmpresa As Integer, FechaEnvio As DateTime)
Dim Usuario As Usuario = ValidaUsuarioSistema(100, pCveEmpresa)
Dim obj As Boolean = EjecutarEnvioScoreCard(Usuario, FechaEnvio)
End Sub
Private Function EjecutarEnvioScoreCard(UsuarioActual As Usuario, FechaEnvio As DateTime) As Boolean
Dim DtGrupoVendedores As DataTable = Nothing
Dim DtGrupoSucursales As DataTable = Nothing
Dim DtGrupoEmpresa As DataTable = Nothing
Using ObjVentas As New ClsVentas
'VENDEDORES
If ObjVentas.GetRepMetasVendedores(FechaEnvio, UsuarioActual.CveEmpresa, -1, -1,
-1, -1, -1, -1,
-1, -1, GrupoSuperior:=0) Then
DtGrupoVendedores = ObjVentas.DtResultados.Copy
End If
'SUCURSAL
If ObjVentas.GetRepMetasVendedores(FechaEnvio, UsuarioActual.CveEmpresa, -1, -1,
-1, -1, -1, -1,
-1, -1, GrupoSuperior:=1) Then
DtGrupoSucursales = ObjVentas.DtResultados.Copy
End If
'EMPRESA
If ObjVentas.GetRepMetasVendedores(FechaEnvio, UsuarioActual.CveEmpresa, -1, -1,
-1, -1, -1, -1,
-1, -1, GrupoSuperior:=2) Then
DtGrupoEmpresa = ObjVentas.DtResultados.Copy
End If
End Using
Dim DtUsuarios As DataTable = GlobalDTUsuariosE140()
Dim ListaDirectivos As New List(Of MUsuarioEnviar)
'OSCAR FERNANDO LOPEZ CARRASCO
ListaDirectivos.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {2138}"), TipoUsuarioEnviar.Directivo) With
{
.SubProyecto = "Todos",
.ReporteEnviar = New MReporteEnviar() With
{
.Empresa = True, .Sucursal = True, .Vendedor = True
}
})
'ANA IVETTE LOPEZ CARRASCO
ListaDirectivos.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {2292}"), TipoUsuarioEnviar.Directivo) With
{
.SubProyecto = "Todos",
.ReporteEnviar = New MReporteEnviar() With
{
.Empresa = True, .Sucursal = True, .Vendedor = True
}
})
'FERNANDO MENDOZA LAMADRID
ListaDirectivos.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {2275}"), TipoUsuarioEnviar.Directivo) With
{
.SubProyecto = "Todos",
.ReporteEnviar = New MReporteEnviar() With
{
.Empresa = True, .Sucursal = True, .Vendedor = True
}
})
'CARLOS ARMANDO MORENO GONZALEZ
ListaDirectivos.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {2763}"), TipoUsuarioEnviar.Directivo) With
{
.SubProyecto = "Todos",
.ReporteEnviar = New MReporteEnviar() With
{
.Empresa = True, .Sucursal = True, .Vendedor = True
}
})
'EMMANUEL LOPEZ FIMBRES
ListaDirectivos.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3099}"), TipoUsuarioEnviar.Directivo) With
{
.SubProyecto = "Todos",
.ReporteEnviar = New MReporteEnviar() With
{
.Empresa = True, .Sucursal = True, .Vendedor = True
}
})
Dim PDFEmpresa As Byte() = GenerarScoredCardDirectivo(UsuarioActual, DtGrupoEmpresa)
Dim PDFSucursales As Byte() = GenerarScoredCardDirectivo(UsuarioActual, DtGrupoSucursales)
Dim PDFVendedores As Byte() = GenerarScoredCardDirectivo(UsuarioActual, DtGrupoVendedores)
For Each UsuarioEnviar As MUsuarioEnviar In ListaDirectivos
Dim LSRutasMail As New List(Of ClsSisMail.ArchivoMail)
If UsuarioEnviar.ReporteEnviar.Empresa Then
LSRutasMail.Add(New ClsSisMail.ArchivoMail With
{
.ArchivoBinario = PDFEmpresa,
.NombreArchivo = "ScoreCardEmpresa.pdf"
})
End If
If UsuarioEnviar.ReporteEnviar.Sucursal Then
LSRutasMail.Add(New ClsSisMail.ArchivoMail With
{
.ArchivoBinario = PDFSucursales,
.NombreArchivo = "ScoreCardSucursales.pdf"
})
End If
If UsuarioEnviar.ReporteEnviar.Vendedor Then
LSRutasMail.Add(New ClsSisMail.ArchivoMail With
{
.ArchivoBinario = PDFVendedores,
.NombreArchivo = "ScoreCardVendedores.pdf"
})
End If
If LSRutasMail.Count > 0 Then
EnviarCorreoFactura(UsuarioActual, UsuarioEnviar, LSRutasMail)
End If
Next
Dim ListaVendedores As New List(Of MUsuarioEnviar)
'LUIS FERNADO GRIJALVA COTA
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3236} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'FERNANDO GRIJALVA
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3293} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'ADRIAN MURRIETA
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3352} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'BRAYAM URIEL CORRALES
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {2700} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'DANIEL GASTELUM
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3360} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'ALEJANDRA QUINTERO
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3336} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'RICARDO FUENTES
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3363} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
'GERMAN LUNA
ListaVendedores.Add(New MUsuarioEnviar(DtUsuarios.FiltroPrimero($"CveUsuario = {3354} AND CveSubProyecto > 0"), TipoUsuarioEnviar.Vendedor))
For Each UsuarioEnviar As MUsuarioEnviar In ListaVendedores
Dim LSRutasMail As New List(Of ClsSisMail.ArchivoMail)
Dim DtReporteVendedor As DataTable = Nothing
If UsuarioEnviar.CveSubProyecto > 0 AndAlso UsuarioEnviar.CveVendedor > 0 Then
Using ObjVentas As New ClsVentas
If ObjVentas.GetRepMetasVendedores(FechaEnvio, UsuarioActual.CveEmpresa, UsuarioEnviar.CveVendedor, -1,
-1, -1, -1, UsuarioEnviar.CveSubProyecto, -1, -1, GrupoSuperior:=1) Then
DtReporteVendedor = ObjVentas.DtResultados.Copy
End If
End Using
LSRutasMail.Add(New ClsSisMail.ArchivoMail With
{
.ArchivoBinario = GenerarScoredCard(UsuarioActual, UsuarioEnviar, DtReporteVendedor),
.NombreArchivo = "ScoreCardSucursales.pdf"
})
If LSRutasMail.Count > 0 Then
EnviarCorreoFactura(UsuarioActual, UsuarioEnviar, LSRutasMail)
End If
End If
Next
Return False
End Function
Private Sub EnviarCorreoFactura(UsuarioActual As Usuario, UsuarioEnviar As MUsuarioEnviar, LSRutasMail As List(Of ClsSisMail.ArchivoMail))
Dim ObjMail As New ClsSisMail()
Dim Mail As String = "jonathan.perez@adssistemas.mx"
Dim MailCC As String = "rene.molina@adssistemas.mx"
Dim ExistePDF As Boolean = False
If Not String.IsNullOrEmpty(Mail) Then
Try
Dim Asunto As String = $"ScoreCard: {ClsPaginas.NowADS().ToString("dd/MM/yyyy")}"
Dim Cuerpo As String = String.Empty
Dim ResultadoMail As Integer = 0
If ObjMail.SendMail(ClsPaginas.EmpresaNotificaciones, Mail, Asunto, Cuerpo, If(String.IsNullOrEmpty(MailCC), "", MailCC), LSRutasMail) Then
ResultadoMail = 1
End If
Catch ex As Exception
OnError("Ocurrió error al mandar el Mail", ex)
End Try
End If
End Sub
Protected Function GenerarScoredCard(UsuarioActual As Usuario, UsuarioEnviar As MUsuarioEnviar, DtDatos As DataTable) As Byte()
Dim Imagen As New System.IO.FileInfo(String.Format("{0}/Logo.png", UsuarioActual.Empresa.Ruta))
Dim logouri As String = String.Format("{0}://{1}:{2}/Empresas/{3}/Logo.png", HttpContext.Current.Request.Url.Scheme, HttpContext.Current.Request.Url.Host, HttpContext.Current.Request.Url.Port, UsuarioActual.CveEmpresa)
Dim params As New List(Of ReportParameter)
params.Add(New ReportParameter("pEmp", UsuarioActual.Empresa.Empresa))
If Imagen.Exists Then
params.Add(New ReportParameter("pImg", logouri))
Else
params.Add(New ReportParameter("pImg", ""))
End If
params.Add(New ReportParameter("UsuarioImprimio", UsuarioActual.Usuario))
params.Add(New ReportParameter("FechaImpresion", Today.ToString))
params.Add(New ReportParameter("SubProyecto", UsuarioEnviar.SubProyecto))
params.Add(New ReportParameter("Agente", UsuarioEnviar.Agente))
Dim lrds As New List(Of ReportDataSource)
Dim rds As New ReportDataSource
rds.Name = "DataSet1"
rds.Value = DtDatos
lrds.Add(rds)
Return StreamPDF(UsuarioActual, "Empresas/Grales/Formatos/MetasVendedores.rdlc", lrds, params, "Rep. Metas por vendedores", "PDF")
End Function
Protected Function GenerarScoredCardDirectivo(UsuarioActual As Usuario, DtDatos As DataTable) As Byte()
Dim Imagen As New System.IO.FileInfo(String.Format("{0}/Logo.png", UsuarioActual.Empresa.Ruta))
Dim logouri As String = String.Format("{0}://{1}:{2}/Empresas/{3}/Logo.png", HttpContext.Current.Request.Url.Scheme, HttpContext.Current.Request.Url.Host, HttpContext.Current.Request.Url.Port, UsuarioActual.CveEmpresa)
Dim params As New List(Of ReportParameter)
params.Add(New ReportParameter("pEmp", UsuarioActual.Empresa.Empresa))
If Imagen.Exists Then
params.Add(New ReportParameter("pImg", logouri))
Else
params.Add(New ReportParameter("pImg", ""))
End If
params.Add(New ReportParameter("UsuarioImprimio", UsuarioActual.Usuario))
params.Add(New ReportParameter("FechaImpresion", Today.ToString))
params.Add(New ReportParameter("SubProyecto", "Todos"))
params.Add(New ReportParameter("Agente", "Todos"))
Dim lrds As New List(Of ReportDataSource)
Dim rds As New ReportDataSource
rds.Name = "DataSet1"
rds.Value = DtDatos
lrds.Add(rds)
Return StreamPDF(UsuarioActual, "Empresas/Grales/Formatos/MetasVendedores.rdlc", lrds, params, "Rep. Metas por vendedores", "PDF")
End Function
Public Enum TipoUsuarioEnviar
Directivo
Vendedor
End Enum
Public Class MUsuarioEnviar
Sub New(RowUsuario As DataRow, Tipo As TipoUsuarioEnviar)
If RowUsuario IsNot Nothing Then
Me.CveUsuario = RowUsuario("CveUsuario").ToString().ToEntero()
Me.Nombre = RowUsuario("Nombre").ToString()
Me.Correo = RowUsuario("Correo").ToString()
Me.CveSubProyecto = RowUsuario("CveSubProyecto").ToString().ToEntero()
Me.CveVendedor = RowUsuario("CveVendedor").ToString().ToEntero()
Me.Tipo = Tipo
If Me.Tipo = TipoUsuarioEnviar.Vendedor Then
Me.Agente = Me.Nombre
Else
Me.Agente = "Todos"
End If
If String.IsNullOrEmpty(SubProyecto) AndAlso CveSubProyecto > 0 Then
Me.SubProyecto = GlobalDTSubProyectosE140(-1, CveSubProyecto:=Me.CveSubProyecto).FiltroPrimeroValor("SubProyecto")
End If
End If
End Sub
Public Property CveUsuario As Integer
Public Property Nombre As String
Public Property Tipo As TipoUsuarioEnviar
Public Property ReporteEnviar As MReporteEnviar
Public Property CveSubProyecto As Integer
Public Property SubProyecto As String
Public Property Correo As String
Public Property CveVendedor As Integer
Public Property Agente As String
End Class
Public Class MReporteEnviar
Public Property Empresa As Boolean = False
Public Property Sucursal As Boolean = False
Public Property Vendedor As Boolean = False
End Class
Public Function StreamPDF(UsuarioActual As Usuario, RutaReporte As String, DataSource As List(Of ReportDataSource), Parametros As List(Of ReportParameter), Optional NombreArchivo As String = "Reporte", Optional Formato As String = "PDF", Optional MR As ReportViewer = Nothing) As Byte()
'limpio ReportViwer
Dim sw As New System.Diagnostics.Stopwatch()
sw.Start()
Dim Bytes As Byte() = Nothing
Dim CveUsuario As Integer = 0
Dim CveEmpresa As Integer = 0
Dim RutaEmpresa As String = ""
If UsuarioActual IsNot Nothing Then
CveUsuario = UsuarioActual.CveUsuario
CveEmpresa = UsuarioActual.CveEmpresa
RutaEmpresa = UsuarioActual.Empresa.Ruta
End If
Dim bdir As String = If(RutaReporte.Contains("Empresas"), ModExtensiones.DirectorioBaseEmpresas, AppDomain.CurrentDomain.BaseDirectory)
'TOMAR LA RUTA BASE PARA EL DIRECTORIO DE LA EMPRESA
If Not String.IsNullOrEmpty(RutaEmpresa) AndAlso Not RutaReporte.Contains("Grales") Then
bdir = RutaEmpresa.Replace($"{CveEmpresa}/", "")
End If
RutaReporte.Replace("/", "\")
If Not RutaReporte.ToUpper().StartsWith(bdir.ToUpper()) Then
RutaReporte = String.Format("{0}{1}", bdir, RutaReporte)
End If
Dim EsProduccion As Boolean = UsuarioActual.Empresa.FacturaProduccion
If EsProduccion Then
Dim wsreport As New WSRDLC.WebServiceSoapClient
Dim params As New List(Of WSRDLC.ReportParameter)
Dim ds As New DataSet
For Each rpds As ReportDataSource In DataSource
Dim dt As DataTable = DirectCast(rpds.Value, Data.DataTable)
If dt Is Nothing Then
dt = New DataTable()
Else
dt = dt.Copy()
End If
dt.TableName = rpds.Name
ds.Tables.Add(dt)
Next
For Each rpds As ReportParameter In Parametros
Dim param As New WSRDLC.ReportParameter
param.Name = rpds.Name
param.Values = {rpds.Values(0)}
params.Add(param)
Next
Bytes = wsreport.StreamPDFBytes(RutaReporte, ds, params.ToArray(), NombreArchivo, Formato, CveEmpresa, CveUsuario)
wsreport = Nothing
params = Nothing
ds.Dispose() : ds = Nothing
Else
If IsNothing(MR) Then MR = New ReportViewer
Try
' MasterReporteador.LocalReport.DataSources.Clear()
For Each RDS As ReportDataSource In DataSource
MR.LocalReport.DataSources.Add(RDS)
Next
MR.LocalReport.ReportPath = RutaReporte
MR.ProcessingMode = ProcessingMode.Local
MR.LocalReport.EnableExternalImages = True
MR.LocalReport.SetParameters(Parametros)
MR.LocalReport.Refresh()
Dim Warnings As Warning() = Nothing
Dim StreamIds As String() = Nothing
Dim MimeType As String = Nothing
Dim Encoding As String = Nothing
Dim Extension As String = Nothing
Bytes = MR.LocalReport.Render(Formato, Nothing, MimeType, Encoding, Extension, StreamIds, Warnings)
Catch ex As Microsoft.Reporting.WebForms.ScriptManagerNotFoundException
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
Catch ex As Exception
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
End Try
MR.Dispose()
MR = Nothing
'Dim ruta = wsreport.StreamPDF(RutaReporte, ds, params.ToArray(), NombreArchivo, Formato, CveEmpresa, CveUsuario)
'If File.Exists(ruta) Then
' Bytes = File.ReadAllBytes(ruta)
' File.Delete(ruta)
'End If
'Dim setup As AppDomainSetup = New AppDomainSetup
'With setup
' .ApplicationBase = Environment.CurrentDirectory
' .LoaderOptimization = LoaderOptimization.MultiDomainHost
'End With
'setup.SetCompatibilitySwitches({"NetFx40_LegacySecurityPolicy"})
'Dim _casPolicyEnabledDomain As AppDomain = AppDomain.CreateDomain("Full Trust", Nothing, setup)
'Dim fllreport As ADSReportLib.FullTrustReportviewer = Nothing
'Try
' fllreport = CType(_casPolicyEnabledDomain.CreateInstanceFromAndUnwrap(GetType(ADSReportLib.FullTrustReportviewer).Assembly.CodeBase, GetType(ADSReportLib.FullTrustReportviewer).FullName), ADSReportLib.FullTrustReportviewer)
' fllreport.Initialize("DisplayName", RutaReporte, Parametros.AsEnumerable(), New List(Of String()), True)
' For Each RDS As ReportDataSource In DataSource
' fllreport.AddDataSources(RDS.Name, DirectCast(RDS.Value, DataTable))
' Next
' Dim Warnings As Warning() = Nothing
' Dim StreamIds As String() = Nothing
' Dim MimeType As String = Nothing
' Dim Encoding As String = Nothing
' Dim Extension As String = Nothing
' Bytes = fllreport.Render(Formato, Nothing, MimeType, Encoding, Extension, StreamIds)
' fllreport = Nothing
'Catch ex As Microsoft.Reporting.WebForms.ScriptManagerNotFoundException
' GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
' 'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
' 'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
'Catch ex As Exception
' GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
' 'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
' 'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
'Finally
' AppDomain.Unload(_casPolicyEnabledDomain)
'End Try
'If fllreport IsNot Nothing Then fllreport.liberarecursos()
End If
sw.Stop()
If sw.Elapsed.TotalSeconds > 5 Then
GuardaLog($"Reporte:{RutaReporte} | Tiempo Renderizado Milisegundos: {sw.ElapsedMilliseconds},Total Segundos: {sw.Elapsed.TotalSeconds} ")
End If
Return Bytes
End Function
#End Region
#Region "R E P O R T E D I A R I O "
'Private Function ReporteDiario(ByVal CveEmpresa As Integer, ByVal context As HttpContext) As Boolean
' Dim Usuario As Usuario = ValidaUsuarioSistema(100, CveEmpresa)
' Dim objGenerales As ClsGenerales = New ClsGenerales()
' Dim respuesta As Boolean = True
' Dim sbTablas As StringBuilder = New StringBuilder()
' sbTablas.Append($"
Reporte Diario {DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss")}
")
' If objGenerales.GetReporteDiario(CveEmpresa) Then
' Dim TablaActual As Integer = 1
' For Each tabla As DataTable In objGenerales.DSResultados.Tables
' sbTablas.AppendLine(ConvertDataTableToHtml(tabla))
' TablaActual += 1
' sbTablas.Append("
")
' sbTablas.Append("
")
' Next
' Else
' respuesta = False
' End If
' objGenerales.Dispose()
' 'MandaCorreoDiario
' Dim Correos As String = "hdiaz@grupodiaz.com.mx;libarra@grupodiaz.com.mx;jguerrero@grupodiaz.com.mx;contabilidad@grupodiaz.com.mx;cnazarit@yahoo.com;julian@adsistemas.mx;rene.molina@adssistemas.mx"
' ' Dim Correos As String = " rene.molina@adssistemas.mx"
' MandaCorreoDiario(sbTablas.ToString(), Correos, respuesta)
' Return respuesta
'End Function
'Private Function ConvertDataTableToHtml(ByVal table As DataTable) As String
' Dim html As StringBuilder = New StringBuilder()
' Dim ColumnaTitulo As String = "Titulo"
' html.Append("")
' If table.Columns(0).ColumnName = ColumnaTitulo AndAlso table.Rows.Count > 0 Then html.AppendFormat(" {0}", table.Rows(0)(ColumnaTitulo))
' html.Append("")
' For Each column As DataColumn In table.Columns
' If ColumnaTitulo <> column.ColumnName Then html.Append($"| {column.ColumnName} | ")
' Next
' html.Append("
")
' html.Append("")
' Dim numericValue As Decimal = Nothing
' For Each row As DataRow In table.Rows
' html.Append("")
' For Each column As DataColumn In table.Columns
' If ColumnaTitulo <> column.ColumnName Then
' Dim value As Object = row(column)
' Dim cellValue As String
' If column.DataType = GetType(Integer) OrElse column.DataType = GetType(Decimal) OrElse column.DataType = GetType(Double) OrElse column.DataType = GetType(Single) Then
' If value IsNot DBNull.Value AndAlso Decimal.TryParse(value.ToString(), numericValue) Then
' If numericValue <> 0 Then
' cellValue = numericValue.ToString("N2")
' Else
' cellValue = ""
' End If
' Else
' cellValue = ""
' End If
' html.Append($"| {cellValue} | ")
' Else
' cellValue = If(value?.ToString(), String.Empty)
' html.Append($"{cellValue} | ")
' End If
' End If
' Next
' html.Append("
")
' Next
' html.Append("")
' html.Append("
")
' Return html.ToString()
'End Function
Private Function ReporteDiario(ByVal CveEmpresa As Integer, ByVal context As HttpContext) As Boolean
Dim Usuario As Usuario = ValidaUsuarioSistema(100, CveEmpresa)
Dim objGenerales As ClsGenerales = New ClsGenerales()
Dim respuesta As Boolean = True
Dim sbTablas As StringBuilder = New StringBuilder()
'sbTablas.Append($"Reporte Diario {DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss")}
")
Dim LogoBase64emp As String = "/9j/4AAQSkZJRgABAQEAlgCWAAD/4RBoRXhpZgAATU0AKgAAAAgABQEaAAUAAAABAAAASgEbAAUAAAABAAAAUgEoAAMAAAABAAMAAAExAAIAAAANAAAAWgEyAAIAAAAUAAAAaAAAAHwAAASdAAAAFAAABJ0AAAAUR0lNUCAyLjEwLjEyAAAyMDI1OjAyOjI4IDE3OjE2OjE0AAAIAQAABAAAAAEAAAEAAQEABAAAAAEAAABjAQIAAwAAAAMAAADiAQMAAwAAAAEABgAAAQYAAwAAAAEABgAAARUAAwAAAAEAAwAAAgEABAAAAAEAAADoAgIABAAAAAEAAA94AAAAAAAIAAgACP/Y/+AAEEpGSUYAAQEAAAEAAQAA/9sAQwAIBgYHBgUIBwcHCQkICgwUDQwLCwwZEhMPFB0aHx4dGhwcICQuJyAiLCMcHCg3KSwwMTQ0NB8nOT04MjwuMzQy/9sAQwEJCQkMCwwYDQ0YMiEcITIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIy/8AAEQgAYwEAAwEiAAIRAQMRAf/EAB8AAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKC//EALUQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+v/EAB8BAAMBAQEBAQEBAQEAAAAAAAABAgMEBQYHCAkKC//EALURAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/aAAwDAQACEQMRAD8A9/ooooAKKKKACua13Xdu60tH56SSDt7Cn+INYeH/AEO3ypZQWk9j6f41ybusaF3ICjkk0AdNoHiLzJRp98/73OIpT/H6A+/8/r16ivGJNRWa5Py7U6Ke/wCNd94Y8RNd7bC8YmYD93Kf4wOx9/fv9eoB1NFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABXHeJvE2N9hYPz0llU/wDjo/xqXxVrskMCW1k42TA7p0bPQ4Kj39a4ZmVFLMQFHUmuLEV7e5E9DC4ZP35lu2vGBaKeU+XGmU3fwjPI/M/rWZf37XT7VyIh0Hr7ms+fUDLNwv7ocAd/rTwQQGByD0NaYeppyvczxVK0ueOwVcs7sxOquflB4PpVOrdtbII/tNzxCOg7ufQV0nGei+HfEfmMthfSfvOkUpP3x2B9/fvXVV4mt+XmJcBVP3cfw16F4X8Qm5UWV5IPMUfu5GP3x0wffn8aAOqooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACuM8TeJs77CwfjpLKp6+w/xq/4xv7uzsIo7f5UmJV5AeR7D68/lXnrusaF3ICjqTXHiazXuRO/CYdNe0kNkl8o/O5EXJwTwD6/kP0rGvb1rltq5EY6D19zTrnUHml+XiMdFPf61XkjBXzI/u9x6VyJW3O2TvsRVLDMYjg8qeoqKu08GeDG1V01DUEK2KnKIeDMf/if51rCLk7IxnNRV5FeXQxaWcGpyyB7CZVaMj7zEjO0j1HP5Vl3Ny9zJubAUcKo6KK9suLG2u7JrOaFGt2Xb5eMADtj0xXlPiPw3PoN1kZktJD+6lx/463v/AD/l6SPKe5h1cs7vynVJD8nTPpVOr8UaWMYnnUNMeY4z29zQI9B8OeIzKy6ffv8AvgdscpP3/Y+/v3+vXqq8ShvWaQ+c2dxzu9K9I8Ka3LqET2ly26WJQVcnll6c+44596AOlrItdeguvEV3pS4zAgIYfxN/EPwyo/Or19ci1ti4K+YxEcQY8M7HCj8zXH+Ire40W60zWljQG2YQylZNzSA55OVHJ+bJ96ANnxTrN5olvbz2wgdZJPLKyoT2JzkMPSlvtcudDu7ZNTWGW1uG2i4hUp5Z/wBpSTx759eOKy/Hk8U+iafNG4aOSdXVgeo2nmpPGgOqrY6TZgS3LzeYQpyEUAjLeg5/Q0AdXPKsEEkz52xqWOOuAM1i2WrXuo6QdQtGtJTgk24Vty/7JbPUfQZ9utbF1KLazmmK7xHGzEeuBmuL1PRYbC2/t/w9eNDnawiU5V8kcD8/unP4UAbOuazf6bq+m2kH2Yx3snl5kjYlOVGeGGfvfpViXV3bXv7Jjmt4ZUiDlpUJ8xj2Ubh069T+maxvEzs2veGDIAshmBZc9DuSr2q6ZpniO/uLSZjDf2m0JIh+YqVBBx3GSf8A62aANIy6q0ZjSO3SYT7PMZWZDHtzuxkHrxjPXjPesq11fV7nxHeaR5tiv2ePf5v2dzu+7xjzOPvevap/CjX6213a3sxuFtpzFFOed4HXnvj/AOt2qhpRB+I+r4P/ACwH/tOgCzrWt6ppS6YNtp5t0RHKrRsQjcZI+YZGTWpE+ppfRpLLaTwElZDHCyMjbcjqxGP/AK1YHjrb5+jBm2j7QcnOMDK1uWpttLlNqLjzZLq4LRq0m5yNoJyeuBg/pQBmv4hvrLxPFp17Hbmzmfy45kRlO7AwOp7kD8c1L4q1+60S3je0jhkbcPM80EgA524wR12t+VVvE2nDUtGv5YSDPaTmVSpGRhV3DP05+oFZ/ikTt4Mtri8AW6uJ45JAMjB2EAYPTgD8c0AdtbtIbaNpmQuVBYqu0fkSf51naHrsOtrdmMBTBMUxzyv8Le2eePapLuXfaW9nGUaS5UDazYygGW6c9OM+4rm5Wk8PeN4rmVY4rXUgVcI+VDcc9B3wc/7RoA3ZNXaTX5NKhmggkjjDZmQsZCecKAw6DH1z7Vo2cly6yi6jRHSQqCmcMMDB59c/h0561h6tpOmeIr64t3cwaha7QJEPzFSoIJHcZJ/KpfCkl+bK5t72Xz/s87RRzk53ge/fn/PFAG/RRRQBleI7E3+iXEaqWkQeYgAycjsB6kZH414ne3jXL7RlY1PC/wCNfQNcF418FfbPM1TS48XP3poFH+s/2l/2vUd/r15q9Lm95HXh63KuR7HmFPjkMbZH4j1phBBweDVq3t0CfaLjiIdB3c1xs70W7CG1S9trq5haW03bnhzgnHavbrC6tbyxims2VoCvy7RgD2x2x6V4JJeSSTB+ijhUHQCum8K+IpNKvkIcm0lYCaPrj3HvW1GpyOz2ZhiKXtFdbo9ZubmK0gaaZgqL+vtXCaxfvrEjCUYg6LH6e/1qfWtQa/u8rKGtwAYwO3rn37VhXt6lpH2aQ/dX+prvPMM5oItOkeR/3jg/ulI4+prPlleaQySNlj3qQXTvIxmJdX+8D/SmSxeXhlO5D0agCOt/wnqMlpr1ouGZZG8vAGTg8f8A1/wrEggluZ0hhRpJXOFVRyTXqfhfwvFokAnnCyXzj5m7IPQf40AaWoXSRSrHJplxdjbuDRxK4HtyevFV5NTSVVWTQ79wvQNApx/49WpcTeTFkEB2O1M92PSudXxHNBpkHmCJ7uMzQ3AZv44kZs9vvbR/31UtPuWpR7Fw30BAB0C8IHQfZ04/Wnx6qIhiPRdQQeiwqP8A2aqN/rTia7WOQJst2ZGV+FZSh6dyd4/Ae5qVNbkVpUPKGW4QSZDbSmSPTAwDzz70uWXcOaPYttrDMpVtH1EqRggxLg/+PVH/AGhF53nf2De+b/f+zpu/PNO0bU5r1UjkQg/ZopVc/Nu3IpOSO+SeMDsR14sW93NcWE8syCFo96MORhlJBIPp0waOWXcOaPYqvqEUjFpNBvXY92t0J/nQ+oRSLtfQb1lznBt0IzjHr6CqNrrV1HBbzlvPgNjA8znGI5WYAkn6EsR229s1cbW5kd0lihQiOMqQ25SWKA8j3fgHGeDnBODll3Dmj2Jl1cogRNG1FVAwFEKgD/x6olv4VcOugXoYHIIt0z/Oo49fmlt5ZlihAishdOCxzkh/l/NR+dTHV51mt43gQiURN8hPzB2IO0/7IGT7HtRyy7hzR7CSajHK26TQr529Wt0J/nQmoRRuHTQb1WHQrboD/Os+x1u5CqzyiXdbW7MzH5UYrIWY49doH1Iq5rOrzQaQkkaG3kntpJQz9Y2Cbgv+9k/oaOWXcOaPYlTU0iz5eh36buu2BRn/AMeok1JJiDLod85HTdAh/wDZqsWOovd3txBsUJCdpO4bs4BBx6HJ59u+eMuPU7qJY455N7edCvnxyApKrMRnBGVPHK9PSjll3Dmj2LY1CIMrDQb0FfukW6cfTmiTUY5W3SaFfO3q1uhP86rjX7nEchhXAgmkeIDJZkCkKrZII+Y8jOQPwp76/KlxDHtt2Dqj7lfIIaYRgjB9DnvjGPejll3Dmj2JHv4pF2voN6y+jW6EdMevpVi31QtJHCulX0SkhQWiUKo/A9KpQeImlNn8kP77hwGPHLrn6ZT369uM6mmXj31ks0ibHyVZfQjr3II9wadn3Dmj2LlFFFUQFFFFAHF+KvBVteyS6paIwuFUs8CDiY+vscZ+teW3M8k0p3jbt4Cf3favoauF8a+Cxfq+p6ZHi6HMsKj/AFvuP9r+f1681ajf3onXQr29yR5bT45GjcMv5etMIIOCMGtq0tE0+Nbm6XM55iiPb3Nc0IObsjqqVFTV2an2x7e0Ejxt5jKG2nsfesaWV5pDJI2WPU083MpmMrNuY9c9/aiSNSvmxfd7j+7XorRHlt3dyGren7pLuKDyGuFkcAwjq3sKghhluZ0hhRpJHO1VUZJNep+F/C8WiQiecLJfOPmbqIx6D+ppiJdA8LWmhPLKrGadiQsjjlV7Af1Nb1FFABRRRQAUUUUAGM0yKJIYljQEKowMkk/meTT6KACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAOR8R+EraWWbWLG2L3wG4wg/K57tj+9/P6815tLJJLKzyklyec17vXGeLfCQvQ+oaemLkcyxD/lp7j3/nSSS2G5N7nnFTWiTSXKRW6GSRztCAZ3e1NiglnuFgijZ5WbaqAck+lep+F/C8WiQCecLJfOPmbqEH90f1NMRY0Tw5ZaVI12kGy5lUFgTuEWRyq+2c1t0UUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQBmW+mWUOuXN5HbItw0akuB3JbJ9s4FadFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFAH//2f/iArBJQ0NfUFJPRklMRQABAQAAAqBsY21zBDAAAG1udHJSR0IgWFlaIAfpAAMAAQAAAAwAImFjc3BNU0ZUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD21gABAAAAANMtbGNtcwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADWRlc2MAAAEgAAAAQGNwcnQAAAFgAAAANnd0cHQAAAGYAAAAFGNoYWQAAAGsAAAALHJYWVoAAAHYAAAAFGJYWVoAAAHsAAAAFGdYWVoAAAIAAAAAFHJUUkMAAAIUAAAAIGdUUkMAAAIUAAAAIGJUUkMAAAIUAAAAIGNocm0AAAI0AAAAJGRtbmQAAAJYAAAAJGRtZGQAAAJ8AAAAJG1sdWMAAAAAAAAAAQAAAAxlblVTAAAAJAAAABwARwBJAE0AUAAgAGIAdQBpAGwAdAAtAGkAbgAgAHMAUgBHAEJtbHVjAAAAAAAAAAEAAAAMZW5VUwAAABoAAAAcAFAAdQBiAGwAaQBjACAARABvAG0AYQBpAG4AAFhZWiAAAAAAAAD21gABAAAAANMtc2YzMgAAAAAAAQxCAAAF3v//8yUAAAeTAAD9kP//+6H///2iAAAD3AAAwG5YWVogAAAAAAAAb6AAADj1AAADkFhZWiAAAAAAAAAknwAAD4QAALbEWFlaIAAAAAAAAGKXAAC3hwAAGNlwYXJhAAAAAAADAAAAAmZmAADypwAADVkAABPQAAAKW2Nocm0AAAAAAAMAAAAAo9cAAFR8AABMzQAAmZoAACZnAAAPXG1sdWMAAAAAAAAAAQAAAAxlblVTAAAACAAAABwARwBJAE0AUG1sdWMAAAAAAAAAAQAAAAxlblVTAAAACAAAABwAcwBSAEcAQv/bAEMAAwICAwICAwMDAwQDAwQFCAUFBAQFCgcHBggMCgwMCwoLCw0OEhANDhEOCwsQFhARExQVFRUMDxcYFhQYEhQVFP/bAEMBAwQEBQQFCQUFCRQNCw0UFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFP/AABEIAFIA0gMBIgACEQEDEQH/xAAfAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJCgv/xAC1EAACAQMDAgQDBQUEBAAAAX0BAgMABBEFEiExQQYTUWEHInEUMoGRoQgjQrHBFVLR8CQzYnKCCQoWFxgZGiUmJygpKjQ1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4eLj5OXm5+jp6vHy8/T19vf4+fr/xAAfAQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgv/xAC1EQACAQIEBAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZGiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4+fr/2gAMAwEAAhEDEQA/AP1TooooAKRmCqWYgKBkk9qR3WNGd2CqoyWY4AHrXgvxK+M1j4kjn0XQr1gschWdgMeegHVD3XPB9eO1RKpGLUZPV7Gkac5xcoq6W5P8UvivJqM0mlaLO0VohxLdRsQ0jDsp7AevetT4O/GIa4x0DXrhU1aI7YLh+PtC9gf9r+dfPXibxND4ete0l04/dxf1PtXn2neKrhL5prqVnLvv8wHlD6j2qzM/SeivHvgv8aIPFFjZ6Tq02NWA2JcN92fA+Xn+8R+eDXsNABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUjMFUknAHJJpHdY0Z3YKqjJZjgAetfN/xe/aCuZtQXT/Ctx5dvbPuluyoInYfw4PVPX1rkxOKp4WPNNnbhMHVxk+SmvmV/jh8b31qS48P6DNt05fkuLuM8znuqn+7/P6V8/ah4ii8P3ltMJFFzkhUboQQRz7ZxVfXvFMGm2pmCKLiXJS3U/d/+sK8zvLya/uHnncySMckmvjJVqtat7eT1Wx9/GhRw9D6vBaPf/gnY397PqF09xcOZJXOSx/p7VXrJ0fVAzJbXDhVJAWVv4fr7V6FeeCbnwhcs/iS3ktUQ5ih73PoVPdD/eFfYYXFLExvs1ufCY3BvCTtvF7DvDN3caPp7XdzObW3JX7MckOXByCvfA9a+svgj8ak8UwR6PrVyg1RQBBcMQBcr6f7386+K9U1SbVrozS8Doka/dRewFX/AA54il0a6ibeyiNw6Op5jYHII/Gu484/SuivIfg78aofFnk6Pq0ipquzMNxn5blcZH0bH5169QAUVS1rWLbw/pF5qV4/l2tpE00jf7KjJ/Gqul+JrXXPC9vrthm5tLi2FzGAQCVIzj2I6fUUAa9FeZ6f8eNHvPC0PiSawvrTQnuDbNeMqsImB25dQcgZ716BcaxaW+kSao06tYJAbgzIcqY9u7cPUY5oAuUVzOl+NP7Si0qcabcJaapg204ZWXBUsC2D8uQKzNL+LGnaheeKYZbWe0Tw3n7dNIVKjAY/Lg88KaAO5ormrbxp5kdjLLptxFb3sTSwzKyuu0Jvw2DwSOlYEnxiig8TaL4fm0O+h1TVrY3VtC7Rj5AGOGOeDhDxQB6JRXA6p8W7bSbjw9bT6TeLc63K8EELFAUkVtrK/PHNbDeMpIrfWHm0m6ik02NZWj3I3nKc8oQcH7pH1FAHTUVx3gX4p6N488L3muWpktbayeRLmO5ADxbBuJIHbHNP+HfxGtfiRZ311ZWVzaRWlw1rILraG8xQCRgE+tAHXUViaX4w03WPEer6JazeZfaWI/tC9hvGQB9BjP1qmfHMNxq2r2FhZzahJpIX7X5LKCrMpYKqk5Y4FAHT0VV0vUE1XTbS9jVkjuIlmVXGGAYAgH35q1QAUUUUAeDftMeN9Z0ZbTQ7QfZtPvoS8twh+aXBwY/YdM+ua+VvEXiGLQ7bPD3D/cj/AKn2r7P/AGjPBd74s+H8s2lWn2zVtOf7RBCv3pFwQ6j8MHHfaK/OTULi4uryWS6LGfcQ27gg+mO1fHZlRn9YcpvTofeZVXp/VFGmrS6/5luS4GtMxlwt4eVboH9vrWcytGxVgVYcEGkBIORwa6TTrWO6t7W8vkUMsoCeZ0uAOxHcds1wfCej8Xqevfs1/s2XHxGvI/EHiGB7fwxC2Y4myrXrDsP9gdz36Dvj6q+LfwR0j4meH4bZETT9RsotljcRrhYwBxGQP4OB9O1S/Bn4o6J8RPDcMenxxafeWcSpNpqYHlADAKDunp6U74nfE6PwnC9hYlZdWkXr1EAPc+/oK+ywdKnTpp03e/U+Dx1arUqtVVa3TsfBniHw/feFtZutL1KBre9tnKSIfUdwe4PrU2i6Ml4r3d5J9n0+Hl5O7n+6vqa9I8cWNprEJvNRk/fiQEzs3ztk8jPvXm3iHUZbq6EHk/ZbaD5Yrdeij19yfWu4840bLxe8OqRvGPscEZUQGI4aLHQ59fevs74EfEy48faJPb6gyyajY7Q0y/8ALVD0Yj14NfBVe9/siy63/wAJ4/2S2efSBA8d3MThYgRlfqdwHHpmgD6a8ceX4iuIfDKQ218biNp7y1uJzEDCMKASFY5LMCOP4T6V518DdQn8L6d4r8BapIq3GivI9s2/KvA4LfKxAzgnPT+KvUL688QQ6hI1voemSpuKxzyX5R3HbI8o4OO2TVSa88Q28ck83h3Ro0UFnkfUiAB3JJhrL2i7P7mb+xk+q+9f5ngnh24Wb9lrUNGija61a+vJIbeyiUtKzGZWGFHPQZzXufhvSG8J/Buy07XIvtBstJ8u7hBzkCP5kyOuBkcelS2msa60xW10PQzLg5WHVPm4OD0h7Hj61Zj1nxRdRFo9E0qaMkqSuqswyCQR/qexBH4Uvax7P7n/AJB7GXdfev8AM8v8N+GdQ+G3i7w7H4V1+TWvCeqzlZNJuG8w2ilS3mIf4QPw985pnguewj8S/Gl9Ri+0ae82ZYx/y0j2OGx68Z6V6ZNqmv6ZmebQdFtA5CmV9UKbiegyYeadb3niKSMSweHdGZJBkSR6kSGB9xDyKPax7P7n/kHsZd196/zPOvCPhvVPht448P6f4f1+TX/CGptJusLhvMayUIWDq38K5wO3Xvml8dMP+GpfAcmfkSwlV27KSs+AT2PI/OvSIrnxPC7PH4b0mN2+8y6iwJ+v7mka48TPJ5jeGtJZ+u46ic/n5NHtY9n9z/yD2Mu6+9f5nn3x42t8QvhoPtBtgt+5aZcZiB2fNzwPxrrLXVrGy8M6jon9pLqdzYWjSXV4XB+/I2zcRxuI3Ejtj3FXo9Y13VHJj0PQ7tlAJ26pvIBzj/lj04P5GnNf+ILdkhbw9osbTnCxnUiDIQCcAeTzgZNHtY9n9z/yD2Mu6+9f5nAaH4FvfD3xg1W1skA8I67bx6rcH+BZEbmMduWIJ7bSRUXwJ1mPQfBvjS6d0WQa7cmJZDgOzbQn4Ekc16Pca14js41E+iaPBGRtAk1UqD7cw0yK78QTRkx+HNFdMkErqJIyDgj/AFPUGj2sez+5/wCQexl3X3r/ADPKNXivPhH8VPDniK5gggsNaT7BqklvcNN5khOfPfKLg5IJ68A1peOvCdnqmta74r8K6/L4b8V6cWW4QSfursKoI3KeoYY6ZGfevS5LrxPNjzPDekvt4G7UWOP/ACDSNN4lk27vDOkNt+7nUCcfT9zR7WPZ/c/8g9jLuvvX+Zf8B6hqGreDNFvNVtvseoz2sbzwhdu1iPTt9O2a3qy9FutXuDL/AGpp9rZAY2fZ7ozbvXOUXFalaxfMroylFxdmFFFFMkK+Yf2nP2ZE8TR3XivwnZhdYUGS9sIRj7UO7oP+enqB9769fp6isa1GNaHJM6KFeeHmpwZ+Udjo4tYnvdTRooIztWFhteVv7oHp61R1LVJtUuBJJhVUbY414VF7ACvtT9qT9nGTxpC/irw2rHWIE/0nT1+7cIB95B2cen8X16/EMkbRSMjqUdThlYYIPpXyFfDzw87S+R9zhsVDFU7w+aPQfhT8Rr3wb4qsNQgm8q5hbbub7rqeCrDvx/KvZNa8TQXLXmrXR8hZJGd1ZixDE8qCeTz0r558L+F21hmvLpmttKgP72fux/ur6k112pakniJjFHm38s/uY2YkMMAc/wC1xXt5XGcYSbWj2Pns4nCdSKT95b/oQeI/Elx4gutzkpbqf3cXYe596ggmTUI1t7htsijEUx/kfaqDo0bFWG1gcEGux+GHws1j4pa4LLTU8q2jINzeSD93Cv8AU+gr2j58s/Dn4P638QPFi6QkElnDGBJdXUiHbFGeQfcnt6190+BfAuk/D3w/BpGkQeVAnzPI3Lyv3Zj3Jq14V8M2nhHQbLSrPc0VrEsQkkOXcKMZJrXoA5jxl4e1LXmspLC6jtZbCZLqEsTh5A2GVwB93YWH/AvYVzt94H8WXX9rrHr+1Ly4MkKvPIwhTdKQAO2A0fA4+SvSaKAPMLf4c+I7S6lmt9ZS2aSWaU+W7jJkn8zkAf3SQcEVs+GfC2taFcXb32pyXlm8Vxi3ikYsGeZnUpnGCFbb65A6V21FAHD3HhHVNU8H6VaT3huL+G9tbySS7ZssIpFbaeuCVUA+5J71Qtfh74gsHvFttdaC3uDPOkMEjRrBLI8rbQMHKjzF54OUHrivR6KAPO/+EL8VzX5efxC32Vnh3RwzyodilC+DngsA449Rz6WbjwXr+4NbeILiI/apXKyXEjjyz/qxyeq85HRs89BXd0UAeT2Pws8R6aj/AGLW47GV7aODzISwO5XnYOeOcecPlPBxzWz4u8Ea7rniKHULPVUt47dzLbK7P+5Y28sRwo45aQNu68Yrv6KAOJ1zwVqWq6Lp0MWovDqdrG6i7aUvy3VXBGJUxwQwBOByDzWfL4B8QzT3AbWj9kkdn+z+bIAP9JWVcYxj5Qynr298+jUUAebTeBvFstrEp8SS/aFcs0i3Miq/72NgcDplFYFeRljjrSN4I8YtJHjxIyRpbvFgTyEsx27WJPcFevXBPNelUUAQ2cckNnBHM/mTKiq7jPzMByeamoooAKKKKACiiigAr5x+P37LeneM9Qm8UaNmxvQrS39pbx5+14Gcoo6SHH4/Xr9HUVlUpQrLlmro2pVqlGXNTdmfmXq2pG48u0ii+yWVt8kVt02+59WrOr65/aJ/Z3XXo5/E3hm326muXu7GMcXA7ug/v+o7/Xr87/DX4Wa18TfEA07T4jFFEw+1XUoISBc859T1wO9aJJKyMm23dmv8KPhvJ8YtWn08SSWc9vEsjXojLR7dwBVvRiCceuK+2vAfgPSfhz4eh0jSIfLhT5pJW5eVz1dj3P8AKneBfAulfD3w/BpOkwCOGMZeQj55W7sx7k10NMQUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAVj+H9NtNPutXNraw2xmvDJIYYwm9iiZZsDk+5oooA2KKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigD/9k="
Dim LogoBase64ADS As String = "/9j/4AAQSkZJRgABAQEAlgCWAAD/4RBoRXhpZgAATU0AKgAAAAgABQEaAAUAAAABAAAASgEbAAUAAAABAAAAUgEoAAMAAAABAAMAAAExAAIAAAANAAAAWgEyAAIAAAAUAAAAaAAAAHwAAASdAAAAFAAABJ0AAAAUR0lNUCAyLjEwLjEyAAAyMDI1OjAyOjI4IDE3OjE2OjE0AAAIAQAABAAAAAEAAAEAAQEABAAAAAEAAABjAQIAAwAAAAMAAADiAQMAAwAAAAEABgAAAQYAAwAAAAEABgAAARUAAwAAAAEAAwAAAgEABAAAAAEAAADoAgIABAAAAAEAAA94AAAAAAAIAAgACP/Y/+AAEEpGSUYAAQEAAAEAAQAA/9sAQwAIBgYHBgUIBwcHCQkICgwUDQwLCwwZEhMPFB0aHx4dGhwcICQuJyAiLCMcHCg3KSwwMTQ0NB8nOT04MjwuMzQy/9sAQwEJCQkMCwwYDQ0YMiEcITIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIy/8AAEQgAYwEAAwEiAAIRAQMRAf/EAB8AAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKC//EALUQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+v/EAB8BAAMBAQEBAQEBAQEAAAAAAAABAgMEBQYHCAkKC//EALURAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/aAAwDAQACEQMRAD8A9/ooooAKKKKACua13Xdu60tH56SSDt7Cn+INYeH/AEO3ypZQWk9j6f41ybusaF3ICjkk0AdNoHiLzJRp98/73OIpT/H6A+/8/r16ivGJNRWa5Py7U6Ke/wCNd94Y8RNd7bC8YmYD93Kf4wOx9/fv9eoB1NFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABXHeJvE2N9hYPz0llU/wDjo/xqXxVrskMCW1k42TA7p0bPQ4Kj39a4ZmVFLMQFHUmuLEV7e5E9DC4ZP35lu2vGBaKeU+XGmU3fwjPI/M/rWZf37XT7VyIh0Hr7ms+fUDLNwv7ocAd/rTwQQGByD0NaYeppyvczxVK0ueOwVcs7sxOquflB4PpVOrdtbII/tNzxCOg7ufQV0nGei+HfEfmMthfSfvOkUpP3x2B9/fvXVV4mt+XmJcBVP3cfw16F4X8Qm5UWV5IPMUfu5GP3x0wffn8aAOqooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACuM8TeJs77CwfjpLKp6+w/xq/4xv7uzsIo7f5UmJV5AeR7D68/lXnrusaF3ICjqTXHiazXuRO/CYdNe0kNkl8o/O5EXJwTwD6/kP0rGvb1rltq5EY6D19zTrnUHml+XiMdFPf61XkjBXzI/u9x6VyJW3O2TvsRVLDMYjg8qeoqKu08GeDG1V01DUEK2KnKIeDMf/if51rCLk7IxnNRV5FeXQxaWcGpyyB7CZVaMj7zEjO0j1HP5Vl3Ny9zJubAUcKo6KK9suLG2u7JrOaFGt2Xb5eMADtj0xXlPiPw3PoN1kZktJD+6lx/463v/AD/l6SPKe5h1cs7vynVJD8nTPpVOr8UaWMYnnUNMeY4z29zQI9B8OeIzKy6ffv8AvgdscpP3/Y+/v3+vXqq8ShvWaQ+c2dxzu9K9I8Ka3LqET2ly26WJQVcnll6c+44596AOlrItdeguvEV3pS4zAgIYfxN/EPwyo/Or19ci1ti4K+YxEcQY8M7HCj8zXH+Ire40W60zWljQG2YQylZNzSA55OVHJ+bJ96ANnxTrN5olvbz2wgdZJPLKyoT2JzkMPSlvtcudDu7ZNTWGW1uG2i4hUp5Z/wBpSTx759eOKy/Hk8U+iafNG4aOSdXVgeo2nmpPGgOqrY6TZgS3LzeYQpyEUAjLeg5/Q0AdXPKsEEkz52xqWOOuAM1i2WrXuo6QdQtGtJTgk24Vty/7JbPUfQZ9utbF1KLazmmK7xHGzEeuBmuL1PRYbC2/t/w9eNDnawiU5V8kcD8/unP4UAbOuazf6bq+m2kH2Yx3snl5kjYlOVGeGGfvfpViXV3bXv7Jjmt4ZUiDlpUJ8xj2Ubh069T+maxvEzs2veGDIAshmBZc9DuSr2q6ZpniO/uLSZjDf2m0JIh+YqVBBx3GSf8A62aANIy6q0ZjSO3SYT7PMZWZDHtzuxkHrxjPXjPesq11fV7nxHeaR5tiv2ePf5v2dzu+7xjzOPvevap/CjX6213a3sxuFtpzFFOed4HXnvj/AOt2qhpRB+I+r4P/ACwH/tOgCzrWt6ppS6YNtp5t0RHKrRsQjcZI+YZGTWpE+ppfRpLLaTwElZDHCyMjbcjqxGP/AK1YHjrb5+jBm2j7QcnOMDK1uWpttLlNqLjzZLq4LRq0m5yNoJyeuBg/pQBmv4hvrLxPFp17Hbmzmfy45kRlO7AwOp7kD8c1L4q1+60S3je0jhkbcPM80EgA524wR12t+VVvE2nDUtGv5YSDPaTmVSpGRhV3DP05+oFZ/ikTt4Mtri8AW6uJ45JAMjB2EAYPTgD8c0AdtbtIbaNpmQuVBYqu0fkSf51naHrsOtrdmMBTBMUxzyv8Le2eePapLuXfaW9nGUaS5UDazYygGW6c9OM+4rm5Wk8PeN4rmVY4rXUgVcI+VDcc9B3wc/7RoA3ZNXaTX5NKhmggkjjDZmQsZCecKAw6DH1z7Vo2cly6yi6jRHSQqCmcMMDB59c/h0561h6tpOmeIr64t3cwaha7QJEPzFSoIJHcZJ/KpfCkl+bK5t72Xz/s87RRzk53ge/fn/PFAG/RRRQBleI7E3+iXEaqWkQeYgAycjsB6kZH414ne3jXL7RlY1PC/wCNfQNcF418FfbPM1TS48XP3poFH+s/2l/2vUd/r15q9Lm95HXh63KuR7HmFPjkMbZH4j1phBBweDVq3t0CfaLjiIdB3c1xs70W7CG1S9trq5haW03bnhzgnHavbrC6tbyxims2VoCvy7RgD2x2x6V4JJeSSTB+ijhUHQCum8K+IpNKvkIcm0lYCaPrj3HvW1GpyOz2ZhiKXtFdbo9ZubmK0gaaZgqL+vtXCaxfvrEjCUYg6LH6e/1qfWtQa/u8rKGtwAYwO3rn37VhXt6lpH2aQ/dX+prvPMM5oItOkeR/3jg/ulI4+prPlleaQySNlj3qQXTvIxmJdX+8D/SmSxeXhlO5D0agCOt/wnqMlpr1ouGZZG8vAGTg8f8A1/wrEggluZ0hhRpJXOFVRyTXqfhfwvFokAnnCyXzj5m7IPQf40AaWoXSRSrHJplxdjbuDRxK4HtyevFV5NTSVVWTQ79wvQNApx/49WpcTeTFkEB2O1M92PSudXxHNBpkHmCJ7uMzQ3AZv44kZs9vvbR/31UtPuWpR7Fw30BAB0C8IHQfZ04/Wnx6qIhiPRdQQeiwqP8A2aqN/rTia7WOQJst2ZGV+FZSh6dyd4/Ae5qVNbkVpUPKGW4QSZDbSmSPTAwDzz70uWXcOaPYttrDMpVtH1EqRggxLg/+PVH/AGhF53nf2De+b/f+zpu/PNO0bU5r1UjkQg/ZopVc/Nu3IpOSO+SeMDsR14sW93NcWE8syCFo96MORhlJBIPp0waOWXcOaPYqvqEUjFpNBvXY92t0J/nQ+oRSLtfQb1lznBt0IzjHr6CqNrrV1HBbzlvPgNjA8znGI5WYAkn6EsR229s1cbW5kd0lihQiOMqQ25SWKA8j3fgHGeDnBODll3Dmj2Jl1cogRNG1FVAwFEKgD/x6olv4VcOugXoYHIIt0z/Oo49fmlt5ZlihAishdOCxzkh/l/NR+dTHV51mt43gQiURN8hPzB2IO0/7IGT7HtRyy7hzR7CSajHK26TQr529Wt0J/nQmoRRuHTQb1WHQrboD/Os+x1u5CqzyiXdbW7MzH5UYrIWY49doH1Iq5rOrzQaQkkaG3kntpJQz9Y2Cbgv+9k/oaOWXcOaPYlTU0iz5eh36buu2BRn/AMeok1JJiDLod85HTdAh/wDZqsWOovd3txBsUJCdpO4bs4BBx6HJ59u+eMuPU7qJY455N7edCvnxyApKrMRnBGVPHK9PSjll3Dmj2LY1CIMrDQb0FfukW6cfTmiTUY5W3SaFfO3q1uhP86rjX7nEchhXAgmkeIDJZkCkKrZII+Y8jOQPwp76/KlxDHtt2Dqj7lfIIaYRgjB9DnvjGPejll3Dmj2JHv4pF2voN6y+jW6EdMevpVi31QtJHCulX0SkhQWiUKo/A9KpQeImlNn8kP77hwGPHLrn6ZT369uM6mmXj31ks0ibHyVZfQjr3II9wadn3Dmj2LlFFFUQFFFFAHF+KvBVteyS6paIwuFUs8CDiY+vscZ+teW3M8k0p3jbt4Cf3favoauF8a+Cxfq+p6ZHi6HMsKj/AFvuP9r+f1681ajf3onXQr29yR5bT45GjcMv5etMIIOCMGtq0tE0+Nbm6XM55iiPb3Nc0IObsjqqVFTV2an2x7e0Ejxt5jKG2nsfesaWV5pDJI2WPU083MpmMrNuY9c9/aiSNSvmxfd7j+7XorRHlt3dyGren7pLuKDyGuFkcAwjq3sKghhluZ0hhRpJHO1VUZJNep+F/C8WiQiecLJfOPmbqIx6D+ppiJdA8LWmhPLKrGadiQsjjlV7Af1Nb1FFABRRRQAUUUUAGM0yKJIYljQEKowMkk/meTT6KACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAOR8R+EraWWbWLG2L3wG4wg/K57tj+9/P6815tLJJLKzyklyec17vXGeLfCQvQ+oaemLkcyxD/lp7j3/nSSS2G5N7nnFTWiTSXKRW6GSRztCAZ3e1NiglnuFgijZ5WbaqAck+lep+F/C8WiQCecLJfOPmbqEH90f1NMRY0Tw5ZaVI12kGy5lUFgTuEWRyq+2c1t0UUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQBmW+mWUOuXN5HbItw0akuB3JbJ9s4FadFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFAH//2f/iArBJQ0NfUFJPRklMRQABAQAAAqBsY21zBDAAAG1udHJSR0IgWFlaIAfpAAMAAQAAAAwAImFjc3BNU0ZUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD21gABAAAAANMtbGNtcwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADWRlc2MAAAEgAAAAQGNwcnQAAAFgAAAANnd0cHQAAAGYAAAAFGNoYWQAAAGsAAAALHJYWVoAAAHYAAAAFGJYWVoAAAHsAAAAFGdYWVoAAAIAAAAAFHJUUkMAAAIUAAAAIGdUUkMAAAIUAAAAIGJUUkMAAAIUAAAAIGNocm0AAAI0AAAAJGRtbmQAAAJYAAAAJGRtZGQAAAJ8AAAAJG1sdWMAAAAAAAAAAQAAAAxlblVTAAAAJAAAABwARwBJAE0AUAAgAGIAdQBpAGwAdAAtAGkAbgAgAHMAUgBHAEJtbHVjAAAAAAAAAAEAAAAMZW5VUwAAABoAAAAcAFAAdQBiAGwAaQBjACAARABvAG0AYQBpAG4AAFhZWiAAAAAAAAD21gABAAAAANMtc2YzMgAAAAAAAQxCAAAF3v//8yUAAAeTAAD9kP//+6H///2iAAAD3AAAwG5YWVogAAAAAAAAb6AAADj1AAADkFhZWiAAAAAAAAAknwAAD4QAALbEWFlaIAAAAAAAAGKXAAC3hwAAGNlwYXJhAAAAAAADAAAAAmZmAADypwAADVkAABPQAAAKW2Nocm0AAAAAAAMAAAAAo9cAAFR8AABMzQAAmZoAACZnAAAPXG1sdWMAAAAAAAAAAQAAAAxlblVTAAAACAAAABwARwBJAE0AUG1sdWMAAAAAAAAAAQAAAAxlblVTAAAACAAAABwAcwBSAEcAQv/bAEMAAwICAwICAwMDAwQDAwQFCAUFBAQFCgcHBggMCgwMCwoLCw0OEhANDhEOCwsQFhARExQVFRUMDxcYFhQYEhQVFP/bAEMBAwQEBQQFCQUFCRQNCw0UFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFP/AABEIAFIA0gMBIgACEQEDEQH/xAAfAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJCgv/xAC1EAACAQMDAgQDBQUEBAAAAX0BAgMABBEFEiExQQYTUWEHInEUMoGRoQgjQrHBFVLR8CQzYnKCCQoWFxgZGiUmJygpKjQ1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4eLj5OXm5+jp6vHy8/T19vf4+fr/xAAfAQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgv/xAC1EQACAQIEBAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZGiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4+fr/2gAMAwEAAhEDEQA/AP1TooooAKRmCqWYgKBkk9qR3WNGd2CqoyWY4AHrXgvxK+M1j4kjn0XQr1gschWdgMeegHVD3XPB9eO1RKpGLUZPV7Gkac5xcoq6W5P8UvivJqM0mlaLO0VohxLdRsQ0jDsp7AevetT4O/GIa4x0DXrhU1aI7YLh+PtC9gf9r+dfPXibxND4ete0l04/dxf1PtXn2neKrhL5prqVnLvv8wHlD6j2qzM/SeivHvgv8aIPFFjZ6Tq02NWA2JcN92fA+Xn+8R+eDXsNABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUjMFUknAHJJpHdY0Z3YKqjJZjgAetfN/xe/aCuZtQXT/Ctx5dvbPuluyoInYfw4PVPX1rkxOKp4WPNNnbhMHVxk+SmvmV/jh8b31qS48P6DNt05fkuLuM8znuqn+7/P6V8/ah4ii8P3ltMJFFzkhUboQQRz7ZxVfXvFMGm2pmCKLiXJS3U/d/+sK8zvLya/uHnncySMckmvjJVqtat7eT1Wx9/GhRw9D6vBaPf/gnY397PqF09xcOZJXOSx/p7VXrJ0fVAzJbXDhVJAWVv4fr7V6FeeCbnwhcs/iS3ktUQ5ih73PoVPdD/eFfYYXFLExvs1ufCY3BvCTtvF7DvDN3caPp7XdzObW3JX7MckOXByCvfA9a+svgj8ak8UwR6PrVyg1RQBBcMQBcr6f7386+K9U1SbVrozS8Doka/dRewFX/AA54il0a6ibeyiNw6Op5jYHII/Gu484/SuivIfg78aofFnk6Pq0ipquzMNxn5blcZH0bH5169QAUVS1rWLbw/pF5qV4/l2tpE00jf7KjJ/Gqul+JrXXPC9vrthm5tLi2FzGAQCVIzj2I6fUUAa9FeZ6f8eNHvPC0PiSawvrTQnuDbNeMqsImB25dQcgZ716BcaxaW+kSao06tYJAbgzIcqY9u7cPUY5oAuUVzOl+NP7Si0qcabcJaapg204ZWXBUsC2D8uQKzNL+LGnaheeKYZbWe0Tw3n7dNIVKjAY/Lg88KaAO5ormrbxp5kdjLLptxFb3sTSwzKyuu0Jvw2DwSOlYEnxiig8TaL4fm0O+h1TVrY3VtC7Rj5AGOGOeDhDxQB6JRXA6p8W7bSbjw9bT6TeLc63K8EELFAUkVtrK/PHNbDeMpIrfWHm0m6ik02NZWj3I3nKc8oQcH7pH1FAHTUVx3gX4p6N488L3muWpktbayeRLmO5ADxbBuJIHbHNP+HfxGtfiRZ311ZWVzaRWlw1rILraG8xQCRgE+tAHXUViaX4w03WPEer6JazeZfaWI/tC9hvGQB9BjP1qmfHMNxq2r2FhZzahJpIX7X5LKCrMpYKqk5Y4FAHT0VV0vUE1XTbS9jVkjuIlmVXGGAYAgH35q1QAUUUUAeDftMeN9Z0ZbTQ7QfZtPvoS8twh+aXBwY/YdM+ua+VvEXiGLQ7bPD3D/cj/AKn2r7P/AGjPBd74s+H8s2lWn2zVtOf7RBCv3pFwQ6j8MHHfaK/OTULi4uryWS6LGfcQ27gg+mO1fHZlRn9YcpvTofeZVXp/VFGmrS6/5luS4GtMxlwt4eVboH9vrWcytGxVgVYcEGkBIORwa6TTrWO6t7W8vkUMsoCeZ0uAOxHcds1wfCej8Xqevfs1/s2XHxGvI/EHiGB7fwxC2Y4myrXrDsP9gdz36Dvj6q+LfwR0j4meH4bZETT9RsotljcRrhYwBxGQP4OB9O1S/Bn4o6J8RPDcMenxxafeWcSpNpqYHlADAKDunp6U74nfE6PwnC9hYlZdWkXr1EAPc+/oK+ywdKnTpp03e/U+Dx1arUqtVVa3TsfBniHw/feFtZutL1KBre9tnKSIfUdwe4PrU2i6Ml4r3d5J9n0+Hl5O7n+6vqa9I8cWNprEJvNRk/fiQEzs3ztk8jPvXm3iHUZbq6EHk/ZbaD5Yrdeij19yfWu4840bLxe8OqRvGPscEZUQGI4aLHQ59fevs74EfEy48faJPb6gyyajY7Q0y/8ALVD0Yj14NfBVe9/siy63/wAJ4/2S2efSBA8d3MThYgRlfqdwHHpmgD6a8ceX4iuIfDKQ218biNp7y1uJzEDCMKASFY5LMCOP4T6V518DdQn8L6d4r8BapIq3GivI9s2/KvA4LfKxAzgnPT+KvUL688QQ6hI1voemSpuKxzyX5R3HbI8o4OO2TVSa88Q28ck83h3Ro0UFnkfUiAB3JJhrL2i7P7mb+xk+q+9f5ngnh24Wb9lrUNGija61a+vJIbeyiUtKzGZWGFHPQZzXufhvSG8J/Buy07XIvtBstJ8u7hBzkCP5kyOuBkcelS2msa60xW10PQzLg5WHVPm4OD0h7Hj61Zj1nxRdRFo9E0qaMkqSuqswyCQR/qexBH4Uvax7P7n/AJB7GXdfev8AM8v8N+GdQ+G3i7w7H4V1+TWvCeqzlZNJuG8w2ilS3mIf4QPw985pnguewj8S/Gl9Ri+0ae82ZYx/y0j2OGx68Z6V6ZNqmv6ZmebQdFtA5CmV9UKbiegyYeadb3niKSMSweHdGZJBkSR6kSGB9xDyKPax7P7n/kHsZd196/zPOvCPhvVPht448P6f4f1+TX/CGptJusLhvMayUIWDq38K5wO3Xvml8dMP+GpfAcmfkSwlV27KSs+AT2PI/OvSIrnxPC7PH4b0mN2+8y6iwJ+v7mka48TPJ5jeGtJZ+u46ic/n5NHtY9n9z/yD2Mu6+9f5nn3x42t8QvhoPtBtgt+5aZcZiB2fNzwPxrrLXVrGy8M6jon9pLqdzYWjSXV4XB+/I2zcRxuI3Ejtj3FXo9Y13VHJj0PQ7tlAJ26pvIBzj/lj04P5GnNf+ILdkhbw9osbTnCxnUiDIQCcAeTzgZNHtY9n9z/yD2Mu6+9f5nAaH4FvfD3xg1W1skA8I67bx6rcH+BZEbmMduWIJ7bSRUXwJ1mPQfBvjS6d0WQa7cmJZDgOzbQn4Ekc16Pca14js41E+iaPBGRtAk1UqD7cw0yK78QTRkx+HNFdMkErqJIyDgj/AFPUGj2sez+5/wCQexl3X3r/ADPKNXivPhH8VPDniK5gggsNaT7BqklvcNN5khOfPfKLg5IJ68A1peOvCdnqmta74r8K6/L4b8V6cWW4QSfursKoI3KeoYY6ZGfevS5LrxPNjzPDekvt4G7UWOP/ACDSNN4lk27vDOkNt+7nUCcfT9zR7WPZ/c/8g9jLuvvX+Zf8B6hqGreDNFvNVtvseoz2sbzwhdu1iPTt9O2a3qy9FutXuDL/AGpp9rZAY2fZ7ozbvXOUXFalaxfMroylFxdmFFFFMkK+Yf2nP2ZE8TR3XivwnZhdYUGS9sIRj7UO7oP+enqB9769fp6isa1GNaHJM6KFeeHmpwZ+Udjo4tYnvdTRooIztWFhteVv7oHp61R1LVJtUuBJJhVUbY414VF7ACvtT9qT9nGTxpC/irw2rHWIE/0nT1+7cIB95B2cen8X16/EMkbRSMjqUdThlYYIPpXyFfDzw87S+R9zhsVDFU7w+aPQfhT8Rr3wb4qsNQgm8q5hbbub7rqeCrDvx/KvZNa8TQXLXmrXR8hZJGd1ZixDE8qCeTz0r558L+F21hmvLpmttKgP72fux/ur6k112pakniJjFHm38s/uY2YkMMAc/wC1xXt5XGcYSbWj2Pns4nCdSKT95b/oQeI/Elx4gutzkpbqf3cXYe596ggmTUI1t7htsijEUx/kfaqDo0bFWG1gcEGux+GHws1j4pa4LLTU8q2jINzeSD93Cv8AU+gr2j58s/Dn4P638QPFi6QkElnDGBJdXUiHbFGeQfcnt6190+BfAuk/D3w/BpGkQeVAnzPI3Lyv3Zj3Jq14V8M2nhHQbLSrPc0VrEsQkkOXcKMZJrXoA5jxl4e1LXmspLC6jtZbCZLqEsTh5A2GVwB93YWH/AvYVzt94H8WXX9rrHr+1Ly4MkKvPIwhTdKQAO2A0fA4+SvSaKAPMLf4c+I7S6lmt9ZS2aSWaU+W7jJkn8zkAf3SQcEVs+GfC2taFcXb32pyXlm8Vxi3ikYsGeZnUpnGCFbb65A6V21FAHD3HhHVNU8H6VaT3huL+G9tbySS7ZssIpFbaeuCVUA+5J71Qtfh74gsHvFttdaC3uDPOkMEjRrBLI8rbQMHKjzF54OUHrivR6KAPO/+EL8VzX5efxC32Vnh3RwzyodilC+DngsA449Rz6WbjwXr+4NbeILiI/apXKyXEjjyz/qxyeq85HRs89BXd0UAeT2Pws8R6aj/AGLW47GV7aODzISwO5XnYOeOcecPlPBxzWz4u8Ea7rniKHULPVUt47dzLbK7P+5Y28sRwo45aQNu68Yrv6KAOJ1zwVqWq6Lp0MWovDqdrG6i7aUvy3VXBGJUxwQwBOByDzWfL4B8QzT3AbWj9kkdn+z+bIAP9JWVcYxj5Qynr298+jUUAebTeBvFstrEp8SS/aFcs0i3Miq/72NgcDplFYFeRljjrSN4I8YtJHjxIyRpbvFgTyEsx27WJPcFevXBPNelUUAQ2cckNnBHM/mTKiq7jPzMByeamoooAKKKKACiiigAr5x+P37LeneM9Qm8UaNmxvQrS39pbx5+14Gcoo6SHH4/Xr9HUVlUpQrLlmro2pVqlGXNTdmfmXq2pG48u0ii+yWVt8kVt02+59WrOr65/aJ/Z3XXo5/E3hm326muXu7GMcXA7ug/v+o7/Xr87/DX4Wa18TfEA07T4jFFEw+1XUoISBc859T1wO9aJJKyMm23dmv8KPhvJ8YtWn08SSWc9vEsjXojLR7dwBVvRiCceuK+2vAfgPSfhz4eh0jSIfLhT5pJW5eVz1dj3P8AKneBfAulfD3w/BpOkwCOGMZeQj55W7sx7k10NMQUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAVj+H9NtNPutXNraw2xmvDJIYYwm9iiZZsDk+5oooA2KKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigD/9k="
Dim Logo As New FileInfo($"{Usuario.Empresa.Ruta}/Logo.png")
If Logo.Exists Then
LogoBase64emp = RedimensionarYConvertirBase64(Logo.FullName)
End If
'RedimensionarYConvertirBase64
sbTablas.AppendLine($"
Notificaciones AD Sistemas
 |
Reporte Diario {DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss")}
{Usuario.Empresa.Empresa}
|
 |
")
If objGenerales.GetReporteDiario(CveEmpresa) Then
If objGenerales.DSResultados.Tables(0).Rows.Count > 0 AndAlso objGenerales.DSResultados.Tables(0).Columns.Count > 0 Then
sbTablas.AppendLine($"
VENTA ACUMULADA
Mes actual: ${objGenerales.DSResultados.Tables(0).Rows(0)(1).ToString.ToDecimal.ToString("###,###,###.00")}M.N.
Año actual: ${objGenerales.DSResultados.Tables(0).Rows(0)(2).ToString.ToDecimal.ToString("###,###,###.00")}M.N.
")
End If
sbTablas.AppendLine($"")
sbTablas.AppendLine("")
sbTablas.AppendLine(ConvertDataTableToHtml(objGenerales.DSResultados.Tables(4)))
sbTablas.AppendLine($"")
sbTablas.AppendLine("")
sbTablas.AppendLine(ConvertDataTableToHtml(objGenerales.DSResultados.Tables(3)))
sbTablas.AppendLine($"")
sbTablas.AppendLine("")
sbTablas.AppendLine($"
| {ConvertDataTableToHtml(objGenerales.DSResultados.Tables(1))} |
{ConvertDataTableToHtml(objGenerales.DSResultados.Tables(2))} |
")
sbTablas.AppendLine($"")
sbTablas.AppendLine("")
sbTablas.AppendLine($"
| {ConvertDataTableToHtml(objGenerales.DSResultados.Tables(5))} |
|
")
'sbTablas.AppendLine($"
'
' | {ConvertDataTableToHtml(objGenerales.DSResultados.Tables(2))} |
' |
'
'")
'sbTablas.AppendLine($"")
'sbTablas.AppendLine("")
'Dim TablaActual As Integer = 1
'For Each tabla As DataTable In objGenerales.DSResultados.Tables
' sbTablas.AppendLine(ConvertDataTableToHtml(tabla))
' TablaActual += 1
' sbTablas.Append("
")
' sbTablas.Append("
")
'Next
Else
respuesta = False
End If
sbTablas.AppendLine("
")
objGenerales.Dispose()
'MandaCorreoDiario
Dim Correos As String = "hdiaz@grupodiaz.com.mx;libarra@grupodiaz.com.mx;jguerrero@grupodiaz.com.mx;contabilidad@grupodiaz.com.mx;cnazarit@yahoo.com;julian@adsistemas.mx;rene.molina@adssistemas.mx"
'Dim Correos As String = " oscar.irigoyen@adssistemas.mx"
MandaCorreoDiario(sbTablas.ToString(), Correos, respuesta)
Return respuesta
End Function
Public Function RedimensionarYConvertirBase64(ByVal rutaImagen As String) As String
Try
Using imagenOriginal As Image = Image.FromFile(rutaImagen)
Dim maxWidth As Integer = 210
Dim maxHeight As Integer = 95
Dim ratio As Double = Math.Min(maxWidth / imagenOriginal.Width, maxHeight / imagenOriginal.Height)
Dim nuevoAncho As Integer = CInt(imagenOriginal.Width * ratio)
Dim nuevoAlto As Integer = CInt(imagenOriginal.Height * ratio)
Using imagenRedimensionada As New Bitmap(nuevoAncho, nuevoAlto)
Using g As Graphics = Graphics.FromImage(imagenRedimensionada)
g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(imagenOriginal, 0, 0, nuevoAncho, nuevoAlto)
End Using
'System.Drawing.Imaging
Using ms As New MemoryStream()
imagenRedimensionada.Save(ms, System.Drawing.Imaging.ImageFormat.Png)
Dim imagenBytes As Byte() = ms.ToArray()
Return Convert.ToBase64String(imagenBytes)
End Using
End Using
End Using
Catch ex As Exception
Return String.Empty ' En caso de error, retornar cadena vacía
End Try
End Function
Private Function ConvertDataTableToHtml(ByVal table As DataTable) As String
Dim html As StringBuilder = New StringBuilder()
Dim ColumnaTitulo As String = "Titulo"
html.Append("")
If table.Columns(0).ColumnName = ColumnaTitulo AndAlso table.Rows.Count > 0 Then html.AppendFormat("{0}
", table.Rows(0)(ColumnaTitulo))
html.Append("")
For Each column As DataColumn In table.Columns
If ColumnaTitulo <> column.ColumnName Then html.Append($"| {column.ColumnName} | ")
Next
html.Append("")
html.Append("
")
Dim numericValue As Decimal = Nothing
For Each row As DataRow In table.Rows
html.Append("")
For Each column As DataColumn In table.Columns
If ColumnaTitulo <> column.ColumnName Then
Dim value As Object = row(column)
Dim cellValue As String
If column.DataType = GetType(Integer) OrElse column.DataType = GetType(Decimal) OrElse column.DataType = GetType(Double) OrElse column.DataType = GetType(Single) Then
If value IsNot DBNull.Value AndAlso Decimal.TryParse(value.ToString(), numericValue) Then
If numericValue <> 0 Then
cellValue = numericValue.ToString("N2")
Else
cellValue = ""
End If
Else
cellValue = ""
End If
html.Append($"| {cellValue} | ")
Else
cellValue = If(value?.ToString(), String.Empty)
html.Append($"{cellValue} | ")
End If
End If
Next
html.Append("
")
Next
html.Append("")
html.Append("
")
Return html.ToString()
End Function
Private Sub MandaCorreoDiario(ByVal Cuerpo As String, Correos As String, ByVal ProcesoOK As Boolean)
Try
Dim ListaArchivos As List(Of ClsSisMail.ArchivoMail) = New List(Of ClsSisMail.ArchivoMail)()
Dim Correo As ClsSisMail = New ClsSisMail()
Dim Para As String = Correos '"hdiaz@grupodiaz.com.mx;libarra@grupodiaz.com.mx;jguerrero@grupodiaz.com.mx;contabilidad@grupodiaz.com.mx;cnazarit@yahoo.com;julian@adsistemas.mx;rene.molina@adssistemas.mx"
Dim Asunto As String = If(ProcesoOK, $"Reporte Diario", "Reporte Diario Error")
Asunto = $"{Asunto} {DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss")}"
Correo.SendMail(ClsPaginas.EmpresaNotificaciones, Para, Asunto, Cuerpo, Archivos:=ListaArchivos)
Me.GuardaLog($"EjecutaReporteDiario: MandaCorreo() correo enviado. ")
Catch ex As Exception
Extensiones.ModExtensiones.GuardaLog(Nothing, $"Error Tareas Programadas 119 error enviar mail --> {ex.Message} ")
Me.GuardaLog($"EjecutaReporteDiario: MandaCorreo() Error {ex.StackTrace.ToString()}. ")
End Try
End Sub
Private Function DescargaSAT(ByVal CveEmpresa As Integer, ByVal context As HttpContext) As Boolean
Dim Usuario As Usuario = ValidaUsuarioSistema(100, CveEmpresa)
Dim respuesta As Boolean = True
Dim fInicial As DateTime = Now.AddDays(-2)
Dim fFinal As DateTime = Now.AddDays(-1)
'Dim fInicial As DateTime = "2025-01-01".ToDate
'Dim fFinal As DateTime = "2025-01-03".ToDate
'Dim CveSolicitudAgregadaTipo1 As Integer = -1 'Nomina
Dim CveSolicitudAgregadaTipo2 As Integer = -1 'Egresos (Compras)
' Dim CveSolicitudAgregadaTipo3 As Integer = -1 'Ingresos (Ventas)
'Dim FolioTipo1 As Integer = -1 'Nomina
Dim FolioTipo2 As Integer = -1 'Egresos (Compras)
' Dim FolioTipo3 As Integer = -1 'Ingresos (Ventas)
Using nom As ClsNominas = New ClsNominas()
''Nomina
'CveSolicitudAgregadaTipo1 = nom.SolicitudesAdd2(0, 0, 0, "", fInicial, fFinal, 100, CveEmpresa, CveTipoSolicitud:=1)
'If CveSolicitudAgregadaTipo1 > 0 Then
' FolioTipo1 = nom.FolioSolicitud
' GuardaLog($"DescargaSAT: Solictud Nomina Registrada CveSolicitudAgregada: {CveSolicitudAgregadaTipo1}, Folio: {FolioTipo1} ".ToString())
'Else
' GuardaLog("DescargaSAT: No se puedo registrar la solictud de Nomina".ToString())
'End If
'Egresos (Compras)
CveSolicitudAgregadaTipo2 = nom.SolicitudesAdd2(0, 0, 0, "", fInicial, fFinal, 100, CveEmpresa, CveTipoSolicitud:=2)
If CveSolicitudAgregadaTipo2 > 0 Then
FolioTipo2 = nom.FolioSolicitud
GuardaLog($"DescargaSAT: Solictud Compras Registrada CveSolicitudAgregada: {CveSolicitudAgregadaTipo2}, Folio: {FolioTipo2} ".ToString())
Else
GuardaLog("DescargaSAT: No se puedo registrar la solictud de Compras".ToString())
End If
''Ingresos (Ventas)
'CveSolicitudAgregadaTipo3 = nom.SolicitudesAdd2(0, 0, 0, "", fInicial, fFinal, 100, CveEmpresa, CveTipoSolicitud:=3)
'If CveSolicitudAgregadaTipo3 > 0 Then
' FolioTipo3 = nom.FolioSolicitud
' GuardaLog($"DescargaSAT: Solictud ventas Registrada CveSolicitudAgregada: {CveSolicitudAgregadaTipo3}, Folio: {FolioTipo3} ".ToString())
'Else
' GuardaLog("DescargaSAT: No se puedo registrar la solictud de Ventas".ToString())
'End If
End Using
'If CveSolicitudAgregadaTipo1 > 0 Then
' GeneraSolictud(CveEmpresa, CveSolicitudAgregadaTipo1, FolioTipo1, 1)
'End If
If CveSolicitudAgregadaTipo2 > 0 Then
respuesta = GeneraSolictud(CveEmpresa, CveSolicitudAgregadaTipo2, FolioTipo2, 2)
End If
'If CveSolicitudAgregadaTipo3 > 0 Then
' GeneraSolictud(CveEmpresa, CveSolicitudAgregadaTipo3, FolioTipo1, 3)
'End If
Return respuesta
End Function
Function GeneraSolictud(CveEmpresa As Integer, CveSolicitudAgregada As Integer, Folio As Integer, CveTipoSolicitud As Integer) As Boolean
Dim TipoStr As String = ""
Select Case CveTipoSolicitud
Case 1
TipoStr = "Nomina"
Case 2
TipoStr = "Facturas"
Case 3
TipoStr = "Ventas"
End Select
GuardaLog($"DescargaSAT: Inicia solicitud de generación de solicitud {TipoStr} a API")
Dim api As New GeneralesAPIeFacturas()
Dim ObjApiSolicitud As JToken = CType(api.GeneraSolicitud(CveEmpresa, CveTipoSolicitud, CveSolicitudAgregada), JToken)
Dim resultSolicitud As List(Of String) = New List(Of String)()
Dim resultVerificacion As List(Of String) = New List(Of String)()
Dim TipoMensaje As ModExtensiones.TipoMensaje = ModExtensiones.TipoMensaje.MsgInformacion
Dim ResultadoSolicitudOK As Boolean = False
If Not (ObjApiSolicitud Is Nothing) Then
resultSolicitud = ObjApiSolicitud.[Select](Function(token) token.Values().Aggregate(Function(i, j) $"{i}|{j}").Value(Of String)()).ToList()
ResultadoSolicitudOK = Boolean.Parse(resultSolicitud(0))
Else
GuardaLog($"DescargaSAT: Solicitud Folio: {Folio} Procesada incorrectamente.")
End If
If ResultadoSolicitudOK Then
GuardaLog($"DescargaSAT: Solicitud registrada. {resultSolicitud(1)}
Folio: {Folio}")
Else
If ObjApiSolicitud IsNot Nothing AndAlso resultSolicitud.Count = 4 Then
GuardaLog($"DescargaSAT: Solicitud registrada, pendiente de verificar en SAT
Folio: {Folio}
({resultSolicitud(1)})
")
Else
GuardaLog($"DescargaSAT: Solicitud registrada, pendiente de verificar en SAT
Folio: {Folio}")
End If
End If
Return ResultadoSolicitudOK
End Function
Private Function ValidaDescargaSAT(ByVal CveEmpresa As Integer, ByVal context As HttpContext) As Boolean
GuardaLog($"ValidaDescargaSAT: Inicio")
Dim Usuario As Usuario = ValidaUsuarioSistema(100, CveEmpresa)
Dim respuesta As Boolean = True
'Dim DTSolicitudesNom As New DataTable
Dim DTSolicitudesCom As New DataTable
' Dim DTSolicitudesVen As New DataTable
Using nom As ClsNominas = New ClsNominas()
'If nom.SolicitudesGet(-1, CveEmpresa, CveTipoSolicitud:=1, Estatus:=0, Top:=50) Then
' DTSolicitudesNom = nom.DtResultados
' GuardaLog($"ValidaDescargaSAT: DTSolicitudesNom registros {DTSolicitudesNom.Rows.Count}")
'End If
If nom.SolicitudesGet(-1, CveEmpresa, CveTipoSolicitud:=2, Estatus:=0, Top:=50) Then
DTSolicitudesCom = nom.DtResultados
GuardaLog($"ValidaDescargaSAT: DTSolicitudesCom registros {DTSolicitudesCom.Rows.Count}")
End If
'If nom.SolicitudesGet(-1, CveEmpresa, CveTipoSolicitud:=3, Estatus:=0, Top:=50) Then
' DTSolicitudesVen = nom.DtResultados
' GuardaLog($"ValidaDescargaSAT: DTSolicitudesVen registros {DTSolicitudesVen.Rows.Count}")
'End If
End Using
'If DTSolicitudesNom.Rows.Count > 0 Then
' VerificarSolicitudes(CveEmpresa, DTSolicitudesNom, 1, Usuario)
'End If
If DTSolicitudesCom.Rows.Count > 0 Then
VerificarSolicitudes(CveEmpresa, DTSolicitudesCom, 2, Usuario)
End If
'If DTSolicitudesVen.Rows.Count > 0 Then
' VerificarSolicitudes(CveEmpresa, DTSolicitudesVen, 3, Usuario)
'End If
GuardaLog($"ValidaDescargaSAT: Fin")
Return respuesta
End Function
Private Function VerificarSolicitudes(CveEmpresa As Integer, DTDatos As DataTable, CveTipoSolicitud As Integer, UsuarioActual As Usuario) As Boolean
Try
Dim sbResultado As StringBuilder = New StringBuilder()
Dim sbArchivosFaltantes As New StringBuilder()
Dim TipoMensaje As ModExtensiones.TipoMensaje = ModExtensiones.TipoMensaje.MsgInformacion
For Each drow As DataRow In DTDatos.Rows
Dim ListComprimidos As New List(Of String)
Dim ListXML As New List(Of String)
Dim ListPDF As New List(Of String)
Dim CveSolicitudActual As Integer = drow("CveSolicitud").ToString.ToEntero()
Dim idSolicitud As String = drow("idSolicitud").ToString.Trim()
'Dim CveTipoSolicitud As Integer = GvRow.DataKey("CveTipoSolicitud").ToEntero()
Dim Folio As Integer = drow("Folio").ToString.ToEntero()
Dim CveSolicitudDetalle As Integer = drow("CveSolicitudDetalle").ToString.ToEntero()
Dim resultSolicitud As List(Of String) = New List(Of String)()
Dim resultVerificacion As List(Of String) = New List(Of String)()
Dim ResultadoVerificaionOK As Boolean = False
Dim SeVerifico As Boolean = False
Dim ResultadoSolicitudOK As Boolean = False
Dim api As New GeneralesAPIeFacturas("http://localhost:4001/")
'"http://localhost:60281/"
Dim Verificar As Boolean = True
If idSolicitud.Length = 0 Then
Dim ObjApiSolicitud As JToken = CType(api.GeneraSolicitud(CveEmpresa, CveTipoSolicitud, CveSolicitudActual), JToken)
If Not (ObjApiSolicitud Is Nothing) Then
resultSolicitud = ObjApiSolicitud.[Select](Function(token) token.Values().Aggregate(Function(i, j) $"{i}|{j}").Value(Of String)()).ToList()
ResultadoSolicitudOK = Boolean.Parse(resultSolicitud(0))
Try
sbResultado.Append($"Solicitud {Folio} { resultSolicitud(1)}.
")
If resultSolicitud(1).Contains("No se Generaron solicitudes al SAT") Then
Verificar = False
Else
Verificar = True
End If
Catch ex As Exception
sbResultado.Append($"Solicitud {Folio} solicitada a SAT.
")
Verificar = False
End Try
Else
TipoMensaje = ModExtensiones.TipoMensaje.MsgAdvertencia
End If
Else
resultSolicitud = New List(Of String)()
resultSolicitud.Add("true")
resultSolicitud.Add("")
resultSolicitud.Add("")
resultSolicitud.Add("")
ResultadoSolicitudOK = True
Verificar = True
End If
If ResultadoSolicitudOK And Verificar Then
' If EsProduccion Then
Dim ObjApiVerificacion As JToken = CType(api.VerificaSolicitudesNominas(CveEmpresa, CveTipoSolicitud, CveSolicitudActual), JToken)
If Not (ObjApiVerificacion Is Nothing) Then
resultVerificacion = ObjApiVerificacion.[Select](Function(token) token.Values().Aggregate(Function(i, j) $"{i}|{j}").Value(Of String)()).ToList()
ResultadoVerificaionOK = Boolean.Parse(resultVerificacion(0))
SeVerifico = True
Else
TipoMensaje = ModExtensiones.TipoMensaje.MsgAdvertencia
End If
'Else
' ResultadoVerificaionOK = True
' SeVerifico = True
'End If
Dim Archivo = New FileInfo(String.Format("{0}DescargasSATXML\Compras\{1}.zip", UsuarioActual.Empresa.Ruta, CveSolicitudDetalle))
Dim fileName = Archivo.Name
Dim filemove = Archivo.FullName
If ResultadoVerificaionOK AndAlso Archivo.Exists Then
Try
'COPIAR ARCHIVO A LA CARPETA DE PROCESAMIENTO DE FACTURAS, SE ELIMINARAN ESOS ARCHIVOS TEMPORALES
Dim destFile = String.Format("{0}Temp\Facturas\{1}", UsuarioActual.Empresa.Ruta, fileName)
File.Copy(filemove, destFile, overwrite:=True)
If File.Exists(destFile) Then
ListComprimidos.Add(destFile)
'GuardaLogAD($"eFacturas Solicitudes SAT Archivo copiado a {destFile}")
Else
sbArchivosFaltantes.AppendFormat("
Folio: {0} Archivo: {1}", Folio, fileName)
End If
Catch ex As Exception
ex.ToString().GuardaLog()
sbArchivosFaltantes.AppendFormat("
Folio: {0} Archivo: {1}. Error al procesar", Folio, fileName)
End Try
End If
Else
If resultSolicitud.Count >= 4 Then
sbResultado.Append($"({resultSolicitud(1)})
Folio:{Folio}
")
Else
sbResultado.Append($"Solicitud pendiente de verificar en SAT
Folio:{Folio}
")
End If
TipoMensaje = ModExtensiones.TipoMensaje.MsgAdvertencia
End If
If SeVerifico Then
SubirFacturas(ListComprimidos, ListXML, ListPDF, 1, UsuarioActual)
End If
'If UsuarioActual.CveRol = 1 Then
' Alert($"SeVerifico {SeVerifico.ToString} resultVerificacion.Count {resultVerificacion.Count }")
'End If
If Verificar Then
If SeVerifico AndAlso resultVerificacion.Count >= 4 Then
If ResultadoVerificaionOK Then
sbResultado.Append($"Solicitud procesadaFolio: {Folio}
{resultVerificacion(1)}")
Else
sbResultado.Append($"Solicitud no verificada
Folio: {Folio}{resultVerificacion(1)}.
")
TipoMensaje = ModExtensiones.TipoMensaje.MsgAdvertencia
End If
Else
sbResultado.Append($"Se presento un error al verificar la solicitud Folio: {Folio}.
")
TipoMensaje = ModExtensiones.TipoMensaje.MsgAdvertencia
End If
End If
Next
Alert(sbResultado.ToString(), TipoMensaje)
If sbArchivosFaltantes.Length > 0 Then
'Alert($"No se pudieron procesar los siguientes folios. {sbArchivosFaltantes.ToString()}", TipoMensaje.MsgError)
GuardaLog($"ValidaDescargaSAT: No se pudieron procesar los siguientes folios. {sbArchivosFaltantes.ToString()}")
End If
'cargasolicitudes()
Catch ex As Exception
'Alert(ex.StackTrace)
GuardaLog($"ValidaDescargaSAT: {ex.StackTrace}")
End Try
Return True
End Function
Private Sub ProcesarPDF(UsuarioActual As Usuario, a As ComprobanteFactura, FF As Factura)
a.GeneraPDF(UsuarioActual, UsuarioActual.Empresa.Ruta, FF, UsuarioActual.Empresa.Ruta, True)
End Sub
'Private Sub TmpFacturas()
' Dim Usuario As Usuario = ValidaUsuarioSistema(100, 189)
' Dim ListComprimidos As New List(Of String)
' ListComprimidos.Add("C:\inetpub\WWWSigGit\Empresas\189\Temp\Facturas\3694.zip")
' SubirFacturas(ListComprimidos, New List(Of String), New List(Of String), 1, Usuario)
'End Sub
Private Sub SubirFacturas(ByRef ListComprimidos As List(Of String), ByRef ListXML As List(Of String), ByRef ListPDF As List(Of String), Validada As Integer, UsuarioActual As Usuario)
Dim DTLOG As New DataTable
DTLOG.Columns.Add("Serie", GetType(String))
DTLOG.Columns.Add("Folio", GetType(String))
DTLOG.Columns.Add("Fecha", GetType(Date))
DTLOG.Columns.Add("Proveedor", GetType(String))
DTLOG.Columns.Add("Importe", GetType(Decimal))
DTLOG.Columns.Add("Motivo", GetType(String))
DTLOG.Columns.Add("RFCde", GetType(String))
DTLOG.Columns.Add("Estatus", GetType(Integer))
DTLOG.Columns.Add("Tipo", GetType(String))
'Serie Folio Fecha Proveedor Importe Motivo
Dim sw As New Diagnostics.Stopwatch
Dim swmili As Long = 0
Dim swTiempo As New StringBuilder
sw.Start()
For Each comprmido As String In ListComprimidos
Dim FiInfo As New FileInfo(comprmido)
Try
Using stream As Stream = System.IO.File.OpenRead(FiInfo.FullName)
Try
Dim reader = ReaderFactory.Open(stream)
Dim Multiparte As Boolean = False
If Path.GetExtension(FiInfo.FullName.ToUpper()) = ".RAR" And FiInfo.FullName.ToUpper().Contains(".PART") Then
'SI ES .RAR, PUEDE SER MULTI PART Y PUEDE TRONAR
Using archive As RarArchive = RarArchive.Open(FiInfo.FullName)
If archive.IsMultipartVolume() Then
Multiparte = True
End If
End Using
End If
Dim PdfList As New List(Of String)
If Not Multiparte Then
'puede tronar si el archivo es multiparte
While reader.MoveToNextEntry()
If Not reader.Entry.IsDirectory Then
'Si es un archivo XML, lo leo y lo guardo
Dim nombreArchivo As String = ""
If reader.Entry.FilePath.Contains("/") Then
nombreArchivo = reader.Entry.FilePath.Substring(reader.Entry.FilePath.LastIndexOf("/") + 1)
Else
nombreArchivo = reader.Entry.FilePath
End If
If Path.GetExtension(reader.Entry.FilePath.ToUpper()) = ".XML" Then
reader.WriteEntryToDirectory(String.Format("{0}Temp\Facturas", UsuarioActual.Empresa.Ruta), ExtractOptions.None Or ExtractOptions.Overwrite)
ListXML.Add(String.Format("{0}Temp\Facturas\{1}", UsuarioActual.Empresa.Ruta, nombreArchivo))
End If
If Path.GetExtension(reader.Entry.FilePath.ToUpper()) = ".PDF" Then
'este sale de un error al leer el pdf, como lo estoy recorriendo de una vez lo guardo y lo vinculo, si la coincidencia es por nombre o número de folio
'string RFCEmisor = BuscaFactura(System.IO.Path.GetFileNameWithoutExtension(reader.Entry.FilePath).ToUpper(), Arreglo, True);
'if (!string.IsNullOrEmpty(RFCEmisor))
' {
'If Not Directory.Exists(String.Format("{0}{1}", Temporal, RFCEmisor)) Then Directory.CreateDirectory(String.Format("{0}{1}", Temporal, RFCEmisor))
'reader.WriteEntryToDirectory(String.Format("{0}{1}", Temporal, ""), ExtractOptions.None Or ExtractOptions.Overwrite)
reader.WriteEntryToDirectory(String.Format("{0}{1}", String.Format("{0}Temp\Facturas", UsuarioActual.Empresa.Ruta), ""), ExtractOptions.None Or ExtractOptions.Overwrite)
ListPDF.Add(String.Format("{0}Temp\Facturas\{1}", UsuarioActual.Empresa.Ruta, nombreArchivo))
End If
End If
End While
End If
Catch ex As Exception
'GuardaLogAD("'ERROR :" & ex.Message, eFacturasLog)
GuardaLog($"ValidaDescargaSAT: ERROR : {ex.Message}")
End Try
End Using
Catch ex As Exception
If UsuarioActual.CveRol = 1 Then
'Alert($"Error al procesar archivo: {FiInfo.FullName} Error:{ex.Message} stackTrace: {ex.StackTrace}", TipoMensaje.MsgAdvertencia)
'GuardaLogAD($"Error al procesar archivo: {FiInfo.FullName} Error:{ex.Message} stackTrace: {ex.StackTrace}")
GuardaLog($"ValidaDescargaSAT: ERROR al procesar archivo : {FiInfo.FullName} Error:{ex.Message} stackTrace: {ex.StackTrace}")
Else
'Alert("Se presento un error al procesar las solcictudes. comuniquese con soporte tecnico.", TipoMensaje.MsgAdvertencia)
'GuardaLogAD($"Error al procesar archivo: {FiInfo.FullName} Error:{ex.Message} stackTrace: {ex.StackTrace}")
GuardaLog($"ValidaDescargaSAT: ERROR al procesar archivo : {FiInfo.FullName} Error:{ex.Message} stackTrace: {ex.StackTrace}")
End If
Exit Sub
End Try
Next
'Anexo.Text = ""
'UPAddFacturas.Update()
Dim ErrorFacturas As Boolean = False
For Each filePathXML As String In ListXML
Dim rowLog As DataRow = DTLOG.NewRow
rowLog("Serie") = ""
rowLog("Folio") = ""
rowLog("Fecha") = Now
rowLog("Proveedor") = ""
rowLog("Importe") = 0
rowLog("Motivo") = ""
rowLog("RFCde") = ""
rowLog("Estatus") = 0
rowLog("Tipo") = ""
Dim fInfoXML As New FileInfo(filePathXML)
Dim RutaPDF As String = ""
For Each filePathPDF As String In ListPDF
Dim fInfoPDF As New FileInfo(filePathPDF)
Dim fxml As String = fInfoXML.Name.ToUpper().Replace(".XML", "")
Dim fpdf As String = fInfoPDF.Name.ToUpper().Replace(".PDF", "")
Dim fpdfSplit As String() = fpdf.Split("-"c)
If fpdfSplit.Length >= 2 AndAlso fpdfSplit(0).Length = 18 Then
fpdf = fpdf.Replace($"{fpdfSplit(0)}-", "")
End If
If fxml.Contains(fpdf) Or (ListXML.Count = 1 And ListPDF.Count = 1) Then
RutaPDF = fInfoPDF.FullName
Exit For
End If
Next
If File.Exists(filePathXML) Then
Dim a As New ComprobanteFactura("Log")
Dim FF As ADS.TareasProgramdas.Factura = a.CargaComprobanteXML(File.ReadAllText(filePathXML), UsuarioActual.Empresa.Ruta, UsuarioActual.Empresa.RFC, UsuarioActual.CveEmpresa, True, rowLog, NombreArchivo:=fInfoXML.Name, Validada:=Validada)
If FF IsNot Nothing AndAlso FF.CveFactura > 0 Then
If RutaPDF = "" Then
'Dim Hilo As New System.Threading.Thread(Sub() ProcesarPDF(UsuarioActual, a, FF))
ProcesarPDF(UsuarioActual, a, FF)
'Hilo.Start()
Else
Dim PDfDestino As String = $"{UsuarioActual.Empresa.Ruta}\Compras\{FF.EmisorRFC}\{FF.CveFactura}.PDF"
If File.Exists(RutaPDF) Then
If File.Exists(PDfDestino) Then
File.Delete(PDfDestino)
End If
File.Move(RutaPDF, PDfDestino)
End If
End If
Else
ErrorFacturas = True
End If
End If
DTLOG.Rows.Add(rowLog)
Next
sw.Stop()
swTiempo.AppendFormat("Fill ClsSisMail.ArchivoMail: ({0}) {1} ", sw.ElapsedMilliseconds - swmili, sw.ElapsedMilliseconds)
swmili = sw.ElapsedMilliseconds
sw.Start()
sw.Stop()
swTiempo.AppendFormat("BorrarInicio: ({0}) {1} ", sw.ElapsedMilliseconds - swmili, sw.ElapsedMilliseconds)
swmili = sw.ElapsedMilliseconds
sw.Start()
For Each s As String In ListXML
Try
File.Delete(s)
Catch ex As Exception
End Try
Next
For Each s As String In ListComprimidos
Try
If Not ErrorFacturas Then
File.Delete(s)
GuardaLogAD($"Se elimina comprimido {s}")
End If
Catch ex As Exception
End Try
Next
sw.Stop()
swTiempo.AppendFormat("BorrarEnd: ({0}) {1} ", sw.ElapsedMilliseconds - swmili, sw.ElapsedMilliseconds)
swmili = sw.ElapsedMilliseconds
'GuardaLogefacturas(swTiempo.ToString())
'mesajeFaturasSubidas(DTLOG)
'CargaDatosBitacora()
'Alert(String.Format("Se cargaron {0} Facturas", Arreglo.Count), TipoMensaje.MsgInformacion)
End Sub
End Class
Public Class GeneralesAPIeFacturas
Inherits ADSNetLibraryzdT.HelpersE.ConexionesE.SIGAPIE.BaseSIGAPIeFacturas
Public Sub New(ByVal Optional domainApi As String = "http://localhost:4001/", ByVal Optional token As String = "")
MyBase.New(domainApi, token)
End Sub
Public Function GeneraSolicitud(CveEmpresa As Integer, CveTipoSolicitud As Integer, CveSolicitud As Integer) As Object
Return getData(Of Object)($"GeneraSolicitud/{CveEmpresa}/{CveTipoSolicitud}/{CveSolicitud}", Nothing, ADSNetLibraryzdT.HelpersE.ConexionesE.SIGAPIE.requestMethod.[GET], False)
End Function
Public Function VerificaSolicitudesNominas(CveEmpresa As Integer, CveTipoSolicitud As Integer, CveSolicitud As Integer) As Object
Return getData(Of Object)($"VerificaSolicitudesNominas/{CveEmpresa}/{CveTipoSolicitud}/{CveSolicitud}", Nothing, ADSNetLibraryzdT.HelpersE.ConexionesE.SIGAPIE.requestMethod.[GET], False)
End Function
Public Function CancelarSolicitud(CveEmpresa As Integer, CveSolicitud As Integer, CveUsuario As Integer) As Object
Return getData(Of Object)($"CancelarSolicitud/{CveEmpresa}/{CveSolicitud}/{CveUsuario}", Nothing, ADSNetLibraryzdT.HelpersE.ConexionesE.SIGAPIE.requestMethod.[GET], False)
End Function
End Class
Namespace ADSNetLibraryzdT.HelpersE.ConexionesE.SIGAPIE
Public Enum requestMethod
POST = 1
[GET] = 2
End Enum
Public Class BaseSIGAPIeFacturas
Private Const tituloLog As String = "ADSNetLibrary.Helpers.Conexiones.SIGAPI"
Public domainApi As String
Public authorization As String
Protected RouteController As String = "Generales"
Protected FullRoute As String = ""
Public Function GetRoutbyclass() As String
Dim classname As String = Me.[GetType]().Name
Return classname.Substring(0, classname.Length - 12)
End Function
Public Function GetRoute(ByVal path As String) As String
If String.IsNullOrEmpty(FullRoute) Then
Return String.Format("api/{0}/{1}", (If(String.IsNullOrEmpty(RouteController), GetRoutbyclass(), RouteController)), path)
Else
Return String.Format("{0}{1}", FullRoute, path)
End If
End Function
Public Sub New(ByVal domainApi As String, ByVal Optional authorization As String = Nothing, ByVal Optional fullRoute As String = Nothing)
If String.IsNullOrEmpty(domainApi) Then
domainApi = "http://localhost:4001/"
End If
Me.authorization = authorization
Me.domainApi = domainApi
Me.FullRoute = fullRoute
End Sub
Public Async Function getDataAsync(Of T As {Class, New})(ByVal path As String, ByVal requestobject As Object, ByVal Optional reqmet As requestMethod = requestMethod.POST, ByVal Optional needauthorization As Boolean = True, ByVal Optional isfullpath As Boolean = False) As Task(Of T)
Dim objreturn As T = Nothing
Using client As HttpClient = New HttpClient()
client.BaseAddress = New Uri(domainApi)
client.DefaultRequestHeaders.Accept.Add(New MediaTypeWithQualityHeaderValue("application/json"))
If needauthorization Then
client.DefaultRequestHeaders.Authorization = New AuthenticationHeaderValue("Bearer", authorization)
End If
client.Timeout = TimeSpan.FromMinutes(15)
Dim response As HttpResponseMessage = New HttpResponseMessage()
Dim strjsonreq As String = Newtonsoft.Json.JsonConvert.SerializeObject(requestobject)
Dim content As StringContent = New StringContent(strjsonreq, Encoding.UTF8, "application/json")
Dim route As String = If(isfullpath, path, GetRoute(path))
Try
Select Case reqmet
Case requestMethod.POST
response = Await client.PostAsync(route, content)
Case requestMethod.[GET]
response = Await client.GetAsync(route)
End Select
If response.IsSuccessStatusCode Then
Dim jsondata As String = Await response.Content.ReadAsStringAsync()
Dim settings As Newtonsoft.Json.JsonSerializerSettings = New Newtonsoft.Json.JsonSerializerSettings With {
.NullValueHandling = Newtonsoft.Json.NullValueHandling.Ignore,
.MissingMemberHandling = Newtonsoft.Json.MissingMemberHandling.Ignore
}
objreturn = Newtonsoft.Json.JsonConvert.DeserializeObject(Of T)(jsondata, settings)
Else
End If
Catch e As Exception
End Try
End Using
Return objreturn
End Function
Public Function getData(Of T As {Class, New})(ByVal path As String, ByVal requestobject As Object, ByVal Optional reqmet As requestMethod = requestMethod.POST, ByVal Optional needauthorization As Boolean = True, ByVal Optional isfullpath As Boolean = False) As T
Return AsyncHelper.RunSync(Of T)(Function() getDataAsync(Of T)(path, requestobject, reqmet, needauthorization, isfullpath))
End Function
End Class
Friend Module AsyncHelper
Private ReadOnly _myTaskFactory As TaskFactory = New TaskFactory(CancellationToken.None, TaskCreationOptions.None, TaskContinuationOptions.None, TaskScheduler.[Default])
Function RunSync(Of TResult)(ByVal func As Func(Of Task(Of TResult))) As TResult
'Return AsyncHelper._myTaskFactory.StartNew(Of Task(Of TResult))(func).Unwrap(Of TResult)().GetAwaiter().GetResult()
Return AsyncHelper._myTaskFactory.StartNew(Of Task(Of TResult))(func).Unwrap().GetAwaiter().GetResult()
End Function
Sub RunSync(ByVal func As Func(Of Task))
AsyncHelper._myTaskFactory.StartNew(Of Task)(func).Unwrap().GetAwaiter().GetResult()
End Sub
End Module
End Namespace
Public Class ComprobanteFactura
Private Property EsProduccion As Boolean = True
Public Property ArchivoLog As String
Public Sub New(NombreArchivoLog As String)
ArchivoLog = NombreArchivoLog
End Sub
Public Property Pagos As List(Of Pago)
Public Property XMLNodosPagos As String
Public Property XMLNodosPagosCount As Integer
Private Function CargaFactVersion33(CveEmpresa As Integer, ByRef node As XmlNode, ByRef nodo As XmlNode, ByRef XMLDoc As XmlDocument, ByVal Prefijo As String, ByRef namespaces As XmlNamespaceManager, ByVal VersionCFDI As String) As Factura
Dim Fact = New Factura()
Fact.Version = VersionCFDI
Fact.CveEmpresa = CveEmpresa
Fact.Serie = CaratecteresvalidosFolio(ValorXML(nodo, "serie"))
If Not String.IsNullOrEmpty(Fact.Serie) Then Fact.Serie = Fact.Serie
Fact.Folio = ValorXML(nodo, "folio").TrimStart("0"c)
Fact.Fecha = ValorXML(nodo, "fecha").ToDateTime
Fact.SubTotal = ValorXML(nodo, "subTotal").Replace("..", ".").ToDecimal
Fact.Total = ValorXML(nodo, "total").ToDecimal
Fact.Moneda = ValorXML(nodo, "Moneda")
Fact.MetododePago = ValorXML(nodo, "MetododePago")
Fact.TipoComprobante = ValorXML(nodo, "tipoDeComprobante")
Fact.TipoCambio = ValorXML(nodo, "TipoCambio", "1.0").ToDecimal
If Fact.TipoCambio < 1 Then Fact.TipoCambio = 1
If Fact.TipoComprobante = "P" Then
Dim PagoPrefix As String = ""
If VersionCFDI = "3.3" Then
PagoPrefix = "pago10"
namespaces.AddNamespace("pago10", "http://www.sat.gob.mx/Pagos")
ElseIf VersionCFDI = "4.0" Then
PagoPrefix = "pago20"
namespaces.AddNamespace("pago20", "http://www.sat.gob.mx/Pagos20")
End If
Dim NodoComplementos As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
Dim nodePagos As XmlNode = NodoComplementos.SelectSingleNode($"//{PagoPrefix}:Pagos", namespaces)
For Each nPago As XmlNode In nodePagos.ChildNodes
Fact.Total = ValorXML(nPago, "Monto").ToDecimal
If VersionCFDI = "4.0" And nPago.LocalName.ToUpper() = "TOTALES" Then
Continue For
Else
Exit For
End If
Next
End If
Fact.sUPPrefijo = Prefijo
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Emisor", Prefijo), namespaces)
If node IsNot Nothing AndAlso node.Attributes.Count > 0 Then
Fact.EmisorRFC = ValorXML(node, "RFC").Trim()
Fact.EmisorNombre = ValorXML(node, "nombre")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Receptor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.ReceptorRFC = ValorXML(node, "RFC").Trim()
End If
If XMLDoc.HasChildNodes Then
node = XMLDoc.ChildNodes(0).ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Impuestos", Prefijo), StringComparison.OrdinalIgnoreCase)).FirstOrDefault()
If XMLDoc.ChildNodes.Count > 1 Then
node = XMLDoc.ChildNodes(1).ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Impuestos", Prefijo), StringComparison.OrdinalIgnoreCase)).FirstOrDefault()
End If
End If
If node IsNot Nothing AndAlso node.ChildNodes.Count > 0 Then
Try
Dim nodeRetenciones = node.ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Retenciones", Prefijo), StringComparison.OrdinalIgnoreCase))
Fact.TotalRetenciones = ValorXML(node, "totalImpuestosRetenidos", "0").ToDecimal
Try
Dim retenciones = nodeRetenciones.FirstOrDefault().ChildNodes
For Each retencion As XmlNode In retenciones
Dim TipoImpuesto As String = ValorXML(retencion, "impuesto")
Dim importe As Decimal = ValorXML(retencion, "importe").ToDecimal
If TipoImpuesto = "002" Then
Fact.RetencionIVA += importe
End If
If TipoImpuesto = "001" Then
Fact.RetencionISR += importe
End If
Next
Catch ex As Exception
End Try
Fact.SumaTotalRetenciones += Fact.RetencionIVA
Fact.SumaTotalRetenciones += Fact.RetencionISR
Fact.TotalTraslados = ValorXML(node, "totalImpuestosTrasladados", "0").ToDecimal
Dim nodeTraslados = node.ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Traslados", Prefijo), StringComparison.OrdinalIgnoreCase))
Dim traslados = nodeTraslados.FirstOrDefault().ChildNodes
For Each traslado As XmlNode In traslados
Dim TipoImpuesto As String = ValorXML(traslado, "impuesto")
Dim importe As Decimal = ValorXML(traslado, "importe").ToDecimal()
If TipoImpuesto = "003" Then
Fact.TrasladoIEPS += importe
End If
If TipoImpuesto = "002" Then
Fact.TrasladoIVA += importe
End If
If TipoImpuesto = "001" Then
Fact.TrasladoISR += importe
End If
Next
Fact.SumaTotalTraslados += Fact.TrasladoIVA + Fact.TrasladoIEPS
Catch ex As Exception
ex.ToString().GuardaLogAD(ArchivoLog)
End Try
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim nodeTFD As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:TimbreFiscalDigital", "tfd"), namespaces)
Fact.UUID = ValorXML(nodeTFD, "UUID", "")
Dim nodeRF As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:CFDIRegistroFiscal ", "registrofiscal"), namespaces)
If nodeRF IsNot Nothing Then
Fact.Folio = ValorXML(nodeRF, "folio").TrimStart("0"c)
End If
Else
Fact.UUID = ""
If String.IsNullOrEmpty(Fact.UUID) AndAlso Fact.sUPPrefijo.ToLower() = "cfdi" Then
'Mensajes.AppendFormat("{0}|{1}|{2}|{3}|{4}|{5}{6}&", ValorXML(nodo, "serie"), ValorXML(nodo, "folio"), ValorXML(nodo, "fecha").ToDate().ToShortDateString(), Fact.EmisorNombre, ValorXML(nodo, "total").ToDouble().FormatoNumero(), "Factura no timbrada correctamente.", "")
'CargaMensaje(ValorXML(nodo, "serie"), ValorXML(nodo, "folio"), ValorXML(nodo, "fecha").ToDate(), Fact.EmisorNombre, ValorXML(nodo, "total").ToDouble(), "Factura no timbrada correctamente.", CorreoActual, DateTime.Now, _EmiRFC, 0)
End If
Fact = Nothing
End If
If Fact.TipoComprobante = "P" Then
CargaPagos(XMLDoc)
End If
Return Fact
End Function
Private Sub CargaPagos(ByVal XMLDoc As XmlDocument)
Dim nodo = XMLDoc.DocumentElement
Dim Prefijo As String = If(String.IsNullOrEmpty(XMLDoc.DocumentElement.Prefix), "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = "http://www.sat.gob.mx/cfd/3"
Dim namespaces As XmlNamespaceManager = New XmlNamespaceManager(XMLDoc.NameTable)
Dim Version = ValorXML(nodo, "version").Replace("..", ".")
Dim PrefijoPagos As String = ""
If Prefijo.ToLower() <> "cfdi" Then cfdVer = "http://www.sat.gob.mx/cfd/2"
If Version = "3.3" Then
PrefijoPagos = "pago10"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/3"
namespaces.AddNamespace(Prefijo, cfdVer)
ElseIf Version = "4.0" Then
PrefijoPagos = "pago20"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos20")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/4"
namespaces.AddNamespace(Prefijo, cfdVer)
Else
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If Version = "3.2" Then
ElseIf Version = "3.3" OrElse Version = "4.0" Then
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim NodosNodePagos As XmlNodeList = nodeComp.SelectNodes($"//{PrefijoPagos}:Pago", namespaces)
If NodosNodePagos IsNot Nothing Then
Try
Dim nodePagos As XmlNode = nodeComp.SelectSingleNode($"//{PrefijoPagos}:Pagos", namespaces)
If Version = "3.3" Then
XMLNodosPagos = nodePagos.InnerXml.Replace("pago10:", "").Replace("pagos10:", "").Replace(PrefijoPagos & ":", "")
Else
XMLNodosPagos = nodePagos.InnerXml.Replace("pago20:", "").Replace("pagos20:", "").Replace(PrefijoPagos & ":", "")
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
End If
Dim Pagos = New List(Of Pago)()
Dim FechaPago As Date
For Each nodePago As XmlNode In NodosNodePagos
Try
FechaPago = ValorXML(nodePago, "FechaPago").ToDate()
Catch e As Exception
End Try
Dim pago = New Pago()
pago.FechaPago = FechaPago
pago.FormaDePagoP = ValorXML(nodePago, "FormaDePagoP").ToString()
pago.MonedaP = ValorXML(nodePago, "MonedaP").ToString()
pago.Monto = ValorXML(nodePago, "Monto").ToString().ToDecimal()
Dim docs = New List(Of DoctoRelacionado)()
Dim NodosPagosRelacionados As XmlNodeList = nodePago.SelectNodes($"//{PrefijoPagos}:DoctoRelacionado", namespaces)
For Each docto As XmlNode In NodosPagosRelacionados
Dim idDoc = ValorXML(docto, "idDocumento")
Dim ImportePago = ValorXML(docto, "ImpPagado").ToDecimal()
Dim serie = ValorXML(docto, "Serie")
Dim Folio = ValorXML(docto, "Folio")
Dim MonedaDR = ValorXML(docto, "MonedaDR")
Dim MetodoDePagoDR = ValorXML(docto, "MetodoDePagoDR")
Dim NumParcialidad = ValorXML(docto, "NumParcialidad")
Dim ImpSaldoInsoluto = ValorXML(docto, "ImpSaldoInsoluto").ToDecimal()
Dim ImpSaldoAnt = ValorXML(docto, "ImpSaldoAnt").ToDecimal()
docs.Add(New DoctoRelacionado() With {
.idDocumento = idDoc,
.ImportePago = ImportePago,
.Serie = serie,
.Folio = Folio,
.MonedaDR = MonedaDR,
.MetodoDePagoDR = MetodoDePagoDR,
.NumParcialidad = NumParcialidad,
.ImpSaldoAnt = ImpSaldoAnt,
.ImpSaldoInsoluto = ImpSaldoInsoluto
})
Next
pago.Documentos = docs
Pagos.Add(pago)
Next
Me.Pagos = Pagos
End If
End If
End Sub
Private Function ValorXML(n As XmlNode, Campo As String, Optional Retorno As String = "") As String
Dim o As XmlNode = n.Attributes.Cast(Of XmlAttribute)().SingleOrDefault(Function(a) String.Compare(a.Name, Campo, True) = 0)
If o Is Nothing Then
Return Retorno
Else
Return o.Value
End If
End Function
Private Function CaratecteresvalidosFolio(ByVal Folio As String) As String
Dim Respuesta As String = ""
'For Each c As Char In Folio.ToArray()
' If (c >= 48 AndAlso c <= 57) OrElse (c >= 65 AndAlso c <= 90) OrElse (c >= 97 AndAlso c <= 122) Then
' Respuesta += c
' End If
'Next
Return Respuesta
End Function
'Private Sub CargaDesdeString(StrFuente As String)
' Dim XMLCargaExistosa As Boolean = False
' Dim XMlStr As String = StrFuente.Replace("<br>", "").Replace("<", "").Replace("o;?", "")
' Dim XMLDoc As New XmlDocument
' Try
' XMLDoc.LoadXml(XMlStr)
' XMLCargaExistosa = True
' Catch ex As Exception
' GuardaLog("Error al intentar leer . Error:" & ex.ToString())
' 'Errores.AppendLine("Error al intentar leer el XML. Error:" & ex.ToString())
' XMLCargaExistosa = False
' End Try
' If XMLCargaExistosa Then
' CargaComprobanteXML(XMLDoc)
' End If
'End Sub
Public Function CargaComprobanteXML(StrFuente As String, DirectorioEmpresa As String, RFCEmpresa As String, CveEmpresa As Integer, Registrar As Boolean, ByRef rowLog As DataRow, NombreArchivo As String, Optional Validada As Integer = 0) As Factura
Dim SeValido As Boolean = False
Dim XMLCargaExistosa As Boolean = False
Dim XMlStr As String = StrFuente.Replace("<br>", "").Replace("<", "").Replace("o;?", "")
Dim XMLDoc As New XmlDocument
Try
XMLDoc.LoadXml(XMlStr)
XMLCargaExistosa = True
Catch ex As Exception
GuardaLogAD("Error al intentar leer . Error:" & ex.ToString(), ArchivoLog)
'Errores.AppendLine("Error al intentar leer el XML. Error:" & ex.ToString())
XMLCargaExistosa = False
End Try
If Not XMLCargaExistosa Then
rowLog("Motivo") = $"Error extructura XML archivo {NombreArchivo}"
Return Nothing
End If
Dim nodo As XmlNode = XMLDoc.DocumentElement
Dim Fact As Factura = New Factura()
Fact.Serie = ValorXML(nodo, "serie")
Dim StrCFDIVersion As String = ValorXML(nodo, "version")
Fact.Version = StrCFDIVersion
Fact.Folio = ValorXML(nodo, "folio")
Fact.Fecha = ValorXML(nodo, "fecha").ToDate
Fact.SubTotal = ValorXML(nodo, "subTotal").ToDecimal
Fact.Total = ValorXML(nodo, "total").ToDecimal
Fact.Descuento = ValorXML(nodo, "descuento").ToDecimal
Fact.Moneda = ValorXML(nodo, "Moneda")
Fact.CveMoneda = ClsPaginas.GlobalDTMonedas().FiltroPrimeroValor("CveMoneda", $" AbreviaturaSAT = '{Fact.Moneda}' ").ToEntero
Fact.TipoComprobante = ValorXML(nodo, "tipoDeComprobante")
Fact.TipoCambio = ValorXML(nodo, "TipoCambio", "1").ToDecimal
Fact.noCertificado = ValorXML(nodo, "NoCertificado")
Fact.FormaDePago = ValorXML(nodo, "formaDePago")
Fact.condicionesDePago = ValorXML(nodo, "condicionesDePago", "")
Fact.NumCtaPagoNumCtaPago = ValorXML(nodo, "NumCtaPago", "")
If Fact.Version = "3.3" Or Fact.Version = "4.0" Then
Dim drm As DataRow = ClsPaginas.GlobalDTVtaMetodoPago.FiltroPrimero(String.Format("ClaveMetodoPagoSAT = '{0}'", ValorXML(nodo, "MetodoPago")))
If drm IsNot Nothing Then
Fact.MetododePago = drm("MetodoPagoSAT").ToString
End If
End If
Dim namespaces As New XmlNamespaceManager(XMLDoc.NameTable)
Dim Prefijo As String = If(XMLDoc.DocumentElement.Prefix = "", "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = ""
If StrCFDIVersion = "3.2" Then
Prefijo = "cfd"
cfdVer = "http://www.sat.gob.mx/cfd/2"
ElseIf StrCFDIVersion = "3.3" Then
cfdVer = "http://www.sat.gob.mx/cfd/3"
Else ' se considera que es la version 4.0
cfdVer = "http://www.sat.gob.mx/cfd/4"
End If
namespaces.AddNamespace(Prefijo, cfdVer)
namespaces.AddNamespace("aerolineas", "http://www.sat.gob.mx/aerolineas")
namespaces.AddNamespace("tfd", "http://www.sat.gob.mx/TimbreFiscalDigital")
namespaces.AddNamespace("implocal", "http://www.sat.gob.mx/implocal")
namespaces.AddNamespace("registrofiscal", "http://www.sat.gob.mx/registrofiscal")
Fact.sUPPrefijo = Prefijo
If StrCFDIVersion = "3.2" Then
For i As Integer = 0 To XMLDoc.DocumentElement.ChildNodes(2).ChildNodes.Count - 1
nodo = XMLDoc.DocumentElement.ChildNodes(2).ChildNodes(i)
Fact.AddPS(Convert.ToDouble(nodo.Attributes.GetNamedItem("cantidad").Value), nodo.Attributes.GetNamedItem("unidad").Value, nodo.Attributes.GetNamedItem("descripcion").Value, Convert.ToDouble(nodo.Attributes.GetNamedItem("valorUnitario").Value), 0, Convert.ToDouble(nodo.Attributes.GetNamedItem("importe").Value))
Next
Try
Dim nodosEmisor = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().FirstOrDefault(Function(n) n.Name.Equals("cfdi:Emisor", StringComparison.OrdinalIgnoreCase))
Dim nodoEmisor As XmlNode = nodosEmisor
Fact.EmiRFC = ValorXML(nodoEmisor, "rfc", "")
Fact.EmiNombre = ValorXML(nodoEmisor, "nombre", "")
nodoEmisor = nodosEmisor.ChildNodes(0)
Fact.DomFisCalle = ValorXML(nodoEmisor, "calle", "")
Fact.DomFisNoExt = ValorXML(nodoEmisor, "noExterior", "")
Fact.DomFisCol = ValorXML(nodoEmisor, "colonia", "")
Fact.DomFisCP = ValorXML(nodoEmisor, "codigoPostal", "")
Fact.DomFisMun = ValorXML(nodoEmisor, "municipio", "")
Fact.DomFisLoc = ValorXML(nodoEmisor, "localidad", "")
Fact.DomFisEst = ValorXML(nodoEmisor, "estado", "")
Fact.DomFisPais = ValorXML(nodoEmisor, "pais", "")
nodoEmisor = nodosEmisor.ChildNodes(1)
Fact.ExpEnCalle = ValorXML(nodoEmisor, "calle", "")
Fact.ExpEnNoExt = ValorXML(nodoEmisor, "noExterior", "")
Fact.ExpEnCol = ValorXML(nodoEmisor, "colonia", "")
Fact.ExpEnCP = ValorXML(nodoEmisor, "codigoPostal", "")
Fact.ExpEnMun = ValorXML(nodoEmisor, "municipio", "")
Fact.ExpEnLoc = ValorXML(nodoEmisor, "localidad", "")
Fact.ExpEnEst = ValorXML(nodoEmisor, "estado", "")
Fact.ExpEnPais = ValorXML(nodoEmisor, "pais", "")
nodoEmisor = nodoEmisor.ChildNodes(2)
Fact.Regimen = ValorXML(nodo, "Regimen", "")
Catch ex As Exception
Throw New Exception($"Error CargaEmisorXML - {ex.Message} - {ex.StackTrace}")
End Try
Try
Dim nodosReceptor = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().FirstOrDefault(Function(n) n.Name.Equals("cfdi:Receptor", StringComparison.OrdinalIgnoreCase))
Dim nodoReceptor As XmlNode = nodosReceptor
Fact.RecRfc = ValorXML(nodoReceptor, "rfc", "")
Fact.RecNombre = ValorXML(nodoReceptor, "nombre", "")
nodoReceptor = nodosReceptor.ChildNodes(0)
Fact.DomRecCalle = ValorXML(nodoReceptor, "calle", "")
Fact.DomRecFisNoExt = ValorXML(nodoReceptor, "noExterior", "")
Fact.DomRecFisNoInt = ValorXML(nodoReceptor, "noInterior", "")
Fact.DomRecCol = ValorXML(nodoReceptor, "colonia", "")
Fact.DomRecCP = ValorXML(nodoReceptor, "codigoPostal", "")
Fact.DomRecMun = ValorXML(nodoReceptor, "municipio", "")
Fact.DomRecLoc = ValorXML(nodoReceptor, "localidad", "")
Fact.DomRecEst = ValorXML(nodoReceptor, "estado", "")
Fact.DomRecPais = ValorXML(nodoReceptor, "pais", "")
Catch ex As Exception
Throw New Exception($"Error CargaReceptorXML - {ex.Message} - {ex.StackTrace}")
End Try
ElseIf StrCFDIVersion = "3.3" OrElse StrCFDIVersion = "4.0" Then
Try
Dim nodos = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().Where(Function(n) n.Name.Equals("cfdi:Conceptos", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().ChildNodes
For Each item As XmlNode In nodos
Dim cantidad = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("cantidad", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Dim unidad = item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("ClaveUnidad", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value
Dim descripcion = item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("descripcion", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value
Dim valorUnitario = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("valorUnitario", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Dim importe = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("importe", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Fact.AddPS(cantidad, unidad, descripcion, valorUnitario, 0, importe)
Next
Catch ex As Exception
Throw New Exception($"Error CargaConceptosXML - {ex.Message} - {ex.StackTrace}")
End Try
End If
If Fact.TipoComprobante.ToUpper = "E" AndAlso (Fact.Version.Contiene("3.3", "4.0")) Then
Dim UUIDS As String = ""
Dim UUIDSLista As New List(Of String)
Dim nodeCFDIRelacionados As XmlNode
nodeCFDIRelacionados = XMLDoc.SelectSingleNode(String.Format("//{0}:CfdiRelacionados", Prefijo), namespaces)
If nodeCFDIRelacionados IsNot Nothing Then
For Each CFDIRelacionados As XmlNode In nodeCFDIRelacionados
UUIDSLista.Add("" & CFDIRelacionados.Attributes("UUID").Value.ToString & "")
Next
End If
End If
Dim node As XmlNode
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Emisor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.EmisorRFC = ValorXML(node, "RFC")
Fact.EmisorNombre = ValorXML(node, "Nombre")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Receptor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.ReceptorRFC = ValorXML(node, "RFC")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Impuestos", Prefijo), namespaces)
If node IsNot Nothing AndAlso node.ChildNodes.Count > 0 Then
Dim nodeRetenciones As XmlNodeList = XMLDoc.SelectNodes(String.Format("//{0}:Comprobante/{0}:Impuestos/{0}:Retenciones/{0}:Retencion", Prefijo), namespaces)
If Fact.Version.Contiene("3.3", "4.0") Then
For Each retencion As XmlNode In nodeRetenciones
If retencion.Attributes("Impuesto").Value = "002" Then Fact.RetencionIVA += retencion.Attributes("Importe").Value.ToDecimal
If retencion.Attributes("Impuesto").Value = "001" Then Fact.RetencionISR += retencion.Attributes("Importe").Value.ToDecimal
Next
Else
For Each retencion As XmlNode In nodeRetenciones
If retencion.Attributes("impuesto").Value = "IVA" Then Fact.RetencionIVA += retencion.Attributes("importe").Value.ToDecimal
If retencion.Attributes("impuesto").Value = "ISR" Then Fact.RetencionISR += retencion.Attributes("importe").Value.ToDecimal
Next
End If
Dim nodeTraslados As XmlNodeList = XMLDoc.SelectNodes(String.Format("//{0}:Comprobante/{0}:Impuestos/{0}:Traslados/{0}:Traslado", Prefijo), namespaces)
If Fact.Version.Contiene("3.3", "4.0") Then
For Each traslado As XmlNode In nodeTraslados
If traslado.Attributes("Importe") IsNot Nothing Then
If traslado.Attributes("Impuesto").Value = "002" Then Fact.TrasladoIVA += traslado.Attributes("Importe").Value.ToDecimal
If traslado.Attributes("Impuesto").Value = "003" Then Fact.TrasladoIEPS += traslado.Attributes("Importe").Value.ToDecimal
End If
Next
Else
For Each traslado As XmlNode In nodeTraslados
If traslado.Attributes("Importe") IsNot Nothing Then
If traslado.Attributes("impuesto").Value = "IVA" Then Fact.TrasladoIVA += traslado.Attributes("importe").Value.ToDecimal
If traslado.Attributes("impuesto").Value = "IEPS" Then Fact.TrasladoIEPS += traslado.Attributes("importe").Value.ToDecimal
End If
Next
End If
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim nodeTFD As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:TimbreFiscalDigital", "tfd"), namespaces)
Fact.UUID = ValorXML(nodeTFD, "UUID", "")
Dim nodeRF As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:CFDIRegistroFiscal ", "registrofiscal"), namespaces)
If nodeRF IsNot Nothing Then
Fact.Folio = ValorXML(nodeRF, "folio").TrimStart("0"c)
End If
End If
If Fact.TipoComprobante = "P" Then
CargaPagos(XMLDoc, Fact)
End If
rowLog("Serie") = Fact.Serie
rowLog("Folio") = Fact.Folio
rowLog("Fecha") = Fact.Fecha
rowLog("Proveedor") = Fact.EmisorNombre
rowLog("Importe") = Fact.Total
rowLog("Motivo") = ""
rowLog("RFCde") = Fact.EmisorRFC
rowLog("Estatus") = 0
rowLog("Tipo") = Fact.TipoComprobante
If Registrar Then
If Fact.ReceptorRFC = RFCEmpresa Then
Fact.Validada = Validada
Dim ObjCompra As New ClsCompras
Dim Correcto As Boolean = False
ObjCompra.IniciaTransacSQL()
Fact.RespuestaInsert = ObjCompra.AddFactura(Fact.Serie, Fact.Folio, Fact.Fecha, Fact.EmisorNombre, Fact.EmisorRFC, Fact.SubTotal, Fact.TrasladoIVA, Fact.Total, Fact.UUID, Fact.ReceptorRFC, "", "", Fact.Version, Fact.Descuento, Fact.TipoCambio, Fact.Validada, CveEmpresa, Fact.sUPPrefijo, Fact.TipoComprobante, Fact.Moneda, Fact.MetododePago, 3, Fact.Version, Fact.IEPS, Fact.RetencionIVA, Fact.RetencionISR)
If Fact.RespuestaInsert >= 0 Then
rowLog("Estatus") = 1
Dim Destino As String = $"{DirectorioEmpresa}\Compras\"
Try
If Not Directory.Exists(Destino & Fact.EmisorRFC) Then
Directory.CreateDirectory(Destino & Fact.EmisorRFC)
End If
Select Case Fact.RespuestaInsert
Case 0
Dim RRutaDestino As String = String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura)
ModExtensiones.GuardaLogAD(String.Format(" '--------{0} Compra ya insertada : {1}{2} - {3}", 1, Fact.Serie, Fact.Folio, RRutaDestino), ArchivoLog)
File.WriteAllText(RRutaDestino, StrFuente, UTF8Encoding.UTF8)
'ObjCompra.UpdateArchivo(ObjCompra.CveFactura, "XML")
ModExtensiones.GuardaLogAD(" '--------XML Actualizado ", ArchivoLog)
rowLog("Motivo") = $"Ya registrado {Fact.Serie}-{Fact.Folio} se actualiza XML."
Correcto = True
Exit Select
Case 1
Dim StrMover As String = ""
Try
File.WriteAllText(String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura), StrFuente, UTF8Encoding.UTF8)
' ObjCompra.UpdateArchivo(ObjCompra.CveFactura, "XML")
ModExtensiones.GuardaLogAD($" '-------- XML Guardado Factura: {Fact.Serie}-{Fact.Folio} UUID: {Fact.UUID} , RFC Emisor: {Fact.EmisorRFC}", ArchivoLog)
' Si se movieron los dos archivos, los marca como correcto
If File.Exists(String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura)) Then
Correcto = True
Else
Correcto = False
End If
ModExtensiones.GuardaLogAD(" '++++++++ Compra Insertada :" & Fact.Serie & Fact.Folio & " - Correcto:" & If(Correcto, "Si", "No" & " Obs: "), ArchivoLog)
rowLog("Motivo") = $"Agregado {Fact.Serie}-{Fact.Folio}"
Catch ex As Exception
StrMover = ex.Message
Correcto = False
ModExtensiones.GuardaLogAD(" '++++++++ Compra no Insertada :" & Fact.Serie & Fact.Folio & " - Correcto:" & If(Correcto, "Si", "No" & " Obs: ") & StrMover, ArchivoLog)
rowLog("Motivo") = $"Error al agregar {Fact.Serie}-{Fact.Folio}"
End Try
Exit Select
End Select
Catch ex As Exception
Correcto = True
GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
ElseIf Fact.RespuestaInsert = 0 AndAlso Fact.CveFactura > 0 Then
'FIXME OIC
Else
rowLog("Motivo") = $"RFC ""{Fact.ReceptorRFC}"" Error al insertar"
End If
If Correcto Then
ObjCompra.Commit()
Fact.CveFactura = ObjCompra.CveFactura
Fact.ArchivoXML = $"{ObjCompra.CveFactura}.xml"
Else
ObjCompra.RollBack()
End If
ObjCompra.Dispose()
Else
ModExtensiones.GuardaLogAD($" '++++++++ Compra RFC Distinto RFC Empresa: {RFCEmpresa}, RFC XML: {Fact.ReceptorRFC} ", ArchivoLog)
rowLog("Motivo") = "RFC Distinto"
rowLog("Motivo") = $"RFC ""{Fact.ReceptorRFC}"" Incorrecto"
End If
End If
Return Fact
End Function
Public Function GeneraPDF(UsuarioActual As Usuario, ByVal Ruta As String, ByVal Fact As Factura, DirectorioEmpresa As String, Guardar As Boolean) As Boolean
Dim RutaXML As String = String.Empty
Dim RutaPDF As String = String.Empty
Dim Retorno As Boolean = False
Try
Dim XMLDoc As New XmlDocument()
Dim TmpArchivoPDF As String = $"{Ruta}\Temp\Facturas\{Path.GetFileNameWithoutExtension(Fact.ArchivoXML)}-ttt.pdf"
Dim TmpArchivoQR As String = $"{Ruta}\Temp\Facturas\{Path.GetFileNameWithoutExtension(Fact.ArchivoXML)}-ttt.jpg"
Dim ArchivoXML As String = String.Format("{0}\Compras\{2}\{1}", DirectorioEmpresa, Fact.ArchivoXML, Fact.EmisorRFC)
Dim ArchivoPDF As String = String.Format("{0}\Compras\{2}\{1}.pdf", DirectorioEmpresa, Fact.CveFactura, Fact.EmisorRFC)
Dim dtotal As Decimal = If(Fact.Total <= 0.0D, 0.0001D, Fact.Total)
Dim cfdi As New RVCFDI33.GeneraCFDI()
Try
Dim b As Byte() = cfdi.ConvertirQrCode(String.Format("?re={0}&rr={1}&tt={2}&id={3}", Fact.EmisorRFC, Fact.ReceptorRFC, String.Format("{0,12:F6}", dtotal).Trim(), Fact.UUID))
File.WriteAllBytes(TmpArchivoQR, b)
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.Message, ArchivoLog)
End Try
If System.IO.File.Exists(TmpArchivoQR) Then
Dim TipoDocto As String = ""
If Fact.Version = "3.3" Or Fact.Version = "4.0" Then
Select Case Fact.TipoComprobante
Case "I"
TipoDocto = "Ing"
Case "E"
TipoDocto = "Egs"
Case "P"
TipoDocto = "Pag"
Case "T"
TipoDocto = "Tra"
Case Else
End Select
Else
TipoDocto = Fact.TipoComprobante
End If
'Dim DtPagos As DataTable = Nothing
'Dim DtDocumentosR As DataTable = Nothing
If Fact.TipoComprobante.Contiene("P", "T") Then
ModExtensiones.GuardaLogAD(String.Format(" '--------PDF Generar Tipo {0}", Fact.TipoComprobante), ArchivoLog)
Retorno = GenGoPdf(ArchivoXML, TmpArchivoPDF, DirectorioEmpresas)
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Try
If Guardar Then
If File.Exists(ArchivoPDF) Then
File.Delete(ArchivoPDF)
End If
File.Move(TmpArchivoPDF, ArchivoPDF)
End If
Retorno = True
Catch ex As Exception
Retorno = False
End Try
Else
If (Fact.Version = "3.3" Or Fact.Version = "4.0") Then
Dim cxml As XmlSatCFDI = XmlSatCFDI.readXML(ArchivoXML, ArchivoLog)
ModExtensiones.GuardaLogAD(String.Format(" *********** UUID : {0} ***********", cxml.complemento.UUID), ArchivoLog)
cxml.ImprimirPDF(UsuarioActual, TmpArchivoPDF, DirectorioEmpresa, Fact.TipoComprobante)
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Try
If Guardar Then
If File.Exists(ArchivoPDF) Then
File.Delete(ArchivoPDF)
End If
File.Move(TmpArchivoPDF, ArchivoPDF)
End If
Retorno = True
Catch ex As Exception
Retorno = False
End Try
Else
ModExtensiones.GuardaLogAD(String.Format(" *********** TFDUUID : {0} ***********", Fact.UUID), ArchivoLog)
Dim DomFiscal As String = String.Format("Domicilio Fiscal {0}{1} {2}{0}Col.{3}{0}CP. {4} {5},{6},{7}", vbCr, Fact.DomFisCalle, Fact.DomFisNoExt, Fact.DomFisCol, Fact.DomFisCP, Fact.DomFisMun, Fact.DomFisEst, Fact.DomFisPais)
If GeneraPDFNew(UsuarioActual, TmpArchivoPDF, Fact.UUID, Fact.SubTotal, Fact.Descuento, Fact.Total, Fact.TrasladoIVA.FormatoNumero(), Fact.Moneda, Fact.FormaDePago, Fact.TFDNoCertSAT, Fact.TFDFechaTimbrado.ToDate(), Fact.noCertificado,
Fact.DTConceptos, Fact.TFDSelloCFD, Fact.TFDSelloSAT, TmpArchivoQR, Fact.Serie + Fact.Folio, Fact.TipoComprobante, "", Fact.ReceptorRFC, Fact.RecNombre, Fact.DomRecCalle, Fact.DomRecCol, Fact.DomRecFisNoExt,
Fact.DomRecFisNoInt, Fact.DomRecCP, Fact.DomRecMun, Fact.DomRecEst, Fact.Regimen, Fact.condicionesDePago, Fact.MetododePago, Fact.NumCtaPagoNumCtaPago, DateTime.Now, Fact.DtPagos, Fact.DtDocumentosR, Fact.RetencionIVA,
Fact.RetencionISR, Fact.EmiNombre, Fact.EmiRFC, Fact.ReceptorNombre, DirectorioEmpresa, DomFiscal) Then
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Retorno = True
If Guardar Then
End If
End If
End If
File.Delete(TmpArchivoQR)
End If
RutaPDF = TmpArchivoPDF
Else
Retorno = False
End If
'If DTConceptos IsNot Nothing Then DTConceptos.Dispose()
Catch ex As Exception
Dim MensajeError As String = "***********Ocurrio un error al generar el pdf: " & ex.Message & ""
If ex.InnerException Is Nothing Then
MensajeError &= "."
Else
MensajeError &= " - " & ex.InnerException.ToString()
End If
ModExtensiones.GuardaLogAD(MensajeError, ArchivoLog)
End Try
Return Retorno
End Function
Private Function GeneraPDFNew(UsuarioActual As Usuario, ByVal TmpArchivoPDF As String, ByVal FolioFiscal As String, ByVal SubTotal As Decimal, ByVal Descuento As Decimal, ByVal Total As Decimal, ByVal IVA As String, ByVal Moneda As String, ByVal FormaDePago As String,
ByVal NoSerieCertificado As String, ByVal FechaCertificacion As DateTime, ByVal NoSerieCertificadoContribuyente As String, ByVal DTConceptos As DataTable, ByVal SelloCFDi As String, ByVal SelloSAT As String,
ByVal CBB As String, ByVal Folio As String, ByVal TipodeComprobante As String, ByVal CadenaOriginalCFD As String, ByVal RFC As String, ByVal Cliente As String, ByVal Direccion As String, ByVal Colonia As String,
ByVal NoExt As String, ByVal NoInt As String, ByVal CP As String, ByVal Ciudad As String, ByVal Estado As String, ByVal Regimen As String, ByVal CondicionPago As String, ByVal MetodoPago As String, ByVal NumCtaPago As String,
ByVal fecha As DateTime, Optional ByVal DtPagos As DataTable = Nothing, Optional ByVal DtRelacionados As DataTable = Nothing, Optional ByVal RetIVA As Double = 0, Optional ByVal RetISR As Double = 0,
Optional EmiNombre As String = "", Optional EmiRFC As String = "", Optional NombreEmpresa As String = "", Optional DirectorioEmpresa As String = "", Optional DomFiscal As String = "") As Boolean
Dim RutaRDLC As String = If(TipodeComprobante = "Pag", "Grales\Formatos\CFDIPago.rdlc", "Grales\Formatos\CFDI.rdlc")
Dim Retorno As Boolean = False
Dim NombreArchivo As String = TmpArchivoPDF
Dim CadenaOriginal As String = "||1.0|" & FolioFiscal & "|" & FechaCertificacion.ToString("yyyy-MM-dd") & "T" & FechaCertificacion.ToString("HH:mm:ss") & "|" & SelloCFDi & "|" & NoSerieCertificado & "||"
Dim RutaFormato As String = RutaRDLC
Try
Dim Archivo As New System.IO.FileInfo(RutaFormato)
If Archivo.Exists Then
Dim parametros As New List(Of ReportParameter)()
parametros.Add(New ReportParameter("FolioFiscal", FolioFiscal))
parametros.Add(New ReportParameter("SubTotal", SubTotal.FormatoNumero()))
parametros.Add(New ReportParameter("Descuento", Descuento.FormatoNumero()))
parametros.Add(New ReportParameter("Total", Total.FormatoNumero()))
parametros.Add(New ReportParameter("IVA", IVA.FormatoNumero()))
parametros.Add(New ReportParameter("RetIVA", RetIVA.FormatoNumero()))
parametros.Add(New ReportParameter("RetISR", RetISR.FormatoNumero()))
parametros.Add(New ReportParameter("Moneda", Moneda))
parametros.Add(New ReportParameter("FormaDePago", FormaDePago))
parametros.Add(New ReportParameter("NoSerieCertificado", NoSerieCertificado))
parametros.Add(New ReportParameter("FechaCertificacion", FechaCertificacion.ToString("yyyy-MM-dd") & "T" & FechaCertificacion.ToString("HH:mm:ss")))
parametros.Add(New ReportParameter("NoSerieCertificadoContribuyente", NoSerieCertificadoContribuyente))
parametros.Add(New ReportParameter("SelloCFDi", SelloCFDi))
parametros.Add(New ReportParameter("SelloSAT", SelloSAT))
parametros.Add(New ReportParameter("CBB", String.Format("file:///{0}", CBB)))
parametros.Add(New ReportParameter("Folio", Folio))
parametros.Add(New ReportParameter("TipodeComprobante", TipodeComprobante.ToUpper()))
parametros.Add(New ReportParameter("CadenaOriginalCFD", CadenaOriginalCFD))
parametros.Add(New ReportParameter("RFC", RFC))
parametros.Add(New ReportParameter("Cliente", Cliente))
parametros.Add(New ReportParameter("Direccion", Direccion))
parametros.Add(New ReportParameter("Colonia", Colonia))
parametros.Add(New ReportParameter("NoExt", NoExt))
parametros.Add(New ReportParameter("NoInt", NoInt))
parametros.Add(New ReportParameter("CP", CP))
parametros.Add(New ReportParameter("Ciudad", Ciudad))
parametros.Add(New ReportParameter("Estado", Estado))
parametros.Add(New ReportParameter("Regimen", Regimen))
parametros.Add(New ReportParameter("CondicionPago", CondicionPago))
parametros.Add(New ReportParameter("MetodoPago", MetodoPago))
parametros.Add(New ReportParameter("NumCtaPago", NumCtaPago))
parametros.Add(New ReportParameter("fecha", fecha.ToString("yyyy-MM-dd") & "T" & fecha.ToString("HH:mm:ss")))
parametros.Add(New ReportParameter("Fiscal", DomFiscal))
parametros.Add(New ReportParameter("EmiNombre", EmiNombre))
parametros.Add(New ReportParameter("EmiRFC", EmiRFC))
parametros.Add(New ReportParameter("TotalLetra", ModExtensiones.Texto2Letras(Total)))
parametros.Add(New ReportParameter("Empresa", NombreEmpresa))
Dim listaDs As New List(Of ReportDataSource)
Dim rds1 As New ReportDataSource()
rds1.Name = "DsOC"
rds1.Value = DTConceptos
'MR.LocalReport.DataSources.Add(rds1)
listaDs.Add(rds1)
If DtPagos IsNot Nothing Then
Dim rds2 As New ReportDataSource()
rds2.Name = "DsPago"
rds2.Value = DtPagos
'MR.LocalReport.DataSources.Add(rds2)
listaDs.Add(rds2)
End If
If DtRelacionados IsNot Nothing Then
Dim rds3 As New ReportDataSource()
rds3.Name = "DsDocRelacionados"
rds3.Value = DtRelacionados
'MR.LocalReport.DataSources.Add(rds3)
listaDs.Add(rds3)
End If
Dim bytes As Byte() = Nothing
bytes = StreamPDF(UsuarioActual, RutaRDLC, listaDs, parametros, NombreArchivo:=NombreArchivo, Formato:="PDF")
If bytes IsNot Nothing Then
Using fs As New FileStream(NombreArchivo, FileMode.Create)
fs.Write(bytes, 0, bytes.Length)
fs.Close()
End Using
Retorno = True
Else
Retorno = False
End If
Else
ModExtensiones.GuardaLogAD("ERROR: No existe Formato Base", ArchivoLog)
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(String.Format("Ocurrio un Error al generar el reporte RLDC :" & ex.ToString()), ArchivoLog)
Retorno = False
End Try
Return Retorno
End Function
Private Sub CargaPagos(ByVal XMLDoc As XmlDocument, ByRef Fact As Factura)
Fact.Pagos.Clear()
Dim nodo = XMLDoc.DocumentElement
Dim Prefijo As String = If(String.IsNullOrEmpty(XMLDoc.DocumentElement.Prefix), "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = "http://www.sat.gob.mx/cfd/3"
Dim namespaces As New XmlNamespaceManager(XMLDoc.NameTable)
Dim Version As String = ValorXML(nodo, "version").Replace("..", ".")
Dim PrefijoPagos As String = ""
If Prefijo.ToLower() <> "cfdi" Then
cfdVer = "http://www.sat.gob.mx/cfd/2"
End If
If Version = "3.3" Then
PrefijoPagos = "pago10"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/3"
namespaces.AddNamespace(Prefijo, cfdVer)
ElseIf Version = "4.0" Then
PrefijoPagos = "pago20"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos20")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/4"
namespaces.AddNamespace(Prefijo, cfdVer)
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If Version = "3.3" OrElse Version = "4.0" Then
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim NodosNodePagos As XmlNodeList = nodeComp.SelectNodes($"//{PrefijoPagos}:Pago", namespaces)
If NodosNodePagos IsNot Nothing Then
Try
Dim nodePagos As XmlNode = nodeComp.SelectSingleNode($"//{PrefijoPagos}:Pagos", namespaces)
If Version = "3.3" Then
XMLNodosPagos = nodePagos.InnerXml.Replace("pago10:", "").Replace("pagos10:", "").Replace(PrefijoPagos & ":", "")
Else
XMLNodosPagos = nodePagos.InnerXml.Replace("pago20:", "").Replace("pagos20:", "").Replace(PrefijoPagos & ":", "")
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
End If
Dim Pagos As New List(Of Pago)()
For Each nodePago As XmlNode In NodosNodePagos
Dim FechaPago As DateTime = DateTime.Now
Try
FechaPago = ValorXML(nodePago, "FechaPago").ToDate()
Catch e As Exception
End Try
Dim pago As New Pago()
pago.FechaPago = FechaPago
pago.FormaDePagoP = ValorXML(nodePago, "FormaDePagoP").ToString()
pago.MonedaP = ValorXML(nodePago, "MonedaP").ToString()
pago.Monto = ValorXML(nodePago, "Monto").ToString().ToDecimal()
Dim docs As New List(Of DoctoRelacionado)()
Dim NodosPagosRelacionados As XmlNodeList = nodePago.SelectNodes($"//{PrefijoPagos}:DoctoRelacionado", namespaces)
For Each docto As XmlNode In NodosPagosRelacionados
Dim idDoc = ValorXML(docto, "idDocumento")
Dim ImportePago = ValorXML(docto, "ImpPagado").ToDecimal()
Dim serie = ValorXML(docto, "Serie")
Dim Folio = ValorXML(docto, "Folio")
Dim MonedaDR = ValorXML(docto, "MonedaDR")
Dim MetodoDePagoDR = ValorXML(docto, "MetodoDePagoDR")
Dim NumParcialidad = ValorXML(docto, "NumParcialidad")
Dim ImpSaldoInsoluto = ValorXML(docto, "ImpSaldoInsoluto").ToDecimal()
Dim ImpSaldoAnt = ValorXML(docto, "ImpSaldoAnt").ToDecimal()
docs.Add(New DoctoRelacionado() With {
.idDocumento = idDoc,
.ImportePago = ImportePago,
.Serie = serie,
.Folio = Folio,
.MonedaDR = MonedaDR,
.MetodoDePagoDR = MetodoDePagoDR,
.NumParcialidad = NumParcialidad,
.ImpSaldoAnt = ImpSaldoAnt,
.ImpSaldoInsoluto = ImpSaldoInsoluto
})
Next
pago.Documentos = docs
Pagos.Add(pago)
Next
Fact.Pagos = Pagos
End If
End If
End Sub
Private Function GenGoPdf(ByVal XmlRutaArchivo As String, ByVal PDFRutaArchivo As String, DirectorioEmpresa As String) As Boolean
ModExtensiones.GuardaLogAD(" '--------PDF GenGoPdf Inicia ", ArchivoLog)
Dim Respuesta As Boolean = False
Dim RutaRDLC As String = $"{DirectorioEmpresa}\Grales\Formatos\ReciboDePagoGOPDF.rdlc" 'String.Format("{0}{1}", Extensiones.ApplicationParameter.RutaArchivos, "Empresas\Grales\Formatos\ReciboDePagoGOPDF.rdlc")
Dim Inicio As DateTime = DateTime.Now
Dim goPdf As New GoPdf.GoPdf()
Dim logotipo As Byte() = Nothing 'File.ReadAllBytes(@"C:\inetpub\WWWSIGGit\Empresas\119\Logo.jpg")
Try
Dim XmlString As String = File.ReadAllText(XmlRutaArchivo)
Dim result As Byte() = goPdf.ExportarPdf(XmlString, logotipo, "", RutaRDLC, New GoPdf.Modelos.DatosAdicionales() With {.DomicilioReceptor = ""})
Dim Fin As DateTime = DateTime.Now
If result IsNot Nothing Then
File.WriteAllBytes(PDFRutaArchivo, result)
Respuesta = True
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Generado", ArchivoLog)
Else
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Error se genero nulo \n RDLC: {RutaRDLC} Ruta Xml: {XmlRutaArchivo} Ruta PDF: {PDFRutaArchivo} \n MensajeError: {goPdf.MensajeError} CodigoError :{goPdf.CodigoError}", ArchivoLog)
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Error {ex.Message} -- > {ex.StackTrace} \n RDLC: {RutaRDLC} Ruta Xml: {XmlRutaArchivo} Ruta PDF: {PDFRutaArchivo}", ArchivoLog)
End Try
ModExtensiones.GuardaLogAD(" '--------PDF GenGoPdf Finaliza ", ArchivoLog)
Return Respuesta
End Function
Public Function StreamPDF(UsuarioActual As Usuario, RutaReporte As String, DataSource As List(Of ReportDataSource), Parametros As List(Of ReportParameter), Optional NombreArchivo As String = "Reporte", Optional Formato As String = "PDF", Optional MR As ReportViewer = Nothing, Optional SubReportData As Modelos.MSubReportData = Nothing) As Byte()
'limpio ReportViwer
Dim sw As Stopwatch = Stopwatch.StartNew()
Dim Bytes As Byte() = Nothing
Dim CveUsuario As Integer = 0
Dim CveEmpresa As Integer = 0
Dim RutaEmpresa As String = ""
If UsuarioActual IsNot Nothing Then
CveUsuario = UsuarioActual.CveUsuario
CveEmpresa = UsuarioActual.CveEmpresa
RutaEmpresa = UsuarioActual.Empresa.Ruta
End If
Dim bdir As String = If(RutaReporte.Contains("Empresas"), ModExtensiones.DirectorioBaseEmpresas, AppDomain.CurrentDomain.BaseDirectory)
'TOMAR LA RUTA BASE PARA EL DIRECTORIO DE LA EMPRESA
If Not String.IsNullOrEmpty(RutaEmpresa) AndAlso Not RutaReporte.Contains("Grales") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("AC/Reportes/") Then
bdir = RutaEmpresa.Replace($"{CveEmpresa}/", "")
End If
RutaReporte.Replace("/", "\")
If Not RutaReporte.ToUpper().StartsWith(bdir.ToUpper()) Then
RutaReporte = String.Format("{0}{1}", bdir, RutaReporte)
End If
If EsProduccion Then
Dim wsreport As New WSRDLC2.WebServiceSoapClient
Dim params As New List(Of WSRDLC2.ReportParameter)
Dim reportobjects As New List(Of WSRDLC2.ReportObjects)
Dim jsonData As String = Nothing
If SubReportData IsNot Nothing Then
jsonData = Newtonsoft.Json.JsonConvert.SerializeObject(SubReportData)
End If
Dim ds As New DataSet
For Each rpds As ReportDataSource In DataSource
If rpds.Value IsNot Nothing Then
If rpds.Value.GetType().ToString() = "System.Data.DataTable" Then
Dim dt As DataTable = DirectCast(rpds.Value, Data.DataTable)
dt = dt.Copy()
dt.TableName = rpds.Name
ds.Tables.Add(dt)
Else
Dim ojext As New WSRDLC2.ReportObjects
ojext.Name = rpds.Name
ojext.Value = rpds.Value
reportobjects.Add(ojext)
End If
Else
Dim dt As DataTable = New DataTable()
dt.TableName = If(String.IsNullOrEmpty(rpds.Name), "DataTable1", rpds.Name)
ds.Tables.Add(dt)
End If
Next
For Each rpds As ReportParameter In Parametros
Dim param As New WSRDLC2.ReportParameter
param.Name = rpds.Name
'SI ES TEXTO, QUITAR TABS Y OTROS ESPACIOS QUE DEN PROBLEMAS AL MANDAR LA PETICION
If rpds IsNot Nothing AndAlso rpds.Values IsNot Nothing AndAlso rpds.Values.Count > 0 AndAlso rpds.Values(0) IsNot Nothing AndAlso rpds.Values(0).GetType() = GetType(String) Then
param.Values = {rpds.Values(0).Replace(vbVerticalTab, "")}
Else
param.Values = {rpds.Values(0)}
End If
params.Add(param)
Next
Bytes = wsreport.StreamNEWPDFBytes(RutaReporte, ds, reportobjects.ToArray(), params.ToArray(), NombreArchivo, Formato, CveEmpresa, CveUsuario, jsonData)
wsreport = Nothing
params = Nothing
ds.Dispose() : ds = Nothing
Else
If IsNothing(MR) Then MR = New ReportViewer
Try
' MasterReporteador.LocalReport.DataSources.Clear()
For Each RDS As ReportDataSource In DataSource
MR.LocalReport.DataSources.Add(RDS)
Next
MR.LocalReport.ReportPath = RutaReporte
MR.ProcessingMode = ProcessingMode.Local
MR.LocalReport.EnableExternalImages = True
MR.LocalReport.SetParameters(Parametros)
MR.LocalReport.Refresh()
Dim Warnings As Warning() = Nothing
Dim StreamIds As String() = Nothing
Dim MimeType As String = Nothing
Dim Encoding As String = Nothing
Dim Extension As String = Nothing
Bytes = MR.LocalReport.Render(Formato, Nothing, MimeType, Encoding, Extension, StreamIds, Warnings)
Catch ex As Microsoft.Reporting.WebForms.ScriptManagerNotFoundException
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
Catch ex As Exception
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
End Try
Try
MR.Dispose()
Catch ex As Exception
GuardaLog($"Error: { ex.ToString() }")
End Try
MR = Nothing
End If
sw.Stop()
If sw.Elapsed.TotalSeconds > 5 Then
GuardaLog($"Reporte:{RutaReporte} | Tiempo Renderizado Milisegundos: {sw.ElapsedMilliseconds},Total Segundos: {sw.Elapsed.TotalSeconds} ")
End If
Return Bytes
End Function
End Class
Namespace ADS.TareasProgramdas
Public Class Factura
Public Property CveFactura As Integer = -1
Public Property RespuestaInsert As Integer = -1
Friend noCertificado As String = ""
Public Property CveEmpresa As Integer
Public Property Version As String
Public Property Serie As String
Public Property Folio As String
Public Property Fecha As Date
Public Property SubTotal As Decimal
Public Property Total As Decimal
Public Property Moneda As String
Public Property CveMoneda As Integer
Public Property TipoComprobante As String
Public Property Descuento As Decimal
Public Property TipoCambio As Decimal
Public Property MetododePago As String = ""
Public Property EmisorRFC As String
Public Property EmisorNombre As String
Public Property EmisorRegimenFiscal As String
Public Property ReceptorRFC As String
Public Property ReceptorNombre As String
Public Property ReceptorUsoCFDI As String
Public Property TotalRetenciones As Decimal
Public Property SumaTotalRetenciones As Decimal
Public Property TotalTraslados As Decimal
Public Property SumaTotalTraslados As Decimal
Public Property TrasladoIVA As Decimal
Public Property TrasladoIEPS As Decimal
Public Property TrasladoISR As Decimal
Public Property RetencionIVA As Decimal
Public Property RetencionISR As Decimal
Public Property sUPPrefijo As String
Public Property UUID As String
Public Property Validada As Integer = 0
Public Property ArchivoXML As String
Public Property ArchivoPDF As String
Public Property Pagos As New List(Of Pago)
Public Property IEPS As Decimal
Public Property TFDFechaTimbrado As String
Public Property TFDSelloCFD As String
Public Property TFDNoCertSAT As String
Public Property TFDSelloSAT As String
Public Property FormaDePago As String
Public Property DTConceptos As DataTable
Public Property EmiRFC As String
Public Property EmiNombre As String
Public Property DomFisCalle As String
Public Property DomFisNoExt As String
Public Property DomFisCol As String
Public Property DomFisCP As String
Public Property DomFisMun As String
Public Property DomFisLoc As String
Public Property DomFisEst As String
Public Property DomFisPais As String
Public Property ExpEnCalle As String
Public Property ExpEnNoExt As String
Public Property ExpEnCol As String
Public Property ExpEnCP As String
Public Property ExpEnMun As String
Public Property ExpEnLoc As String
Public Property ExpEnEst As String
Public Property ExpEnPais As String
Public Property Regimen As String
Public Property RecRfc As String
Public Property RecNombre As String
Public Property DomRecCalle As String
Public Property DomRecFisNoExt As String
Public Property DomRecFisNoInt As String
Public Property DomRecCol As String
Public Property DomRecCP As String
Public Property DomRecMun As String
Public Property DomRecLoc As String
Public Property DomRecEst As String
Public Property DomRecPais As String
Public Property condicionesDePago As String
Public Property NumCtaPagoNumCtaPago As String
Private Property EsProduccion As Boolean = True
Public ReadOnly Property DtPagos As DataTable
Get
If Pagos.Count > 0 Then
Dim query = From p In Me.Pagos Select New With {.FechaPago = p.FechaPago, .FormaDePagoP = p.FormaDePagoP, .MonedaP = p.MonedaP, .ImportePago = p.Monto}
Dim DtPagosNew As DataTable = ModExtensiones.CopyToDataTable(query, True)
DtPagosNew.TableName = "DsPagos"
Return DtPagosNew
Else
Dim DtPagosNew As New DataTable
DtPagosNew.TableName = "DsPagos"
Return DtPagosNew
End If
End Get
End Property
Public ReadOnly Property DtDocumentosR As DataTable
Get
If Pagos.Count > 0 Then
Dim DtDocumentosRNew As DataTable = ModExtensiones.CopyToDataTable(Pagos(0).Documentos, True)
DtDocumentosRNew.TableName = "DsDocRelacionados"
Return DtDocumentosRNew
Else
Dim DtDocumentosRNew As New DataTable
DtDocumentosRNew.TableName = "DsDocRelacionados"
Return DtDocumentosRNew
End If
End Get
End Property
Private Sub CreaDTConceptos()
DTConceptos = New DataTable()
DTConceptos.Columns.Add("Consec", GetType(Integer))
DTConceptos.Columns.Add("Cantidad", GetType(Double))
DTConceptos.Columns.Add("UM", GetType(String))
DTConceptos.Columns.Add("PS", GetType(String))
DTConceptos.Columns.Add("PU", GetType(Double))
DTConceptos.Columns.Add("IVA", GetType(Double))
DTConceptos.Columns.Add("Total", GetType(Double))
End Sub
Public Sub New()
CreaDTConceptos()
End Sub
Public Sub AddPS(ByVal Cantidad As Double, ByVal UM As String, ByVal PS As String, ByVal PU As Double, ByVal IVA As Double, Optional ByVal Total As Double = 0)
If PS <> "IVA" Then
Dim Row As DataRow = Nothing
Row = DTConceptos.NewRow()
Row("Consec") = DTConceptos.Rows.Count + 1
Row("Cantidad") = Cantidad
Row("UM") = UM
Row("PS") = PS
Row("PU") = PU
Row("IVA") = IVA
Row("Total") = If(Total > 0, Total, (Cantidad * PU))
DTConceptos.Rows.Add(Row)
End If
End Sub
End Class
Public Class Pago
Public Property FechaPago As DateTime
Public Property FormaDePagoP As String
Public Property MonedaP As String
Public Property Monto As Decimal
Public Property Documentos As List(Of DoctoRelacionado)
End Class
Public Class DoctoRelacionado
Public Property Serie As String
Public Property Folio As String
Public Property ImportePago As Decimal
Public Property ImpSaldoAnt As Decimal
Public Property ImpSaldoInsoluto As Decimal
Public Property idDocumento As String
Public Property MonedaDR As String
Public Property MetodoDePagoDR As String
Public Property NumParcialidad As String
End Class
Public Class ComprobanteFactura
Private Property EsProduccion As Boolean = True
Public Property ArchivoLog As String
Public Sub New(NombreArchivoLog As String)
ArchivoLog = NombreArchivoLog
End Sub
Public Property Pagos As List(Of Pago)
Public Property XMLNodosPagos As String
Public Property XMLNodosPagosCount As Integer
Private Function CargaFactVersion33(CveEmpresa As Integer, ByRef node As XmlNode, ByRef nodo As XmlNode, ByRef XMLDoc As XmlDocument, ByVal Prefijo As String, ByRef namespaces As XmlNamespaceManager, ByVal VersionCFDI As String) As Factura
Dim Fact = New Factura()
Fact.Version = VersionCFDI
Fact.CveEmpresa = CveEmpresa
Fact.Serie = CaratecteresvalidosFolio(ValorXML(nodo, "serie"))
If Not String.IsNullOrEmpty(Fact.Serie) Then Fact.Serie = Fact.Serie
Fact.Folio = ValorXML(nodo, "folio").TrimStart("0"c)
Fact.Fecha = ValorXML(nodo, "fecha").ToDateTime
Fact.SubTotal = ValorXML(nodo, "subTotal").Replace("..", ".").ToDecimal
Fact.Total = ValorXML(nodo, "total").ToDecimal
Fact.Moneda = ValorXML(nodo, "Moneda")
Fact.MetododePago = ValorXML(nodo, "MetododePago")
Fact.TipoComprobante = ValorXML(nodo, "tipoDeComprobante")
Fact.TipoCambio = ValorXML(nodo, "TipoCambio", "1.0").ToDecimal
If Fact.TipoCambio < 1 Then Fact.TipoCambio = 1
If Fact.TipoComprobante = "P" Then
Dim PagoPrefix As String = ""
If VersionCFDI = "3.3" Then
PagoPrefix = "pago10"
namespaces.AddNamespace("pago10", "http://www.sat.gob.mx/Pagos")
ElseIf VersionCFDI = "4.0" Then
PagoPrefix = "pago20"
namespaces.AddNamespace("pago20", "http://www.sat.gob.mx/Pagos20")
End If
Dim NodoComplementos As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
Dim nodePagos As XmlNode = NodoComplementos.SelectSingleNode($"//{PagoPrefix}:Pagos", namespaces)
For Each nPago As XmlNode In nodePagos.ChildNodes
Fact.Total = ValorXML(nPago, "Monto").ToDecimal
If VersionCFDI = "4.0" And nPago.LocalName.ToUpper() = "TOTALES" Then
Continue For
Else
Exit For
End If
Next
End If
Fact.sUPPrefijo = Prefijo
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Emisor", Prefijo), namespaces)
If node IsNot Nothing AndAlso node.Attributes.Count > 0 Then
Fact.EmisorRFC = ValorXML(node, "RFC").Trim()
Fact.EmisorNombre = ValorXML(node, "nombre")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Receptor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.ReceptorRFC = ValorXML(node, "RFC").Trim()
End If
If XMLDoc.HasChildNodes Then
node = XMLDoc.ChildNodes(0).ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Impuestos", Prefijo), StringComparison.OrdinalIgnoreCase)).FirstOrDefault()
If XMLDoc.ChildNodes.Count > 1 Then
node = XMLDoc.ChildNodes(1).ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Impuestos", Prefijo), StringComparison.OrdinalIgnoreCase)).FirstOrDefault()
End If
End If
If node IsNot Nothing AndAlso node.ChildNodes.Count > 0 Then
Try
Dim nodeRetenciones = node.ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Retenciones", Prefijo), StringComparison.OrdinalIgnoreCase))
Fact.TotalRetenciones = ValorXML(node, "totalImpuestosRetenidos", "0").ToDecimal
Try
Dim retenciones = nodeRetenciones.FirstOrDefault().ChildNodes
For Each retencion As XmlNode In retenciones
Dim TipoImpuesto As String = ValorXML(retencion, "impuesto")
Dim importe As Decimal = ValorXML(retencion, "importe").ToDecimal
If TipoImpuesto = "002" Then
Fact.RetencionIVA += importe
End If
If TipoImpuesto = "001" Then
Fact.RetencionISR += importe
End If
Next
Catch ex As Exception
End Try
Fact.SumaTotalRetenciones += Fact.RetencionIVA
Fact.SumaTotalRetenciones += Fact.RetencionISR
Fact.TotalTraslados = ValorXML(node, "totalImpuestosTrasladados", "0").ToDecimal
Dim nodeTraslados = node.ChildNodes.Cast(Of XmlNode)().Where(Function(n, b) n.Name.Equals(String.Format("{0}:Traslados", Prefijo), StringComparison.OrdinalIgnoreCase))
Dim traslados = nodeTraslados.FirstOrDefault().ChildNodes
For Each traslado As XmlNode In traslados
Dim TipoImpuesto As String = ValorXML(traslado, "impuesto")
Dim importe As Decimal = ValorXML(traslado, "importe").ToDecimal()
If TipoImpuesto = "003" Then
Fact.TrasladoIEPS += importe
End If
If TipoImpuesto = "002" Then
Fact.TrasladoIVA += importe
End If
If TipoImpuesto = "001" Then
Fact.TrasladoISR += importe
End If
Next
Fact.SumaTotalTraslados += Fact.TrasladoIVA + Fact.TrasladoIEPS
Catch ex As Exception
ex.ToString().GuardaLogAD(ArchivoLog)
End Try
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim nodeTFD As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:TimbreFiscalDigital", "tfd"), namespaces)
Fact.UUID = ValorXML(nodeTFD, "UUID", "")
Dim nodeRF As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:CFDIRegistroFiscal ", "registrofiscal"), namespaces)
If nodeRF IsNot Nothing Then
Fact.Folio = ValorXML(nodeRF, "folio").TrimStart("0"c)
End If
Else
Fact.UUID = ""
If String.IsNullOrEmpty(Fact.UUID) AndAlso Fact.sUPPrefijo.ToLower() = "cfdi" Then
'Mensajes.AppendFormat("{0}|{1}|{2}|{3}|{4}|{5}{6}&", ValorXML(nodo, "serie"), ValorXML(nodo, "folio"), ValorXML(nodo, "fecha").ToDate().ToShortDateString(), Fact.EmisorNombre, ValorXML(nodo, "total").ToDouble().FormatoNumero(), "Factura no timbrada correctamente.", "")
'CargaMensaje(ValorXML(nodo, "serie"), ValorXML(nodo, "folio"), ValorXML(nodo, "fecha").ToDate(), Fact.EmisorNombre, ValorXML(nodo, "total").ToDouble(), "Factura no timbrada correctamente.", CorreoActual, DateTime.Now, _EmiRFC, 0)
End If
Fact = Nothing
End If
If Fact.TipoComprobante = "P" Then
CargaPagos(XMLDoc)
End If
Return Fact
End Function
Private Sub CargaPagos(ByVal XMLDoc As XmlDocument)
Dim nodo = XMLDoc.DocumentElement
Dim Prefijo As String = If(String.IsNullOrEmpty(XMLDoc.DocumentElement.Prefix), "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = "http://www.sat.gob.mx/cfd/3"
Dim namespaces As XmlNamespaceManager = New XmlNamespaceManager(XMLDoc.NameTable)
Dim Version = ValorXML(nodo, "version").Replace("..", ".")
Dim PrefijoPagos As String = ""
If Prefijo.ToLower() <> "cfdi" Then cfdVer = "http://www.sat.gob.mx/cfd/2"
If Version = "3.3" Then
PrefijoPagos = "pago10"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/3"
namespaces.AddNamespace(Prefijo, cfdVer)
ElseIf Version = "4.0" Then
PrefijoPagos = "pago20"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos20")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/4"
namespaces.AddNamespace(Prefijo, cfdVer)
Else
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If Version = "3.2" Then
ElseIf Version = "3.3" OrElse Version = "4.0" Then
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim NodosNodePagos As XmlNodeList = nodeComp.SelectNodes($"//{PrefijoPagos}:Pago", namespaces)
If NodosNodePagos IsNot Nothing Then
Try
Dim nodePagos As XmlNode = nodeComp.SelectSingleNode($"//{PrefijoPagos}:Pagos", namespaces)
If Version = "3.3" Then
XMLNodosPagos = nodePagos.InnerXml.Replace("pago10:", "").Replace("pagos10:", "").Replace(PrefijoPagos & ":", "")
Else
XMLNodosPagos = nodePagos.InnerXml.Replace("pago20:", "").Replace("pagos20:", "").Replace(PrefijoPagos & ":", "")
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
End If
Dim Pagos = New List(Of Pago)()
Dim FechaPago As Date
For Each nodePago As XmlNode In NodosNodePagos
Try
FechaPago = ValorXML(nodePago, "FechaPago").ToDate()
Catch e As Exception
End Try
Dim pago = New Pago()
pago.FechaPago = FechaPago
pago.FormaDePagoP = ValorXML(nodePago, "FormaDePagoP").ToString()
pago.MonedaP = ValorXML(nodePago, "MonedaP").ToString()
pago.Monto = ValorXML(nodePago, "Monto").ToString().ToDecimal()
Dim docs = New List(Of DoctoRelacionado)()
Dim NodosPagosRelacionados As XmlNodeList = nodePago.SelectNodes($"//{PrefijoPagos}:DoctoRelacionado", namespaces)
For Each docto As XmlNode In NodosPagosRelacionados
Dim idDoc = ValorXML(docto, "idDocumento")
Dim ImportePago = ValorXML(docto, "ImpPagado").ToDecimal()
Dim serie = ValorXML(docto, "Serie")
Dim Folio = ValorXML(docto, "Folio")
Dim MonedaDR = ValorXML(docto, "MonedaDR")
Dim MetodoDePagoDR = ValorXML(docto, "MetodoDePagoDR")
Dim NumParcialidad = ValorXML(docto, "NumParcialidad")
Dim ImpSaldoInsoluto = ValorXML(docto, "ImpSaldoInsoluto").ToDecimal()
Dim ImpSaldoAnt = ValorXML(docto, "ImpSaldoAnt").ToDecimal()
docs.Add(New DoctoRelacionado() With {
.idDocumento = idDoc,
.ImportePago = ImportePago,
.Serie = serie,
.Folio = Folio,
.MonedaDR = MonedaDR,
.MetodoDePagoDR = MetodoDePagoDR,
.NumParcialidad = NumParcialidad,
.ImpSaldoAnt = ImpSaldoAnt,
.ImpSaldoInsoluto = ImpSaldoInsoluto
})
Next
pago.Documentos = docs
Pagos.Add(pago)
Next
Me.Pagos = Pagos
End If
End If
End Sub
Private Function ValorXML(n As XmlNode, Campo As String, Optional Retorno As String = "") As String
Dim o As XmlNode = n.Attributes.Cast(Of XmlAttribute)().SingleOrDefault(Function(a) String.Compare(a.Name, Campo, True) = 0)
If o Is Nothing Then
Return Retorno
Else
Return o.Value
End If
End Function
Private Function CaratecteresvalidosFolio(ByVal Folio As String) As String
Dim Respuesta As String = ""
'For Each c As Char In Folio.ToArray()
' If (c >= 48 AndAlso c <= 57) OrElse (c >= 65 AndAlso c <= 90) OrElse (c >= 97 AndAlso c <= 122) Then
' Respuesta += c
' End If
'Next
Return Respuesta
End Function
'Private Sub CargaDesdeString(StrFuente As String)
' Dim XMLCargaExistosa As Boolean = False
' Dim XMlStr As String = StrFuente.Replace("<br>", "").Replace("<", "").Replace("o;?", "")
' Dim XMLDoc As New XmlDocument
' Try
' XMLDoc.LoadXml(XMlStr)
' XMLCargaExistosa = True
' Catch ex As Exception
' GuardaLog("Error al intentar leer . Error:" & ex.ToString())
' 'Errores.AppendLine("Error al intentar leer el XML. Error:" & ex.ToString())
' XMLCargaExistosa = False
' End Try
' If XMLCargaExistosa Then
' CargaComprobanteXML(XMLDoc)
' End If
'End Sub
Public Function CargaComprobanteXML(StrFuente As String, DirectorioEmpresa As String, RFCEmpresa As String, CveEmpresa As Integer, Registrar As Boolean, ByRef rowLog As DataRow, NombreArchivo As String, Optional Validada As Integer = 0) As Factura
Dim SeValido As Boolean = False
Dim XMLCargaExistosa As Boolean = False
Dim XMlStr As String = StrFuente.Replace("<br>", "").Replace("<", "").Replace("o;?", "")
Dim XMLDoc As New XmlDocument
Try
XMLDoc.LoadXml(XMlStr)
XMLCargaExistosa = True
Catch ex As Exception
GuardaLogAD("Error al intentar leer . Error:" & ex.ToString(), ArchivoLog)
'Errores.AppendLine("Error al intentar leer el XML. Error:" & ex.ToString())
XMLCargaExistosa = False
End Try
If Not XMLCargaExistosa Then
rowLog("Motivo") = $"Error extructura XML archivo {NombreArchivo}"
Return Nothing
End If
Dim nodo As XmlNode = XMLDoc.DocumentElement
Dim Fact As Factura = New Factura()
Fact.Serie = ValorXML(nodo, "serie")
Dim StrCFDIVersion As String = ValorXML(nodo, "version")
Fact.Version = StrCFDIVersion
Fact.Folio = ValorXML(nodo, "folio")
Fact.Fecha = ValorXML(nodo, "fecha").ToDate
Fact.SubTotal = ValorXML(nodo, "subTotal").ToDecimal
Fact.Total = ValorXML(nodo, "total").ToDecimal
Fact.Descuento = ValorXML(nodo, "descuento").ToDecimal
Fact.Moneda = ValorXML(nodo, "Moneda")
Fact.CveMoneda = ClsPaginas.GlobalDTMonedas().FiltroPrimeroValor("CveMoneda", $" AbreviaturaSAT = '{Fact.Moneda}' ").ToEntero
Fact.TipoComprobante = ValorXML(nodo, "tipoDeComprobante")
Fact.TipoCambio = ValorXML(nodo, "TipoCambio", "1").ToDecimal
Fact.noCertificado = ValorXML(nodo, "NoCertificado")
Fact.FormaDePago = ValorXML(nodo, "formaDePago")
Fact.condicionesDePago = ValorXML(nodo, "condicionesDePago", "")
Fact.NumCtaPagoNumCtaPago = ValorXML(nodo, "NumCtaPago", "")
If Fact.Version = "3.3" Or Fact.Version = "4.0" Then
Dim drm As DataRow = ClsPaginas.GlobalDTVtaMetodoPago.FiltroPrimero(String.Format("ClaveMetodoPagoSAT = '{0}'", ValorXML(nodo, "MetodoPago")))
If drm IsNot Nothing Then
Fact.MetododePago = drm("MetodoPagoSAT").ToString
End If
End If
Dim namespaces As New XmlNamespaceManager(XMLDoc.NameTable)
Dim Prefijo As String = If(XMLDoc.DocumentElement.Prefix = "", "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = ""
If StrCFDIVersion = "3.2" Then
Prefijo = "cfd"
cfdVer = "http://www.sat.gob.mx/cfd/2"
ElseIf StrCFDIVersion = "3.3" Then
cfdVer = "http://www.sat.gob.mx/cfd/3"
Else ' se considera que es la version 4.0
cfdVer = "http://www.sat.gob.mx/cfd/4"
End If
namespaces.AddNamespace(Prefijo, cfdVer)
namespaces.AddNamespace("aerolineas", "http://www.sat.gob.mx/aerolineas")
namespaces.AddNamespace("tfd", "http://www.sat.gob.mx/TimbreFiscalDigital")
namespaces.AddNamespace("implocal", "http://www.sat.gob.mx/implocal")
namespaces.AddNamespace("registrofiscal", "http://www.sat.gob.mx/registrofiscal")
Fact.sUPPrefijo = Prefijo
If StrCFDIVersion = "3.2" Then
For i As Integer = 0 To XMLDoc.DocumentElement.ChildNodes(2).ChildNodes.Count - 1
nodo = XMLDoc.DocumentElement.ChildNodes(2).ChildNodes(i)
Fact.AddPS(Convert.ToDouble(nodo.Attributes.GetNamedItem("cantidad").Value), nodo.Attributes.GetNamedItem("unidad").Value, nodo.Attributes.GetNamedItem("descripcion").Value, Convert.ToDouble(nodo.Attributes.GetNamedItem("valorUnitario").Value), 0, Convert.ToDouble(nodo.Attributes.GetNamedItem("importe").Value))
Next
Try
Dim nodosEmisor = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().FirstOrDefault(Function(n) n.Name.Equals("cfdi:Emisor", StringComparison.OrdinalIgnoreCase))
Dim nodoEmisor As XmlNode = nodosEmisor
Fact.EmiRFC = ValorXML(nodoEmisor, "rfc", "")
Fact.EmiNombre = ValorXML(nodoEmisor, "nombre", "")
nodoEmisor = nodosEmisor.ChildNodes(0)
Fact.DomFisCalle = ValorXML(nodoEmisor, "calle", "")
Fact.DomFisNoExt = ValorXML(nodoEmisor, "noExterior", "")
Fact.DomFisCol = ValorXML(nodoEmisor, "colonia", "")
Fact.DomFisCP = ValorXML(nodoEmisor, "codigoPostal", "")
Fact.DomFisMun = ValorXML(nodoEmisor, "municipio", "")
Fact.DomFisLoc = ValorXML(nodoEmisor, "localidad", "")
Fact.DomFisEst = ValorXML(nodoEmisor, "estado", "")
Fact.DomFisPais = ValorXML(nodoEmisor, "pais", "")
nodoEmisor = nodosEmisor.ChildNodes(1)
Fact.ExpEnCalle = ValorXML(nodoEmisor, "calle", "")
Fact.ExpEnNoExt = ValorXML(nodoEmisor, "noExterior", "")
Fact.ExpEnCol = ValorXML(nodoEmisor, "colonia", "")
Fact.ExpEnCP = ValorXML(nodoEmisor, "codigoPostal", "")
Fact.ExpEnMun = ValorXML(nodoEmisor, "municipio", "")
Fact.ExpEnLoc = ValorXML(nodoEmisor, "localidad", "")
Fact.ExpEnEst = ValorXML(nodoEmisor, "estado", "")
Fact.ExpEnPais = ValorXML(nodoEmisor, "pais", "")
nodoEmisor = nodoEmisor.ChildNodes(2)
Fact.Regimen = ValorXML(nodo, "Regimen", "")
Catch ex As Exception
Throw New Exception($"Error CargaEmisorXML - {ex.Message} - {ex.StackTrace}")
End Try
Try
Dim nodosReceptor = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().FirstOrDefault(Function(n) n.Name.Equals("cfdi:Receptor", StringComparison.OrdinalIgnoreCase))
Dim nodoReceptor As XmlNode = nodosReceptor
Fact.RecRfc = ValorXML(nodoReceptor, "rfc", "")
Fact.RecNombre = ValorXML(nodoReceptor, "nombre", "")
nodoReceptor = nodosReceptor.ChildNodes(0)
Fact.DomRecCalle = ValorXML(nodoReceptor, "calle", "")
Fact.DomRecFisNoExt = ValorXML(nodoReceptor, "noExterior", "")
Fact.DomRecFisNoInt = ValorXML(nodoReceptor, "noInterior", "")
Fact.DomRecCol = ValorXML(nodoReceptor, "colonia", "")
Fact.DomRecCP = ValorXML(nodoReceptor, "codigoPostal", "")
Fact.DomRecMun = ValorXML(nodoReceptor, "municipio", "")
Fact.DomRecLoc = ValorXML(nodoReceptor, "localidad", "")
Fact.DomRecEst = ValorXML(nodoReceptor, "estado", "")
Fact.DomRecPais = ValorXML(nodoReceptor, "pais", "")
Catch ex As Exception
Throw New Exception($"Error CargaReceptorXML - {ex.Message} - {ex.StackTrace}")
End Try
ElseIf StrCFDIVersion = "3.3" OrElse StrCFDIVersion = "4.0" Then
Try
Dim nodos = XMLDoc.DocumentElement.ChildNodes.Cast(Of XmlNode)().Where(Function(n) n.Name.Equals("cfdi:Conceptos", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().ChildNodes
For Each item As XmlNode In nodos
Dim cantidad = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("cantidad", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Dim unidad = item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("ClaveUnidad", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value
Dim descripcion = item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("descripcion", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value
Dim valorUnitario = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("valorUnitario", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Dim importe = Convert.ToDouble(item.Attributes.Cast(Of XmlAttribute)().Where(Function(n) n.Name.Equals("importe", StringComparison.OrdinalIgnoreCase)).FirstOrDefault().Value)
Fact.AddPS(cantidad, unidad, descripcion, valorUnitario, 0, importe)
Next
Catch ex As Exception
Throw New Exception($"Error CargaConceptosXML - {ex.Message} - {ex.StackTrace}")
End Try
End If
If Fact.TipoComprobante.ToUpper = "E" AndAlso (Fact.Version.Contiene("3.3", "4.0")) Then
Dim UUIDS As String = ""
Dim UUIDSLista As New List(Of String)
Dim nodeCFDIRelacionados As XmlNode
nodeCFDIRelacionados = XMLDoc.SelectSingleNode(String.Format("//{0}:CfdiRelacionados", Prefijo), namespaces)
If nodeCFDIRelacionados IsNot Nothing Then
For Each CFDIRelacionados As XmlNode In nodeCFDIRelacionados
UUIDSLista.Add("" & CFDIRelacionados.Attributes("UUID").Value.ToString & "")
Next
End If
End If
Dim node As XmlNode
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Emisor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.EmisorRFC = ValorXML(node, "RFC")
Fact.EmisorNombre = ValorXML(node, "Nombre")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Receptor", Prefijo), namespaces)
If node IsNot Nothing Then
Fact.ReceptorRFC = ValorXML(node, "RFC")
End If
node = XMLDoc.SelectSingleNode(String.Format("//{0}:Impuestos", Prefijo), namespaces)
If node IsNot Nothing AndAlso node.ChildNodes.Count > 0 Then
Dim nodeRetenciones As XmlNodeList = XMLDoc.SelectNodes(String.Format("//{0}:Comprobante/{0}:Impuestos/{0}:Retenciones/{0}:Retencion", Prefijo), namespaces)
If Fact.Version.Contiene("3.3", "4.0") Then
For Each retencion As XmlNode In nodeRetenciones
If retencion.Attributes("Impuesto").Value = "002" Then Fact.RetencionIVA += retencion.Attributes("Importe").Value.ToDecimal
If retencion.Attributes("Impuesto").Value = "001" Then Fact.RetencionISR += retencion.Attributes("Importe").Value.ToDecimal
Next
Else
For Each retencion As XmlNode In nodeRetenciones
If retencion.Attributes("impuesto").Value = "IVA" Then Fact.RetencionIVA += retencion.Attributes("importe").Value.ToDecimal
If retencion.Attributes("impuesto").Value = "ISR" Then Fact.RetencionISR += retencion.Attributes("importe").Value.ToDecimal
Next
End If
Dim nodeTraslados As XmlNodeList = XMLDoc.SelectNodes(String.Format("//{0}:Comprobante/{0}:Impuestos/{0}:Traslados/{0}:Traslado", Prefijo), namespaces)
If Fact.Version.Contiene("3.3", "4.0") Then
For Each traslado As XmlNode In nodeTraslados
If traslado.Attributes("Importe") IsNot Nothing Then
If traslado.Attributes("Impuesto").Value = "002" Then Fact.TrasladoIVA += traslado.Attributes("Importe").Value.ToDecimal
If traslado.Attributes("Impuesto").Value = "003" Then Fact.TrasladoIEPS += traslado.Attributes("Importe").Value.ToDecimal
End If
Next
Else
For Each traslado As XmlNode In nodeTraslados
If traslado.Attributes("Importe") IsNot Nothing Then
If traslado.Attributes("impuesto").Value = "IVA" Then Fact.TrasladoIVA += traslado.Attributes("importe").Value.ToDecimal
If traslado.Attributes("impuesto").Value = "IEPS" Then Fact.TrasladoIEPS += traslado.Attributes("importe").Value.ToDecimal
End If
Next
End If
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim nodeTFD As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:TimbreFiscalDigital", "tfd"), namespaces)
Fact.UUID = ValorXML(nodeTFD, "UUID", "")
Dim nodeRF As XmlNode = nodeComp.SelectSingleNode(String.Format("//{0}:CFDIRegistroFiscal ", "registrofiscal"), namespaces)
If nodeRF IsNot Nothing Then
Fact.Folio = ValorXML(nodeRF, "folio").TrimStart("0"c)
End If
End If
If Fact.TipoComprobante = "P" Then
CargaPagos(XMLDoc, Fact)
End If
rowLog("Serie") = Fact.Serie
rowLog("Folio") = Fact.Folio
rowLog("Fecha") = Fact.Fecha
rowLog("Proveedor") = Fact.EmisorNombre
rowLog("Importe") = Fact.Total
rowLog("Motivo") = ""
rowLog("RFCde") = Fact.EmisorRFC
rowLog("Estatus") = 0
rowLog("Tipo") = Fact.TipoComprobante
If Registrar Then
If Fact.ReceptorRFC = RFCEmpresa Then
Fact.Validada = Validada
Dim ObjCompra As New ClsCompras
Dim Correcto As Boolean = False
ObjCompra.IniciaTransacSQL()
Fact.RespuestaInsert = ObjCompra.AddFactura(Fact.Serie, Fact.Folio, Fact.Fecha, Fact.EmisorNombre, Fact.EmisorRFC, Fact.SubTotal, Fact.TrasladoIVA, Fact.Total, Fact.UUID, Fact.ReceptorRFC, "", "", Fact.Version, Fact.Descuento, Fact.TipoCambio, Fact.Validada, CveEmpresa, Fact.sUPPrefijo, Fact.TipoComprobante, Fact.Moneda, Fact.MetododePago, 3, Fact.Version, Fact.IEPS, Fact.RetencionIVA, Fact.RetencionISR)
If Fact.RespuestaInsert >= 0 Then
rowLog("Estatus") = 1
Dim Destino As String = $"{DirectorioEmpresa}\Compras\"
Try
If Not Directory.Exists(Destino & Fact.EmisorRFC) Then
Directory.CreateDirectory(Destino & Fact.EmisorRFC)
End If
Select Case Fact.RespuestaInsert
Case 0
Dim RRutaDestino As String = String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura)
ModExtensiones.GuardaLogAD(String.Format(" '--------{0} Compra ya insertada : {1}{2} - {3}", 1, Fact.Serie, Fact.Folio, RRutaDestino), ArchivoLog)
File.WriteAllText(RRutaDestino, StrFuente, UTF8Encoding.UTF8)
'ObjCompra.UpdateArchivo(ObjCompra.CveFactura, "XML")
ModExtensiones.GuardaLogAD(" '--------XML Actualizado ", ArchivoLog)
rowLog("Motivo") = $"Ya registrado {Fact.Serie}-{Fact.Folio} se actualiza XML."
Correcto = True
Exit Select
Case 1
Dim StrMover As String = ""
Try
File.WriteAllText(String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura), StrFuente, UTF8Encoding.UTF8)
' ObjCompra.UpdateArchivo(ObjCompra.CveFactura, "XML")
ModExtensiones.GuardaLogAD($" '-------- XML Guardado Factura: {Fact.Serie}-{Fact.Folio} UUID: {Fact.UUID} , RFC Emisor: {Fact.EmisorRFC}", ArchivoLog)
' Si se movieron los dos archivos, los marca como correcto
If File.Exists(String.Format("{0}{1}\{2}.xml", Destino, Fact.EmisorRFC, ObjCompra.CveFactura)) Then
Correcto = True
Else
Correcto = False
End If
ModExtensiones.GuardaLogAD(" '++++++++ Compra Insertada :" & Fact.Serie & Fact.Folio & " - Correcto:" & If(Correcto, "Si", "No" & " Obs: "), ArchivoLog)
rowLog("Motivo") = $"Agregado {Fact.Serie}-{Fact.Folio}"
Catch ex As Exception
StrMover = ex.Message
Correcto = False
ModExtensiones.GuardaLogAD(" '++++++++ Compra no Insertada :" & Fact.Serie & Fact.Folio & " - Correcto:" & If(Correcto, "Si", "No" & " Obs: ") & StrMover, ArchivoLog)
rowLog("Motivo") = $"Error al agregar {Fact.Serie}-{Fact.Folio}"
End Try
Exit Select
End Select
Catch ex As Exception
Correcto = True
GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
ElseIf Fact.RespuestaInsert = 0 AndAlso Fact.CveFactura > 0 Then
'FIXME OIC
Else
rowLog("Motivo") = $"RFC ""{Fact.ReceptorRFC}"" Error al insertar"
End If
If Correcto Then
ObjCompra.Commit()
Fact.CveFactura = ObjCompra.CveFactura
Fact.ArchivoXML = $"{ObjCompra.CveFactura}.xml"
Else
ObjCompra.RollBack()
End If
ObjCompra.Dispose()
Else
ModExtensiones.GuardaLogAD($" '++++++++ Compra RFC Distinto RFC Empresa: {RFCEmpresa}, RFC XML: {Fact.ReceptorRFC} ", ArchivoLog)
rowLog("Motivo") = "RFC Distinto"
rowLog("Motivo") = $"RFC ""{Fact.ReceptorRFC}"" Incorrecto"
End If
End If
Return Fact
End Function
Public Function GeneraPDF(UsuarioActual As Usuario, ByVal Ruta As String, ByVal Fact As Factura, DirectorioEmpresa As String, Guardar As Boolean) As Boolean
Dim RutaXML As String = String.Empty
Dim RutaPDF As String = String.Empty
Dim Retorno As Boolean = False
Try
Dim XMLDoc As New XmlDocument()
Dim TmpArchivoPDF As String = $"{Ruta}\Temp\Facturas\{Path.GetFileNameWithoutExtension(Fact.ArchivoXML)}-ttt.pdf"
Dim TmpArchivoQR As String = $"{Ruta}\Temp\Facturas\{Path.GetFileNameWithoutExtension(Fact.ArchivoXML)}-ttt.jpg"
Dim ArchivoXML As String = String.Format("{0}\Compras\{2}\{1}", DirectorioEmpresa, Fact.ArchivoXML, Fact.EmisorRFC)
Dim ArchivoPDF As String = String.Format("{0}\Compras\{2}\{1}.pdf", DirectorioEmpresa, Fact.CveFactura, Fact.EmisorRFC)
Dim dtotal As Decimal = If(Fact.Total <= 0.0D, 0.0001D, Fact.Total)
Dim cfdi As New RVCFDI33.GeneraCFDI()
Try
Dim b As Byte() = cfdi.ConvertirQrCode(String.Format("?re={0}&rr={1}&tt={2}&id={3}", Fact.EmisorRFC, Fact.ReceptorRFC, String.Format("{0,12:F6}", dtotal).Trim(), Fact.UUID))
File.WriteAllBytes(TmpArchivoQR, b)
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.Message, ArchivoLog)
End Try
If System.IO.File.Exists(TmpArchivoQR) Then
Dim TipoDocto As String = ""
If Fact.Version = "3.3" Or Fact.Version = "4.0" Then
Select Case Fact.TipoComprobante
Case "I"
TipoDocto = "Ing"
Case "E"
TipoDocto = "Egs"
Case "P"
TipoDocto = "Pag"
Case "T"
TipoDocto = "Tra"
Case Else
End Select
Else
TipoDocto = Fact.TipoComprobante
End If
'Dim DtPagos As DataTable = Nothing
'Dim DtDocumentosR As DataTable = Nothing
If Fact.TipoComprobante.Contiene("P", "T") Then
ModExtensiones.GuardaLogAD(String.Format(" '--------PDF Generar Tipo {0}", Fact.TipoComprobante), ArchivoLog)
Retorno = GenGoPdf(ArchivoXML, TmpArchivoPDF, DirectorioEmpresas)
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Try
If Guardar Then
If File.Exists(ArchivoPDF) Then
File.Delete(ArchivoPDF)
End If
File.Move(TmpArchivoPDF, ArchivoPDF)
End If
Retorno = True
Catch ex As Exception
Retorno = False
End Try
Else
If (Fact.Version = "3.3" Or Fact.Version = "4.0") Then
Dim cxml As XmlSatCFDI = XmlSatCFDI.readXML(ArchivoXML, ArchivoLog)
ModExtensiones.GuardaLogAD(String.Format(" *********** UUID : {0} ***********", cxml.complemento.UUID), ArchivoLog)
cxml.ImprimirPDF(UsuarioActual, TmpArchivoPDF, DirectorioEmpresa, Fact.TipoComprobante)
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Try
If Guardar Then
If File.Exists(ArchivoPDF) Then
File.Delete(ArchivoPDF)
End If
File.Move(TmpArchivoPDF, ArchivoPDF)
End If
Retorno = True
Catch ex As Exception
Retorno = False
End Try
Else
ModExtensiones.GuardaLogAD(String.Format(" *********** TFDUUID : {0} ***********", Fact.UUID), ArchivoLog)
Dim DomFiscal As String = String.Format("Domicilio Fiscal {0}{1} {2}{0}Col.{3}{0}CP. {4} {5},{6},{7}", vbCr, Fact.DomFisCalle, Fact.DomFisNoExt, Fact.DomFisCol, Fact.DomFisCP, Fact.DomFisMun, Fact.DomFisEst, Fact.DomFisPais)
If GeneraPDFNew(UsuarioActual, TmpArchivoPDF, Fact.UUID, Fact.SubTotal, Fact.Descuento, Fact.Total, Fact.TrasladoIVA.FormatoNumero(), Fact.Moneda, Fact.FormaDePago, Fact.TFDNoCertSAT, Fact.TFDFechaTimbrado.ToDate(), Fact.noCertificado,
Fact.DTConceptos, Fact.TFDSelloCFD, Fact.TFDSelloSAT, TmpArchivoQR, Fact.Serie + Fact.Folio, Fact.TipoComprobante, "", Fact.ReceptorRFC, Fact.RecNombre, Fact.DomRecCalle, Fact.DomRecCol, Fact.DomRecFisNoExt,
Fact.DomRecFisNoInt, Fact.DomRecCP, Fact.DomRecMun, Fact.DomRecEst, Fact.Regimen, Fact.condicionesDePago, Fact.MetododePago, Fact.NumCtaPagoNumCtaPago, DateTime.Now, Fact.DtPagos, Fact.DtDocumentosR, Fact.RetencionIVA,
Fact.RetencionISR, Fact.EmiNombre, Fact.EmiRFC, Fact.ReceptorNombre, DirectorioEmpresa, DomFiscal) Then
Fact.ArchivoPDF = Path.GetFileName(TmpArchivoPDF)
Retorno = True
If Guardar Then
End If
End If
End If
File.Delete(TmpArchivoQR)
End If
RutaPDF = TmpArchivoPDF
Else
Retorno = False
End If
'If DTConceptos IsNot Nothing Then DTConceptos.Dispose()
Catch ex As Exception
Dim MensajeError As String = "***********Ocurrio un error al generar el pdf: " & ex.Message & ""
If ex.InnerException Is Nothing Then
MensajeError &= "."
Else
MensajeError &= " - " & ex.InnerException.ToString()
End If
ModExtensiones.GuardaLogAD(MensajeError, ArchivoLog)
End Try
Return Retorno
End Function
Private Function GeneraPDFNew(UsuarioActual As Usuario, ByVal TmpArchivoPDF As String, ByVal FolioFiscal As String, ByVal SubTotal As Decimal, ByVal Descuento As Decimal, ByVal Total As Decimal, ByVal IVA As String, ByVal Moneda As String, ByVal FormaDePago As String,
ByVal NoSerieCertificado As String, ByVal FechaCertificacion As DateTime, ByVal NoSerieCertificadoContribuyente As String, ByVal DTConceptos As DataTable, ByVal SelloCFDi As String, ByVal SelloSAT As String,
ByVal CBB As String, ByVal Folio As String, ByVal TipodeComprobante As String, ByVal CadenaOriginalCFD As String, ByVal RFC As String, ByVal Cliente As String, ByVal Direccion As String, ByVal Colonia As String,
ByVal NoExt As String, ByVal NoInt As String, ByVal CP As String, ByVal Ciudad As String, ByVal Estado As String, ByVal Regimen As String, ByVal CondicionPago As String, ByVal MetodoPago As String, ByVal NumCtaPago As String,
ByVal fecha As DateTime, Optional ByVal DtPagos As DataTable = Nothing, Optional ByVal DtRelacionados As DataTable = Nothing, Optional ByVal RetIVA As Double = 0, Optional ByVal RetISR As Double = 0,
Optional EmiNombre As String = "", Optional EmiRFC As String = "", Optional NombreEmpresa As String = "", Optional DirectorioEmpresa As String = "", Optional DomFiscal As String = "") As Boolean
Dim RutaRDLC As String = If(TipodeComprobante = "Pag", "Grales\Formatos\CFDIPago.rdlc", "Grales\Formatos\CFDI.rdlc")
Dim Retorno As Boolean = False
Dim NombreArchivo As String = TmpArchivoPDF
Dim CadenaOriginal As String = "||1.0|" & FolioFiscal & "|" & FechaCertificacion.ToString("yyyy-MM-dd") & "T" & FechaCertificacion.ToString("HH:mm:ss") & "|" & SelloCFDi & "|" & NoSerieCertificado & "||"
Dim RutaFormato As String = RutaRDLC
Try
Dim Archivo As New System.IO.FileInfo(RutaFormato)
If Archivo.Exists Then
Dim parametros As New List(Of ReportParameter)()
parametros.Add(New ReportParameter("FolioFiscal", FolioFiscal))
parametros.Add(New ReportParameter("SubTotal", SubTotal.FormatoNumero()))
parametros.Add(New ReportParameter("Descuento", Descuento.FormatoNumero()))
parametros.Add(New ReportParameter("Total", Total.FormatoNumero()))
parametros.Add(New ReportParameter("IVA", IVA.FormatoNumero()))
parametros.Add(New ReportParameter("RetIVA", RetIVA.FormatoNumero()))
parametros.Add(New ReportParameter("RetISR", RetISR.FormatoNumero()))
parametros.Add(New ReportParameter("Moneda", Moneda))
parametros.Add(New ReportParameter("FormaDePago", FormaDePago))
parametros.Add(New ReportParameter("NoSerieCertificado", NoSerieCertificado))
parametros.Add(New ReportParameter("FechaCertificacion", FechaCertificacion.ToString("yyyy-MM-dd") & "T" & FechaCertificacion.ToString("HH:mm:ss")))
parametros.Add(New ReportParameter("NoSerieCertificadoContribuyente", NoSerieCertificadoContribuyente))
parametros.Add(New ReportParameter("SelloCFDi", SelloCFDi))
parametros.Add(New ReportParameter("SelloSAT", SelloSAT))
parametros.Add(New ReportParameter("CBB", String.Format("file:///{0}", CBB)))
parametros.Add(New ReportParameter("Folio", Folio))
parametros.Add(New ReportParameter("TipodeComprobante", TipodeComprobante.ToUpper()))
parametros.Add(New ReportParameter("CadenaOriginalCFD", CadenaOriginalCFD))
parametros.Add(New ReportParameter("RFC", RFC))
parametros.Add(New ReportParameter("Cliente", Cliente))
parametros.Add(New ReportParameter("Direccion", Direccion))
parametros.Add(New ReportParameter("Colonia", Colonia))
parametros.Add(New ReportParameter("NoExt", NoExt))
parametros.Add(New ReportParameter("NoInt", NoInt))
parametros.Add(New ReportParameter("CP", CP))
parametros.Add(New ReportParameter("Ciudad", Ciudad))
parametros.Add(New ReportParameter("Estado", Estado))
parametros.Add(New ReportParameter("Regimen", Regimen))
parametros.Add(New ReportParameter("CondicionPago", CondicionPago))
parametros.Add(New ReportParameter("MetodoPago", MetodoPago))
parametros.Add(New ReportParameter("NumCtaPago", NumCtaPago))
parametros.Add(New ReportParameter("fecha", fecha.ToString("yyyy-MM-dd") & "T" & fecha.ToString("HH:mm:ss")))
parametros.Add(New ReportParameter("Fiscal", DomFiscal))
parametros.Add(New ReportParameter("EmiNombre", EmiNombre))
parametros.Add(New ReportParameter("EmiRFC", EmiRFC))
parametros.Add(New ReportParameter("TotalLetra", ModExtensiones.Texto2Letras(Total)))
parametros.Add(New ReportParameter("Empresa", NombreEmpresa))
Dim listaDs As New List(Of ReportDataSource)
Dim rds1 As New ReportDataSource()
rds1.Name = "DsOC"
rds1.Value = DTConceptos
'MR.LocalReport.DataSources.Add(rds1)
listaDs.Add(rds1)
If DtPagos IsNot Nothing Then
Dim rds2 As New ReportDataSource()
rds2.Name = "DsPago"
rds2.Value = DtPagos
'MR.LocalReport.DataSources.Add(rds2)
listaDs.Add(rds2)
End If
If DtRelacionados IsNot Nothing Then
Dim rds3 As New ReportDataSource()
rds3.Name = "DsDocRelacionados"
rds3.Value = DtRelacionados
'MR.LocalReport.DataSources.Add(rds3)
listaDs.Add(rds3)
End If
Dim bytes As Byte() = Nothing
bytes = StreamPDF(UsuarioActual, RutaRDLC, listaDs, parametros, NombreArchivo:=NombreArchivo, Formato:="PDF")
If bytes IsNot Nothing Then
Using fs As New FileStream(NombreArchivo, FileMode.Create)
fs.Write(bytes, 0, bytes.Length)
fs.Close()
End Using
Retorno = True
Else
Retorno = False
End If
Else
ModExtensiones.GuardaLogAD("ERROR: No existe Formato Base", ArchivoLog)
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(String.Format("Ocurrio un Error al generar el reporte RLDC :" & ex.ToString()), ArchivoLog)
Retorno = False
End Try
Return Retorno
End Function
Private Sub CargaPagos(ByVal XMLDoc As XmlDocument, ByRef Fact As Factura)
Fact.Pagos.Clear()
Dim nodo = XMLDoc.DocumentElement
Dim Prefijo As String = If(String.IsNullOrEmpty(XMLDoc.DocumentElement.Prefix), "cfd", XMLDoc.DocumentElement.Prefix)
Dim cfdVer As String = "http://www.sat.gob.mx/cfd/3"
Dim namespaces As New XmlNamespaceManager(XMLDoc.NameTable)
Dim Version As String = ValorXML(nodo, "version").Replace("..", ".")
Dim PrefijoPagos As String = ""
If Prefijo.ToLower() <> "cfdi" Then
cfdVer = "http://www.sat.gob.mx/cfd/2"
End If
If Version = "3.3" Then
PrefijoPagos = "pago10"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/3"
namespaces.AddNamespace(Prefijo, cfdVer)
ElseIf Version = "4.0" Then
PrefijoPagos = "pago20"
namespaces.AddNamespace(PrefijoPagos, "http://www.sat.gob.mx/Pagos20")
Prefijo = "cfdi"
cfdVer = "http://www.sat.gob.mx/cfd/4"
namespaces.AddNamespace(Prefijo, cfdVer)
End If
Dim nodeComp As XmlNode = XMLDoc.SelectSingleNode(String.Format("//{0}:Complemento", Prefijo), namespaces)
If Version = "3.3" OrElse Version = "4.0" Then
If nodeComp IsNot Nothing AndAlso nodeComp.ChildNodes.Count > 0 Then
Dim NodosNodePagos As XmlNodeList = nodeComp.SelectNodes($"//{PrefijoPagos}:Pago", namespaces)
If NodosNodePagos IsNot Nothing Then
Try
Dim nodePagos As XmlNode = nodeComp.SelectSingleNode($"//{PrefijoPagos}:Pagos", namespaces)
If Version = "3.3" Then
XMLNodosPagos = nodePagos.InnerXml.Replace("pago10:", "").Replace("pagos10:", "").Replace(PrefijoPagos & ":", "")
Else
XMLNodosPagos = nodePagos.InnerXml.Replace("pago20:", "").Replace("pagos20:", "").Replace(PrefijoPagos & ":", "")
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD(ex.ToString(), ArchivoLog)
End Try
End If
Dim Pagos As New List(Of Pago)()
For Each nodePago As XmlNode In NodosNodePagos
Dim FechaPago As DateTime = DateTime.Now
Try
FechaPago = ValorXML(nodePago, "FechaPago").ToDate()
Catch e As Exception
End Try
Dim pago As New Pago()
pago.FechaPago = FechaPago
pago.FormaDePagoP = ValorXML(nodePago, "FormaDePagoP").ToString()
pago.MonedaP = ValorXML(nodePago, "MonedaP").ToString()
pago.Monto = ValorXML(nodePago, "Monto").ToString().ToDecimal()
Dim docs As New List(Of DoctoRelacionado)()
Dim NodosPagosRelacionados As XmlNodeList = nodePago.SelectNodes($"//{PrefijoPagos}:DoctoRelacionado", namespaces)
For Each docto As XmlNode In NodosPagosRelacionados
Dim idDoc = ValorXML(docto, "idDocumento")
Dim ImportePago = ValorXML(docto, "ImpPagado").ToDecimal()
Dim serie = ValorXML(docto, "Serie")
Dim Folio = ValorXML(docto, "Folio")
Dim MonedaDR = ValorXML(docto, "MonedaDR")
Dim MetodoDePagoDR = ValorXML(docto, "MetodoDePagoDR")
Dim NumParcialidad = ValorXML(docto, "NumParcialidad")
Dim ImpSaldoInsoluto = ValorXML(docto, "ImpSaldoInsoluto").ToDecimal()
Dim ImpSaldoAnt = ValorXML(docto, "ImpSaldoAnt").ToDecimal()
docs.Add(New DoctoRelacionado() With {
.idDocumento = idDoc,
.ImportePago = ImportePago,
.Serie = serie,
.Folio = Folio,
.MonedaDR = MonedaDR,
.MetodoDePagoDR = MetodoDePagoDR,
.NumParcialidad = NumParcialidad,
.ImpSaldoAnt = ImpSaldoAnt,
.ImpSaldoInsoluto = ImpSaldoInsoluto
})
Next
pago.Documentos = docs
Pagos.Add(pago)
Next
Fact.Pagos = Pagos
End If
End If
End Sub
Private Function GenGoPdf(ByVal XmlRutaArchivo As String, ByVal PDFRutaArchivo As String, DirectorioEmpresa As String) As Boolean
ModExtensiones.GuardaLogAD(" '--------PDF GenGoPdf Inicia ", ArchivoLog)
Dim Respuesta As Boolean = False
Dim RutaRDLC As String = $"{DirectorioEmpresa}\Grales\Formatos\ReciboDePagoGOPDF.rdlc" 'String.Format("{0}{1}", Extensiones.ApplicationParameter.RutaArchivos, "Empresas\Grales\Formatos\ReciboDePagoGOPDF.rdlc")
Dim Inicio As DateTime = DateTime.Now
Dim goPdf As New GoPdf.GoPdf()
Dim logotipo As Byte() = Nothing 'File.ReadAllBytes(@"C:\inetpub\WWWSIGGit\Empresas\119\Logo.jpg")
Try
Dim XmlString As String = File.ReadAllText(XmlRutaArchivo)
Dim result As Byte() = goPdf.ExportarPdf(XmlString, logotipo, "", RutaRDLC, New GoPdf.Modelos.DatosAdicionales() With {.DomicilioReceptor = ""})
Dim Fin As DateTime = DateTime.Now
If result IsNot Nothing Then
File.WriteAllBytes(PDFRutaArchivo, result)
Respuesta = True
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Generado", ArchivoLog)
Else
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Error se genero nulo \n RDLC: {RutaRDLC} Ruta Xml: {XmlRutaArchivo} Ruta PDF: {PDFRutaArchivo} \n MensajeError: {goPdf.MensajeError} CodigoError :{goPdf.CodigoError}", ArchivoLog)
End If
Catch ex As Exception
ModExtensiones.GuardaLogAD($" '--------PDF GenGoPdf Error {ex.Message} -- > {ex.StackTrace} \n RDLC: {RutaRDLC} Ruta Xml: {XmlRutaArchivo} Ruta PDF: {PDFRutaArchivo}", ArchivoLog)
End Try
ModExtensiones.GuardaLogAD(" '--------PDF GenGoPdf Finaliza ", ArchivoLog)
Return Respuesta
End Function
Public Function StreamPDF(UsuarioActual As Usuario, RutaReporte As String, DataSource As List(Of ReportDataSource), Parametros As List(Of ReportParameter), Optional NombreArchivo As String = "Reporte", Optional Formato As String = "PDF", Optional MR As ReportViewer = Nothing, Optional SubReportData As Modelos.MSubReportData = Nothing) As Byte()
'limpio ReportViwer
Dim sw As Stopwatch = Stopwatch.StartNew()
Dim Bytes As Byte() = Nothing
Dim CveUsuario As Integer = 0
Dim CveEmpresa As Integer = 0
Dim RutaEmpresa As String = ""
If UsuarioActual IsNot Nothing Then
CveUsuario = UsuarioActual.CveUsuario
CveEmpresa = UsuarioActual.CveEmpresa
RutaEmpresa = UsuarioActual.Empresa.Ruta
End If
Dim bdir As String = If(RutaReporte.Contains("Empresas"), ModExtensiones.DirectorioBaseEmpresas, AppDomain.CurrentDomain.BaseDirectory)
'TOMAR LA RUTA BASE PARA EL DIRECTORIO DE LA EMPRESA
If Not String.IsNullOrEmpty(RutaEmpresa) AndAlso Not RutaReporte.Contains("Grales") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("AC/Reportes/") Then
bdir = RutaEmpresa.Replace($"{CveEmpresa}/", "")
End If
RutaReporte.Replace("/", "\")
If Not RutaReporte.ToUpper().StartsWith(bdir.ToUpper()) Then
RutaReporte = String.Format("{0}{1}", bdir, RutaReporte)
End If
If EsProduccion Then
Dim wsreport As New WSRDLC2.WebServiceSoapClient
Dim params As New List(Of WSRDLC2.ReportParameter)
Dim reportobjects As New List(Of WSRDLC2.ReportObjects)
Dim jsonData As String = Nothing
If SubReportData IsNot Nothing Then
jsonData = Newtonsoft.Json.JsonConvert.SerializeObject(SubReportData)
End If
Dim ds As New DataSet
For Each rpds As ReportDataSource In DataSource
If rpds.Value IsNot Nothing Then
If rpds.Value.GetType().ToString() = "System.Data.DataTable" Then
Dim dt As DataTable = DirectCast(rpds.Value, Data.DataTable)
dt = dt.Copy()
dt.TableName = rpds.Name
ds.Tables.Add(dt)
Else
Dim ojext As New WSRDLC2.ReportObjects
ojext.Name = rpds.Name
ojext.Value = rpds.Value
reportobjects.Add(ojext)
End If
Else
Dim dt As DataTable = New DataTable()
dt.TableName = If(String.IsNullOrEmpty(rpds.Name), "DataTable1", rpds.Name)
ds.Tables.Add(dt)
End If
Next
For Each rpds As ReportParameter In Parametros
Dim param As New WSRDLC2.ReportParameter
param.Name = rpds.Name
'SI ES TEXTO, QUITAR TABS Y OTROS ESPACIOS QUE DEN PROBLEMAS AL MANDAR LA PETICION
If rpds IsNot Nothing AndAlso rpds.Values IsNot Nothing AndAlso rpds.Values.Count > 0 AndAlso rpds.Values(0) IsNot Nothing AndAlso rpds.Values(0).GetType() = GetType(String) Then
param.Values = {rpds.Values(0).Replace(vbVerticalTab, "")}
Else
param.Values = {rpds.Values(0)}
End If
params.Add(param)
Next
Bytes = wsreport.StreamNEWPDFBytes(RutaReporte, ds, reportobjects.ToArray(), params.ToArray(), NombreArchivo, Formato, CveEmpresa, CveUsuario, jsonData)
wsreport = Nothing
params = Nothing
ds.Dispose() : ds = Nothing
Else
If IsNothing(MR) Then MR = New ReportViewer
Try
' MasterReporteador.LocalReport.DataSources.Clear()
For Each RDS As ReportDataSource In DataSource
MR.LocalReport.DataSources.Add(RDS)
Next
MR.LocalReport.ReportPath = RutaReporte
MR.ProcessingMode = ProcessingMode.Local
MR.LocalReport.EnableExternalImages = True
MR.LocalReport.SetParameters(Parametros)
MR.LocalReport.Refresh()
Dim Warnings As Warning() = Nothing
Dim StreamIds As String() = Nothing
Dim MimeType As String = Nothing
Dim Encoding As String = Nothing
Dim Extension As String = Nothing
Bytes = MR.LocalReport.Render(Formato, Nothing, MimeType, Encoding, Extension, StreamIds, Warnings)
Catch ex As Microsoft.Reporting.WebForms.ScriptManagerNotFoundException
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
Catch ex As Exception
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
End Try
Try
MR.Dispose()
Catch ex As Exception
GuardaLog($"Error: { ex.ToString() }")
End Try
MR = Nothing
End If
sw.Stop()
If sw.Elapsed.TotalSeconds > 5 Then
GuardaLog($"Reporte:{RutaReporte} | Tiempo Renderizado Milisegundos: {sw.ElapsedMilliseconds},Total Segundos: {sw.Elapsed.TotalSeconds} ")
End If
Return Bytes
End Function
End Class
'''
''' Clase para contener los valores de un xml CFDI cambio norma
'''
Public Class XmlSatCFDI
Private Property EsProduccion As Boolean = True
Public Sub New(NombreArchivoLog As String)
comprobante = New CFDIComprobante()
emisor = New CFDIEmisor()
receptor = New CFDIReceptor()
complemento = New CFDIComplemento()
cFDIRelacionados = New List(Of CFDIRelacionado)()
conceptos = New List(Of CFDIConcepto)()
Impuestos = New List(Of CFDIImpuesto)()
ArchivoLog = NombreArchivoLog
End Sub
Public comprobante As CFDIComprobante
Public emisor As CFDIEmisor
Public receptor As CFDIReceptor
Public complemento As CFDIComplemento
Public cFDIRelacionados As List(Of CFDIRelacionado)
Public conceptos As List(Of CFDIConcepto)
Public Impuestos As List(Of CFDIImpuesto)
Public Property ArchivoLog As String = "Log"
Public Function GetConceptosforpdf() As List(Of CFDIConcepto_I)
Dim lcon As New List(Of CFDIConcepto_I)()
If conceptos IsNot Nothing Then
Dim _orden As Integer = 0
For Each item As CFDIConcepto In conceptos
_orden += 1
Dim con As New CFDIConcepto_I With {
.tipo = 1,
.orden = _orden,
.ClaveProdServ = item.ClaveProdServ,
.NoIdentificacion = item.NoIdentificacion,
.Cantidad = item.Cantidad,
.ClaveUnidad = item.ClaveUnidad,
.Unidad = item.Unidad,
.ValorUnitario = item.ValorUnitario,
.Importe = item.Importe,
.Descuento = item.Descuento,
.NumeroPedimento = item.NumeroPedimento,
.CuentaPredial = item.CuentaPredial,
.Descripcion = item.Descripcion
}
Dim index As Integer = 0
For Each Imp As CFDIConceptoImpuesto In item.Impuestos
index += 1
If index > 1 Then
lcon.Add(con)
con = New CFDIConcepto_I With {
.tipo = 2,
.orden = _orden
}
End If
con.Impuesto = Imp.ImpuestoTexto
con.Impuesto_Tipo = Imp.Tipo
con.Impuesto_Base = Imp.Base
con.Impuesto_TipoFactor = Imp.TipoFactor
con.Impuesto_TasaOCuota = Imp.TasaOCuota
con.Impuesto_Importe = Imp.Importe
Next
lcon.Add(con)
Next
End If
Return lcon
End Function
Public Shared Function readXML(fileUrl As String, NombreArchivoLog As String) As XmlSatCFDI
Dim xmlCFDI As New XmlSatCFDI(NombreArchivoLog)
Dim canread As Boolean = True
' Keys
Dim keyComprobante As String = "cfdi:Comprobante"
Dim keyCfdiRelacionados As String = "cfdi:CfdiRelacionados"
Dim keyEmisor As String = "cfdi:Emisor"
Dim keyReceptor As String = "cfdi:Receptor"
Dim keyConceptos As String = "cfdi:Conceptos"
Dim keyImpuestos As String = "cfdi:Impuestos"
Dim keyComplemento As String = "cfdi:Complemento"
' Endkeys
Dim PrimerNivel As String() = {keyCfdiRelacionados, keyEmisor, keyReceptor, keyConceptos, keyImpuestos, keyComplemento}
' (canread = xtr.Read()) para evitar ciclos infinitos, todos los .Read() los guardo en la variable Canread y en los while reviso primero esta variable
If File.Exists(fileUrl) Then
Dim settings As New XmlReaderSettings()
settings.ConformanceLevel = ConformanceLevel.Fragment
settings.IgnoreWhitespace = True
settings.IgnoreComments = True
Using xtr As XmlReader = XmlReader.Create(fileUrl, settings)
While (InlineAssignHelper.Assign(canread, xtr.Read())) AndAlso Not (xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyComprobante)
'if (xtr.NodeType != XmlNodeType.Element) { while (xtr.Read() && xtr.NodeType != XmlNodeType.Element) { } }
End While
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyComprobante Then
Dim Nivel As Integer = xtr.Depth
Dim cont As Boolean = xtr.MoveToFirstAttribute()
While cont
Select Case xtr.Name.ToUpper()
Case "XMLNS:CFDI"
xmlCFDI.comprobante.xmlns_cfdi = xtr.Value
Case "XMLNS:XSI"
xmlCFDI.comprobante.xmlns_xsi = xtr.Value
Case "XSI:SCHEMALOCATION"
xmlCFDI.comprobante.xsi_schemaLocation = xtr.Value
Case "VERSION"
xmlCFDI.comprobante.Version = xtr.Value
Case "SERIE"
xmlCFDI.comprobante.Serie = xtr.Value
Case "FOLIO"
xmlCFDI.comprobante.Folio = xtr.Value
Case "FECHA"
xmlCFDI.comprobante.Fecha = xtr.Value
Case "MONEDA"
xmlCFDI.comprobante.Moneda = xtr.Value
Case "SUBTOTAL"
Dim SubTotal As Decimal = 0
Decimal.TryParse(xtr.Value, SubTotal)
xmlCFDI.comprobante.SubTotal = SubTotal
Case "TOTAL"
Dim Total As Decimal = 0
Decimal.TryParse(xtr.Value, Total)
xmlCFDI.comprobante.Total = Total
Case "DESCUENTO"
Dim Descuento As Decimal = 0
Decimal.TryParse(xtr.Value, Descuento)
xmlCFDI.comprobante.Descuento = Descuento
Case "TIPOCAMBIO"
Dim TipoCambio As Decimal = 0
Decimal.TryParse(xtr.Value, TipoCambio)
xmlCFDI.comprobante.TipoCambio = TipoCambio
Case "TIPODECOMPROBANTE"
xmlCFDI.comprobante.TipoDeComprobante = xtr.Value
Case "FORMAPAGO", "FORMADEPAGO"
xmlCFDI.comprobante.FormaPago = xtr.Value
Case "METODOPAGO", "METODODEPAGO"
xmlCFDI.comprobante.MetodoPago = xtr.Value
Case "CONDICIONESDEPAGO"
xmlCFDI.comprobante.CondicionesDePago = xtr.Value
Case "LUGAREXPEDICION"
xmlCFDI.comprobante.LugarExpedicion = xtr.Value
Case "CONFIRMACION"
xmlCFDI.comprobante.Confirmacion = xtr.Value
Case "NOCERTIFICADO"
xmlCFDI.comprobante.NoCertificado = xtr.Value
Case "SELLO"
xmlCFDI.comprobante.Sello = xtr.Value
Case "CERTIFICADO"
xmlCFDI.comprobante.Certificado = xtr.Value
End Select
cont = xtr.MoveToNextAttribute()
End While
cont = xtr.MoveToFirstAttribute()
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > Nivel
If PrimerNivel.Contains(xtr.Name) Then
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyCfdiRelacionados Then
Dim cDepth As Integer = xtr.Depth
Dim TipoRelacion As String = Nothing
cont = xtr.MoveToFirstAttribute()
While cont
If xtr.Name.ToUpper() = "TIPORELACION" Then
TipoRelacion = xtr.Value
End If
cont = xtr.MoveToNextAttribute()
End While
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepth
If xtr.Name = "cfdi:CfdiRelacionado" Then
Dim cfdir As New CFDIRelacionado()
cfdir.TipoRelacion = TipoRelacion
cfdir.UUID = xtr.GetAttribute("UUID")
xmlCFDI.cFDIRelacionados.Add(cfdir)
End If
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End While
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyEmisor Then
Dim curentNivel As Integer = xtr.Depth
cont = xtr.MoveToFirstAttribute()
While cont
Select Case xtr.Name.ToUpper()
Case "REGIMENFISCAL"
xmlCFDI.emisor.RegimenFiscal = xtr.Value
Case "NOMBRE"
xmlCFDI.emisor.Nombre = xtr.Value
Case "RFC"
xmlCFDI.emisor.Rfc = xtr.Value
End Select
cont = xtr.MoveToNextAttribute()
End While
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso Not (xtr.NodeType = XmlNodeType.Element AndAlso curentNivel >= xtr.Depth)
End While 'continua hasta que no tenga nodos y (el nodo sea tipo elemento y este en el mismo nivel)
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyReceptor Then
Dim curentNivel As Integer = xtr.Depth
cont = xtr.MoveToFirstAttribute()
While cont
Select Case xtr.Name.ToUpper()
Case "RFC"
xmlCFDI.receptor.Rfc = xtr.Value
Case "NOMBRE"
xmlCFDI.receptor.Nombre = xtr.Value
Case "RESIDENCIAFISCAL"
xmlCFDI.receptor.ResidenciaFiscal = xtr.Value
Case "NUMREGIDTRIB"
xmlCFDI.receptor.NumRegIdTrib = xtr.Value
Case "USOCFDI"
xmlCFDI.receptor.UsoCFDI = xtr.Value
End Select
cont = xtr.MoveToNextAttribute()
End While
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso Not (xtr.NodeType = XmlNodeType.Element AndAlso curentNivel >= xtr.Depth)
End While 'continua hasta que no tenga nodos y (el nodo sea tipo elemento y este en el mismo nivel)
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyConceptos Then
Dim cDepth As Integer = xtr.Depth
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepth
If xtr.Name = "cfdi:Concepto" Then
Dim cDepthb As Integer = xtr.Depth
Dim concepto As New CFDIConcepto()
cont = xtr.MoveToFirstAttribute()
While cont
Select Case xtr.Name.ToUpper()
Case "CLAVEPRODSERV"
concepto.ClaveProdServ = xtr.Value
Case "NOIDENTIFICACION"
concepto.NoIdentificacion = xtr.Value
Case "CANTIDAD"
concepto.Cantidad = xtr.Value
Case "CLAVEUNIDAD"
concepto.ClaveUnidad = xtr.Value
Case "UNIDAD"
concepto.Unidad = xtr.Value
Case "VALORUNITARIO"
Dim ValorUnitario As Decimal = 0
Decimal.TryParse(xtr.Value, ValorUnitario)
concepto.ValorUnitario = ValorUnitario
Case "IMPORTE"
Dim Importe As Decimal = 0
Decimal.TryParse(xtr.Value, Importe)
concepto.Importe = Importe
Case "DESCUENTO"
Dim DDescuento As Decimal = 0
Decimal.TryParse(xtr.Value, DDescuento)
concepto.Descuento = DDescuento
Case "DESCRIPCION"
concepto.Descripcion = xtr.Value
End Select
cont = xtr.MoveToNextAttribute()
End While
xtr.MoveToFirstAttribute()
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepthb
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = "cfdi:Impuestos" Then
Dim cDepthc As Integer = xtr.Depth
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepthc
If xtr.Name = "cfdi:Traslado" OrElse xtr.Name = "cfdi:Retencion" Then
Dim impuesto As New CFDIConceptoImpuesto()
impuesto.Impuesto = xtr.GetAttribute("Impuesto")
impuesto.Tipo = xtr.LocalName
Dim Base As Decimal = 0
Decimal.TryParse(xtr.GetAttribute("Base"), Base)
impuesto.Base = Base
impuesto.TipoFactor = xtr.GetAttribute("TipoFactor")
Dim tasaOCuota As Decimal = 0
Decimal.TryParse(xtr.GetAttribute("TasaOCuota"), tasaOCuota)
impuesto.TasaOCuota = If(impuesto.TipoFactor = "Tasa", (tasaOCuota * 100).ToString("N4"), xtr.GetAttribute("TasaOCuota"))
Dim ImImporte As Decimal = 0
Decimal.TryParse(xtr.GetAttribute("Importe"), ImImporte)
impuesto.Importe = ImImporte
concepto.Impuestos.Add(impuesto)
End If
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End While
Else
Dim rednew As Boolean = True
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = "cfdi:InformacionAduanera" Then
concepto.NumeroPedimento = xtr.GetAttribute("NumeroPedimento")
rednew = False
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = "cfdi:CuentaPredial" Then
concepto.CuentaPredial = xtr.GetAttribute("CuentaPredial")
rednew = False
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End If
If rednew Then
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End If
End If
End While
xmlCFDI.conceptos.Add(concepto)
End If
End While
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyImpuestos Then
Dim cDepth As Integer = xtr.Depth
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepth
Dim impuest As New CFDIImpuesto()
If (xtr.Name = "cfdi:Traslado" OrElse xtr.Name = "cfdi:Retencion") AndAlso xmlCFDI.comprobante.Version IsNot Nothing Then
impuest.Tipo = If(xtr.LocalName = "Traslado", "Traslados", If(xtr.LocalName = "Retencion", "Retenciones", ""))
impuest.Impuesto = If(xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "4.0", xtr.GetAttribute("Impuesto"), xtr.GetAttribute("impuesto"))
impuest.TipoFactor = xtr.GetAttribute("TipoFactor")
impuest.TasaOCuota = If(xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "4.0", xtr.GetAttribute("TasaOCuota"), xtr.GetAttribute("tasa"))
Dim ImImporte As Decimal = 0
Decimal.TryParse(If(xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "4.0", xtr.GetAttribute("Importe"), xtr.GetAttribute("importe")), ImImporte)
impuest.Importe = ImImporte
xmlCFDI.Impuestos.Add(impuest)
End If
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End While
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.Name = keyComplemento Then
Dim cDepth As Integer = xtr.Depth
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > cDepth
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.LocalName = "TimbreFiscalDigital" AndAlso xmlCFDI.comprobante.Version IsNot Nothing Then
xmlCFDI.complemento.xmlns_tfd = xtr.GetAttribute("xmlns:tfd")
xmlCFDI.complemento.xsi_schemaLocation = xtr.GetAttribute("xsi:schemaLocation")
xmlCFDI.complemento.Version = xtr.GetAttribute("Version")
xmlCFDI.complemento.UUID = xtr.GetAttribute("UUID")
xmlCFDI.complemento.FechaTimbrado = xtr.GetAttribute("FechaTimbrado")
xmlCFDI.complemento.RfcProvCertif = xtr.GetAttribute("RfcProvCertif")
xmlCFDI.complemento.SelloCFD = If(xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "4.0", xtr.GetAttribute("SelloCFD"), xtr.GetAttribute("selloCFD"))
xmlCFDI.complemento.NoCertificadoSAT = If(xmlCFDI.comprobante.Version = "3.3", xtr.GetAttribute("NoCertificadoSAT"), xtr.GetAttribute("noCertificadoSAT"))
xmlCFDI.complemento.SelloSAT = If(xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "4.0", xtr.GetAttribute("SelloSAT"), xtr.GetAttribute("selloSAT"))
End If
If xtr.NodeType = XmlNodeType.Element AndAlso xtr.LocalName = "Pagos" AndAlso xmlCFDI.comprobante.Version IsNot Nothing Then
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
xmlCFDI.complemento.Pagos = New CFDIPago()
Dim depthpagos As Integer = xtr.Depth
Dim conts As Boolean = xtr.MoveToFirstAttribute()
While conts
Dim Base As Decimal = 0
Select Case xtr.Name.ToUpper()
Case "FECHAPAGO"
xmlCFDI.complemento.Pagos.FechaPago = xtr.Value
Case "FORMADEPAGOP"
xmlCFDI.complemento.Pagos.FormaDePagoP = xtr.Value
Case "FORMADEPAGOPTEXT"
xmlCFDI.complemento.Pagos.FormaDePagoPText = xtr.Value
Case "MONEDAP"
xmlCFDI.complemento.Pagos.MonedaP = xtr.Value
Case "MONTO"
Decimal.TryParse(xtr.Value, Base)
xmlCFDI.complemento.Pagos.Monto = Base
Case "TIPOCAMBIOP"
Decimal.TryParse(xtr.Value, Base)
xmlCFDI.complemento.Pagos.TipoCambioP = Base
Case "NUMOPERACION"
xmlCFDI.complemento.Pagos.NumOperacion = xtr.Value
Case "NOMBANCOORDEXT"
xmlCFDI.complemento.Pagos.NomBancoOrdExt = xtr.Value
Case "RFCEMISORCTAORD"
xmlCFDI.complemento.Pagos.RfcEmisorCtaOrd = xtr.Value
Case "CTAORDENANTE"
xmlCFDI.complemento.Pagos.CtaOrdenante = xtr.Value
Case "RFCEMISORCTABEN"
xmlCFDI.complemento.Pagos.RfcEmisorCtaBen = xtr.Value
Case "CTABENEFICIARIO"
xmlCFDI.complemento.Pagos.CtaBeneficiario = xtr.Value
End Select
conts = xtr.MoveToNextAttribute()
End While
conts = xtr.MoveToFirstAttribute()
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
While canread AndAlso xtr.Depth > depthpagos
Dim objpago As New CFDIPagoDoctoRelacionado()
conts = xtr.MoveToFirstAttribute()
While conts
Dim Basep As Decimal = 0
Select Case xtr.Name.ToUpper()
Case "IDDOCUMENTO"
objpago.IdDocumento = xtr.Value
Case "SERIE"
objpago.Serie = xtr.Value
Case "FOLIO"
objpago.Folio = xtr.Value
Case "MONEDADR"
objpago.MonedaDR = xtr.Value
Case "METODODEPAGODR"
objpago.MetodoDePagoDR = xtr.Value
Case "NUMPARCIALIDAD"
objpago.NumParcialidad = xtr.Value
Case "IMPSALDOANT"
Decimal.TryParse(xtr.Value, Basep)
objpago.ImpSaldoAnt = Basep
Case "IMPPAGADO"
Decimal.TryParse(xtr.Value, Basep)
objpago.ImpPagado = Basep
Case "IMPSALDOINSOLUTO"
Decimal.TryParse(xtr.Value, Basep)
objpago.ImpSaldoInsoluto = Basep
End Select
conts = xtr.MoveToNextAttribute()
End While
conts = xtr.MoveToFirstAttribute()
xmlCFDI.complemento.Pagos.doctosRelacionados.Add(objpago)
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End While
Else
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End If
End While
End If
Else
'si no entro en ninguna de los anteriores no se debe ciclar
While InlineAssignHelper.Assign(canread, xtr.Read()) AndAlso xtr.NodeType <> XmlNodeType.Element
End While
End If
End While
End If
End Using
End If
If xmlCFDI.comprobante.Version = "4.0" OrElse xmlCFDI.comprobante.Version = "3.3" OrElse xmlCFDI.comprobante.Version = "3.2" Then
Return xmlCFDI
Else
Return Nothing
End If
End Function
Public Sub ImprimirPDF(UsuarioActual As Usuario, NombreArchivo As String, DirectorioEmpresa As String, TipodeComprobante As String)
Dim objxml As XmlSatCFDI = Me
Dim rutaReporte As String = $"{DirectorioEmpresas}{If(TipodeComprobante = "Pag", "Grales\Formatos\CFDIV3Pago.rdlc", "Grales\Formatos\CFDIV3.rdlc")}"
'Dim rutaReporte As String = If(TipodeComprobante = "Pag", "Grales\Formatos\CFDIV3Pago.rdlc", "Grales\Formatos\CFDIV3.rdlc")
Dim cQr As Byte() = Nothing
Try
Dim cfdi As New RVCFDI33.GeneraCFDI()
cQr = cfdi.ConvertirQrCode($"?re={objxml.emisor.Rfc}&rr={objxml.receptor.Rfc}&tt={(If(objxml.complemento.Pagos Is Nothing, objxml.comprobante.Total, objxml.complemento.Pagos.Monto))}&id={objxml.complemento.UUID}")
Catch exQR As Exception
ModExtensiones.GuardaLogAD("Error al generar QR - " & exQR.Message & " - " & exQR.StackTrace.ToString(), ArchivoLog)
End Try
Dim parametros As New List(Of ReportParameter)()
' Comprobante
parametros.Add(New ReportParameter("comprobante_Certificado", objxml.comprobante.Certificado))
parametros.Add(New ReportParameter("comprobante_CondicionesDePago", objxml.comprobante.CondicionesDePago))
parametros.Add(New ReportParameter("comprobante_Confirmacion", objxml.comprobante.Confirmacion))
parametros.Add(New ReportParameter("comprobante_Fecha", objxml.comprobante.Fecha))
parametros.Add(New ReportParameter("comprobante_Serie", objxml.comprobante.Serie))
parametros.Add(New ReportParameter("comprobante_Folio", objxml.comprobante.Folio))
parametros.Add(New ReportParameter("comprobante_Descuento", objxml.comprobante.Descuento.ToString("N2")))
parametros.Add(New ReportParameter("comprobante_SubTotal", objxml.comprobante.SubTotal.ToString("N2")))
parametros.Add(New ReportParameter("comprobante_Total", objxml.comprobante.Total.ToString("N2")))
parametros.Add(New ReportParameter("comprobante_Version", objxml.comprobante.Version))
parametros.Add(New ReportParameter("comprobante_TipoDeComprobante", objxml.comprobante.TipoDeComprobanteTexto))
parametros.Add(New ReportParameter("comprobante_FormaPago", objxml.comprobante.FormaPagoTexto))
parametros.Add(New ReportParameter("comprobante_LugarExpedicion", objxml.comprobante.LugarExpedicion))
parametros.Add(New ReportParameter("comprobante_NoCertificado", objxml.comprobante.NoCertificado))
parametros.Add(New ReportParameter("comprobante_Sello", objxml.comprobante.Sello))
parametros.Add(New ReportParameter("comprobante_Moneda", objxml.comprobante.Moneda))
parametros.Add(New ReportParameter("comprobante_TipoCambio", objxml.comprobante.TipoCambio.ToString("N2")))
parametros.Add(New ReportParameter("comprobante_MetodoPago", objxml.comprobante.MetodoPagoTexto))
' Emisor
parametros.Add(New ReportParameter("emisor_Rfc", objxml.emisor.Rfc))
parametros.Add(New ReportParameter("emisor_Nombre", objxml.emisor.Nombre))
parametros.Add(New ReportParameter("emisor_RegimenFiscal", objxml.emisor.RegimenFiscalTexto))
' Receptor
parametros.Add(New ReportParameter("receptor_Rfc", objxml.receptor.Rfc))
parametros.Add(New ReportParameter("receptor_Nombre", objxml.receptor.Nombre))
parametros.Add(New ReportParameter("receptor_NumRegIdTrib", objxml.receptor.NumRegIdTrib))
parametros.Add(New ReportParameter("receptor_ResidenciaFiscal", objxml.receptor.ResidenciaFiscal))
parametros.Add(New ReportParameter("receptor_UsoCFDI", objxml.receptor.UsoCFDITexto))
' Complemento
parametros.Add(New ReportParameter("complemento_FechaTimbrado", objxml.complemento.FechaTimbrado))
parametros.Add(New ReportParameter("complemento_NoCertificadoSAT", objxml.complemento.NoCertificadoSAT))
parametros.Add(New ReportParameter("complemento_RfcProvCertif", objxml.complemento.RfcProvCertif))
parametros.Add(New ReportParameter("complemento_SelloCFD", objxml.complemento.SelloCFD))
parametros.Add(New ReportParameter("complemento_SelloSAT", objxml.complemento.SelloSAT))
parametros.Add(New ReportParameter("complemento_UUID", objxml.complemento.UUID))
parametros.Add(New ReportParameter("complemento_CadenaOriginal", objxml.complemento.CadenaOriginal))
' Pagos
If objxml.complemento.Pagos IsNot Nothing Then
parametros.Add(New ReportParameter("CPFechaPago", objxml.complemento.Pagos.FechaPago))
parametros.Add(New ReportParameter("CPFormaDePagoP", objxml.complemento.Pagos.FormaDePagoP))
parametros.Add(New ReportParameter("CPFormaDePagoPText", objxml.complemento.Pagos.FormaDePagoPText))
parametros.Add(New ReportParameter("CPMonedaP", objxml.complemento.Pagos.MonedaP))
parametros.Add(New ReportParameter("CPMonto", objxml.complemento.Pagos.Monto.ToString()))
parametros.Add(New ReportParameter("CPTipoCambioP", objxml.complemento.Pagos.TipoCambioP.ToString()))
parametros.Add(New ReportParameter("CPNumOperacion", objxml.complemento.Pagos.NumOperacion))
parametros.Add(New ReportParameter("CPNomBancoOrdExt", objxml.complemento.Pagos.NomBancoOrdExt))
parametros.Add(New ReportParameter("CPRfcEmisorCtaOrd", objxml.complemento.Pagos.RfcEmisorCtaOrd))
parametros.Add(New ReportParameter("CPCtaOrdenante", objxml.complemento.Pagos.CtaOrdenante))
parametros.Add(New ReportParameter("CPRfcEmisorCtaBen", objxml.complemento.Pagos.RfcEmisorCtaBen))
parametros.Add(New ReportParameter("CPCtaBeneficiario", objxml.complemento.Pagos.CtaBeneficiario))
End If
Try
Dim listaDS As New List(Of ReportDataSource)
Dim rdsTotales As New ReportDataSource()
'Dim ltotales As New List(Of utilValores)()
Dim DTTotales As New DataTable
DTTotales.TableName = "DTTotales"
DTTotales.Columns.Add("Nombre")
DTTotales.Columns.Add("Valor")
Dim nRowSubtotales As DataRow = DTTotales.NewRow
nRowSubtotales("Nombre") = "Subtotal"
nRowSubtotales("Valor") = objxml.comprobante.SubTotal.ToString("N2")
DTTotales.Rows.Add(nRowSubtotales)
If objxml.comprobante.Descuento > 0 Then
Dim nRowDescuento As DataRow = DTTotales.NewRow
nRowDescuento("Nombre") = "Descuento"
nRowDescuento("Valor") = objxml.comprobante.Descuento.ToString("N2")
DTTotales.Rows.Add(nRowDescuento)
End If
For Each item As CFDIImpuesto In objxml.Impuestos
Dim nRow As DataRow = DTTotales.NewRow
If item.Importe > 0 Then
Dim TasaOCuota As Decimal = 0
Decimal.TryParse(item.TasaOCuota, TasaOCuota)
nRow("Nombre") = $"Impuestos {item.Tipo} {item.ImpuestoTexto} {(If(item.TipoFactor = "Tasa", (TasaOCuota * 100).ToString("N4"), item.TasaOCuota))} {(If(item.TipoFactor = "Tasa", "%", ""))}"
nRow("Valor") = item.Importe.ToString("N2")
DTTotales.Rows.Add(nRow)
End If
Next
Dim nRowTotal As DataRow = DTTotales.NewRow
nRowTotal("Nombre") = "Subtotal"
nRowTotal("Valor") = objxml.comprobante.Total.ToString("N2")
DTTotales.Rows.Add(nRowTotal)
rdsTotales.Name = "dsTotales"
rdsTotales.Value = DTTotales 'ltotales.ToDataTable
listaDS.Add(rdsTotales)
Dim dtByte As New DataTable()
dtByte.Columns.Add("ImagenByte", GetType(Byte()))
dtByte.TableName = "dtImagenes"
Dim nrowByteArray As DataRow = dtByte.NewRow
nrowByteArray("ImagenByte") = cQr
dtByte.Rows.Add(nrowByteArray)
'byteArrayList.Add(cQr)
Dim rds2 As New ReportDataSource()
'Dim limagenes As New List(Of utilImage)()
'limagenes.Add(New utilImage(cQr))
rds2.Name = "dsImagenes"
rds2.Value = dtByte
listaDS.Add(rds2)
Dim dtRelacionados As New DataTable
dtRelacionados.TableName = "dtRelacionados"
dtRelacionados.Columns.Add("TipoRelacion")
dtRelacionados.Columns.Add("TipoRelacionTexto")
dtRelacionados.Columns.Add("UUID")
For Each relaciondo As CFDIRelacionado In objxml.cFDIRelacionados
Dim CFDIRelacionadoRow As DataRow = dtRelacionados.NewRow
CFDIRelacionadoRow("TipoRelacion") = relaciondo.TipoRelacion
CFDIRelacionadoRow("TipoRelacionTexto") = relaciondo.TipoRelacionTexto
CFDIRelacionadoRow("UUID") = relaciondo.UUID
dtRelacionados.Rows.Add(CFDIRelacionadoRow)
Next
Dim rdsrelacionados As New ReportDataSource()
rdsrelacionados.Name = "dsRelacionados"
rdsrelacionados.Value = dtRelacionados 'objxml.cFDIRelacionados
listaDS.Add(rdsrelacionados)
Dim dtConceptos As New DataTable
dtConceptos.TableName = "dtConceptos"
dtConceptos.Columns.Add("tipo", GetType(Integer))
dtConceptos.Columns.Add("orden", GetType(Integer))
dtConceptos.Columns.Add("ClaveProdServ", GetType(String))
dtConceptos.Columns.Add("NoIdentificacion", GetType(String))
dtConceptos.Columns.Add("Cantidad", GetType(String)) ' Nota: Se asume que es cadena, cambiar si necesario
dtConceptos.Columns.Add("ClaveUnidad", GetType(String))
dtConceptos.Columns.Add("Unidad", GetType(String))
dtConceptos.Columns.Add("ValorUnitario", GetType(Decimal))
dtConceptos.Columns.Add("Importe", GetType(Decimal))
dtConceptos.Columns.Add("Descuento", GetType(Decimal))
dtConceptos.Columns.Add("NumeroPedimento", GetType(String))
dtConceptos.Columns.Add("CuentaPredial", GetType(String))
dtConceptos.Columns.Add("Descripcion", GetType(String))
dtConceptos.Columns.Add("Impuesto", GetType(String))
dtConceptos.Columns.Add("Impuesto_Tipo", GetType(String))
dtConceptos.Columns.Add("Impuesto_Base", GetType(Decimal))
dtConceptos.Columns.Add("Impuesto_TipoFactor", GetType(String))
dtConceptos.Columns.Add("Impuesto_TasaOCuota", GetType(String))
dtConceptos.Columns.Add("Impuesto_Importe", GetType(Decimal))
For Each concepto As CFDIConcepto_I In objxml.GetConceptosforpdf()
Dim CFDIRelacionadoRow As DataRow = dtConceptos.NewRow
CFDIRelacionadoRow("tipo") = concepto.tipo
CFDIRelacionadoRow("orden") = concepto.orden
CFDIRelacionadoRow("ClaveProdServ") = concepto.ClaveProdServ
CFDIRelacionadoRow("NoIdentificacion") = concepto.NoIdentificacion
CFDIRelacionadoRow("Cantidad") = concepto.Cantidad
CFDIRelacionadoRow("ClaveUnidad") = concepto.ClaveUnidad
CFDIRelacionadoRow("Unidad") = concepto.Unidad
CFDIRelacionadoRow("ValorUnitario") = concepto.ValorUnitario
CFDIRelacionadoRow("Importe") = concepto.Importe
CFDIRelacionadoRow("Descuento") = concepto.Descuento
CFDIRelacionadoRow("NumeroPedimento") = concepto.NumeroPedimento
CFDIRelacionadoRow("CuentaPredial") = concepto.CuentaPredial
CFDIRelacionadoRow("Descripcion") = concepto.Descripcion
CFDIRelacionadoRow("Impuesto") = concepto.Impuesto
CFDIRelacionadoRow("Impuesto_Tipo") = concepto.Impuesto_Tipo
CFDIRelacionadoRow("Impuesto_Base") = concepto.Impuesto_Base
CFDIRelacionadoRow("Impuesto_TipoFactor") = concepto.Impuesto_TipoFactor
CFDIRelacionadoRow("Impuesto_TasaOCuota") = If(concepto.Impuesto_TasaOCuota Is Nothing, "", concepto.Impuesto_TasaOCuota)
CFDIRelacionadoRow("Impuesto_Importe") = If(concepto.Impuesto_Importe > 0, concepto.Impuesto_Importe, 0)
dtConceptos.Rows.Add(CFDIRelacionadoRow)
Next
Dim rds1 As New ReportDataSource()
rds1.Name = "dsConceptos"
rds1.Value = dtConceptos 'objxml.GetConceptosforpdf()
listaDS.Add(rds1)
If objxml.complemento.Pagos IsNot Nothing Then
' Crear un nuevo DataTable y agregar las columnas correspondientes
Dim DTdoctosRelacionados As New DataTable()
DTdoctosRelacionados.TableName = "dtDocumentos"
' Agregar todas las columnas respetando los tipos de datos
DTdoctosRelacionados.Columns.Add("IdDocumento", GetType(String))
DTdoctosRelacionados.Columns.Add("Serie", GetType(String))
DTdoctosRelacionados.Columns.Add("Folio", GetType(String))
DTdoctosRelacionados.Columns.Add("MonedaDR", GetType(String))
DTdoctosRelacionados.Columns.Add("MetodoDePagoDR", GetType(String))
DTdoctosRelacionados.Columns.Add("NumParcialidad", GetType(String))
DTdoctosRelacionados.Columns.Add("ImpSaldoAnt", GetType(Decimal))
DTdoctosRelacionados.Columns.Add("ImpPagado", GetType(Decimal))
DTdoctosRelacionados.Columns.Add("ImpSaldoInsoluto", GetType(Decimal))
' Llenar el DataTable con los valores de la lista de documentos
For Each doctosRelacionado As CFDIPagoDoctoRelacionado In objxml.complemento.Pagos.doctosRelacionados
Dim nRowdoctosRelacionados As DataRow = DTdoctosRelacionados.NewRow()
' Asignar valores a cada columna desde las propiedades del objeto documento
nRowdoctosRelacionados("IdDocumento") = doctosRelacionado.IdDocumento
nRowdoctosRelacionados("Serie") = doctosRelacionado.Serie
nRowdoctosRelacionados("Folio") = doctosRelacionado.Folio
nRowdoctosRelacionados("MonedaDR") = doctosRelacionado.MonedaDR
nRowdoctosRelacionados("MetodoDePagoDR") = doctosRelacionado.MetodoDePagoDR
nRowdoctosRelacionados("NumParcialidad") = doctosRelacionado.NumParcialidad
nRowdoctosRelacionados("ImpSaldoAnt") = doctosRelacionado.ImpSaldoAnt
nRowdoctosRelacionados("ImpPagado") = doctosRelacionado.ImpPagado
nRowdoctosRelacionados("ImpSaldoInsoluto") = doctosRelacionado.ImpSaldoInsoluto
' Agregar la fila al DataTable
DTdoctosRelacionados.Rows.Add(nRowdoctosRelacionados)
Next
Dim rdsp As New ReportDataSource()
rdsp.Name = "dsPagos"
rdsp.Value = DTdoctosRelacionados ' objxml.complemento.Pagos.doctosRelacionados
listaDS.Add(rdsp)
End If
'Dim bytes As Byte() = Nothing
'bytes = MR.LocalReport.Render("PDF", Nothing, mimeType, encoding, extension, streamids, warnings)
Dim bytes As Byte() = Nothing
bytes = StreamPDF(UsuarioActual, rutaReporte, listaDS, parametros, NombreArchivo:=NombreArchivo, Formato:="PDF")
If bytes IsNot Nothing Then
Using fs As New FileStream(NombreArchivo, FileMode.Create)
fs.Write(bytes, 0, bytes.Length)
fs.Close()
End Using
End If
Catch ex As Exception
ex.ToString().GuardaLogAD()
End Try
End Sub
Public Class utilValores
Public Sub New()
' Constructor sin parámetros
End Sub
Public Sub New(nombre As String, valor As String)
Me.Nombre = nombre
Me.Valor = valor
End Sub
Public Property Nombre As String
Public Property Valor As String
End Class
Public Class utilImage
Public Sub New(imagenByte As Byte())
Me.ImagenByte = imagenByte
End Sub
Public Property ImagenByte As Byte()
End Class
Public Function StreamPDF(UsuarioActual As Usuario, RutaReporte As String, DataSource As List(Of ReportDataSource), Parametros As List(Of ReportParameter), Optional NombreArchivo As String = "Reporte", Optional Formato As String = "PDF", Optional MR As ReportViewer = Nothing, Optional SubReportData As Modelos.MSubReportData = Nothing) As Byte()
'limpio ReportViwer
Dim sw As Stopwatch = Stopwatch.StartNew()
Dim Bytes As Byte() = Nothing
Dim CveUsuario As Integer = 0
Dim CveEmpresa As Integer = 0
Dim RutaEmpresa As String = ""
If UsuarioActual IsNot Nothing Then
CveUsuario = UsuarioActual.CveUsuario
CveEmpresa = UsuarioActual.CveEmpresa
RutaEmpresa = UsuarioActual.Empresa.Ruta
End If
Dim bdir As String = If(RutaReporte.Contains("Empresas"), ModExtensiones.DirectorioBaseEmpresas, AppDomain.CurrentDomain.BaseDirectory)
'TOMAR LA RUTA BASE PARA EL DIRECTORIO DE LA EMPRESA
If Not String.IsNullOrEmpty(RutaEmpresa) AndAlso Not RutaReporte.Contains("Grales") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("Contabilidad/Reportes/") AndAlso Not RutaReporte.Contains("AC/Reportes/") Then
bdir = RutaEmpresa.Replace($"{CveEmpresa}/", "")
End If
RutaReporte.Replace("/", "\")
If Not RutaReporte.ToUpper().StartsWith(bdir.ToUpper()) Then
RutaReporte = String.Format("{0}{1}", bdir, RutaReporte)
End If
If EsProduccion Then
Dim wsreport As New WSRDLC2.WebServiceSoapClient
Dim params As New List(Of WSRDLC2.ReportParameter)
Dim reportobjects As New List(Of WSRDLC2.ReportObjects)
Dim jsonData As String = Nothing
If SubReportData IsNot Nothing Then
jsonData = Newtonsoft.Json.JsonConvert.SerializeObject(SubReportData)
End If
Dim ds As New DataSet
For Each rpds As ReportDataSource In DataSource
If rpds.Value IsNot Nothing Then
If rpds.Value.GetType().ToString() = "System.Data.DataTable" Then
Dim dt As DataTable = DirectCast(rpds.Value, Data.DataTable)
dt = dt.Copy()
dt.TableName = rpds.Name
ds.Tables.Add(dt)
Else
Dim ojext As New WSRDLC2.ReportObjects
ojext.Name = rpds.Name
ojext.Value = rpds.Value
reportobjects.Add(ojext)
End If
Else
Dim dt As DataTable = New DataTable()
dt.TableName = If(String.IsNullOrEmpty(rpds.Name), "DataTable1", rpds.Name)
ds.Tables.Add(dt)
End If
Next
For Each rpds As ReportParameter In Parametros
Dim param As New WSRDLC2.ReportParameter
param.Name = rpds.Name
'SI ES TEXTO, QUITAR TABS Y OTROS ESPACIOS QUE DEN PROBLEMAS AL MANDAR LA PETICION
If rpds IsNot Nothing AndAlso rpds.Values IsNot Nothing AndAlso rpds.Values.Count > 0 AndAlso rpds.Values(0) IsNot Nothing AndAlso rpds.Values(0).GetType() = GetType(String) Then
param.Values = {rpds.Values(0).Replace(vbVerticalTab, "")}
Else
param.Values = {rpds.Values(0)}
End If
params.Add(param)
Next
Bytes = wsreport.StreamNEWPDFBytes(RutaReporte, ds, reportobjects.ToArray(), params.ToArray(), NombreArchivo, Formato, CveEmpresa, CveUsuario, jsonData)
wsreport = Nothing
params = Nothing
ds.Dispose() : ds = Nothing
Else
If IsNothing(MR) Then MR = New ReportViewer
Try
' MasterReporteador.LocalReport.DataSources.Clear()
For Each RDS As ReportDataSource In DataSource
MR.LocalReport.DataSources.Add(RDS)
Next
MR.LocalReport.ReportPath = RutaReporte
MR.ProcessingMode = ProcessingMode.Local
MR.LocalReport.EnableExternalImages = True
MR.LocalReport.SetParameters(Parametros)
MR.LocalReport.Refresh()
Dim Warnings As Warning() = Nothing
Dim StreamIds As String() = Nothing
Dim MimeType As String = Nothing
Dim Encoding As String = Nothing
Dim Extension As String = Nothing
Bytes = MR.LocalReport.Render(Formato, Nothing, MimeType, Encoding, Extension, StreamIds, Warnings)
Catch ex As Microsoft.Reporting.WebForms.ScriptManagerNotFoundException
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error: {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
Catch ex As Exception
GuardaLog($"Error: { If(ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, ex.Message) } | Descripcion: {If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException IsNot Nothing AndAlso ex.InnerException.InnerException.Message IsNot Nothing, ex.InnerException.InnerException.Message, If(ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message IsNot Nothing, ex.InnerException.Message, "Sin descripcion"))} - Ruta {RutaReporte}")
'HAY QUE VALIDAR QUE LOS OBJETOS QUE SE USAN PARA GUARDAR LOG EXISTEN!!! IPP 14 AGOSTO 2017
'GuardaLog($"Error {ex.InnerException.Message} | Descripcion: {If(ex.InnerException.InnerException IsNot Nothing, ex.InnerException.InnerException.Message, "Sin descripcion")} - Ruta {RutaReporte}")
End Try
Try
MR.Dispose()
Catch ex As Exception
GuardaLog($"Error: { ex.ToString() }")
End Try
MR = Nothing
End If
sw.Stop()
If sw.Elapsed.TotalSeconds > 5 Then
GuardaLog($"Reporte:{RutaReporte} | Tiempo Renderizado Milisegundos: {sw.ElapsedMilliseconds},Total Segundos: {sw.Elapsed.TotalSeconds} ")
End If
Return Bytes
End Function
End Class
Public Module InlineAssignHelper
Public Function Assign(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
End Module
#Region "impresion nd"
Public Class CFDIComprobante
Public Property xmlns_cfdi As String
Public Property xmlns_xsi As String
Public Property xsi_schemaLocation As String
Public Property Version As String
Public Property Serie As String
Public Property Folio As String
Public Property Fecha As String
Public Property Moneda As String
Public Property SubTotal As Decimal
Public Property Total As Decimal
Public Property Descuento As Decimal
Public Property TipoCambio As Decimal
Public Property TipoDeComprobante As String
Public ReadOnly Property TipoDeComprobanteTexto As String
Get
Dim retorno As String = ""
If Version = "3.3" OrElse Version = "4.0" Then
Select Case TipoDeComprobante
Case "I"
retorno = "Ingreso"
Case "E"
retorno = "Egreso"
Case "P"
retorno = "Pago"
Case "T"
retorno = "Traslado"
Case "N"
retorno = "Nómina"
Case Else
retorno = TipoDeComprobante
End Select
End If
If Version = "3.2" Then
Select Case TipoDeComprobante
Case "ingreso"
retorno = "Ing"
Case "egreso"
retorno = "Egs"
Case "P"
retorno = "PA"
Case Else
retorno = TipoDeComprobante
End Select
Else
retorno = TipoDeComprobante
End If
Return retorno
End Get
End Property
Public ReadOnly Property TipoDeComprobanteSIG As String
Get
Dim retorno As String = ""
If Version = "3.3" OrElse Version = "4.0" Then
Select Case TipoDeComprobante
Case "I"
retorno = "Ing"
Case "E"
retorno = "Egs"
Case "P"
retorno = "PA"
Case Else
retorno = TipoDeComprobante
End Select
End If
If Version = "3.2" Then
Select Case TipoDeComprobante
Case "ingreso"
retorno = "Ing"
Case "egreso"
retorno = "Egs"
Case "P"
retorno = "PA"
Case Else
retorno = TipoDeComprobante
End Select
Else
retorno = TipoDeComprobante
End If
Return retorno
End Get
End Property
Public Property FormaPago As String
Public ReadOnly Property FormaPagoTexto As String
Get
Dim retorno As String = ""
Select Case FormaPago
Case "01"
retorno = "Efectivo"
Case "02"
retorno = "Cheque nominativo"
Case "03"
retorno = "Transferencia electrónica de fondos"
Case "04"
retorno = "Tarjeta de crédito"
Case "05"
retorno = "Monedero electrónico"
Case "06"
retorno = "Dinero electrónico"
Case "08"
retorno = "Vales de despensa"
Case "12"
retorno = "Dación en pago"
Case "13"
retorno = "Pago por subrogación"
Case "14"
retorno = "Pago por consignación"
Case "15"
retorno = "Condonación"
Case "17"
retorno = "Compensación"
Case "23"
retorno = "Novación"
Case "24"
retorno = "Confusión"
Case "25"
retorno = "Remisión de deuda"
Case "26"
retorno = "Prescripción o caducidad"
Case "27"
retorno = "A satisfacción del acreedor"
Case "28"
retorno = "Tarjeta de débito"
Case "29"
retorno = "Tarjeta de servicios"
Case "30"
retorno = "Aplicación de anticipos"
Case "31"
retorno = "Intermediario pagos"
Case "99"
retorno = "Por definir"
Case Else
retorno = FormaPago
End Select
Return retorno
End Get
End Property
Public Property MetodoPago As String
Public ReadOnly Property MetodoPagoTexto As String
Get
Dim retorno As String = ""
Select Case MetodoPago
Case "PUE"
retorno = "Pago en una sola exhibición"
Case "PPD"
retorno = "Pago en parcialidades o diferido"
Case Else
retorno = MetodoPago
End Select
Return retorno
End Get
End Property
Public Property CondicionesDePago As String
Public Property LugarExpedicion As String
Public Property Confirmacion As String
Public Property NoCertificado As String
Public Property Sello As String
Public Property Certificado As String
End Class
Public Class CFDIEmisor
Public Property RegimenFiscal As String
Public ReadOnly Property RegimenFiscalTexto As String
Get
Dim retorno As String = ""
Select Case RegimenFiscal
Case "601"
retorno = "General de Ley Personas Morales"
Case "603"
retorno = "Personas Morales con Fines no Lucrativos"
Case "605"
retorno = "Sueldos y Salarios e Ingresos Asimilados a Salarios"
Case "606"
retorno = "Arrendamiento"
Case "608"
retorno = "Demás ingresos"
Case "609"
retorno = "Consolidación"
Case "610"
retorno = "Residentes en el Extranjero sin Establecimiento Permanente en México"
Case "611"
retorno = "Ingresos por Dividendos (socios y accionistas)"
Case "612"
retorno = "Personas Físicas con Actividades Empresariales y Profesionales"
Case "614"
retorno = "Ingresos por intereses"
Case "616"
retorno = "Sin obligaciones fiscales"
Case "620"
retorno = "Sociedades Cooperativas de Producción que optan por diferir sus ingresos"
Case "621"
retorno = "Incorporación Fiscal"
Case "622"
retorno = "Actividades Agrícolas, Ganaderas, Silvícolas y Pesqueras"
Case "623"
retorno = "Opcional para Grupos de Sociedades"
Case "624"
retorno = "Coordinados"
Case "628"
retorno = "Hidrocarburos"
Case "607"
retorno = "Régimen de Enajenación o Adquisición de Bienes"
Case "629"
retorno = "De los Regímenes Fiscales Preferentes y de las Empresas Multinacionales"
Case "630"
retorno = "Enajenación de acciones en bolsa de valores"
Case "615"
retorno = "Régimen de los ingresos por obtención de premios"
End Select
Return retorno
End Get
End Property
Public Property Nombre As String
Public Property Rfc As String
End Class
Public Class CFDIReceptor
Public Property Rfc As String
Public Property Nombre As String
Public Property ResidenciaFiscal As String
Public Property NumRegIdTrib As String
Public Property UsoCFDI As String
Public ReadOnly Property UsoCFDITexto As String
Get
Dim retorno As String = "N/A"
Select Case UsoCFDI
Case "G01"
retorno = "Adquisición de mercancías"
Case "G02"
retorno = "Devoluciones, descuentos o bonificaciones"
Case "G03"
retorno = "Gastos en general"
Case "I01"
retorno = "Construcciones"
Case "I02"
retorno = "Mobiliario y equipo de oficina por inversiones"
Case "I03"
retorno = "Equipo de transporte"
Case "I04"
retorno = "Equipo de cómputo y accesorios"
Case "I05"
retorno = "Dados, troqueles, moldes, matrices y herramental"
Case "I06"
retorno = "Comunicaciones telefónicas"
Case "I07"
retorno = "Comunicaciones satelitales"
Case "I08"
retorno = "Otra maquinaria y equipo"
Case "D01"
retorno = "Honorarios médicos, dentales y gastos hospitalarios."
Case "D02"
retorno = "Gastos médicos por incapacidad o discapacidad"
Case "D03"
retorno = "Gastos funerales."
Case "D04"
retorno = "Donativos."
Case "D05"
retorno = "Intereses reales efectivamente pagados por créditos hipotecarios (casa habitación)."
Case "D06"
retorno = "Aportaciones voluntarias al SAR."
Case "D07"
retorno = "Primas por seguros de gastos médicos."
Case "D08"
retorno = "Gastos de transportación escolar obligatoria."
Case "D09"
retorno = "Depósitos en cuentas para el ahorro, primas que tengan como base planes de pensiones."
Case "D10"
retorno = "Pagos por servicios educativos (colegiaturas)"
Case "P01"
retorno = "Por definir"
Case Else
retorno = UsoCFDI
End Select
Return retorno
End Get
End Property
End Class
Public Class CFDIComplemento
Public Property xmlns_tfd As String
Public Property xsi_schemaLocation As String
Public Property Version As String
Public Property UUID As String
Public Property FechaTimbrado As String
Public Property RfcProvCertif As String
Public Property SelloCFD As String
Public Property NoCertificadoSAT As String
Public Property SelloSAT As String
Public Property Pagos As CFDIPago
Public ReadOnly Property CadenaOriginal As String
Get
Return $"||{Version}|{UUID}|{FechaTimbrado}|{RfcProvCertif}|{SelloCFD}|{NoCertificadoSAT}||"
End Get
End Property
End Class
Public Class CFDIPago
Public Sub New()
doctosRelacionados = New List(Of CFDIPagoDoctoRelacionado)()
End Sub
Public Property FechaPago As String
Public Property FormaDePagoP As String
Public Property FormaDePagoPText As String
Public Property MonedaP As String
Public Property Monto As Decimal
Public Property TipoCambioP As Decimal
Public Property NumOperacion As String
Public Property NomBancoOrdExt As String
Public Property RfcEmisorCtaOrd As String
Public Property CtaOrdenante As String
Public Property RfcEmisorCtaBen As String
Public Property CtaBeneficiario As String
Public Property doctosRelacionados As List(Of CFDIPagoDoctoRelacionado)
End Class
Public Class CFDIPagoDoctoRelacionado
Public Property IdDocumento As String
Public Property Serie As String
Public Property Folio As String
Public Property MonedaDR As String
Public Property MetodoDePagoDR As String
Public Property NumParcialidad As String
Public Property ImpSaldoAnt As Decimal
Public Property ImpPagado As Decimal
Public Property ImpSaldoInsoluto As Decimal
End Class
Public Class CFDIRelacionado
Public Property TipoRelacion As String
Public ReadOnly Property TipoRelacionTexto As String
Get
Dim retorno As String = ""
Select Case TipoRelacion
Case "01"
retorno = "Nota de crédito de los documentos relacionados"
Case "02"
retorno = "Nota de débito de los documentos relacionados"
Case "03"
retorno = "Devolución de mercancía sobre facturas o traslados previos"
Case "04"
retorno = "Sustitución de los CFDI previos"
Case "05"
retorno = "Traslados de mercancías facturados previamente"
Case "06"
retorno = "Factura generada por los traslados previos"
Case "07"
retorno = "CFDI por aplicación de anticipo"
Case Else
retorno = "Por definir"
End Select
Return retorno
End Get
End Property
Public Property UUID As String
End Class
Public Class CFDIConcepto
Public Sub New()
Impuestos = New List(Of CFDIConceptoImpuesto)()
End Sub
Public Property ClaveProdServ As String
Public Property NoIdentificacion As String
Public Property Cantidad As String
Public Property ClaveUnidad As String
Public Property Unidad As String
Public Property ValorUnitario As Decimal
Public Property Importe As Decimal
Public Property Descuento As Decimal
Public Property NumeroPedimento As String
Public Property CuentaPredial As String
Public Property Descripcion As String
Public Property Impuestos As List(Of CFDIConceptoImpuesto)
End Class
Public Class CFDIConceptoImpuesto
Public Property Impuesto As String
Public ReadOnly Property ImpuestoTexto As String
Get
Dim retorno As String = ""
Select Case Impuesto
Case "001"
retorno = "ISR"
Case "002"
retorno = "IVA"
Case "003"
retorno = "IEPS"
End Select
Return retorno
End Get
End Property
Public Property Tipo As String
Public Property Base As Decimal
Public Property TipoFactor As String
Public Property TasaOCuota As String
Public Property Importe As Decimal
End Class
Public Class CFDIImpuesto
Public Property Tipo As String
Public Property Impuesto As String
Public ReadOnly Property ImpuestoTexto As String
Get
Dim retorno As String = ""
Select Case Impuesto
Case "001"
retorno = "ISR"
Case "002"
retorno = "IVA"
Case "003"
retorno = "IEPS"
End Select
Return retorno
End Get
End Property
Public Property TipoFactor As String
Public Property TasaOCuota As String
Public Property Importe As Decimal
End Class
Public Class CFDIConcepto_I
Public Property tipo As Integer
Public Property orden As Integer
Public Property ClaveProdServ As String
Public Property NoIdentificacion As String
Public Property Cantidad As String
Public Property ClaveUnidad As String
Public Property Unidad As String
Public Property ValorUnitario As Decimal
Public Property Importe As Decimal
Public Property Descuento As Decimal
Public Property NumeroPedimento As String
Public Property CuentaPredial As String
Public Property Descripcion As String
Public Property Impuesto As String
Public Property Impuesto_Tipo As String
Public Property Impuesto_Base As Decimal
Public Property Impuesto_TipoFactor As String
Public Property Impuesto_TasaOCuota As String
Public Property Impuesto_Importe As Decimal
End Class
#End Region
End Namespace
#End Region