<%@ 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(" ", table.Rows(0)(ColumnaTitulo)) ' html.Append("") ' For Each column As DataColumn In table.Columns ' If ColumnaTitulo <> column.ColumnName Then html.Append($"") ' 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($"") ' Else ' cellValue = If(value?.ToString(), String.Empty) ' html.Append($"") ' End If ' End If ' Next ' html.Append("") ' Next ' html.Append("") ' html.Append("
{0}
{column.ColumnName}
{cellValue}{cellValue}
") ' 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("
Información generada por SIG ERP (www.adsistemas.mx)
") 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("", table.Rows(0)(ColumnaTitulo)) html.Append("") For Each column As DataColumn In table.Columns If ColumnaTitulo <> column.ColumnName Then html.Append($"") 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($"") Else cellValue = If(value?.ToString(), String.Empty) html.Append($"") End If End If Next html.Append("") Next html.Append("") html.Append("

{0}

{column.ColumnName}
{cellValue}{cellValue}
") 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