Imports System.IO Imports Microsoft.VisualBasic Imports tsWPF Public Class Informes Public Shared Function CCODTaPDF(ByVal PlantillaODT As String, ByVal Valores As DataTable, Optional ByVal DirectorioTemporal As String = "") As IO.MemoryStream Dim fs As FileStream = Nothing Dim sNombreFicheroTmp As String Dim sNombreFicheroODTTmp As String Dim sDirectorioODTTmp As String Dim sNombreFicheroPDFTmp As String Dim i As Integer If DirectorioTemporal = "" Then DirectorioTemporal = System.Windows.Forms.Application.StartupPath & "\CCO_TMP\" If Not IO.Directory.Exists(DirectorioTemporal) Then IO.Directory.CreateDirectory(DirectorioTemporal) Try Do Do i += 1 sNombreFicheroTmp = DirectorioTemporal & "ODTaPDF-" & i.ToString & ".tmp" Loop Until BloqueaFicheroProceso(sNombreFicheroTmp, fs) sNombreFicheroODTTmp = sNombreFicheroTmp & ".odt" sDirectorioODTTmp = sNombreFicheroTmp & ".dir" sNombreFicheroPDFTmp = sNombreFicheroTmp & ".pdf" Try If File.Exists(sNombreFicheroODTTmp) Then IO.File.Delete(sNombreFicheroODTTmp) If Directory.Exists(sDirectorioODTTmp) Then IO.Directory.Delete(sDirectorioODTTmp, True) If IO.File.Exists(sNombreFicheroPDFTmp) Then IO.File.Delete(sNombreFicheroPDFTmp) Exit Do Catch ex As Exception End Try Loop Dim iosPdf(Valores.Rows.Count - 1) As MemoryStream For i = 0 To Valores.Rows.Count - 1 Anadelogtxt(sNombreFicheroODTTmp & " " & sDirectorioODTTmp, "c:\tmp\logodt.txt") RellenaODT(PlantillaODT, Valores.Rows(i), sNombreFicheroODTTmp, sDirectorioODTTmp) iosPdf(i) = New MemoryStream(tsWPF.Utilidades.odt.ExportarApdf(sNombreFicheroODTTmp)) If iosPdf(i).CanSeek Then iosPdf(i).Seek(0, 0) If File.Exists(sNombreFicheroODTTmp) Then IO.File.Delete(sNombreFicheroODTTmp) If Directory.Exists(sDirectorioODTTmp) Then IO.Directory.Delete(sDirectorioODTTmp, True) If IO.File.Exists(sNombreFicheroPDFTmp) Then IO.File.Delete(sNombreFicheroPDFTmp) Next Try Dim msDestino As MemoryStream = New MemoryStream(TSpdfUtils.pdf.UnePdfs(iosPdf)) Return msDestino Catch EX As Exception Throw New Exception(EX.Message, EX) 'For Each ios In iosPdf ' If ios.CanSeek Then ios.Seek(0, 0) ' Dim fa = tsl5.Utilidades.ObtieneFicheroAleatorio("C:\TMP\", "txt") ' IO.File.WriteAllBytes(fa, ios.ToArray) 'Next End Try Catch ex As Exception Throw New Exception(ex.Message, ex) Finally Try If Not fs Is Nothing Then fs.Close() Catch End Try End Try End Function Friend Shared Sub Anadelogtxt(ByVal Mensaje As String, ByVal FicheroLog As String) Dim sw As IO.StreamWriter Try Mensaje = Mensaje.Replace(vbCrLf, "---") If IO.File.Exists(FicheroLog) Then sw = IO.File.AppendText(FicheroLog) Else sw = IO.File.CreateText(FicheroLog) End If Mensaje = Now.ToString & "|" & "Ws: " & System.Diagnostics.Process.GetCurrentProcess.WorkingSet64.ToString.PadLeft(20) & " PMS: " & System.Diagnostics.Process.GetCurrentProcess.PrivateMemorySize64.ToString.PadLeft(20) & "|" & Mensaje sw.WriteLine(Mensaje) sw.Close() Catch ex As Exception Finally Try sw.Close() Catch End Try End Try End Sub Public Shared Function CCODTaPDF(ByVal msPlantillaODT As MemoryStream, ByVal Valores As DataTable, Optional ByVal DirectorioTemporal As String = "") As IO.MemoryStream Dim fs As FileStream = Nothing Dim sNombreFicheroTmp As String Dim sNombreFicheroODTTmp As String Dim sDirectorioODTTmp As String Dim sNombreFicheroPDFTmp As String Dim i As Integer If DirectorioTemporal = "" Then DirectorioTemporal = System.Windows.Forms.Application.StartupPath & "\CCO_TMP\" If Not IO.Directory.Exists(DirectorioTemporal) Then IO.Directory.CreateDirectory(DirectorioTemporal) Try Do Do i += 1 sNombreFicheroTmp = DirectorioTemporal & "ODTaPDF-" & i.ToString & ".tmp" Loop Until BloqueaFicheroProceso(sNombreFicheroTmp, fs) sNombreFicheroODTTmp = sNombreFicheroTmp & ".odt" sDirectorioODTTmp = sNombreFicheroTmp & ".dir" sNombreFicheroPDFTmp = sNombreFicheroTmp & ".pdf" Try If File.Exists(sNombreFicheroODTTmp) Then IO.File.Delete(sNombreFicheroODTTmp) If Directory.Exists(sDirectorioODTTmp) Then IO.Directory.Delete(sDirectorioODTTmp, True) If IO.File.Exists(sNombreFicheroPDFTmp) Then IO.File.Delete(sNombreFicheroPDFTmp) Exit Do Catch ex As Exception End Try Loop Dim iosPdf(Valores.Rows.Count - 1) As MemoryStream For i = 0 To Valores.Rows.Count - 1 RellenaODT(msPlantillaODT, Valores.Rows(i), sNombreFicheroODTTmp, sDirectorioODTTmp) iosPdf(i) = New MemoryStream(tsWPF.Utilidades.odt.ExportarApdf(sNombreFicheroODTTmp)) ' New MemoryStream(My.Computer.FileSystem.ReadAllBytes(sNombreFicheroPDFTmp)) If File.Exists(sNombreFicheroODTTmp) Then IO.File.Delete(sNombreFicheroODTTmp) If Directory.Exists(sDirectorioODTTmp) Then IO.Directory.Delete(sDirectorioODTTmp, True) If IO.File.Exists(sNombreFicheroPDFTmp) Then IO.File.Delete(sNombreFicheroPDFTmp) Next Dim msDestino As MemoryStream = New MemoryStream(TSpdfUtils.pdf.UnePdfs(iosPdf)) 'Dim msDestino As MemoryStream = tsPDFUtils.pdf.UnePdfs(iosPdf) Return msDestino 'If Valores.Rows.Count = 1 Then ' Return iosPdf(0) 'Else ' Dim p4nDestino As New PDFDocument ' Dim msDestino As New MemoryStream ' p4nDestino = PDFFile.PDFFile.MergeFiles(iosPdf) ' p4nDestino.SaveToStream(msDestino) ' Return msDestino 'End If Catch ex As Exception Throw New Exception(ex.Message, ex) Finally Try If Not fs Is Nothing Then fs.Close() Catch End Try End Try End Function Friend Shared Function BloqueaFicheroProceso(ByVal NombreFichero As String, ByRef fs As FileStream) As Boolean ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Bloquea Fichero Proceso para que no se pisen procesos simultáneos ' Fecha. Creacion: ??? ' Creada por: manmog ' Ultima Modificacion: 21/10/2009 ' ' Modificaciones: ' =============== ' ' ---------------------------------------------------------------------------------------------------- Try fs = IO.File.Open(NombreFichero, FileMode.OpenOrCreate, FileAccess.Read, FileShare.None) BloqueaFicheroProceso = True Catch ex As Exception BloqueaFicheroProceso = False Exit Function End Try End Function Public Shared Sub RellenaODT(ByVal PlantillaOdt As MemoryStream, ByVal Valores As DataRow, ByVal FicheroODTRelleno As String, Optional ByVal DirectorioTemporal As String = "") Try Dim sDirectorioTMP As String = FicheroODTRelleno & ".dir.tmp" If DirectorioTemporal <> "" Then sDirectorioTMP = DirectorioTemporal If IO.Directory.Exists(sDirectorioTMP) Then IO.Directory.Delete(sDirectorioTMP, True) Zip.ExtraerTodo(PlantillaOdt, sDirectorioTMP, True) ' tsl5.Utilidades.CopiaDirectorio(DirectorioPlantilla, sDirectorioTMP, True, True, , , , , False) Dim sContentxml As String = sDirectorioTMP & "\content.xml" Dim sStylesxml As String = sDirectorioTMP & "\styles.xml" Dim sContenidoContent As String = ReemplazaXMLODT(IndentaXML(My.Computer.FileSystem.ReadAllText(sContentxml)), Valores) Dim sContenidoStyles As String = ReemplazaXMLODT(IndentaXML(My.Computer.FileSystem.ReadAllText(sStylesxml)), Valores) My.Computer.FileSystem.WriteAllText(sContentxml, sContenidoContent, False) My.Computer.FileSystem.WriteAllText(sStylesxml, sContenidoStyles, False) 'zip.ComprimeDirectorio(sDirectorioTMP, FicheroODTRelleno, False) Zip.ComprimirDirectorio(sDirectorioTMP, FicheroODTRelleno) Catch ex As Exception Throw New Exception("Error en RellenaODT " & ex.Message, ex) End Try End Sub Public Shared Function IndentaXML(xml As String) As String Try Dim doc As XDocument = XDocument.Parse(xml) Return doc.ToString Catch ex As Exception Return xml End Try End Function Public Shared Sub RellenaODT(ByVal DirectorioPlantilla As String, ByVal Valores As DataRow, ByVal FicheroODTRelleno As String, Optional ByVal DirectorioTemporal As String = "") Try Dim sDirectorioTMP As String = FicheroODTRelleno & ".dir.tmp" If DirectorioTemporal <> "" Then sDirectorioTMP = DirectorioTemporal If IO.Directory.Exists(sDirectorioTMP) Then IO.Directory.Delete(sDirectorioTMP, True) tsl5.Utilidades.CopiaDirectorio(DirectorioPlantilla, sDirectorioTMP, True, True, , , , , False) Dim sContentxml As String = sDirectorioTMP & "\content.xml" Dim sStylesxml As String = sDirectorioTMP & "\styles.xml" Dim sContenidoContent As String = ReemplazaXMLODT(My.Computer.FileSystem.ReadAllText(sContentxml), Valores) Dim sContenidoStyles As String = ReemplazaXMLODT(My.Computer.FileSystem.ReadAllText(sStylesxml), Valores) My.Computer.FileSystem.WriteAllText(sContentxml, sContenidoContent, False) My.Computer.FileSystem.WriteAllText(sStylesxml, sContenidoStyles, False) Zip.ComprimirDirectorio(sDirectorioTMP, FicheroODTRelleno) Catch ex As Exception Throw New Exception("Error en RellenaODT " & ex.Message, ex) End Try End Sub Public Shared Function ReemplazaXMLODT(ByVal Texto As String, ByVal Valores As DataRow) As String Try Dim sResultado As String = Texto For i As Integer = 0 To Valores.Table.Columns.Count - 1 Valores(i) = Valores(i).ToString.Replace("&", "&") Valores(i) = Valores(i).ToString.Replace(Chr(34), """) Valores(i) = Valores(i).ToString.Replace("'", "'") Valores(i) = Valores(i).ToString.Replace("<", "<") Valores(i) = Valores(i).ToString.Replace(">", ">") Valores(i) = Valores(i).ToString.Replace("<text:line-break/>", "") sResultado = sResultado.Replace("$" & Valores.Table.Columns(i).ColumnName & "$", Valores(i).ToString) Next Return sResultado Catch ex As Exception Throw New Exception("Error en RellenaODT " & ex.Message, ex) End Try End Function 'Public Shared Function ValorXML(ByVal Valor As Object, ByVal tipo As Type) As String ' If tipo Is GetType(String) Then ' Valor = Valor.ToString ' Valor = Valor.Replace("&", "&") ' Valor = Valor.Replace(Chr(34), """) ' Valor = Valor.ToString.Replace("'", "'") ' Valor = Valor.ToString.Replace("<", "<") ' Valor = Valor.ToString.Replace(">", ">") ' Valor = Valor.ToString.Replace("<text:line-break/>", "") ' Return Valor ' ElseIf tipo Is GetType(Date) Then ' Dim dFecha As Date ' Dim resultado As String ' If Valor Is DBNull.Value Then ' resultado = "" ' Else ' dFecha = Valor ' resultado = dFecha.ToShortDateString ' End If ' Return resultado ' ElseIf tipo Is GetType(Integer) Or tipo Is GetType(Int16) Or tipo Is GetType(Int32) Or tipo Is GetType(Short) Or tipo Is GetType(Long) Then ' Valor = String.Format("{0:n0}", Valor) ' Else ' Valor = String.Format("{0:n2}", Valor) ' End If ' Return Valor 'End Function Public Shared Function ValorXML(ByVal Valor As Object, ByVal tipo As Type, Optional SiNoComoX As Boolean = False) As String If tipo Is GetType(String) Or tipo Is GetType(Byte()) Then If tipo Is GetType(Byte()) Then If Valor.length < 5 Then Valor = "" Else Valor = System.Text.Encoding.Unicode.GetString(Valor) End If Else Valor = Valor.ToString End If Dim sRetorno As String = Chr(13) & Chr(10) If Valor.ToString.Contains(sRetorno) Then Valor = Valor.ToString.Replace(sRetorno, "") End If Valor = Valor.Replace("&", "&") Valor = Valor.Replace(Chr(34), """) Valor = Valor.ToString.Replace("'", "'") Valor = Valor.ToString.Replace("<", "<") Valor = Valor.ToString.Replace(">", ">") Valor = Valor.ToString.Replace("<text:line-break/>", "") Return Valor ElseIf tipo Is GetType(Date) Then Dim resultado As String If Valor Is DBNull.Value Then resultado = "" Else Dim dFecha As Date = Valor resultado = dFecha.ToShortDateString End If Return resultado ElseIf tipo Is GetType(UInt64) Then 'MYSQL BIT If Valor Is Nothing Or Valor Is DBNull.Value Then If SiNoComoX Then Return "" Else Return "No" End If Else If SiNoComoX Then If Valor = 1 Then Return "X" Else Return "" End If Else If Valor = 1 Then Return "Si" Else Return "No" End If End If End If ElseIf tipo Is GetType(Boolean) Then If SiNoComoX Then If Valor Then Return "X" Else Return "" End If Else If Valor Then Return "Si" Else Return "No" End If End If ElseIf tipo Is GetType(Integer) Or tipo Is GetType(Int16) Or tipo Is GetType(Int32) Or tipo Is GetType(Short) Or tipo Is GetType(Long) Then Valor = String.Format("{0:n0}", Valor) Else Valor = String.Format("{0:n2}", Valor) End If Return Valor End Function Public Shared Sub RellenaODT(ByVal drCabecera As DataRow, ByVal FicheroODT As String, Optional SiNoComoX As Boolean = False) Try Dim sContentTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sContentTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Zip.ExtraerArchivo(FicheroODT, "content.xml", sContentTmp) Zip.ExtraerArchivo(FicheroODT, "styles.xml", sStylesTmp) Dim ds As New DataSet Dim dt As New DataTable dt = drCabecera.Table.Clone ds.Tables.Add(dt) ds.EnforceConstraints = False dt.ImportRow(drCabecera) dt.TableName = "cabecera" RellenaXML(ds, sContentTmp, sContentTmp2, SiNoComoX) RellenaXML(ds, sStylesTmp, sStylesTmp2, SiNoComoX) Zip.AñadirArchivo(FicheroODT, sContentTmp2, "content.xml") Zip.AñadirArchivo(FicheroODT, sStylesTmp2, "styles.xml") Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Sub Public Shared Sub RellenaODT(ByVal ds As DataSet, ByVal FicheroODT As String, Optional SiNoComoX As Boolean = False) Dim sContentTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sContentTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Zip.ExtraerArchivo(FicheroODT, "content.xml", sContentTmp) Zip.ExtraerArchivo(FicheroODT, "styles.xml", sStylesTmp) RellenaXML(ds, sContentTmp, sContentTmp2, SiNoComoX) RellenaXML(ds, sStylesTmp, sStylesTmp2, SiNoComoX) Zip.AñadirArchivo(FicheroODT, sContentTmp2, "content.xml") Zip.AñadirArchivo(FicheroODT, sStylesTmp2, "styles.xml") End Sub 'Public Shared Sub RellenaODTEtiquetas(ByVal ds As DataSet, CampoIndice As String, ByVal FicheroODT As String) ' 'PKICOAATSE.UtilsBArray.Array2Fichero(PlantillaODT, "", FicheroDestinoODT) ' Dim sContentTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") ' Dim sContentTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") ' Dim sStylesTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") ' Dim sStylesTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") ' ' Dim odttmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("odt") ' ' IO.File.Copy(FicheroODT, odttmp) ' tszip.zip.ExtraeDeZip(FicheroODT, "content.xml", sContentTmp) ' tszip.zip.ExtraeDeZip(FicheroODT, "styles.xml", sStylesTmp) ' RellenaXMLEtiquetas(ds, sContentTmp, sContentTmp2, CampoIndice) ' 'IO.File.Copy(sStylesTmp, sStylesTmp2, True) ' RellenaXML(ds, sStylesTmp, sStylesTmp2) ' tszip.zip.AñadeAZip(FicheroODT, sContentTmp2, "content.xml") ' tszip.zip.AñadeAZip(FicheroODT, sStylesTmp2, "styles.xml") 'End Sub Public Shared Sub RellenaODT(ByVal ds As DataSet, CampoIndice As String, ByVal FicheroODT As String, Optional TipoInforme As Boolean = False, Optional SiNoComoX As Boolean = False) 'PKICOAATSE.UtilsBArray.Array2Fichero(PlantillaODT, "", FicheroDestinoODT) Dim sContentTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sContentTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sStylesTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sMetaTmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") Dim sMetaTmp2 As String = tsl5.Utilidades.ObtieneFicheroAleatorio("xml") ' Dim odttmp As String = tsl5.Utilidades.ObtieneFicheroAleatorio("odt") ' IO.File.Copy(FicheroODT, odttmp) Zip.ExtraerArchivo(FicheroODT, "content.xml", sContentTmp) Zip.ExtraerArchivo(FicheroODT, "styles.xml", sStylesTmp) Zip.ExtraerArchivo(FicheroODT, "meta.xml", sMetaTmp) RellenaXML(ds, sContentTmp, sContentTmp2, CampoIndice, TipoInforme, SiNoComoX) 'IO.File.Copy(sStylesTmp, sStylesTmp2, True) RellenaXML(ds, sStylesTmp, sStylesTmp2, SiNoComoX) CorrigeMeta(sMetaTmp, sMetaTmp2, ds.Tables("cabecera").Rows.Count) Zip.AñadirArchivo(FicheroODT, sMetaTmp2, "content.xml") Zip.AñadirArchivo(FicheroODT, sContentTmp2, "content.xml") Zip.AñadirArchivo(FicheroODT, sStylesTmp2, "styles.xml") End Sub Public Shared Sub RellenaXML(ByVal ds As DataSet, ByVal FicheroOrigenXML As String, ByVal FicheroDestinoXML As String, Optional SiNoComoX As Boolean = False) Try Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroOrigenXML) Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestinoXML) Dim sResultado As String = "" Dim sLinea As String = clsReader.ReadLine() Dim sBloque, sBloquePlantilla As String Dim sTabla As String Dim iInicioNT As Integer Dim iInicioNC As Integer Dim iLongitudNT As Integer Dim iLongitudNC As Integer Dim sCampo As String Dim dr As DataRow While Not sLinea Is Nothing sResultado &= sLinea & vbCrLf sLinea = clsReader.ReadLine() If Not sLinea Is Nothing Then If sLinea.Contains("") If sBloquePlantilla.Contains("#F#") Then iInicioNT = sBloquePlantilla.IndexOf("#F#") + 3 iLongitudNT = sBloquePlantilla.IndexOf("#", iInicioNT) - iInicioNT sTabla = sBloquePlantilla.Substring(iInicioNT, iLongitudNT) For Each dr In ds.Tables(sTabla).Rows sBloque = sBloquePlantilla While sBloque.IndexOf("#F#") > 0 iInicioNC = sBloque.IndexOf("#F#") + 4 + sTabla.Length iLongitudNC = sBloque.IndexOf("#", iInicioNC + 1) - iInicioNC sCampo = sBloque.Substring(iInicioNC, iLongitudNC) sBloque = sBloque.Replace("#F#" & sTabla & "#" & sCampo & "#", ValorXML(dr(sCampo), ds.Tables(sTabla).Columns(sCampo).DataType, SiNoComoX)) End While While sBloque.Contains("#C#") iInicioNC = sBloque.IndexOf("#C#") + 3 iLongitudNC = sBloque.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sBloque.Substring(iInicioNC, iLongitudNC) sBloque = sBloque.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(0)(sCampo).ToString, ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sBloque) Next Else While sBloquePlantilla.Contains("#C#") iInicioNC = sBloquePlantilla.IndexOf("#C#") + 3 iLongitudNC = sBloquePlantilla.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sBloquePlantilla.Substring(iInicioNC, iLongitudNC) sBloquePlantilla = sBloquePlantilla.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(0)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sBloquePlantilla) End If Else While sLinea.Contains("#C#") iInicioNC = sLinea.IndexOf("#C#") + 3 iLongitudNC = sLinea.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sLinea.Substring(iInicioNC, iLongitudNC) sLinea = sLinea.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(0)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sLinea) End If End If End While clsReader.Close() clsWriter.Close() Catch EX As Exception Throw New Exception(EX.Message, EX) End Try End Sub 'Public Shared Sub RellenaXML(ByVal ds As DataSet, ByVal FicheroOrigenXML As String, ByVal FicheroDestinoXML As String, CampoIndice As String, Optional TipoInforme As Boolean = False) ' Try ' Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroOrigenXML) ' Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestinoXML) ' Dim sResultado As String = "" ' Dim drcabecera As DataRow ' Dim sValorIndice As String ' Dim sBloqueCuerpo() As String ' Dim sLinea As String = clsReader.ReadLine() ' Dim bCuerpo As Boolean ' Dim i As Integer ' While Not sLinea.Contains("") ' If Not bCuerpo Then ' If Not sLinea.Contains("") Or TipoInforme Then ' sResultado &= sLinea & vbCrLf ' Else ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' End If ' If sLinea.Contains("") Then bCuerpo = True ' Else ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i) = sLinea & vbCrLf ' i += 1 ' End If ' sLinea = clsReader.ReadLine() ' End While ' If Not TipoInforme Then ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i - 1) = "" ' sBloqueCuerpo(i) = "" ' Else ' i -= 1 ' End If ' ' sResultado &= "" & vbCrLf ' clsWriter.Write(sResultado) ' Dim Nc As Integer ' For Nc = 0 To ds.Tables("cabecera").Rows.Count - 1 ' 'For Each drcabecera In ds.Tables("cabecera").Rows ' drcabecera = ds.Tables("cabecera").Rows(Nc) ' sValorIndice = drcabecera(CampoIndice).ToString ' If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" ' Dim sBloque, sBloquePlantilla As String ' 'Dim drCabecera As DataRow = ds.tables("Cabecera").Rows(0) ' Dim sTabla As String ' Dim iInicioNT As Integer ' Dim iInicioNC As Integer ' Dim iLongitudNT As Integer ' Dim iLongitudNC As Integer ' Dim sCampo As String ' Dim dr As DataRow ' sLinea = sBloqueCuerpo(0) ' clsWriter.Write(sLinea) ' Dim j As Integer = 0 ' While j < i ' j += 1 ' sLinea = sBloqueCuerpo(j) ' If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then ' If Not sLinea Is Nothing Then ' If sLinea.Contains("") ' If sBloquePlantilla.Contains("#F#") Then ' iInicioNT = sBloquePlantilla.IndexOf("#F#") + 3 ' iLongitudNT = sBloquePlantilla.IndexOf("#", iInicioNT) - iInicioNT ' sTabla = sBloquePlantilla.Substring(iInicioNT, iLongitudNT) ' For Each dr In ds.Tables(sTabla).Select(CampoIndice & "=" & sValorIndice) ' sBloque = sBloquePlantilla ' While sBloque.IndexOf("#F#") > 0 ' iInicioNC = sBloque.IndexOf("#F#") + 4 + sTabla.Length ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 1) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#F#" & sTabla & "#" & sCampo & "#", ValorXML(dr(sCampo), ds.Tables(sTabla).Columns(sCampo).DataType)) ' End While ' While sBloque.Contains("#C#") ' iInicioNC = sBloque.IndexOf("#C#") + 3 ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo).ToString, ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sBloque) ' Next ' Else ' While sBloquePlantilla.Contains("#C#") ' iInicioNC = sBloquePlantilla.IndexOf("#C#") + 3 ' iLongitudNC = sBloquePlantilla.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sBloquePlantilla.Substring(iInicioNC, iLongitudNC) ' sBloquePlantilla = sBloquePlantilla.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sBloquePlantilla) ' End If ' Else ' While sLinea.Contains("#C#") ' iInicioNC = sLinea.IndexOf("#C#") + 3 ' iLongitudNC = sLinea.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sLinea.Substring(iInicioNC, iLongitudNC) ' sLinea = sLinea.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sLinea) ' End If ' End If ' End If ' End While ' Next ' clsReader.Close() ' clsWriter.Write("" & vbCrLf) ' clsWriter.Write("") ' clsWriter.Close() ' Catch EX As Exception ' Throw New Exception(EX.Message, EX) ' End Try 'End Sub Public Shared Sub RellenaXML(ByVal ds As DataSet, ByVal FicheroOrigenXML As String, ByVal FicheroDestinoXML As String, CampoIndice As String, Optional TipoInforme As Boolean = False, Optional SiNoComoX As Boolean = False) Try Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroOrigenXML) Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestinoXML) Dim sResultado As String = "" Dim drcabecera As DataRow Dim sValorIndice As String Dim sBloqueCuerpo() As String = Nothing Dim sLinea As String = clsReader.ReadLine() Dim bCuerpo As Boolean Dim i As Integer Dim bEtiquetas As Boolean While Not sLinea.Contains("") If sLinea.Contains("#E#") Then bEtiquetas = True If Not bCuerpo Then If Not sLinea.Contains("") Or TipoInforme Then sResultado &= sLinea & vbCrLf Else If Not sResultado.Contains("fo:break-before=""page""") Then sResultado &= "" & vbCrLf sResultado &= "" & vbCrLf sResultado &= "" & vbCrLf sResultado &= "" & vbCrLf End If sResultado &= "" & vbCrLf End If If sLinea.Contains("") Then bCuerpo = True Else ReDim Preserve sBloqueCuerpo(i) sBloqueCuerpo(i) = sLinea & vbCrLf i += 1 End If sLinea = clsReader.ReadLine() End While If bEtiquetas Then 'If Not TipoInforme Then ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i - 1) = "" ' sBloqueCuerpo(i) = "" 'Else i -= 1 'End If clsWriter.Write(sResultado) Dim Nc As Integer Dim iPaginaActual As Integer Dim iTotalEtiquetas As Integer 'Dim iTotalEtiquetasTmp As Integer Do While (iPaginaActual * iTotalEtiquetas) - 1 <= ds.Tables("cabecera").Rows.Count - 1 iPaginaActual += 1 drcabecera = ds.Tables("cabecera").Rows(Nc) sValorIndice = drcabecera(CampoIndice).ToString If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" Dim iInicioNumeroEtiqueta As Integer Dim iLongitudNumeroEtiqueta As Integer Dim iInicioNombreCampo As Integer Dim iLongitudNombreCampo As Integer Dim iNumeroEtiqueta As Integer Dim sNumeroEtiqueta As String Dim sCampo As String sLinea = sBloqueCuerpo(0) clsWriter.Write(sLinea) Dim j As Integer = 0 While j < i j += 1 sLinea = sBloqueCuerpo(j) If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then If Not sLinea Is Nothing Then While sLinea.Contains("#E#") iInicioNumeroEtiqueta = sLinea.IndexOf("#E#") + 3 iLongitudNumeroEtiqueta = sLinea.IndexOf("#", iInicioNumeroEtiqueta) - iInicioNumeroEtiqueta sNumeroEtiqueta = sLinea.Substring(iInicioNumeroEtiqueta, iLongitudNumeroEtiqueta) iInicioNombreCampo = iInicioNumeroEtiqueta + iLongitudNumeroEtiqueta + 1 iLongitudNombreCampo = sLinea.IndexOf("#", iInicioNombreCampo + 1) - iInicioNombreCampo sCampo = sLinea.Substring(iInicioNombreCampo, iLongitudNombreCampo) iNumeroEtiqueta = Integer.Parse(sNumeroEtiqueta) iTotalEtiquetas = Math.Max(iTotalEtiquetas, iNumeroEtiqueta) Nc = ((iPaginaActual - 1) * iTotalEtiquetas) + iNumeroEtiqueta If Nc <= ds.Tables("cabecera").Rows.Count Then sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc - 1)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) Nc += 1 Else sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", "") End If End While clsWriter.Write(sLinea) End If End If End While Loop Else If Not TipoInforme Then ReDim Preserve sBloqueCuerpo(i) sBloqueCuerpo(i - 1) = "" sBloqueCuerpo(i) = "" Else i -= 1 End If ' sResultado &= "" & vbCrLf clsWriter.Write(sResultado) Dim Nc As Integer For Nc = 0 To ds.Tables("cabecera").Rows.Count - 1 'For Each drcabecera In ds.Tables("cabecera").Rows drcabecera = ds.Tables("cabecera").Rows(Nc) sValorIndice = drcabecera(CampoIndice).ToString If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" Dim sBloque, sBloquePlantilla As String 'Dim drCabecera As DataRow = ds.tables("Cabecera").Rows(0) Dim sTabla As String Dim iInicioNT As Integer Dim iInicioNC As Integer Dim iLongitudNT As Integer Dim iLongitudNC As Integer Dim sCampo As String Dim dr As DataRow sLinea = sBloqueCuerpo(0) clsWriter.Write(sLinea) Dim j As Integer = 0 ' Dim bIncluir As Boolean While j < i j += 1 sLinea = sBloqueCuerpo(j) 'If sLinea.Trim.StartsWith("") Then ' If Nc = ds.Tables("cabecera").Rows.Count - 1 Then ' bIncluir = True ' Else ' bIncluir = False ' End If 'ElseIf sLinea.Trim.StartsWith("")) And bIncluir Then If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then If Not sLinea Is Nothing Then If sLinea.Contains("") If sBloquePlantilla.Contains("#F#") Then iInicioNT = sBloquePlantilla.IndexOf("#F#") + 3 iLongitudNT = sBloquePlantilla.IndexOf("#", iInicioNT) - iInicioNT sTabla = sBloquePlantilla.Substring(iInicioNT, iLongitudNT) For Each dr In ds.Tables(sTabla).Select(CampoIndice & "=" & sValorIndice) sBloque = sBloquePlantilla While sBloque.IndexOf("#F#") > 0 iInicioNC = sBloque.IndexOf("#F#") + 4 + sTabla.Length iLongitudNC = sBloque.IndexOf("#", iInicioNC + 1) - iInicioNC sCampo = sBloque.Substring(iInicioNC, iLongitudNC) sBloque = sBloque.Replace("#F#" & sTabla & "#" & sCampo & "#", ValorXML(dr(sCampo), ds.Tables(sTabla).Columns(sCampo).DataType, SiNoComoX)) End While While sBloque.Contains("#C#") iInicioNC = sBloque.IndexOf("#C#") + 3 iLongitudNC = sBloque.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sBloque.Substring(iInicioNC, iLongitudNC) sBloque = sBloque.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo).ToString, ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sBloque) Next Else While sBloquePlantilla.Contains("#C#") iInicioNC = sBloquePlantilla.IndexOf("#C#") + 3 iLongitudNC = sBloquePlantilla.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sBloquePlantilla.Substring(iInicioNC, iLongitudNC) sBloquePlantilla = sBloquePlantilla.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sBloquePlantilla) End If Else While sLinea.Contains("#C#") iInicioNC = sLinea.IndexOf("#C#") + 3 iLongitudNC = sLinea.IndexOf("#", iInicioNC + 3) - iInicioNC sCampo = sLinea.Substring(iInicioNC, iLongitudNC) sLinea = sLinea.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType, SiNoComoX)) End While clsWriter.Write(sLinea) End If End If End If End While Next End If clsReader.Close() clsWriter.Write("" & vbCrLf) clsWriter.Write("") clsWriter.Close() Catch EX As Exception Throw New Exception(EX.Message, EX) End Try End Sub 'Public Shared Sub RellenaXMLEtiquetas(ByVal ds As DataSet, ByVal FicheroOrigenXML As String, ByVal FicheroDestinoXML As String, CampoIndice As String) ' Try ' Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroOrigenXML) ' Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestinoXML) ' Dim sResultado As String = "" ' Dim drcabecera As DataRow ' Dim sValorIndice As String ' Dim sBloqueCuerpo() As String ' Dim sLinea As String = clsReader.ReadLine() ' Dim bCuerpo As Boolean ' Dim i As Integer ' While Not sLinea.Contains("") ' If Not bCuerpo Then ' If Not sLinea.Contains("") Then ' sResultado &= sLinea & vbCrLf ' Else ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' End If ' If sLinea.Contains("") Then bCuerpo = True ' Else ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i) = sLinea & vbCrLf ' i += 1 ' End If ' sLinea = clsReader.ReadLine() ' End While ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i - 1) = "" ' sBloqueCuerpo(i) = "" ' clsWriter.Write(sResultado) ' Dim Nc As Integer ' Do Until Nc <= ds.Tables("cabecera").Rows.Count - 1 ' drcabecera = ds.Tables("cabecera").Rows(Nc) ' sValorIndice = drcabecera(CampoIndice).ToString ' If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" ' Dim iInicioNumeroEtiqueta As Integer ' Dim iLongitudNumeroEtiqueta As Integer ' Dim iInicioNombreCampo As Integer ' Dim iLongitudNombreCampo As Integer ' Dim iNumeroEtiqueta As Integer ' Dim sNumeroEtiqueta As String ' Dim sCampo As String ' sLinea = sBloqueCuerpo(0) ' clsWriter.Write(sLinea) ' Dim j As Integer = 0 ' While j < i ' j += 1 ' sLinea = sBloqueCuerpo(j) ' If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then ' If Not sLinea Is Nothing Then ' While sLinea.Contains("#E#") ' iInicioNumeroEtiqueta = sLinea.IndexOf("#E#") + 3 ' iLongitudNumeroEtiqueta = sLinea.IndexOf("#", iInicioNumeroEtiqueta + 3) - iInicioNumeroEtiqueta ' sNumeroEtiqueta = sLinea.Substring(iInicioNumeroEtiqueta, iLongitudNumeroEtiqueta) ' iInicioNombreCampo = iInicioNumeroEtiqueta + iLongitudNumeroEtiqueta + 1 ' iLongitudNombreCampo = sLinea.IndexOf("#", iInicioNombreCampo + 1) - iInicioNombreCampo ' sCampo = sLinea.Substring(iInicioNombreCampo, iLongitudNombreCampo) ' iNumeroEtiqueta = Integer.Parse(sNumeroEtiqueta) ' If Nc <= ds.Tables("cabecera").Rows.Count - 1 Then ' sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc + iNumeroEtiqueta - 1)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' Nc += 1 ' Else ' sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", "") ' End If ' End While ' clsWriter.Write(sLinea) ' End If ' End If ' End While ' Loop ' clsReader.Close() ' clsWriter.Write("" & vbCrLf) ' clsWriter.Write("") ' clsWriter.Close() ' Catch EX As Exception ' Throw New Exception(EX.Message, EX) ' End Try 'End Sub Public Shared Sub ObtieneFicherosRecursivo(ByVal Ruta As String, ByRef Ficheros() As String) Dim sFicheros() As String = IO.Directory.GetFiles(Ruta) Dim iNumeroFicheros As Integer If Not IsNothing(Ficheros) Then iNumeroFicheros = Ficheros.Length ReDim Preserve Ficheros(sFicheros.Length - 1 + iNumeroFicheros) sFicheros.CopyTo(Ficheros, iNumeroFicheros) Dim sDirectorio, sDirectorios() As String sDirectorios = IO.Directory.GetDirectories(Ruta) For Each sDirectorio In sDirectorios ObtieneFicherosRecursivo(sDirectorio, Ficheros) Next End Sub Public Shared Sub ODTAPDF(ByVal FicheroODT As String, ByVal FicheroPDF As String, Optional FicheroRecoveryxcu As String = "") ' ''Dim oSM, oDesk, oDoc As Object ' ''Dim OpenParam(0) As Object ' ''Dim SaveParam(0) As Object ' ''Dim iNumintentos As Integer ' ''Dim sMensajes As String = "" ' ''If FicheroRecoveryxcu = "" Then ' '' FicheroRecoveryxcu = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\OpenOffice.org\3\user\registry\data\org\openoffice\Office\Recovery.xcu" ' ''End If ' ''Do ' '' Try ' '' If IO.File.Exists(FicheroRecoveryxcu) Then ' '' Try ' '' IO.File.Delete(FicheroRecoveryxcu) ' '' Catch ex As Exception ' '' End Try ' '' End If ' '' oSM = CreateObject("com.sun.star.ServiceManager") ' '' oDesk = oSM.createInstance("com.sun.star.frame.Desktop") ' '' Exit Do ' '' Catch ex As Exception ' '' If iNumintentos > 5 Then Throw New Exception(sMensajes) ' '' iNumintentos += 1 ' '' sMensajes &= ex.Message & vbCrLf ' '' Try ' '' Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName("soffice.bin") ' '' For Each p As Process In pProcess ' '' p.Kill() ' '' Next ' '' ''' Windows.Forms.Application.DoEvents() ' '' System.threading.thread.Sleep(1000) ' '' Catch ex2 As Exception ' '' sMensajes &= ex2.Message ' '' End Try ' '' Try ' '' Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName("soffice") ' '' For Each p As Process In pProcess ' '' p.Kill() ' '' Next ' '' ''' Windows.Forms.Application.DoEvents() ' '' System.threading.thread.Sleep(1000) ' '' Catch ex2 As Exception ' '' sMensajes &= ex2.Message ' '' End Try ' '' End Try ' ''Loop ' ''OpenParam(0) = MakePropertyValue("Hidden", True) ' Open the file hidden ' ''oDoc = oDesk.loadComponentFromURL("file:///" & FicheroODT.Replace("\", "/"), "_blank", 0, OpenParam) ' ''SaveParam(0) = MakePropertyValue("FilterName", "writer_pdf_Export") ' ''Call oDoc.storeToURL("file:///" & FicheroPDF.Replace("\", "/"), SaveParam) ' ''oDesk = Nothing ' ''oSM = Nothing ' ''oDoc.dispose() Dim oSM As Object = Nothing Dim oDesk As Object = Nothing Dim oDoc As Object = Nothing Try Dim OpenParam(0) As Object Dim SaveParam(0) As Object Dim sMensajes As String = "" If FicheroRecoveryxcu = "" Then FicheroRecoveryxcu = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\OpenOffice.org\3\user\registry\data\org\openoffice\Office\Recovery.xcu" End If If IO.File.Exists(FicheroRecoveryxcu) Then Try IO.File.Delete(FicheroRecoveryxcu) Catch ex As Exception End Try End If ' oSM = CreateObject("opendocument.WriterDocument.1") oSM = CreateObject("com.sun.star.ServiceManager") oDesk = oSM.createInstance("com.sun.star.frame.Desktop") OpenParam(0) = MakePropertyValue("Hidden", True) ' Open the file hidden oDoc = oDesk.loadComponentFromURL("file:///" & FicheroODT.Replace("\", "/"), "_blank", 0, OpenParam) SaveParam(0) = MakePropertyValue("FilterName", "writer_pdf_Export") Call oDoc.storeToURL("file:///" & FicheroPDF.Replace("\", "/"), SaveParam) Catch ex As Exception Throw New Exception(ex.Message, ex) Finally Try oDoc.dispose() Catch End Try Try oDesk.terminate() oSM = Nothing Catch ex As Exception End Try End Try End Sub Shared Function MakePropertyValue(ByVal cName As Object, ByVal uValue As Object) As Object Dim oServiceManager As Object = CreateObject("com.sun.star.ServiceManager") Dim oStruct As Object oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue") oStruct.Name = cName oStruct.Value = uValue MakePropertyValue = oStruct End Function 'Public Shared Sub RellenaXML(ByVal ds As DataSet, ByVal FicheroOrigenXML As String, ByVal FicheroDestinoXML As String, Optional TipoInforme As Boolean = False) ' Try ' Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroOrigenXML) ' Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroDestinoXML) ' Dim sResultado As String = "" ' Dim drcabecera As DataRow ' Dim sValorIndice As String ' Dim sBloqueCuerpo() As String = Nothing ' Dim sLinea As String = clsReader.ReadLine() ' Dim bCuerpo As Boolean ' Dim i As Integer ' Dim bEtiquetas As Boolean ' While Not sLinea.Contains("") ' If sLinea.Contains("#E#") Then bEtiquetas = True ' If Not bCuerpo Then ' If Not sLinea.Contains("") Or TipoInforme Then ' sResultado &= sLinea & vbCrLf ' Else ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' sResultado &= "" & vbCrLf ' End If ' If sLinea.Contains("") Then bCuerpo = True ' Else ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i) = sLinea & vbCrLf ' i += 1 ' End If ' sLinea = clsReader.ReadLine() ' End While ' If bEtiquetas Then ' 'If Not TipoInforme Then ' ' ReDim Preserve sBloqueCuerpo(i) ' ' sBloqueCuerpo(i - 1) = "" ' ' sBloqueCuerpo(i) = "" ' 'Else ' i -= 1 ' 'End If ' clsWriter.Write(sResultado) ' Dim Nc As Integer ' Dim iPaginaActual As Integer ' Dim iTotalEtiquetas As Integer ' 'Dim iTotalEtiquetasTmp As Integer ' Do While (iPaginaActual * iTotalEtiquetas) - 1 <= ds.Tables("cabecera").Rows.Count - 1 ' iPaginaActual += 1 ' drcabecera = ds.Tables("cabecera").Rows(Nc) ' sValorIndice = drcabecera(CampoIndice).ToString ' If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" ' Dim iInicioNumeroEtiqueta As Integer ' Dim iLongitudNumeroEtiqueta As Integer ' Dim iInicioNombreCampo As Integer ' Dim iLongitudNombreCampo As Integer ' Dim iNumeroEtiqueta As Integer ' Dim sNumeroEtiqueta As String ' Dim sCampo As String ' sLinea = sBloqueCuerpo(0) ' clsWriter.Write(sLinea) ' Dim j As Integer = 0 ' While j < i ' j += 1 ' sLinea = sBloqueCuerpo(j) ' If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then ' If Not sLinea Is Nothing Then ' While sLinea.Contains("#E#") ' iInicioNumeroEtiqueta = sLinea.IndexOf("#E#") + 3 ' iLongitudNumeroEtiqueta = sLinea.IndexOf("#", iInicioNumeroEtiqueta) - iInicioNumeroEtiqueta ' sNumeroEtiqueta = sLinea.Substring(iInicioNumeroEtiqueta, iLongitudNumeroEtiqueta) ' iInicioNombreCampo = iInicioNumeroEtiqueta + iLongitudNumeroEtiqueta + 1 ' iLongitudNombreCampo = sLinea.IndexOf("#", iInicioNombreCampo + 1) - iInicioNombreCampo ' sCampo = sLinea.Substring(iInicioNombreCampo, iLongitudNombreCampo) ' iNumeroEtiqueta = Integer.Parse(sNumeroEtiqueta) ' iTotalEtiquetas = Math.Max(iTotalEtiquetas, iNumeroEtiqueta) ' Nc = ((iPaginaActual - 1) * iTotalEtiquetas) + iNumeroEtiqueta ' If Nc <= ds.Tables("cabecera").Rows.Count - 1 Then ' sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' Nc += 1 ' Else ' sLinea = sLinea.Replace("#E#" & sNumeroEtiqueta & "#" & sCampo & "#", "") ' End If ' End While ' clsWriter.Write(sLinea) ' End If ' End If ' End While ' Loop ' Else ' If Not TipoInforme Then ' ReDim Preserve sBloqueCuerpo(i) ' sBloqueCuerpo(i - 1) = "" ' sBloqueCuerpo(i) = "" ' Else ' i -= 1 ' End If ' ' sResultado &= "" & vbCrLf ' clsWriter.Write(sResultado) ' Dim Nc As Integer ' For Nc = 0 To ds.Tables("cabecera").Rows.Count - 1 ' 'For Each drcabecera In ds.Tables("cabecera").Rows ' drcabecera = ds.Tables("cabecera").Rows(Nc) ' sValorIndice = drcabecera(CampoIndice).ToString ' If drcabecera(CampoIndice).GetType Is GetType(String) Then sValorIndice = "'" & sValorIndice & "'" ' Dim sBloque, sBloquePlantilla As String ' 'Dim drCabecera As DataRow = ds.tables("Cabecera").Rows(0) ' Dim sTabla As String ' Dim iInicioNT As Integer ' Dim iInicioNC As Integer ' Dim iLongitudNT As Integer ' Dim iLongitudNC As Integer ' Dim sCampo As String ' Dim dr As DataRow ' sLinea = sBloqueCuerpo(0) ' clsWriter.Write(sLinea) ' Dim j As Integer = 0 ' While j < i ' j += 1 ' sLinea = sBloqueCuerpo(j) ' If Not (Nc = ds.Tables("cabecera").Rows.Count - 1 And sLinea.Contains("")) Then ' If Not sLinea Is Nothing Then ' If sLinea.Contains("") ' If sBloquePlantilla.Contains("#F#") Then ' iInicioNT = sBloquePlantilla.IndexOf("#F#") + 3 ' iLongitudNT = sBloquePlantilla.IndexOf("#", iInicioNT) - iInicioNT ' sTabla = sBloquePlantilla.Substring(iInicioNT, iLongitudNT) ' If ds.Tables("Tablas").Select("Nombre='" & sTabla & "'")(0)("ContieneHijos") = True Then ' For Each dr In ds.Tables(sTabla).Select(CampoIndice & "=" & sValorIndice) ' sBloque = sBloquePlantilla ' While sBloque.IndexOf("#F#") > 0 ' iInicioNC = sBloque.IndexOf("#F#") + 4 + sTabla.Length ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 1) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#F#" & sTabla & "#" & sCampo & "#", ValorXML(dr(sCampo), ds.Tables(sTabla).Columns(sCampo).DataType)) ' End While ' While sBloque.Contains("#C#") ' iInicioNC = sBloque.IndexOf("#C#") + 3 ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo).ToString, ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sBloque) ' Next ' Else ' For Each dr In ds.Tables(sTabla).Select(CampoIndice & "=" & sValorIndice) ' sBloque = sBloquePlantilla ' While sBloque.IndexOf("#F#") > 0 ' iInicioNC = sBloque.IndexOf("#F#") + 4 + sTabla.Length ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 1) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#F#" & sTabla & "#" & sCampo & "#", ValorXML(dr(sCampo), ds.Tables(sTabla).Columns(sCampo).DataType)) ' End While ' While sBloque.Contains("#C#") ' iInicioNC = sBloque.IndexOf("#C#") + 3 ' iLongitudNC = sBloque.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sBloque.Substring(iInicioNC, iLongitudNC) ' sBloque = sBloque.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo).ToString, ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sBloque) ' Next ' End If ' Else ' While sBloquePlantilla.Contains("#C#") ' iInicioNC = sBloquePlantilla.IndexOf("#C#") + 3 ' iLongitudNC = sBloquePlantilla.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sBloquePlantilla.Substring(iInicioNC, iLongitudNC) ' sBloquePlantilla = sBloquePlantilla.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sBloquePlantilla) ' End If ' Else ' While sLinea.Contains("#C#") ' iInicioNC = sLinea.IndexOf("#C#") + 3 ' iLongitudNC = sLinea.IndexOf("#", iInicioNC + 3) - iInicioNC ' sCampo = sLinea.Substring(iInicioNC, iLongitudNC) ' sLinea = sLinea.Replace("#C#" & sCampo & "#", ValorXML(ds.Tables("Cabecera").Rows(Nc)(sCampo), ds.Tables("Cabecera").Columns(sCampo).DataType)) ' End While ' clsWriter.Write(sLinea) ' End If ' End If ' End If ' End While ' Next ' End If ' clsReader.Close() ' clsWriter.Write("" & vbCrLf) ' clsWriter.Write("") ' clsWriter.Close() ' Catch EX As Exception ' Throw New Exception(EX.Message, EX) ' End Try 'End Sub Private Shared Sub CorrigeMeta(FicheroMetaOriginal As String, FicheroMetaDestino As String, NumeroRegistros As Integer) Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(FicheroMetaOriginal) Dim clsWriter As System.IO.TextWriter = System.IO.File.CreateText(FicheroMetaDestino) Dim sResultado As String = "" Dim sLinea As String = clsReader.ReadLine() Do Until sLinea Is Nothing If sLinea.Contains("meta:page-count=") Then Dim iMetaPage As Integer = sLinea.Substring(sLinea.IndexOf("meta:page-count=")).Split(Chr(34))(1) Dim sMetaPageOrg As String = "meta:page-count=" & Chr(34) & iMetaPage.ToString & Chr(34) Dim sMetaPageCor As String = "meta:page-count=" & Chr(34) & (iMetaPage * NumeroRegistros).ToString & Chr(34) sLinea = sLinea.Replace(sMetaPageOrg, sMetaPageCor) End If If sLinea.Contains("meta:image-count=") Then Dim iMetaimage As Integer = sLinea.Substring(sLinea.IndexOf("meta:image-count=")).Split(Chr(34))(1) Dim sMetaimageOrg As String = "meta:image-count=" & Chr(34) & iMetaimage.ToString & Chr(34) Dim sMetaimageCor As String = "meta:image-count=" & Chr(34) & (iMetaimage * NumeroRegistros).ToString & Chr(34) sLinea = sLinea.Replace(sMetaimageOrg, sMetaimageCor) End If If sLinea.Contains("meta:paragraph-count=") Then Dim iMetaparagraph As Integer = sLinea.Substring(sLinea.IndexOf("meta:paragraph-count=")).Split(Chr(34))(1) Dim sMetaparagraphOrg As String = "meta:paragraph-count=" & Chr(34) & iMetaparagraph.ToString & Chr(34) Dim sMetaparagraphCor As String = "meta:paragraph-count=" & Chr(34) & (iMetaparagraph * NumeroRegistros).ToString & Chr(34) sLinea = sLinea.Replace(sMetaparagraphOrg, sMetaparagraphCor) End If If sLinea.Contains("meta:character-count=") Then Dim iMetacharacter As Integer = sLinea.Substring(sLinea.IndexOf("meta:character-count=")).Split(Chr(34))(1) Dim sMetacharacterOrg As String = "meta:character-count=" & Chr(34) & iMetacharacter.ToString & Chr(34) Dim sMetacharacterCor As String = "meta:character-count=" & Chr(34) & (iMetacharacter * NumeroRegistros * 30).ToString & Chr(34) sLinea = sLinea.Replace(sMetacharacterOrg, sMetacharacterCor) End If If sLinea.Contains("meta:word-count=") Then Dim iMetaword As Integer = sLinea.Substring(sLinea.IndexOf("meta:word-count=")).Split(Chr(34))(1) Dim sMetawordOrg As String = "meta:word-count=" & Chr(34) & iMetaword.ToString & Chr(34) Dim sMetawordCor As String = "meta:word-count=" & Chr(34) & (iMetaword * NumeroRegistros * 15).ToString & Chr(34) sLinea = sLinea.Replace(sMetawordOrg, sMetawordCor) End If If sLinea.Contains("meta:object-count=") Then Dim iMetaobject As Integer = sLinea.Substring(sLinea.IndexOf("meta:object-count=")).Split(Chr(34))(1) Dim sMetaobjectOrg As String = "meta:object-count=" & Chr(34) & iMetaobject.ToString & Chr(34) Dim sMetaobjectCor As String = "meta:object-count=" & Chr(34) & (iMetaobject * NumeroRegistros).ToString & Chr(34) sLinea = sLinea.Replace(sMetaobjectOrg, sMetaobjectCor) End If If sLinea.Contains("meta:table-count=") Then Dim iMetatable As Integer = sLinea.Substring(sLinea.IndexOf("meta:table-count=")).Split(Chr(34))(1) Dim sMetatableOrg As String = "meta:table-count=" & Chr(34) & iMetatable.ToString & Chr(34) Dim sMetatableCor As String = "meta:table-count=" & Chr(34) & (iMetatable * NumeroRegistros).ToString & Chr(34) sLinea = sLinea.Replace(sMetatableOrg, sMetatableCor) End If clsWriter.WriteLine(sLinea) sLinea = clsReader.ReadLine Loop clsReader.Close() clsWriter.Close() End Sub End Class