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