Imports System.Windows.Forms Imports System.Data Imports System.Data.SqlClient Imports MySql.Data.MySqlClient Imports System.Data.OleDb Imports System.IO 'Imports ComponentAce.Compression.ZipForge 'Imports ComponentAce.Compression.Archiver Imports System.Environment 'Imports UtilidadesTSL4net.clCharConv Public Class clFuncionesGenericas 'DANMUN Private Shared WithEvents Zip As C1.C1Zip.C1ZipFile Public Shared EsServicio As Boolean = True Private Shared pbProgreso As ProgressBar Private Shared WINDOWS() As Char = "ñѺªçÇáéíóúÁÉÍÓÚàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛäëïöüÄËÏÖÜ" Private Shared ROMAN8() As Char = "·¶úùµ´ÄÅÕÆÇàÜåçíÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ" Private Shared ROMAN8SA() As Char = "·¶úùµ´aeiouAEIOUÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ" Private Shared NumChar As Integer = WINDOWS.Length 'Public Shared Function prueba() As String ' Return "prueba desde cablin4" 'End Function Public Shared Function Ttag(ByVal sValortag As String, ByVal sToken As String) As String Ttag = "" Try ' Devuelve el token pedido sValortag = "|" & sValortag & "|" If InStr(1, "|" & sValortag & "|", "|" & sToken & ":", vbTextCompare) > 0 Then Ttag = Mid(sValortag, (InStr(1, sValortag, "|" & sToken & ":") + Len(sToken) + 2), InStr(1, Mid(sValortag, InStr(1, sValortag, "|" & sToken & ":") + Len(sToken) + 2), "|") - 1) End If Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) MsgBox(ex.Message, MsgBoxStyle.Exclamation, "ttag") End Try End Function Public Shared Function Ttag(ByVal sValortag As String, ByVal sToken As String, ByVal SeparadorVariableValor As String) As String Ttag = "" Try ' Devuelve el token pedido sValortag = "|" & sValortag & "|" If InStr(1, "|" & sValortag & "|", "|" & sToken & SeparadorVariableValor, vbTextCompare) > 0 Then Ttag = Mid(sValortag, (InStr(1, sValortag, "|" & sToken & SeparadorVariableValor) + Len(sToken) + 2), InStr(1, Mid(sValortag, InStr(1, sValortag, "|" & sToken & SeparadorVariableValor) + Len(sToken) + 2), "|") - 1) End If Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) MsgBox(ex.Message, MsgBoxStyle.Exclamation, "ttag") End Try End Function Public Shared Function Numero_Caracteres(ByVal Cadena_Origen As String, ByVal caracter As String) As Integer Dim iNC As Integer Try Dim i As Integer iNC = 0 For i = 1 To Len(Trim$(Cadena_Origen)) If Mid$(Trim$(Cadena_Origen), i, 1) = caracter Then iNC = iNC + 1 End If Next i Catch ex As Exception iNC = 0 MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Numero_Caracteres") If EsServicio Then Throw New Exception(ex.Message, ex) End Try Return iNC End Function Public Shared Function Lee_Registro(ByVal conexion As System.Data.Common.DbConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, Optional ByVal sCampoAIncrementar As String = "", Optional ByVal iIncremento As Integer = 0, Optional ByVal bGuardar As Boolean = False, Optional ByVal bSinMensajesError As Boolean = True, Optional ByVal Transaccion As System.Data.Common.DbTransaction = Nothing) As DataRow If conexion.GetType Is GetType(OleDbConnection) Then Dim co As OleDbConnection = conexion Dim ts As OleDbTransaction = Transaccion Return Lee_Registro(co, Clausula_FROM, Clausula_WHERE, sCampoAIncrementar, iIncremento, bGuardar, bSinMensajesError, ts) ElseIf conexion.GetType Is GetType(MySqlConnection) Then Dim co As MySqlConnection = conexion Dim ts As MySqlTransaction = Transaccion Return LeeRegistroMySQL(co, Clausula_FROM, Clausula_WHERE, sCampoAIncrementar, iIncremento, bGuardar, bSinMensajesError, ts) Else Throw New Exception("Tipo no soportado") End If End Function Public Shared Function Lee_Registro(ByVal Conexion As OleDbConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, Optional ByVal sCampoAIncrementar As String = "", Optional ByVal iIncremento As Integer = 0, Optional ByVal bGuardar As Boolean = False, Optional ByVal bSinMensajesError As Boolean = True, Optional ByVal Transaccion As OleDb.OleDbTransaction = Nothing) As DataRow ' ---------------------------------------------------------------------------------------------------- ' Descripción Función: Devuelve el primer registro de una conexion oledb ' Fecha. Creacion: ????? ' Creada por: manmog ' Ultima Modificacion: 14/09/2010 ' ' Modificaciones: ' =============== ' 14/09/2010 manmog En caso de error se devuelve más información de los parámetros. Lee_Registro = Nothing Try Dim adAdaptador As OleDbDataAdapter, dsDatos As New DataSet Dim sSQL As String If Trim(Clausula_WHERE) <> "" Then sSQL = "SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";" Else sSQL = "SELECT * FROM " & Clausula_FROM & ";" End If If Conexion.Provider = "SQLOLEDB" Then sSQL = sSQL.Replace(Chr(34), "'") adAdaptador = New OleDbDataAdapter(sSQL, Conexion) If Not Transaccion Is Nothing Then adAdaptador.SelectCommand.Transaction = Transaccion End If TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Lee_Registro = Nothing Else If sCampoAIncrementar <> "" Then If IsDBNull(dsDatos.Tables(0).Rows(0)(sCampoAIncrementar)) Then dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) = 0 dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) += iIncremento End If Lee_Registro = dsDatos.Tables(0).Rows(0) If bGuardar Then Dim coComando As New OleDbCommandBuilder(adAdaptador) 'adAdaptador.Update(dsDatos, "TABLA") TSUpdate(adAdaptador, dsDatos, "TABLA") End If End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & " WHERE: " & Clausula_WHERE & "(Transaccion=" & (Transaccion IsNot Nothing).ToString & " Connectionstring=" & Conexion.ConnectionString & ")", ex) 'Throw ex Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Function Public Shared Function Lee_Registro(ByVal Conexion As SqlConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, Optional ByVal sCampoAIncrementar As String = "", Optional ByVal iIncremento As Integer = 0, Optional ByVal bGuardar As Boolean = False, Optional ByVal bSinMensajesError As Boolean = True, Optional ByVal Transaccion As SqlTransaction = Nothing) As DataRow Lee_Registro = Nothing Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet If Trim(Clausula_WHERE) <> "" Then adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If If Not IsNothing(Transaccion) Then adAdaptador.SelectCommand.Transaction = Transaccion End If TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Lee_Registro = Nothing Else If sCampoAIncrementar <> "" Then If IsDBNull(dsDatos.Tables(0).Rows(0)(sCampoAIncrementar)) Then dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) = 0 dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) += iIncremento End If Lee_Registro = dsDatos.Tables(0).Rows(0) If bGuardar Then Dim coComando As New SqlCommandBuilder(adAdaptador) 'adAdaptador.Update(dsDatos, "TABLA") TSUpdate(adAdaptador, dsDatos, "TABLA") End If End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & "WHERE: " & Clausula_WHERE, ex) 'Throw ex Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Function Public Shared Function LeeRegistroMySQL(ByVal Conexion As MySqlConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, Optional ByVal sCampoAIncrementar As String = "", Optional ByVal iIncremento As Integer = 0, Optional ByVal bGuardar As Boolean = False, Optional ByVal bSinMensajesError As Boolean = True, Optional ByVal Transaccion As MySqlTransaction = Nothing) As DataRow LeeRegistroMySQL = Nothing Try Dim adAdaptador As MySqlDataAdapter, dsDatos As New DataSet dsDatos.EnforceConstraints = False If Trim(Clausula_WHERE) <> "" Then adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If If Not IsNothing(Transaccion) Then adAdaptador.SelectCommand.Transaction = Transaccion End If TSFillMySQL(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then LeeRegistroMySQL = Nothing Else If sCampoAIncrementar <> "" Then If IsDBNull(dsDatos.Tables(0).Rows(0)(sCampoAIncrementar)) Then dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) = 0 dsDatos.Tables(0).Rows(0)(sCampoAIncrementar) += iIncremento End If LeeRegistroMySQL = dsDatos.Tables(0).Rows(0) If bGuardar Then Dim coComando As New MySqlCommandBuilder(adAdaptador) 'adAdaptador.Update(dsDatos, "TABLA") TSUpdateMySQL(adAdaptador, dsDatos, "TABLA") End If End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & "WHERE: " & Clausula_WHERE, ex) 'Throw ex Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Function Public Shared Function Lee_Registros(ByVal Conexion As OleDbConnection, ByVal Clausula_FROM As String, Optional ByVal Clausula_WHERE As String = "", Optional ByVal Clausula_ORDER As String = "", Optional ByVal SinMensajesError As Boolean = True) As DataTable Lee_Registros = Nothing Try Dim adAdaptador As OleDbDataAdapter, dsDatos As New DataSet Dim sSQL As String If Trim(Clausula_WHERE) = "" Then If Trim(Clausula_ORDER) = "" Then sSQL = "SELECT * FROM " & Clausula_FROM & ";" Else sSQL = "SELECT * FROM " & Clausula_FROM & " ORDER BY " & Clausula_ORDER & ";" End If Else If Trim(Clausula_ORDER) = "" Then sSQL = "SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";" Else sSQL = "SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & " ORDER BY " & Clausula_ORDER & ";" End If End If If Conexion.Provider = "SQLOLEDB" Then sSQL = sSQL.Replace(Chr(34), "'") adAdaptador = New OleDbDataAdapter(sSQL, Conexion) TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, "TABLA") 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") Lee_Registros = dsDatos.Tables(0) Catch ex As Exception If SinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & "WHERE: " & Clausula_WHERE & " ORDER: " & Clausula_ORDER, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros") End If End Try End Function Public Shared Function Lee_Registros(ByVal Conexion As SqlConnection, ByVal Clausula_FROM As String, Optional ByVal Clausula_WHERE As String = "", Optional ByVal Clausula_ORDER As String = "", Optional ByVal SinMensajesError As Boolean = True) As DataTable Lee_Registros = Nothing Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet If Trim(Clausula_WHERE) = "" Then If Trim(Clausula_ORDER) = "" Then adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) Else adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & " ORDER BY " & Clausula_ORDER & ";", Conexion) End If Else If Trim(Clausula_ORDER) = "" Then adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & " ORDER BY " & Clausula_ORDER & ";", Conexion) End If End If TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, "TABLA") 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") Lee_Registros = dsDatos.Tables(0) Catch ex As Exception If SinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & "WHERE: " & Clausula_WHERE & " ORDER: " & Clausula_ORDER, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros") End If End Try End Function Public Shared Function LeeRegistrosMYSQL(ByVal Conexion As MySqlConnection, ByVal Clausula_FROM As String, Optional ByVal Clausula_WHERE As String = "", Optional ByVal Clausula_ORDER As String = "", Optional ByVal SinMensajesError As Boolean = True) As DataTable LeeRegistrosMYSQL = Nothing Try Dim adAdaptador As MySqlDataAdapter, dsDatos As New DataSet dsDatos.EnforceConstraints = False If Trim(Clausula_WHERE) = "" Then If Trim(Clausula_ORDER) = "" Then adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) Else adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & " ORDER BY " & Clausula_ORDER & ";", Conexion) End If Else If Trim(Clausula_ORDER) = "" Then adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & " ORDER BY " & Clausula_ORDER & ";", Conexion) End If End If TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, "TABLA") 'adAdaptador.Fill(dsDatos, "TABLA") TSFillMySQL(adAdaptador, dsDatos, "TABLA") LeeRegistrosMYSQL = dsDatos.Tables(0) Catch ex As Exception If SinMensajesError Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "FROM: " & Clausula_FROM & "WHERE: " & Clausula_WHERE & " ORDER: " & Clausula_ORDER, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros") End If End Try End Function Public Shared Function Lee_Registros_SQL(ByVal Conexion As OleDbConnection, ByVal Clausula_SQL As String, Optional ByVal Sin_Errores As Boolean = True) As DataTable Lee_Registros_SQL = Nothing Try Dim adAdaptador As OleDbDataAdapter, dsDatos As New DataSet If Conexion.Provider = "SQLOLEDB" Then Clausula_SQL = Clausula_SQL.Replace(Chr(34), "'") If Not Clausula_SQL.EndsWith(";") Then Clausula_SQL &= ";" adAdaptador = New OleDbDataAdapter(Clausula_SQL, Conexion) 'adAdaptador.FillSchema(dsDatos, SchemaType.Mapped, "TABLA") TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, "TABLA") 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") Lee_Registros_SQL = dsDatos.Tables(0) Catch ex As Exception If Sin_Errores Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros_SQL") End If End Try End Function Public Shared Function Lee_Registros_SQL(ByVal Conexion As SqlConnection, ByVal Clausula_SQL As String, Optional ByVal Sin_Errores As Boolean = True) As DataTable Lee_Registros_SQL = Nothing Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet If Not Clausula_SQL.EndsWith(";") Then Clausula_SQL &= ";" Clausula_SQL = Clausula_SQL.Replace(Chr(34), "'") adAdaptador = New SqlDataAdapter(Clausula_SQL, Conexion) 'adAdaptador.FillSchema(dsDatos, SchemaType.Mapped, "TABLA") TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, "TABLA") 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") Lee_Registros_SQL = dsDatos.Tables(0) Catch ex As Exception If Sin_Errores Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros_SQL") End If End Try End Function Public Shared Function LeeRegistrosSQLMySQL(ByVal Conexion As MySqlConnection, ByVal Clausula_SQL As String, Optional ByVal Sin_Errores As Boolean = True, Optional ByVal NombreDataset As String = "DATASET", Optional ByVal NombreTabla As String = "TABLA") As DataTable LeeRegistrosSQLMySQL = Nothing Try Dim adAdaptador As MySqlDataAdapter, dsDatos As New DataSet(NombreDataset) dsDatos.EnforceConstraints = False If Not Clausula_SQL.EndsWith(";") Then Clausula_SQL &= ";" Clausula_SQL = Clausula_SQL.Replace(Chr(34), "'") adAdaptador = New MySqlDataAdapter(Clausula_SQL, Conexion) 'adAdaptador.FillSchema(dsDatos, SchemaType.Mapped, "TABLA") TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, NombreTabla) 'adAdaptador.Fill(dsDatos, "TABLA") TSFillMySQL(adAdaptador, dsDatos, NombreTabla) LeeRegistrosSQLMySQL = dsDatos.Tables(0) Catch ex As Exception If Sin_Errores Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros_SQL") End If End Try End Function 'Public Shared Function Max(ByVal A, ByVal B) ' If A > B Then Return A Else Return B 'End Function 'Public Shared Function Min(ByVal A, ByVal B) ' If A > B Then Return B Else Return A 'End Function Public Shared Function RED(ByVal Valor As Double, ByVal Numero As Integer) As Double If Numero < 0 Then Return Math.Round(Valor, Math.Abs(Numero), MidpointRounding.AwayFromZero) Else Return Math.Round(Valor / 10 ^ Numero, MidpointRounding.AwayFromZero) * 10 ^ Numero End If End Function Public Shared Function SeleccionaRegistros(ByVal Tabla As DataTable, ByVal Filtro As String) As DataView Try Tabla.CaseSensitive = False Tabla.DefaultView.RowFilter = Filtro SeleccionaRegistros = Tabla.DefaultView Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "SeleccionaRegistros") SeleccionaRegistros = Nothing End If End Try End Function Public Shared Function rellena(ByRef I_D As String, ByRef Valor As String, ByRef NUMERO As Integer, ByRef Caracter_Relleno As String) As String rellena = "" Try If Len(Trim(Valor)) >= NUMERO Then rellena = Mid(Valor, 1, NUMERO) Else If I_D = "I" Then rellena = New String(Caracter_Relleno, NUMERO - Len(Trim(Valor))) & Trim(Valor) Else rellena = Trim(Valor) & New String(Caracter_Relleno, NUMERO - Len(Trim(Valor))) End If End If Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Rellena") End If End Try End Function Public Shared Function Lee_Registro_SQL(ByVal Conexion As OleDbConnection, ByVal Clausula_SQL As String, Optional ByVal SinErrores As Boolean = True) As DataRow Lee_Registro_SQL = Nothing Try Dim adAdaptador As OleDbDataAdapter, dsDatos As New DataSet If Conexion.Provider = "SQLOLEDB" Then Clausula_SQL = Clausula_SQL.Replace(Chr(34), "'") adAdaptador = New OleDbDataAdapter(Clausula_SQL, Conexion) TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Lee_Registro_SQL = Nothing Else Lee_Registro_SQL = dsDatos.Tables(0).Rows(0) End If Catch ex As Exception If SinErrores = False And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro_SQL") Else Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) 'Throw ex End If End Try End Function Public Shared Function Lee_Registro_SQL(ByVal Conexion As SqlConnection, ByVal Clausula_SQL As String, Optional ByVal SinErrores As Boolean = True) As DataRow Lee_Registro_SQL = Nothing Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet adAdaptador = New SqlDataAdapter(Clausula_SQL, Conexion) TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Lee_Registro_SQL = Nothing Else Lee_Registro_SQL = dsDatos.Tables(0).Rows(0) End If Catch ex As Exception If SinErrores = False And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro_SQL") Else Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) 'Throw ex End If End Try End Function Public Shared Function LeeRegistroSQLMySQL(ByVal Conexion As MySqlConnection, ByVal Clausula_SQL As String, Optional ByVal SinErrores As Boolean = True) As DataRow LeeRegistroSQLMySQL = Nothing Try Dim adAdaptador As MySqlDataAdapter, dsDatos As New DataSet adAdaptador = New MySqlDataAdapter(Clausula_SQL, Conexion) TSFillMySQL(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count > 0 Then LeeRegistroSQLMySQL = dsDatos.Tables(0).Rows(0) End If Catch ex As Exception If SinErrores = False And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro_SQL") Else Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) 'Throw ex End If End Try End Function 'Public Shared Function ENST(ByVal Base As Long, ByVal CADENA As String) As String ' Try ' Dim caracter As Integer, X As Integer, RESP As Long, I As Integer ' Randomize(Base) ' ENST = "" ' X = Base ' For I = 1 To Len(CADENA) ' X = (Rnd(-X) * 254) ' caracter = Asc(Mid$(CADENA, I, 1)) - 1 ' ENST = ENST & Chr((caracter Xor X) + 1) ' Next I ' Catch ex As Exception ' MsgBox(ex) ' End Try 'End Function 'Public Shared Function ENST(ByVal Base As Long, ByVal CADENA As String, ByVal Caracter_Inicio As Integer, ByVal Caracter_Fin As Integer) As String ' Try ' Dim caracter As Integer, X As Integer, RESP As Long, I As Integer, iNumCar As Integer ' iNumCar = Caracter_Fin - Caracter_Inicio ' Randomize(Base) ' ENST = "" ' X = Base ' For I = 1 To Len(CADENA) ' X = (Rnd(-X) * iNumCar) ' caracter = Asc(Mid$(CADENA, I, 1)) - 1 ' ENST = ENST & Chr((caracter Xor X) + Caracter_Inicio) ' Next I ' Catch ex As Exception ' MsgBox(ex) ' End Try 'End Function 'Public Shared Function ENSTG(ByVal Base As Long, ByVal CADENA As String, ByVal Caracter_Inicio As Integer, ByVal Caracter_Fin As Integer) As String ' Try ' Dim caracter As Integer, X As Integer, RESP As Long, I As Integer, iNumCar As Integer ' iNumCar = Caracter_Fin - Caracter_Inicio ' Randomize(Base) ' ENSTG = "" ' X = Base ' For I = 1 To Len(CADENA) ' X = (Rnd(-X) * iNumCar) ' caracter = Asc(Mid$(CADENA, I, 1)) - 1 ' ENSTG = ENSTG & Chr((caracter Xor X) + Caracter_Inicio) ' Next I ' Catch ex As Exception ' MsgBox(ex) ' End Try 'End Function Public Shared Sub TablaATxt(ByVal Tabla As DataTable, ByVal RutaFichero As String, Optional ByVal Roman8 As Boolean = False, Optional ByVal Version As String = "") Try Dim drTmp As DataRow, dcTmp As DataColumn, sCadena As String Dim iFichero As Integer = FreeFile() FileOpen(iFichero, RutaFichero, OpenMode.Output, OpenAccess.Write, OpenShare.LockReadWrite) If Version = "" Then sCadena = "TABLA:" & Tabla.TableName & "|CAMPOS:" Else sCadena = "VERSION:" & Version & "|TABLA:" & Tabla.TableName & "|CAMPOS:" End If Dim i As Integer For Each dcTmp In Tabla.Columns Select Case dcTmp.DataType.ToString.ToUpper Case "SYSTEM.STRING" If dcTmp.MaxLength < 256 Then sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";" & dcTmp.MaxLength.ToString & ")," i += dcTmp.MaxLength End If Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";25)," i += 25 Case "SYSTEM.DATETIME" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";19)," i += 19 Case "SYSTEM.BOOLEAN" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";1)," i += 1 Case "SYSTEM.BYTE[]" Case Else If EsServicio Then Throw New Exception("TIPO NO SOPORTADO " & dcTmp.ColumnName) Else MsgBox("TIPO NO SOPORTADO " & dcTmp.ColumnName) End If End Select Next PrintLine(iFichero, sCadena) For Each drTmp In Tabla.Rows sCadena = "" For Each dcTmp In Tabla.Columns Select Case dcTmp.DataType.ToString.ToUpper Case "SYSTEM.STRING" If dcTmp.MaxLength <= 0 Then Console.WriteLine(dcTmp.MaxLength) End If If dcTmp.MaxLength < 256 Then sCadena = sCadena & drTmp(dcTmp).ToString.Replace(Chr(13), "").Replace(Chr(10), "").PadRight(dcTmp.MaxLength) Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" sCadena = sCadena & drTmp(dcTmp).ToString.PadRight(25).Replace(",", ".") Case "SYSTEM.DATETIME" If IsDBNull(drTmp(dcTmp)) Then sCadena = sCadena & " " Else sCadena = sCadena & Format(drTmp(dcTmp), "dd/MM/yyyy HH:mm:ss") End If Case "SYSTEM.BOOLEAN" If drTmp(dcTmp) Then sCadena = sCadena & "V" Else sCadena = sCadena & "F" End If Case "SYSTEM.BYTE[]" Case Else If EsServicio Then Throw New Exception("TIPO NO SOPORTADO " & dcTmp.ColumnName) Else MsgBox("TIPO NO SOPORTADO " & dcTmp.ColumnName) End If End Select Next PrintLine(iFichero, sCadena) Next FileClose(iFichero) If Roman8 Then CharConverter("WINDOWS", "ROMAN8SA", RutaFichero) Catch ex As Exception Throw New Exception(ex.Message & " Fichero: " & RutaFichero, ex) ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") End Try End Sub Public Shared Sub DataSetATxt(ByVal ds As DataSet, ByVal RutaFichero As String, Optional ByVal Roman8 As Boolean = False, Optional ByVal Version As String = "") Try Dim drTmp As DataRow, dcTmp As DataColumn, sCadena As String Dim iFichero As Integer = FreeFile() FileOpen(iFichero, RutaFichero, OpenMode.Output, OpenAccess.Write, OpenShare.LockReadWrite) For Each Tabla In ds.Tables If Version = "" Then sCadena = "TABLA:" & Tabla.TableName & "|CAMPOS:" Else sCadena = "VERSION:" & Version & "|TABLA:" & Tabla.TableName & "|CAMPOS:" End If Dim i As Integer = 0 For Each dcTmp In Tabla.Columns Select Case dcTmp.DataType.ToString.ToUpper Case "SYSTEM.STRING" If dcTmp.MaxLength < 256 Then sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";" & dcTmp.MaxLength.ToString & ")," i += dcTmp.MaxLength End If Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";25)," i += 25 Case "SYSTEM.DATETIME" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";19)," i += 19 Case "SYSTEM.BOOLEAN" sCadena = sCadena & dcTmp.ColumnName & ":" & dcTmp.DataType.ToString.ToUpper & "(" & i.ToString & ";1)," i += 1 Case "SYSTEM.BYTE[]" Case Else If EsServicio Then Throw New Exception("TIPO NO SOPORTADO " & dcTmp.ColumnName) Else MsgBox("TIPO NO SOPORTADO " & dcTmp.ColumnName) End If End Select Next PrintLine(iFichero, sCadena) For Each drTmp In Tabla.Rows sCadena = "" For Each dcTmp In Tabla.Columns Select Case dcTmp.DataType.ToString.ToUpper Case "SYSTEM.STRING" If dcTmp.MaxLength < 256 Then sCadena = sCadena & drTmp(dcTmp).ToString.Replace(Chr(13), "").Replace(Chr(10), "").PadRight(dcTmp.MaxLength) Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" sCadena = sCadena & drTmp(dcTmp).ToString.PadRight(25).Replace(",", ".") Case "SYSTEM.DATETIME" If IsDBNull(drTmp(dcTmp)) Then sCadena = sCadena & " " Else sCadena = sCadena & Format(drTmp(dcTmp), "dd/MM/yyyy HH:mm:ss") End If Case "SYSTEM.BOOLEAN" If Not drTmp(dcTmp) Is DBNull.Value AndAlso drTmp(dcTmp) Then sCadena = sCadena & "V" Else sCadena = sCadena & "F" End If Case "SYSTEM.BYTE[]" Case Else If EsServicio Then Throw New Exception("TIPO NO SOPORTADO " & dcTmp.ColumnName) Else MsgBox("TIPO NO SOPORTADO " & dcTmp.ColumnName) End If End Select Next PrintLine(iFichero, sCadena) Next Next FileClose(iFichero) If Roman8 Then CharConverter("WINDOWS", "ROMAN8SA", RutaFichero) Catch ex As Exception Throw New Exception(ex.Message & " Fichero: " & RutaFichero, ex) ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") End Try End Sub Public Shared Sub CopiaDirectorio(ByVal DirectorioOrigen As String, ByVal DirectorioDestino As String, ByVal Recursivo As Boolean, ByVal SobreEscribir As Boolean, Optional ByRef EtiquetaProgreso As Label = Nothing, Optional ByRef BarraProgreso As ProgressBar = Nothing, Optional ByRef NumeroFicherosACopiar As Integer = 0, Optional ByRef OmitirBloqueados As Boolean = False) If Not BarraProgreso Is Nothing Then If BarraProgreso.Tag = "CANCELAR" Then Exit Sub End If Try If Not BarraProgreso Is Nothing And NumeroFicherosACopiar = 0 Then NumeroFicherosACopiar = ObtieneNumeroFicheros(DirectorioOrigen) BarraProgreso.Maximum = NumeroFicherosACopiar End If Dim sDir As String Dim dDirInfo As IO.DirectoryInfo Dim sDirInfo As IO.DirectoryInfo Dim sFile As String Dim sFileInfo As IO.FileInfo Dim dFileInfo As IO.FileInfo ' Add trailing separators to the supplied paths if they don't exist. If Not DirectorioOrigen.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then DirectorioOrigen &= System.IO.Path.DirectorySeparatorChar End If If Not DirectorioDestino.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then DirectorioDestino &= System.IO.Path.DirectorySeparatorChar End If 'If destination directory does not exist, create it. dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino) If dDirInfo.Exists = False Then dDirInfo.Create() dDirInfo = Nothing ' Recursive switch to continue drilling down into directory structure. If Recursivo Then ' Get a list of directories from the current parent. For Each sDir In System.IO.Directory.GetDirectories(DirectorioOrigen) sDirInfo = New System.IO.DirectoryInfo(sDir) dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino & sDirInfo.Name) ' Create the directory if it does not exist. If dDirInfo.Exists = False Then dDirInfo.Create() ' Since we are in recursive mode, copy the children also CopiaDirectorio(sDirInfo.FullName, dDirInfo.FullName, Recursivo, SobreEscribir, EtiquetaProgreso, BarraProgreso, NumeroFicherosACopiar, OmitirBloqueados) sDirInfo = Nothing dDirInfo = Nothing Next End If ' Get the files from the current parent. For Each sFile In System.IO.Directory.GetFiles(DirectorioOrigen) sFileInfo = New System.IO.FileInfo(sFile) dFileInfo = New System.IO.FileInfo(Replace(sFile, DirectorioOrigen, DirectorioDestino)) 'If File does not exist. Copy. If Not EtiquetaProgreso Is Nothing Then EtiquetaProgreso.Text = "Copiando " & sFileInfo.FullName & " ..." End If If dFileInfo.Exists = False Then Try sFileInfo.CopyTo(dFileInfo.FullName, SobreEscribir) Catch ex As Exception If Not OmitirBloqueados Then Throw New Exception(ex.Message, ex) End Try Else 'If file exists and is the same length (size). Skip. 'If file exists and is of different Length (size) and SobreEscribir = True. Copy If sFileInfo.Length <> dFileInfo.Length AndAlso SobreEscribir Then Try sFileInfo.CopyTo(dFileInfo.FullName, SobreEscribir) Catch ex As Exception If Not OmitirBloqueados Then Throw New Exception(ex.Message, ex) End Try 'If file exists and is of different Length (size) and SobreEscribir = False. Skip ElseIf sFileInfo.Length <> dFileInfo.Length AndAlso Not SobreEscribir Then 'Debug.WriteLine(sFileInfo.FullName & " Not copied.") End If End If Application.DoEvents() If Not BarraProgreso Is Nothing Then If BarraProgreso.Tag = "CANCELAR" Then Exit Sub BarraProgreso.Value = Math.Min(BarraProgreso.Maximum, BarraProgreso.Value + 1) End If sFileInfo = Nothing dFileInfo = Nothing Next Catch ex As Exception Throw New Exception("Error en Copiadirectorio. " & ex.Message, ex) 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "CopiaDirectorio") End Try End Sub 'Public Shared Sub CopiaDirectorio(ByVal DirectorioOrigen As String, ByVal DirectorioDestino As String, ByVal Recursivo As Boolean, ByVal SobreEscribir As Boolean) ' Try ' Dim sDir As String ' Dim dDirInfo As IO.DirectoryInfo ' Dim sDirInfo As IO.DirectoryInfo ' Dim sFile As String ' Dim sFileInfo As IO.FileInfo ' Dim dFileInfo As IO.FileInfo ' ' Add trailing separators to the supplied paths if they don't exist. ' If Not DirectorioOrigen.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then ' DirectorioOrigen &= System.IO.Path.DirectorySeparatorChar ' End If ' If Not DirectorioDestino.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then ' DirectorioDestino &= System.IO.Path.DirectorySeparatorChar ' End If ' 'If destination directory does not exist, create it. ' dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino) ' If dDirInfo.Exists = False Then dDirInfo.Create() ' dDirInfo = Nothing ' ' Recursive switch to continue drilling down into directory structure. ' If Recursivo Then ' ' Get a list of directories from the current parent. ' For Each sDir In System.IO.Directory.GetDirectories(DirectorioOrigen) ' sDirInfo = New System.IO.DirectoryInfo(sDir) ' dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino & sDirInfo.Name) ' ' Create the directory if it does not exist. ' If dDirInfo.Exists = False Then dDirInfo.Create() ' ' Since we are in recursive mode, copy the children also ' CopiaDirectorio(sDirInfo.FullName, dDirInfo.FullName, Recursivo, SobreEscribir) ' sDirInfo = Nothing ' dDirInfo = Nothing ' Next ' End If ' ' Get the files from the current parent. ' For Each sFile In System.IO.Directory.GetFiles(DirectorioOrigen) ' sFileInfo = New System.IO.FileInfo(sFile) ' dFileInfo = New System.IO.FileInfo(Replace(sFile, DirectorioOrigen, DirectorioDestino)) ' 'If File does not exist. Copy. ' If dFileInfo.Exists = False Then ' sFileInfo.CopyTo(dFileInfo.FullName, SobreEscribir) ' Else ' 'If file exists and is the same length (size). Skip. ' 'If file exists and is of different Length (size) and SobreEscribir = True. Copy ' If sFileInfo.Length <> dFileInfo.Length AndAlso SobreEscribir Then ' sFileInfo.CopyTo(dFileInfo.FullName, SobreEscribir) ' 'If file exists and is of different Length (size) and SobreEscribir = False. Skip ' ElseIf sFileInfo.Length <> dFileInfo.Length AndAlso Not SobreEscribir Then ' 'Debug.WriteLine(sFileInfo.FullName & " Not copied.") ' End If ' End If ' sFileInfo = Nothing ' dFileInfo = Nothing ' Next ' Catch ex As Exception ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "CopiaDirectorio") ' End Try 'End Sub Public Shared Function CalculoLetraCif(ByVal DNI As String) As String Dim sResultado As String = "", iTamanoDNI As Integer, sLetrasNif As String, i As Integer, Cdd0 As Integer, V1 As String = "" sLetrasNif = "TRWAGMYFPDXBNJZSQVHLCKE" iTamanoDNI = Len(DNI) If iTamanoDNI = 0 Then Return DNI DNI = DNI.ToUpper For i = 1 To iTamanoDNI If Asc(Mid(DNI, i, 1)) >= 48 And Asc(Mid(DNI, i, 1)) <= 57 Or Asc(Mid(DNI, i, 1)) >= 65 And Asc(Mid(DNI, i, 1)) <= 90 Then sResultado = sResultado & Mid(DNI, i, 1) Next i iTamanoDNI = Len(sResultado) If iTamanoDNI = 0 Then Return sResultado End If If Asc(Mid(sResultado, 1, 1)) < 48 Or Asc(Mid(sResultado, 1, 1)) > 57 Or Asc(Mid(sResultado, iTamanoDNI, 1)) < 48 Or Asc(Mid(sResultado, iTamanoDNI, 1)) > 57 Then Return sResultado End If Cdd0 = 0 For i = 1 To iTamanoDNI If Cdd0 Or (Asc(Mid(sResultado, i, 1)) <> 48) Then If Asc(Mid(sResultado, i, 1)) >= 48 And Asc(Mid(sResultado, i, 1)) <= 57 Then V1 = V1 & Mid(sResultado, i, 1) Cdd0 = 1 End If Next i If Trim(V1) = "" Then Return V1 Return V1 & Mid(sLetrasNif, Val(V1) Mod 23 + 1, 1) End Function ' Public Shared Sub AgregaBarraGenerica(ByRef Formulario As Form, ByRef tlbBarraGenerica As ucBarraGenerica) Public Shared Sub AgregaBarraGenerica(ByRef Formulario As Form, ByRef tlbBarraGenerica As Object) Formulario.Controls.Add(tlbBarraGenerica) tlbBarraGenerica.Top = 0 tlbBarraGenerica.Left = 0 tlbBarraGenerica.Anchor = AnchorStyles.Top + AnchorStyles.Left 'tlbBarraGenerica.Visible = True 'tlbBarraGenerica.BringToFront() End Sub 'Public Shared Function CodTecnosis(ByVal CadenaACod As String) As String ' Dim i As Integer, lSumaCaracter As Long ' For i = 1 To Len(CadenaACod) ' lSumaCaracter = lSumaCaracter + Asc(Mid$(CadenaACod, i, 1)) ' Next ' CodTecnosis = ((Math.Sqrt((lSumaCaracter) / 13) * 100)) ' CodTecnosis = Int((CodTecnosis - (Int(CodTecnosis))) * 1000000.0) 'End Function Public Shared Function EjecutaSql(ByVal Conexion As OleDbConnection, ByVal InstruccionSQL As String, Optional ByVal Mostrar_Error As Boolean = False) As Boolean Try EjecutaSql = True Dim sql As New OleDb.OleDbCommand, bCerrar As Boolean = False If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpen(Conexion) End If sql.Connection = Conexion sql.CommandText = InstruccionSQL EjecutaSql = sql.ExecuteNonQuery() If bCerrar Then Conexion.Close() Catch ex As Exception ' Throw New Exception(ex.Message) EjecutaSql = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message) End If End Try End Function Public Shared Function EjecutaSql(ByVal Conexion As SqlConnection, ByVal InstruccionSQL As String, Optional ByVal Mostrar_Error As Boolean = False) As Boolean Try EjecutaSql = True Dim sql As New SqlCommand, bCerrar As Boolean = False If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpen(Conexion) End If sql.Connection = Conexion sql.CommandText = InstruccionSQL.Replace(Chr(34), "'") EjecutaSql = sql.ExecuteNonQuery() If bCerrar Then Conexion.Close() Catch ex As Exception ' Throw New Exception(ex.Message) EjecutaSql = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message) End If End Try End Function Public Shared Function EjecutaSqlMySQL(ByVal Conexion As MySqlConnection, ByVal InstruccionSQL As String, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal ReemplazarComillas As Boolean = True) As Boolean Try EjecutaSqlMySQL = True Dim sql As New MySqlCommand, bCerrar As Boolean = False If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpenMySQL(Conexion) End If sql.Connection = Conexion If ReemplazarComillas Then sql.CommandText = InstruccionSQL.Replace(Chr(34), "'") Else sql.CommandText = InstruccionSQL End If EjecutaSqlMySQL = sql.ExecuteNonQuery() If bCerrar Then Conexion.Close() Catch ex As Exception ' Throw New Exception(ex.Message) EjecutaSqlMySQL = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message) End If End Try End Function Public Shared Function EjecutaSqlConTransaccion(ByVal Conexion As OleDbConnection, ByVal InstruccionSQL As String, Optional ByVal Mostrar_Error As Boolean = False) As Boolean ' Dim ts As OleDb.OleDbTransaction = Nothing Dim bTransaccionIniciada, bCerrar As Boolean Dim sql As New OleDb.OleDbCommand Try EjecutaSqlConTransaccion = True If Conexion.State = ConnectionState.Closed Then TSOpen(Conexion) bCerrar = True End If sql.Connection = Conexion sql.CommandText = InstruccionSQL.Replace(Chr(34), "'") sql.Transaction = Conexion.BeginTransaction bTransaccionIniciada = True EjecutaSqlConTransaccion = sql.ExecuteNonQuery() sql.Transaction.Commit() Catch ex As Exception If bTransaccionIniciada Then Try sql.Transaction.Rollback() Catch ex2 As Exception End Try End If ' Throw New Exception(ex.Message) EjecutaSqlConTransaccion = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & "SQL: " & InstruccionSQL) End If Finally If bCerrar Then Conexion.Close() End Try End Function Public Shared Function EjecutaSqlConTransaccion(ByVal Conexion As SqlConnection, ByVal InstruccionSQL As String, Optional ByVal Mostrar_Error As Boolean = False) As Boolean ' Dim ts As OleDb.OleDbTransaction = Nothing Dim bTransaccionIniciada, bCerrar As Boolean Dim sql As New SqlCommand Try EjecutaSqlConTransaccion = True If Conexion.State = ConnectionState.Closed Then TSOpen(Conexion) bCerrar = True End If sql.Connection = Conexion sql.CommandText = InstruccionSQL.Replace(Chr(34), "'") sql.Transaction = Conexion.BeginTransaction bTransaccionIniciada = True EjecutaSqlConTransaccion = sql.ExecuteNonQuery() sql.Transaction.Commit() Catch ex As Exception If bTransaccionIniciada Then Try sql.Transaction.Rollback() Catch ex2 As Exception End Try End If ' Throw New Exception(ex.Message) EjecutaSqlConTransaccion = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & "SQL: " & InstruccionSQL) End If Finally If bCerrar Then Conexion.Close() End Try End Function Public Shared Function EjecutaSqlConTransaccionMySQL(ByVal Conexion As MySqlConnection, ByVal InstruccionSQL As String, ByVal Transaccion As MySqlTransaction) As Boolean Dim sql As New MySqlCommand Try EjecutaSqlConTransaccionMySQL = True sql.Connection = Conexion sql.CommandText = InstruccionSQL sql.Transaction = Transaccion EjecutaSqlConTransaccionMySQL = sql.ExecuteNonQuery() Catch ex As Exception Throw New Exception(ex.Message & vbCrLf & "SQL: " & InstruccionSQL, ex) End Try End Function Public Shared Function EjecutaSql(ByVal Conexion As OleDbConnection, ByVal Comando As OleDbCommand, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal MilisegundosReintentos As Integer = 20000) As Boolean Dim sw As New Stopwatch Dim bCerrar As Boolean = False Try Do Try sw.Start() EjecutaSql = True Comando.Connection = Conexion If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpen(Conexion) Else bCerrar = False End If EjecutaSql = Comando.ExecuteNonQuery() Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MilisegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & "COMMANDTEXT: " & Comando.CommandText, ex) End If End If Application.DoEvents() Catch ex As Exception EjecutaSql = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & "COMMANDTEXT: " & Comando.CommandText) End If End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try Try If bCerrar Then Conexion.Close() Catch ex As Exception End Try End Try End Function Public Shared Function EjecutaSqlMySQL(ByVal Conexion As MySqlConnection, ByVal Comando As MySqlCommand, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal MilisegundosReintentos As Integer = 2500) As Boolean Dim sw As New Stopwatch Dim bCerrar As Boolean = False Try Do Try sw.Start() EjecutaSqlMySQL = True Comando.Connection = Conexion If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpenMySQL(Conexion) Else bCerrar = False End If EjecutaSqlMySQL = Comando.ExecuteNonQuery() Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MilisegundosReintentos Then Throw ex If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & "COMMANDTEXT: " & Comando.CommandText, ex) End If Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try Try If bCerrar Then Conexion.Close() Catch ex As Exception End Try End Try End Function Public Shared Function EjecutaSqlConTransaccion(ByVal Conexion As OleDbConnection, ByVal Comando As OleDbCommand, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal MilisegundosReintentos As Integer = 20000) As Boolean Dim sw As New Stopwatch Dim bTransaccionIniciada, bCerrar As Boolean Try Do Try sw.Start() EjecutaSqlConTransaccion = True Comando.Connection = Conexion If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpen(Conexion) Else bCerrar = False End If Comando.Transaction = Conexion.BeginTransaction bTransaccionIniciada = True EjecutaSqlConTransaccion = Comando.ExecuteNonQuery() Comando.Transaction.Commit() Exit Do Catch ex As OleDb.OleDbException If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MilisegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End If Application.DoEvents() Catch ex As Exception If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If EjecutaSqlConTransaccion = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try Try If bCerrar Then Conexion.Close() Catch ex As Exception End Try End Try End Function Public Shared Function EjecutaSqlConTransaccion(ByVal Conexion As SqlConnection, ByVal Comando As SqlCommand, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal MiliSegundosReintentos As Integer = 2500) As Boolean Dim sw As New Stopwatch Dim bTransaccionIniciada, bCerrar As Boolean Try Do Try sw.Start() EjecutaSqlConTransaccion = True Comando.CommandText = Comando.CommandText.Replace(Chr(34), "'") Comando.Connection = Conexion If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpen(Conexion) Else bCerrar = False End If Comando.Transaction = Conexion.BeginTransaction bTransaccionIniciada = True EjecutaSqlConTransaccion = Comando.ExecuteNonQuery() Comando.Transaction.Commit() Exit Do Catch ex As OleDb.OleDbException If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End If Application.DoEvents() Catch ex As Exception If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If EjecutaSqlConTransaccion = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try Try If bCerrar Then Conexion.Close() Catch ex As Exception End Try End Try End Function Public Shared Function EjecutaSqlConTransaccionMySQL(ByVal Conexion As MySqlConnection, ByVal Comando As MySqlCommand, Optional ByVal Mostrar_Error As Boolean = False, Optional ByVal MiliSegundosReintentos As Integer = 2500) As Boolean Dim sw As New Stopwatch Dim bTransaccionIniciada, bCerrar As Boolean Try Do Try sw.Start() EjecutaSqlConTransaccionMySQL = True Comando.CommandText = Comando.CommandText.Replace(Chr(34), "'") Comando.Connection = Conexion If Conexion.State = ConnectionState.Closed Then bCerrar = True TSOpenMySQL(Conexion) Else bCerrar = False End If Comando.Transaction = Conexion.BeginTransaction bTransaccionIniciada = True EjecutaSqlConTransaccionMySQL = Comando.ExecuteNonQuery() Comando.Transaction.Commit() Exit Do Catch ex As OleDb.OleDbException If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End If Application.DoEvents() Catch ex As Exception If bTransaccionIniciada Then Try Comando.Transaction.Rollback() Catch ex2 As Exception End Try End If EjecutaSqlConTransaccionMySQL = False If Mostrar_Error And Not EsServicio Then MsgBox(ex.Message, MsgBoxStyle.Exclamation, "EjecutaSql") Else Throw New Exception(ex.Message & vbCrLf & Comando.CommandText) End If End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try Try If bCerrar Then Conexion.Close() Catch ex As Exception End Try End Try End Function 'Public Shared Sub InicializaMenus(ByVal Menu As C1.Win.C1Command.C1CommandHolder, ByVal Conexion As OleDbConnection, ByVal Usuario As String, ByVal grupo As String) ' Try ' Dim c1SubMenu As C1.Win.C1Command.C1Command ' For Each c1SubMenu In Menu.Commands ' Call PermisosObjeto(c1SubMenu.Name, "Menu", Conexion, Usuario, grupo, c1SubMenu) ' Next ' Catch ex As Exception ' If EsServicio Then ' Throw New Exception(ex.Message, ex) ' Else ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "InicializaMenus") ' End If ' End Try 'End Sub 'Public Shared Sub InicializaMenus(ByVal Menu As C1.Win.C1Command.C1CommandHolder, ByVal Conexion As MySqlConnection, ByVal Usuario As String, ByVal grupo As String) ' Try ' Dim c1SubMenu As C1.Win.C1Command.C1Command ' For Each c1SubMenu In Menu.Commands ' Call PermisosObjetoMySQL(c1SubMenu.Name, "Menu", Conexion, Usuario, grupo, c1SubMenu) ' Next ' Catch ex As Exception ' If EsServicio Then ' Throw New Exception(ex.Message, ex) ' Else ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "InicializaMenus") ' End If ' End Try 'End Sub Public Shared Sub PermisosObjeto(ByVal Nombre As String, ByVal Tipo As String, ByVal conexion As OleDbConnection, ByVal Usuario As String, ByVal grupo As String, Optional ByVal Objeto As Object = Nothing) Try Dim drPermisos As DataRow drPermisos = Lee_Registro(conexion, "ExcUsu", "Codigo_Usuario=" & Chr(34) & Usuario & Chr(34) & " AND Nombre=" & Chr(34) & Nombre & Chr(34)) If Not IsNothing(drPermisos) Then LimitarAccesoObjeto(drPermisos, Tipo, Objeto) drPermisos = Lee_Registro(conexion, "ExcGru", "Codigo_Grupo=" & Chr(34) & grupo & Chr(34) & " AND Nombre=" & Chr(34) & Nombre & Chr(34)) If Not IsNothing(drPermisos) Then LimitarAccesoObjeto(drPermisos, Tipo, Objeto) Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "PermisosObjeto") End If End Try End Sub Public Shared Sub PermisosObjetoMySQL(ByVal Nombre As String, ByVal Tipo As String, ByVal conexion As MySqlConnection, ByVal Usuario As String, ByVal grupo As String, Optional ByVal Objeto As Object = Nothing) Try Dim drPermisos As DataRow drPermisos = LeeRegistroMySQL(conexion, "ExcUsu", "Codigo_Usuario=" & Chr(34) & Usuario & Chr(34) & " AND Nombre=" & Chr(34) & Nombre & Chr(34)) If Not IsNothing(drPermisos) Then LimitarAccesoObjeto(drPermisos, Tipo, Objeto) drPermisos = LeeRegistroMySQL(conexion, "ExcGru", "Codigo_Grupo=" & Chr(34) & grupo & Chr(34) & " AND Nombre=" & Chr(34) & Nombre & Chr(34)) If Not IsNothing(drPermisos) Then LimitarAccesoObjeto(drPermisos, Tipo, Objeto) Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "PermisosObjeto") End If End Try End Sub Private Shared Sub LimitarAccesoObjeto(ByVal Registro As DataRow, ByVal Tipo As String, Optional ByVal Objeto As Object = Nothing) Try Select Case Tipo.ToUpper Case "MENU" If Registro("Denegar_Modificaciones") Then Objeto.enabled = False If Registro("Denegar_Visualizacion") Then Objeto.visible = False End Select Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "LimitarAccesoObjeto") End If End Try End Sub 'Public Shared Sub ConstruyeComando(ByRef adAdaptador As OleDbDataAdapter, ByVal dtTabla As DataTable, ByVal TablaAActualizar As String, ByVal CampoSIndice() As String, ByVal CamposRelacionados As String, ByVal Conexion As OleDbConnection) ' Try ' Dim adTabla As OleDb.OleDbDataAdapter, dsDatos As New DataSet, dcColumna As DataColumn ' Dim sComandoUpdate As String = "UPDATE " & TablaAActualizar & " SET " ' Dim sComandoInsert As String = "INSERT INTO " & TablaAActualizar & " (" ' Dim sComandoInsertFin As String = ") VALUES (" ' Dim sComandoDelete As String = "" ' ' Dim sComandoDelete As String = "DELETE FROM " & TablaAActualizar & " WHERE (" & sCampoIndiceSinPrefijo & "=@" & sCampoIndiceSinPrefijo & ")" ' Dim bCampoDeBusquedaEnUpdate As Boolean ' Dim coComandoDelete As New OleDbCommand, coComandoUpdate As New OleDbCommand, coComandoInsert As New OleDbCommand ' Dim sCamposOrigen As String = "|" ' Dim sNombreColumna As String ' Dim sCamposIndiceSinPrefijo(CampoSIndice.Length - 1) As String ' Dim sCampoIndice As String ' Dim i As Integer ' For i = 0 To CampoSIndice.Length - 1 ' sCampoIndice = CampoSIndice(i) ' If InStr(sCampoIndice, ".") = 0 Then ' sCamposIndiceSinPrefijo(i) = sCampoIndice ' Else ' sCamposIndiceSinPrefijo(i) = sCampoIndice.Split(".")(1) ' End If ' If i = 0 Then ' sComandoDelete = "DELETE FROM " & TablaAActualizar & " WHERE (" & sCampoIndice & "=@" & sCampoIndice & ")" ' Else ' sComandoDelete &= " AND (" & sCampoIndice & "=@" & sCampoIndice & ")" ' End If ' Next i ' For Each dcColumna In dtTabla.Columns ' sCamposOrigen = sCamposOrigen & dcColumna.ColumnName & "|" ' Next ' adTabla = New OleDb.OleDbDataAdapter("SELECT * FROM " & TablaAActualizar, Conexion) ' 'adTabla.FillSchema(dsDatos, SchemaType.Mapped, TablaAActualizar) ' TSFillSchema(adTabla, dsDatos, SchemaType.Mapped, TablaAActualizar) ' For i = 0 To CampoSIndice.Length - 1 ' sCampoIndice = CampoSIndice(i) ' coComandoDelete.Parameters.Add("@" & sCampoIndice, GetOleDbType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) ' coComandoDelete.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' dsDatos.Tables(TablaAActualizar).Columns(sCampoIndiceSinPrefijo).ColumnName ' coComandoDelete.Parameters("@" & sCampoIndice).Value = GetOleDbTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) ' adAdaptador.DeleteCommand = coComandoDelete ' Next i ' For Each dcColumna In dsDatos.Tables(TablaAActualizar).Columns ' For i = 0 To CampoSIndice.Length - 1 ' If sCamposIndiceSinPrefijo(i).ToUpper = dcColumna.ColumnName.ToUpper Then bCampoDeBusquedaEnUpdate = True ' Next i ' If dcColumna.AutoIncrement = False Then ' ' If CampoIndice.ToUpper = dcColumna.ColumnName.ToUpper Then bCampoDeBusquedaEnUpdate = True ' OJO SE SACA DEL IF 20050226 ' If InStr(sCamposOrigen.ToUpper, "|" & dcColumna.ColumnName.ToUpper & "|") > 0 Then ' sNombreColumna = dcColumna.ColumnName ' Else ' If InStr(sCamposOrigen.ToUpper, "|" & TablaAActualizar.ToUpper & "." & dcColumna.ColumnName.ToUpper & "|") > 0 Then ' sNombreColumna = TablaAActualizar & "." & dcColumna.ColumnName ' Else ' sNombreColumna = "" ' End If ' End If ' If sNombreColumna <> "" Then ' ' If InStr("|" & CamposRelacionados & "|", "|" & TablaAActualizar & "." & dcColumna.ColumnName & "|") > 0 Then ' ' sNombreColumna = TablaAActualizar & "." & dcColumna.ColumnName ' ' End If ' coComandoUpdate.Parameters.Add("@" & sNombreColumna, GetOleDbType(dcColumna.DataType)) ' coComandoUpdate.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna ' coComandoUpdate.Parameters("@" & sNombreColumna).Value = GetOleDbTypeDefaultValue(dcColumna.DataType) ' coComandoInsert.Parameters.Add("@" & sNombreColumna, GetOleDbType(dcColumna.DataType)) ' coComandoInsert.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna ' coComandoInsert.Parameters("@" & sNombreColumna).Value = GetOleDbTypeDefaultValue(dcColumna.DataType) ' sComandoUpdate = sComandoUpdate & sNombreColumna & "=@" & sNombreColumna & ", " ' sComandoInsert = sComandoInsert & dcColumna.ColumnName & ", " ' sComandoInsertFin = sComandoInsertFin & "@" & sNombreColumna & ", " ' End If ' End If ' Next ' For i = 0 To CampoSIndice.Length - 1 ' sCampoIndice = CampoSIndice(i) ' If i = 0 Then ' sComandoUpdate = Mid$(sComandoUpdate, 1, Len(sComandoUpdate) - 2) & " WHERE " & sCampoIndice & "=@" & sCampoIndice ' Else ' sComandoUpdate &= " AND " & sCampoIndice & "=@" & sCampoIndice ' End If ' If bCampoDeBusquedaEnUpdate Then ' sCampoIndice = CampoSIndice(i) ' coComandoUpdate.Parameters.Add("@" & sCampoIndice, GetOleDbType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) ' coComandoUpdate.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' ' If dsDatos.Tables(TablaAActualizar).Columns(CampoIndice).AutoIncrement = False Then ' coComandoUpdate.Parameters("@" & sCampoIndice).Value = GetOleDbTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) ' ' End If ' End If ' Next i ' sComandoInsert = Mid$(sComandoInsert, 1, Len(sComandoInsert) - 2) & Mid$(sComandoInsertFin, 1, Len(sComandoInsertFin) - 2) & ")" ' adAdaptador.InsertCommand = coComandoInsert ' adAdaptador.UpdateCommand = coComandoUpdate ' adAdaptador.DeleteCommand.CommandText = sComandoDelete ' adAdaptador.InsertCommand.CommandText = sComandoInsert ' adAdaptador.UpdateCommand.CommandText = sComandoUpdate ' adAdaptador.InsertCommand.Connection = Conexion ' adAdaptador.UpdateCommand.Connection = Conexion ' adAdaptador.DeleteCommand.Connection = Conexion ' Catch ex As Exception ' If EsServicio Then ' Throw New Exception(ex.Message, ex) ' Else ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "ConstruyeComando") ' End If ' End Try 'End Sub Public Shared Sub ConstruyeComando(ByRef adAdaptador As System.Data.Common.DbDataAdapter, ByVal dtTabla As DataTable, ByVal TablaAActualizar As String, ByVal CampoSIndice() As String, ByVal CamposRelacionados As String, ByVal Conexion As System.Data.Common.DbConnection, CampoAutonumericoTraspasado As String) Try Dim adTabla As System.Data.Common.DbDataAdapter, dsDatos As New DataSet, dcColumna As DataColumn Dim sComandoUpdate As String = "UPDATE " & TablaAActualizar & " SET " Dim sComandoInsert As String = "INSERT INTO " & TablaAActualizar & " (" Dim sComandoInsertFin As String = ") VALUES (" Dim sComandoDelete As String = "" ' Dim sComandoDelete As String = "DELETE FROM " & TablaAActualizar & " WHERE (" & sCampoIndiceSinPrefijo & "=@" & sCampoIndiceSinPrefijo & ")" Dim bCampoDeBusquedaEnUpdate As Boolean Dim coComandoDeleteoledb, coComandoUpdateoledb, coComandoInsertoledb As OleDbCommand Dim coComandoDeleteMySQL, coComandoUpdateMySQL, coComandoInsertMySQL As MySqlCommand ' Dim coComandoDelete As System.Data.Common.DbCommand, coComandoUpdate As System.Data.Common.DbCommand, coComandoInsert As System.Data.Common.DbCommand If Conexion.GetType Is GetType(OleDbConnection) Then coComandoDeleteoledb = New OleDbCommand coComandoUpdateoledb = New OleDbCommand coComandoInsertoledb = New OleDbCommand ElseIf Conexion.GetType Is GetType(MySql.Data.MySqlClient.MySqlConnection) Then coComandoDeleteMySQL = New MySql.Data.MySqlClient.MySqlCommand coComandoUpdateMySQL = New MySql.Data.MySqlClient.MySqlCommand coComandoInsertMySQL = New MySql.Data.MySqlClient.MySqlCommand Else Throw New Exception("Tipo de conexión no soportado") End If Dim sCamposOrigen As String = "|" Dim sNombreColumna As String Dim sCamposIndiceSinPrefijo(CampoSIndice.Length - 1) As String Dim sCampoIndice As String Dim i As Integer For i = 0 To CampoSIndice.Length - 1 sCampoIndice = CampoSIndice(i) If InStr(sCampoIndice, ".") = 0 Then sCamposIndiceSinPrefijo(i) = sCampoIndice Else sCamposIndiceSinPrefijo(i) = sCampoIndice.Split(".")(1) End If If i = 0 Then sComandoDelete = "DELETE FROM " & TablaAActualizar & " WHERE (" & sCampoIndice & "=@" & sCampoIndice & ")" Else sComandoDelete &= " AND (" & sCampoIndice & "=@" & sCampoIndice & ")" End If Next i For Each dcColumna In dtTabla.Columns sCamposOrigen = sCamposOrigen & dcColumna.ColumnName & "|" Next If Conexion.GetType Is GetType(OleDbConnection) Then adTabla = New OleDb.OleDbDataAdapter("SELECT * FROM " & TablaAActualizar, Conexion) ElseIf Conexion.GetType Is GetType(MySql.Data.MySqlClient.MySqlConnection) Then adTabla = New MySql.Data.MySqlClient.MySqlDataAdapter("SELECT * FROM " & TablaAActualizar, Conexion) Else Throw New Exception("Tipo no soportado.") End If 'adTabla.FillSchema(dsDatos, SchemaType.Mapped, TablaAActualizar) TSFillSchema(adTabla, dsDatos, SchemaType.Mapped, TablaAActualizar) If Conexion.GetType Is GetType(OleDbConnection) Then For i = 0 To CampoSIndice.Length - 1 sCampoIndice = CampoSIndice(i) coComandoDeleteoledb.Parameters.Add("@" & sCampoIndice, GetOleDbType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) coComandoDeleteoledb.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' dsDatos.Tables(TablaAActualizar).Columns(sCampoIndiceSinPrefijo).ColumnName coComandoDeleteoledb.Parameters("@" & sCampoIndice).Value = GetOleDbTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) adAdaptador.DeleteCommand = coComandoDeleteoledb Next i ElseIf Conexion.GetType Is GetType(MySqlConnection) Then For i = 0 To CampoSIndice.Length - 1 sCampoIndice = CampoSIndice(i) coComandoDeleteMySQL.Parameters.Add("@" & sCampoIndice, GetMySQLType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) coComandoDeleteMySQL.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' dsDatos.Tables(TablaAActualizar).Columns(sCampoIndiceSinPrefijo).ColumnName coComandoDeleteMySQL.Parameters("@" & sCampoIndice).Value = GetmysqlTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) adAdaptador.DeleteCommand = coComandoDeleteMySQL Next i End If For Each dcColumna In dsDatos.Tables(TablaAActualizar).Columns For i = 0 To CampoSIndice.Length - 1 If sCamposIndiceSinPrefijo(i).ToUpper = dcColumna.ColumnName.ToUpper Then bCampoDeBusquedaEnUpdate = True Next i If dcColumna.AutoIncrement = False Then ' If CampoIndice.ToUpper = dcColumna.ColumnName.ToUpper Then bCampoDeBusquedaEnUpdate = True ' OJO SE SACA DEL IF 20050226 If InStr(sCamposOrigen.ToUpper, "|" & dcColumna.ColumnName.ToUpper & "|") > 0 Then sNombreColumna = dcColumna.ColumnName Else If InStr(sCamposOrigen.ToUpper, "|" & TablaAActualizar.ToUpper & "." & dcColumna.ColumnName.ToUpper & "|") > 0 Then sNombreColumna = TablaAActualizar & "." & dcColumna.ColumnName Else sNombreColumna = "" End If End If If sNombreColumna <> "" Then ' If InStr("|" & CamposRelacionados & "|", "|" & TablaAActualizar & "." & dcColumna.ColumnName & "|") > 0 Then ' sNombreColumna = TablaAActualizar & "." & dcColumna.ColumnName ' End If If Conexion.GetType Is GetType(OleDbConnection) Then coComandoUpdateoledb.Parameters.Add("@" & sNombreColumna, GetOleDbType(dcColumna.DataType)) coComandoUpdateoledb.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna coComandoUpdateoledb.Parameters("@" & sNombreColumna).Value = GetOleDbTypeDefaultValue(dcColumna.DataType) coComandoInsertoledb.Parameters.Add("@" & sNombreColumna, GetOleDbType(dcColumna.DataType)) coComandoInsertoledb.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna coComandoInsertoledb.Parameters("@" & sNombreColumna).Value = GetOleDbTypeDefaultValue(dcColumna.DataType) ElseIf Conexion.GetType Is GetType(MySqlConnection) Then coComandoUpdateMySQL.Parameters.Add("@" & sNombreColumna, GetMySQLType(dcColumna.DataType)) coComandoUpdateMySQL.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna coComandoUpdateMySQL.Parameters("@" & sNombreColumna).Value = GetmysqlTypeDefaultValue(dcColumna.DataType) coComandoInsertMySQL.Parameters.Add("@" & sNombreColumna, GetMySQLType(dcColumna.DataType)) coComandoInsertMySQL.Parameters("@" & sNombreColumna).SourceColumn = sNombreColumna coComandoInsertMySQL.Parameters("@" & sNombreColumna).Value = GetmysqlTypeDefaultValue(dcColumna.DataType) End If sComandoUpdate = sComandoUpdate & sNombreColumna & "=@" & sNombreColumna & ", " sComandoInsert = sComandoInsert & dcColumna.ColumnName & ", " sComandoInsertFin = sComandoInsertFin & "@" & sNombreColumna & ", " End If End If Next For i = 0 To CampoSIndice.Length - 1 sCampoIndice = CampoSIndice(i) If i = 0 Then sComandoUpdate = Mid$(sComandoUpdate, 1, Len(sComandoUpdate) - 2) & " WHERE " & sCampoIndice & "=@" & sCampoIndice Else sComandoUpdate &= " AND " & sCampoIndice & "=@" & sCampoIndice End If If bCampoDeBusquedaEnUpdate Then sCampoIndice = CampoSIndice(i) If Conexion.GetType Is GetType(OleDbConnection) Then coComandoUpdateoledb.Parameters.Add("@" & sCampoIndice, GetOleDbType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) coComandoUpdateoledb.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' If dsDatos.Tables(TablaAActualizar).Columns(CampoIndice).AutoIncrement = False Then coComandoUpdateoledb.Parameters("@" & sCampoIndice).Value = GetOleDbTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) ElseIf Conexion.GetType Is GetType(MySqlConnection) Then coComandoUpdateMySQL.Parameters.Add("@" & sCampoIndice, GetMySQLType(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType)) coComandoUpdateMySQL.Parameters("@" & sCampoIndice).SourceColumn = sCampoIndice ' If dsDatos.Tables(TablaAActualizar).Columns(CampoIndice).AutoIncrement = False Then coComandoUpdateMySQL.Parameters("@" & sCampoIndice).Value = GetmysqlTypeDefaultValue(dsDatos.Tables(TablaAActualizar).Columns(sCamposIndiceSinPrefijo(i)).DataType) End If ' End If End If Next i sComandoInsert = Mid$(sComandoInsert, 1, Len(sComandoInsert) - 2) & Mid$(sComandoInsertFin, 1, Len(sComandoInsertFin) - 2) & ")" If Conexion.GetType Is GetType(OleDbConnection) Then adAdaptador.InsertCommand = coComandoInsertoledb adAdaptador.UpdateCommand = coComandoUpdateoledb ElseIf Conexion.GetType Is GetType(MySqlConnection) Then adAdaptador.InsertCommand = coComandoInsertMySQL adAdaptador.UpdateCommand = coComandoUpdateMySQL End If adAdaptador.DeleteCommand.CommandText = sComandoDelete & ";" If CampoAutonumericoTraspasado = "" Then adAdaptador.InsertCommand.CommandText = sComandoInsert & ";" Else adAdaptador.InsertCommand.CommandText = sComandoInsert & ";SELECT last_insert_id() as " & CampoAutonumericoTraspasado adAdaptador.InsertCommand.UpdatedRowSource = UpdateRowSource.FirstReturnedRecord End If adAdaptador.UpdateCommand.CommandText = sComandoUpdate & ";" adAdaptador.InsertCommand.Connection = Conexion adAdaptador.UpdateCommand.Connection = Conexion adAdaptador.DeleteCommand.Connection = Conexion Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "ConstruyeComando") End If End Try End Sub Public Shared Function GetOleDbType(ByVal sysType As Type) As OleDbType If sysType Is GetType(String) Then Return OleDbType.VarChar ElseIf sysType Is GetType(Integer) Then Return OleDbType.Integer ElseIf sysType Is GetType(Int16) Then Return OleDbType.Integer ElseIf sysType Is GetType(Int32) Then Return OleDbType.Integer ElseIf sysType Is GetType(Int64) Then Return OleDbType.Integer ElseIf sysType Is GetType(Boolean) Then Return OleDbType.Boolean ElseIf sysType Is GetType(Date) Then Return OleDbType.Date ElseIf sysType Is GetType(Char) Then Return OleDbType.Char ElseIf sysType Is GetType(Decimal) Then Return OleDbType.Decimal ElseIf sysType Is GetType(Double) Then Return OleDbType.Double ElseIf sysType Is GetType(Single) Then Return OleDbType.Single ElseIf sysType Is GetType(Byte()) Then Return OleDbType.Binary ElseIf sysType Is GetType(Guid) Then Return OleDbType.Guid End If End Function Public Shared Function GetOleDbTypeDefaultValue(ByVal sysType As Type) As Object If sysType Is GetType(String) Then Return "" ElseIf sysType Is GetType(Integer) Or sysType Is GetType(Int16) Or sysType Is GetType(Int64) Or sysType Is GetType(Int32) Then Return 0 ElseIf sysType Is GetType(Boolean) Then Return False ElseIf sysType Is GetType(Date) Then Return Nothing ElseIf sysType Is GetType(Char) Then Return "" ElseIf sysType Is GetType(Decimal) Then Return 0 ElseIf sysType Is GetType(Double) Then Return 0 ElseIf sysType Is GetType(Single) Then Return 0 ElseIf sysType Is GetType(Byte()) Then Return 0 Else Return Nothing End If End Function Public Shared Function GetMySQLType(ByVal sysType As Type) As MySqlDbType If sysType Is GetType(String) Then Return MySqlDbType.VarChar ElseIf sysType Is GetType(Integer) Then Return MySqlDbType.Int64 ElseIf sysType Is GetType(Boolean) Then Return MySqlDbType.Byte ElseIf sysType Is GetType(Date) Then Return MySqlDbType.DateTime ElseIf sysType Is GetType(Char) Then Return MySqlDbType.Byte ElseIf sysType Is GetType(Decimal) Then Return MySqlDbType.Decimal ElseIf sysType Is GetType(Double) Then Return MySqlDbType.Double ElseIf sysType Is GetType(Single) Then Return MySqlDbType.LongBlob ElseIf sysType Is GetType(Byte()) Then Return MySqlDbType.Binary ElseIf sysType Is GetType(Guid) Then Return MySqlDbType.Guid End If End Function Public Shared Function GetmysqlTypeDefaultValue(ByVal sysType As Type) As Object If sysType Is GetType(String) Then Return "" ElseIf sysType Is GetType(Integer) Then Return 0 ElseIf sysType Is GetType(Boolean) Then Return False ElseIf sysType Is GetType(Date) Then Return Nothing ElseIf sysType Is GetType(Char) Then Return "" ElseIf sysType Is GetType(Decimal) Then Return 0 ElseIf sysType Is GetType(Double) Then Return 0 ElseIf sysType Is GetType(Single) Then Return 0 ElseIf sysType Is GetType(Byte()) Then Return 0 Else Return Nothing End If End Function Public Shared Sub VisualizarPdf(ByVal RutaTemporal As String, ByVal Fichero As String, ByVal VisualizaCopia As Boolean) 'Public Sub VisualizaPdf(ByVal Fichero As String, ByVal FormularioAOcultar As Form) 'If GbCerrandoFormularioActivo Then Try If VisualizaCopia Then If Not IO.Directory.Exists(RutaTemporal) Then IO.Directory.CreateDirectory(RutaTemporal) Try Kill(RutaTemporal & "\*.pdf") Catch ex As Exception End Try Dim i As Integer, sNombreFicherotmp As String Dim sNombreFicherotmpse As String = IO.Path.GetFileNameWithoutExtension(Fichero) If Not IO.Directory.Exists(RutaTemporal) Then IO.Directory.CreateDirectory(RutaTemporal) sNombreFicherotmpse = IO.Path.GetFileNameWithoutExtension(Fichero) Do i += 1 sNombreFicherotmp = RutaTemporal & "\" & sNombreFicherotmpse & "-" & Trim(Str(i)) & ".pdf" Loop Until Not IO.File.Exists(sNombreFicherotmp) IO.File.Copy(Fichero, sNombreFicherotmp) Process.Start(sNombreFicherotmp) Else Process.Start(Fichero) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error") End Try End Sub Public Shared Function FEncS$(ByVal X$, ByVal Jco0$, ByVal Jcd0$, ByVal Xs0 As Long) Dim T$, Resultado$, Jco$, Jcd$, Cd$, Co$ Dim R, F, Lo0, Ld0, Lx, Ld, Xs, Po, Lo, Pd, Px, Spac As Long Dim SEncDes, I As Integer Resultado$ = "" If Xs0 = 0 Then ' Traduccion de tokens T$ = X$ Do F = 0 If Left$(T$, 3) = "[V]" Then Resultado$ = Resultado$ + "" : T$ = Mid$(T$, 4) : F = 1 If Left$(T$, 4) = "[AM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" : T$ = Mid$(T$, 5) : F = 1 If Left$(T$, 4) = "[Am]" Then Resultado$ = Resultado$ + "abcdefghijklmnopqrstuvwxyz" : T$ = Mid$(T$, 5) : F = 1 If Left$(T$, 3) = "[N]" Then Resultado$ = Resultado$ + "0123456789" : T$ = Mid$(T$, 4) : F = 1 If Left$(T$, 4) = "[AN]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" : T$ = Mid$(T$, 5) : F = 1 'If Left$(T$, 5) = "[ANM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" : T$ = Mid$(T$, 6) : F = 1 If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1 If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1 ' If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1 ' If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1 Loop Until F = 0 FEncS$ = Resultado$ + T$ Exit Function End If If Math.Abs(Xs0) < 100000000.0 Then Error 11 SEncDes = Math.Sign(Xs0) ' +1 o -1 If SEncDes > 0 Then ' inversion de parametros si Desencriptacion Jco$ = Jco0$ : Jcd$ = Jcd0$ Else Jco$ = Jcd0$ : Jcd$ = Jco0$ End If Jco$ = FEncS$(Jco$, "", "", 0) Jcd$ = FEncS$(Jcd$, "", "", 0) Lo0 = Len(Jco$) : Ld0 = Len(Jcd$) Lo = Lo0 + -256 * (Lo0 = 0) : Ld = Ld0 + -256 * (Ld0 = 0) If SEncDes > 0 Then Lx = Ld Else Lx = Lo Xs = Math.Abs(Xs0) + 611957 * (Len(X$) Mod 1000) ' ???? ' R = FRndL(-(ABS(Xs0) + 1000000 * (LEN(X$) MOD 1000))) Spac = Math.Abs(Xs0) Mod Lx For I = 1 To Len(X$) Co$ = Mid$(X$, I, 1) If Lo0 <> 0 Then Po = InStr(Jco$, Co$) Else Po = Asc(Co$) + 1 If Po = 0 Then Resultado$ = "" : Error 11 Xs = 16807 * (Xs Mod 127773) - 2836 * (Xs \ 127773) If Xs < 0 Then Xs = Xs + 2147483647 R = Int((Xs / 2147483647.0#) * Lx) ' R1 = INT(FRndL(0) * Lx) ' IF R <> R1 THEN STOP Pd = ((Po - 1) + SEncDes * (R + Spac) + 2 * Lx) Mod Lx + 1 If SEncDes > 0 Then Px = Po Else Px = Pd Spac = (Spac + Px * 17) Mod Lx If Ld0 <> 0 Then Cd$ = Mid$(Jcd$, Pd, 1) Else Cd$ = Chr(Pd - 1) Resultado$ = Resultado$ + Cd$ Next I FEncS$ = Resultado$ End Function Public Shared Function FRndL#(ByVal Xs0 As Double) ' <0:set=ABS 0:LaAnterior >0:usaXs0 Static Xs As Double If Xs0 Then Xs = Math.Abs(Xs0) : If Xs0 < 0 Then Exit Function If Xs = 0 Then Xs = 1718281829 Xs = 16807 * (Xs Mod 127773) - 2836 * (Xs \ 127773) If Xs < 0 Then Xs = Xs + 2147483647 FRndL# = Xs / 2147483647 End Function Public Shared Function HashdeFichero(ByVal NombreFichero As String) As String Dim byHash() As Byte, shaTmp As New System.Security.Cryptography.SHA1CryptoServiceProvider Dim fsTmp As IO.FileStream fsTmp = IO.File.OpenRead(NombreFichero) byHash = shaTmp.ComputeHash(fsTmp) fsTmp.Close() Return ByteArrayAString(byHash) End Function Public Shared Function ByteArrayAString(ByVal arrInput() As Byte) As String Dim i As Integer Dim sOutput As New System.Text.StringBuilder(arrInput.Length) For i = 0 To arrInput.Length - 1 'Convierte el array de bytes en cadena hexadecimal de 2 caracteres por byte (x2) sOutput.Append(arrInput(i).ToString("x2")) Next Return sOutput.ToString() End Function Public Shared Function PrevInstance() As Boolean If UBound(Diagnostics.Process.GetProcessesByName(System.Diagnostics.Process.GetCurrentProcess.ProcessName)) > 0 Then Return True Else Return False End If End Function Public Shared Function PreviaInstanciaMismoEjecutable() As Boolean Dim cp = Application.ExecutablePath Dim prs = Diagnostics.Process.GetProcessesByName(System.Diagnostics.Process.GetCurrentProcess.ProcessName).Where(Function(x) x.MainModule.FileName = cp).Count Return prs > 1 End Function Public Shared Function arraysIguales(ByVal a1 As Byte(), ByVal a2 As Byte()) As Boolean '------------------------------------------------------------------------------------- ' Devuelve True si los dos arrays de bytes "a1" y "a2" coinciden; False en otro caso. '------------------------------------------------------------------------------------- If (a1 Is Nothing) Or (a2 Is Nothing) Then Return (a1 Is Nothing) And (a2 Is Nothing) If a1.Length <> a2.Length Then Return False Dim i As Integer For i = 0 To (a1.Length - 1) If a1(i) <> a2(i) Then Return False Next Return True End Function Public Shared Function FicheroAArrayBytes(ByVal RutaFichero As String) As Byte() FicheroAArrayBytes = Nothing Try Dim fstmp As IO.FileStream, by() As Byte fstmp = IO.File.OpenRead(RutaFichero) ReDim by(fstmp.Length - 1) fstmp.Read(by, 0, fstmp.Length) fstmp.Close() FicheroAArrayBytes = by Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error") End If End Try End Function Public Shared Function FilasNoEliminadas(ByVal Tabla As DataTable) As Integer Try Dim i As Integer Dim dr As DataRow For Each dr In Tabla.Rows If dr.RowState <> DataRowState.Deleted Then i += 1 Next Return i Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error FilasNoEliminadas") End If End Try End Function Public Shared Function CopiaRegistro(ByVal RegistroOrigen As DataRow, ByVal RegistroDestino As DataRow) As Boolean Try Dim i As Integer, sColumna As String, bResultado As Boolean bResultado = True For i = 0 To RegistroDestino.Table.Columns.Count - 1 sColumna = RegistroDestino.Table.Columns(i).ColumnName Try RegistroDestino(sColumna) = RegistroOrigen(sColumna) Catch ex As Exception bResultado = False End Try Next Return bResultado Catch ex As Exception If EsServicio Then Throw New Exception(ex.Message, ex) MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error CopiaRegistro") End Try End Function Public Shared Function ValorN(ByVal Valor As Object) As Double Try Return CDbl(Valor) Catch ex As Exception Return 0 End Try End Function Public Shared Function DateToString(ByVal dDate As Date) As String DateToString = Year(dDate) & Right("0" & Month(dDate), 2) & Right("0" & dDate.Day, 2) End Function Public Shared Function DateTimeToString(ByVal dDateTime As DateTime) As String DateTimeToString = Year(dDateTime) & Right("0" & Month(dDateTime), 2) & Right("0" & dDateTime.Day, 2) & Right("0" & Hour(dDateTime), 2) & Right("0" & Minute(dDateTime), 2) & Right("0" & Second(dDateTime), 2) End Function Public Shared Function TimeToString(ByVal dTime As Date) As String TimeToString = Right("0" & Hour(dTime), 2) & ":" & Right("0" & Minute(dTime), 2) & ":" & Right("0" & Second(dTime), 2) End Function Public Shared Function StringToDate(ByVal sDate As String) As Date Dim dDate As Date If sDate Like "????-??-??" Or sDate Like "????/??/??" Then dDate = DateSerial(Left(sDate, 4), Mid(sDate, 6, 2), Mid(sDate, 9, 2)) Else If Len(sDate) < 8 Then dDate = DateSerial(Left(sDate, 4), Mid(sDate, 5, 2), Mid(sDate, 7, 2)) Else dDate = New Date(Left(sDate, 4), Mid(sDate, 5, 2), Mid(sDate, 7, 2), Mid(sDate, 9, 2), Mid(sDate, 11, 2), Mid(sDate, 13, 2)) End If End If StringToDate = dDate End Function Public Shared Sub ActualizaRegistro(ByVal Conexion As SqlConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, ByVal Campos() As String, ByVal Valores() As Object, Optional ByVal bSinMensajesError As Boolean = False) Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet, dr As DataRow Dim i As Integer If Trim(Clausula_WHERE) <> "" Then adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New SqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If Try 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Throw New Exception("Registro no encontrado") Else dr = dsDatos.Tables("TABLA").Rows(0) Dim coComando As New SqlCommandBuilder(adAdaptador) For i = 0 To Campos.Length - 1 dr(Campos(i)) = Valores(i) Next 'adAdaptador.Update(dsDatos, "TABLA") TSUpdate(adAdaptador, dsDatos, "TABLA") End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Sub Public Shared Sub ActualizaRegistro(ByVal Conexion As MySqlConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, ByVal Campos() As String, ByVal Valores() As Object, Optional ByVal bSinMensajesError As Boolean = False) Try Dim adAdaptador As MySqlDataAdapter, dsDatos As New DataSet, dr As DataRow Dim i As Integer If Trim(Clausula_WHERE) <> "" Then adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New MySqlDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If Try 'adAdaptador.Fill(dsDatos, "TABLA") TSFillMySQL(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Throw New Exception("Registro no encontrado") Else dr = dsDatos.Tables("TABLA").Rows(0) Dim coComando As New MySqlCommandBuilder(adAdaptador) For i = 0 To Campos.Length - 1 dr(Campos(i)) = Valores(i) Next 'adAdaptador.Update(dsDatos, "TABLA") TSUpdateMySQL(adAdaptador, dsDatos, "TABLA") End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Sub Public Shared Sub ActualizaRegistro(ByVal Conexion As OleDbConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, ByVal Campos() As String, ByVal Valores() As Object, Optional ByVal bSinMensajesError As Boolean = False) Try Dim adAdaptador As OleDbDataAdapter, dsDatos As New DataSet, dr As DataRow Dim i As Integer If Trim(Clausula_WHERE) <> "" Then adAdaptador = New OleDbDataAdapter("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else adAdaptador = New OleDbDataAdapter("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If Try 'adAdaptador.Fill(dsDatos, "TABLA") TSFill(adAdaptador, dsDatos, "TABLA") If dsDatos.Tables(0).Rows.Count = 0 Then Throw New Exception("Registro no encontrado") Else dr = dsDatos.Tables("TABLA").Rows(0) Dim coComando As New OleDbCommandBuilder(adAdaptador) For i = 0 To Campos.Length - 1 dr(Campos(i)) = Valores(i) Next 'adAdaptador.Update(dsDatos, "TABLA") TSUpdate(adAdaptador, dsDatos, "TABLA") End If Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try Catch ex As Exception If bSinMensajesError Or EsServicio Then Throw New Exception(ex.Message, ex) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registro") End If End Try End Sub Public Shared Sub CreaEstructuraDirectorio(ByVal Ruta As String) Dim sDirectorios() As String = Ruta.Split("\") Dim sDirectorio As String = "" Dim i As Integer For i = 0 To sDirectorios.Length - 1 Try sDirectorio &= sDirectorios(i) & "\" If Not IO.Directory.Exists(sDirectorio) Then IO.Directory.CreateDirectory(sDirectorio) Catch ex As Exception End Try Next End Sub Public Shared Function FechaHoraMySQL(ByVal FechaHora As Date) As String 'Return FechaHora.ToString Return FechaHora.Year.ToString & FechaHora.Month.ToString.PadLeft(2, "0") & FechaHora.Day.ToString.PadLeft(2, "0") & FechaHora.Hour.ToString.PadLeft(2, "0") & FechaHora.Minute.ToString.PadLeft(2, "0") & FechaHora.Second.ToString.PadLeft(2, "0") End Function Public Shared Function FechaSQL(ByVal FechaHora As Date) As String 'Return FechaHora.ToShortDateString() Return FechaHora.Day & "/" & FechaHora.Month & "/" & FechaHora.Year End Function Public Shared Function FechaAccess(ByVal FechaHora As Date) As String 'Return FechaHora.ToShortDateString() Return "#" & FechaHora.Month & "/" & FechaHora.Day & "/" & FechaHora.Year & "#" End Function Public Shared Function FechaEnCastellano(ByVal Fecha As Date, ByVal Formato As Integer) As String Dim sMeses(11) As String sMeses(0) = "Enero" sMeses(1) = "Febrero" sMeses(2) = "Marzo" sMeses(3) = "Abril" sMeses(4) = "Mayo" sMeses(5) = "Junio" sMeses(6) = "Julio" sMeses(7) = "Agosto" sMeses(8) = "Septiembre" sMeses(9) = "Octubre" sMeses(10) = "Noviembre" sMeses(11) = "Diciembre" Dim sDia As String, sMes As String, sAño As String sDia = Fecha.Day.ToString sMes = sMeses(Fecha.Month - 1) sAño = Fecha.Year Select Case Formato Case 1 FechaEnCastellano = sDia & " de " & sMes & " de " & sAño Case 2 FechaEnCastellano = Fecha.Day.ToString.PadLeft(2, "0") & "/" & Fecha.Month.ToString.PadLeft(2, "0") & "/" & Fecha.Year.ToString & " " & Fecha.Hour.ToString.PadLeft(2, "0") & ":" & Fecha.Minute.ToString.PadLeft(2, "0") & ":" & Fecha.Second.ToString.PadLeft(2, "0") Case Else FechaEnCastellano = sDia & " de " & sMes & " de " & sAño End Select End Function Public Shared Function FicheroTxtAString(ByVal Fichero As String) As String Try Dim clsReader As System.IO.TextReader = System.IO.File.OpenText(Fichero) Dim sResultado As String = "" Dim sLine As String = clsReader.ReadLine() While Not sLine Is Nothing sResultado &= sLine & vbCrLf sLine = clsReader.ReadLine() End While clsReader.Close() Return sResultado Catch ex As Exception Return "" End Try End Function Public Shared Function LeeRegistroDR(ByVal Conexion As OleDbConnection, ByVal Clausula_FROM As String, ByVal Clausula_WHERE As String, Optional ByVal sCampoAIncrementar As String = "", Optional ByVal iIncremento As Integer = 0, Optional ByVal bGuardar As Boolean = False, Optional ByVal bSinMensajesError As Boolean = True) As Collection Dim bCerrar As Boolean Try Dim dr As OleDbDataReader Dim co As OleDb.OleDbCommand Dim col As New Collection If Conexion.State = ConnectionState.Closed Then bCerrar = True Conexion.Open() End If If Trim(Clausula_WHERE) <> "" Then co = New OleDbCommand("SELECT * FROM " & Clausula_FROM & " WHERE " & Clausula_WHERE & ";", Conexion) Else co = New OleDbCommand("SELECT * FROM " & Clausula_FROM & ";", Conexion) End If dr = co.ExecuteReader dr.Read() Dim i As Integer For i = 0 To dr.FieldCount - 1 col.Add(dr(i), dr.GetName(i)) Next dr.Close() LeeRegistroDR = col Catch ex As Exception Throw New Exception(ex.Message, ex) Finally If bCerrar Then Conexion.Close() End If End Try End Function 'Public Shared Sub TxtATabla(ByVal Tabla As DataTable, ByVal Adaptador As OleDb.OleDbDataAdapter, ByVal RutaFichero As String, Optional ByVal CampoIndice As String = "", Optional ByVal Roman8 As Boolean = False) ' Try ' Dim sCadena As String ' Dim iFichero As Integer = FreeFile() ' Dim sCampos(), sCampo As String, sTipo As String = "" ' Dim iLongitudCampo As Integer ' Dim i As Integer ' If Roman8 Then UtilidadesTSL4net.clCharConv.CharConverter("ROMAN8", "WINDOWS", RutaFichero) ' FileOpen(iFichero, RutaFichero, OpenMode.Input, OpenAccess.Read, OpenShare.LockReadWrite) ' sCadena = LineInput(iFichero) ' sCampos = Ttag(sCadena, "CAMPOS").ToString.Split(",") ' Dim iPosicion As Integer = 0 ' Dim dr As DataRow, drIndice() As DataRow = Nothing ' Dim sFecha As String ' Dim iDia, iMes, iAño, iHora, iMinutos, iSegundos As Integer ' Dim dfecha As DateTime ' Dim iInicio, iLongitud As Integer ' Dim sSelect As String ' Dim sLongitudCampo As String ' If CampoIndice <> "" Then ' iPosicion = 0 ' For i = 0 To sCampos.Length - 1 ' sCampo = sCampos(i).Split(":")(0) ' sTipo = sCampos(i).Split(":")(1).Split("(")(0) ' sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) ' If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) ' iLongitudCampo = Val(sLongitudCampo) ' Select Case sTipo ' Case "SYSTEM.STRING" ' If sCampo.ToUpper = CampoIndice.ToUpper Then ' iInicio = iPosicion ' iLongitud = iLongitudCampo ' Exit For ' End If ' iPosicion += iLongitudCampo ' Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" ' iPosicion += 25 ' Case "SYSTEM.DATETIME" ' iPosicion += 19 ' Case "SYSTEM.BOOLEAN" ' iPosicion += 1 ' Case "SYSTEM.BYTE[]" ' Case Else ' Throw New Exception("Tipo " & sTipo & " no soportado") ' End Select ' Next ' End If ' Do ' If EOF(iFichero) Then Exit Do ' iPosicion = 0 ' sCadena = LineInput(iFichero) ' If CampoIndice <> "" Then ' Select Case sTipo ' Case "SYSTEM.STRING" ' sSelect = CampoIndice & "='" & sCadena.Substring(iInicio, iLongitud).Trim & "'" ' Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" ' sSelect = CampoIndice & "=" & sCadena.Substring(iInicio, iLongitud).Trim ' Case Else ' Throw New Exception("Tipo del índice " & sTipo & " no soportado") ' End Select ' drIndice = Tabla.Select(sSelect) ' If drIndice.Length > 0 Then ' dr = drIndice(0) ' ' dr.Delete() ' ' dr = Tabla.NewRow ' Else ' dr = Tabla.NewRow ' End If ' Else ' dr = Tabla.NewRow ' End If ' For i = 0 To sCampos.Length - 1 ' If sCampos(i).Trim <> "" Then ' sCampo = sCampos(i).Split(":")(0) ' sTipo = sCampos(i).Split(":")(1).Split("(")(0) ' sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) ' If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) ' iLongitudCampo = Val(sLongitudCampo) ' Select Case sTipo ' Case "SYSTEM.STRING" ' If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = sCadena.Substring(iPosicion, iLongitudCampo).Trim ' iPosicion += iLongitudCampo ' Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" ' If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = Val(sCadena.Substring(iPosicion, 25).Trim) ' iPosicion += 25 ' Case "SYSTEM.DATETIME" ' If Tabla.Columns.Contains(sCampo) Then ' sFecha = sCadena.Substring(iPosicion, 19).Trim ' If sFecha = "" Then ' dr(sCampo) = DBNull.Value ' Else ' iDia = sFecha.Split("/")(0) ' iMes = sFecha.Split("/")(1) ' iAño = sFecha.Split("/")(2).Split(" ")(0) ' iHora = sFecha.Split(" ")(1).Split(":")(0) ' iMinutos = sFecha.Split(" ")(1).Split(":")(1) ' iSegundos = sFecha.Split(" ")(1).Split(":")(2) ' dfecha = New Date(iAño, iMes, iDia, iHora, iMinutos, iSegundos) ' dr(sCampo) = dfecha ' End If ' End If ' iPosicion += 19 ' Case "SYSTEM.BOOLEAN" ' If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = (sCadena.Substring(iPosicion, 1) = "V") ' iPosicion += 1 ' Case "SYSTEM.BYTE[]" ' Case Else ' Throw New Exception("Tipo " & sTipo & " no soportado") ' End Select ' End If ' Next ' If IsNothing(drIndice) Then ' Tabla.Rows.Add(dr) ' Else ' If drIndice.Length = 0 Then Tabla.Rows.Add(dr) ' End If ' Loop Until EOF(iFichero) ' 'Adaptador.Update(Tabla) ' TSUpdate(Adaptador, Tabla) ' 'Tabla.AcceptChanges() ' FileClose(iFichero) ' Catch ex As Exception ' Throw New Exception(ex.Message, ex) ' 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") ' End Try 'End Sub Public Shared Sub TxtATablaConIndices(ByVal Tabla As DataTable, ByVal Adaptador As OleDb.OleDbDataAdapter, ByVal RutaFichero As String, ByVal CamposIndice() As String, ByVal BusquedaIndice As String, Optional ByVal Roman8 As Boolean = False) Try Dim sCadena As String Dim iFichero As Integer = FreeFile() Dim sCampos(), sCampo As String, sTipo As String = "" Dim iLongitudCampo As Integer Dim i, j As Integer If Roman8 Then CharConverter("ROMAN8", "WINDOWS", RutaFichero) FileOpen(iFichero, RutaFichero, OpenMode.Input, OpenAccess.Read, OpenShare.LockReadWrite) sCadena = LineInput(iFichero) sCampos = Ttag(sCadena, "CAMPOS").ToString.Split(",") Dim iPosicion As Integer = 0 Dim dr As DataRow = Nothing, drIndice() As DataRow = Nothing Dim sFecha As String Dim iDia, iMes, iAño, iHora, iMinutos, iSegundos As Integer Dim dfecha As DateTime Dim iInicio() As Integer = Nothing, iLongitud() As Integer = Nothing Dim sTipos() As String = Nothing Dim sSelect As String = BusquedaIndice Dim sLongitudCampo As String Dim h As Integer = 0 If Not IsNothing(CamposIndice) Then iPosicion = 0 ReDim iInicio(CamposIndice.Length - 1) ReDim iLongitud(CamposIndice.Length - 1) ReDim sTipos(CamposIndice.Length - 1) For i = 0 To sCampos.Length - 1 sCampo = sCampos(i).Split(":")(0) If sCampo.Trim <> "" Then sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Select Case sTipo Case "SYSTEM.STRING" For j = 0 To CamposIndice.Length - 1 If sCampo.ToUpper = CamposIndice(j).ToUpper Then h += 1 sTipos(h - 1) = sTipo iInicio(h - 1) = iPosicion iLongitud(h - 1) = iLongitudCampo Exit For End If Next j iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" For j = 0 To CamposIndice.Length - 1 If sCampo.ToUpper = CamposIndice(j).ToUpper Then h += 1 sTipos(h - 1) = sTipo iInicio(h - 1) = iPosicion iLongitud(h - 1) = 25 Exit For End If Next j iPosicion += 25 Case "SYSTEM.DATETIME" iPosicion += 19 Case "SYSTEM.BOOLEAN" iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select If h = CamposIndice.Length Then Exit For End If Next End If Dim sValor As String Do If EOF(iFichero) Then Exit Do iPosicion = 0 sCadena = LineInput(iFichero) If Not IsNothing(CamposIndice) Then For j = 0 To CamposIndice.Length - 1 sValor = "" Select Case sTipos(j) Case "SYSTEM.STRING" 'If sSelect.Trim = "" Then ' sSelect = "(" & CamposIndice(j) & "='" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim & "'" 'Else ' sSelect &= " AND " & CamposIndice(j) & "='" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim & "'" 'End If sValor = "'" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim & "'" Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" 'If sSelect.Trim = "" Then ' sSelect = CamposIndice(j) & "=" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim 'Else ' sSelect &= " AND " & CamposIndice(j) & "=" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim 'End If sValor = sCadena.Substring(iInicio(j), iLongitud(j)).Trim Case Else Throw New Exception("Tipo del índice " & sTipos(j) & " no soportado") End Select sSelect = sSelect.Replace("$" & CamposIndice(j), sValor) Next j drIndice = Tabla.Select(sSelect) If drIndice.Length > 0 Then dr = drIndice(0) ' dr.Delete() ' dr = Tabla.NewRow Else dr = Tabla.NewRow End If Else dr = Tabla.NewRow End If For i = 0 To sCampos.Length - 1 If sCampos(i).Trim <> "" Then sCampo = sCampos(i).Split(":")(0) sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Select Case sTipo Case "SYSTEM.STRING" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = sCadena.Substring(iPosicion, iLongitudCampo).Trim iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = Val(sCadena.Substring(iPosicion, 25).Trim) iPosicion += 25 Case "SYSTEM.DATETIME" If Tabla.Columns.Contains(sCampo) Then sFecha = sCadena.Substring(iPosicion, 19).Trim If sFecha = "" Then dr(sCampo) = DBNull.Value Else iDia = sFecha.Split("/")(0) iMes = sFecha.Split("/")(1) iAño = sFecha.Split("/")(2).Split(" ")(0) iHora = sFecha.Split(" ")(1).Split(":")(0) iMinutos = sFecha.Split(" ")(1).Split(":")(1) iSegundos = sFecha.Split(" ")(1).Split(":")(2) dfecha = New Date(iAño, iMes, iDia, iHora, iMinutos, iSegundos) dr(sCampo) = dfecha End If End If iPosicion += 19 Case "SYSTEM.BOOLEAN" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = (sCadena.Substring(iPosicion, 1) = "V") iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select End If Next If IsNothing(drIndice) Then Tabla.Rows.Add(dr) Else If drIndice.Length = 0 Then Tabla.Rows.Add(dr) End If Loop Until EOF(iFichero) 'Adaptador.Update(Tabla) TSUpdate(Adaptador, Tabla) 'Tabla.AcceptChanges() FileClose(iFichero) Catch ex As Exception Throw New Exception(ex.Message, ex) 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") End Try End Sub Public Shared Sub TxtATabla(ByVal Tabla As DataTable, ByVal Adaptador As OleDb.OleDbDataAdapter, ByVal RutaFichero As String, Optional ByVal CamposIndice() As String = Nothing, Optional ByVal Roman8 As Boolean = False) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Pasa fichero txt a tabla ' Fecha. Creacion: ??? ' Creada por: manmog ' Ultima Modificacion: 02/10/2009 ' ' Modificaciones: ' =============== ' 02/10/2009 DANMUN Corrección en la incorporación de fechas Try Dim sCadena As String Dim iFichero As Integer = FreeFile() Dim sCampos(), sCampo As String, sTipo As String = "" Dim iLongitudCampo As Integer Dim i, j As Integer If Roman8 Then CharConverter("ROMAN8", "WINDOWS", RutaFichero) FileOpen(iFichero, RutaFichero, OpenMode.Input, OpenAccess.Read, OpenShare.LockReadWrite) sCadena = LineInput(iFichero) sCampos = Ttag(sCadena, "CAMPOS").ToString.Split(",") Dim iPosicion As Integer = 0 Dim dr As DataRow = Nothing, drIndice() As DataRow = Nothing Dim sFecha As String Dim iDia, iMes, iAño, iHora, iMinutos, iSegundos As Integer Dim dfecha As DateTime Dim iInicio() As Integer = Nothing, iLongitud() As Integer = Nothing Dim sTipos() As String = Nothing Dim sSelect As String = "" Dim sLongitudCampo As String Dim h As Integer = 0 If Not IsNothing(CamposIndice) Then iPosicion = 0 ReDim iInicio(CamposIndice.Length - 1) ReDim iLongitud(CamposIndice.Length - 1) ReDim sTipos(CamposIndice.Length - 1) For i = 0 To sCampos.Length - 1 sCampo = sCampos(i).Split(":")(0) If sCampo.Trim <> "" Then sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Select Case sTipo Case "SYSTEM.STRING" For j = 0 To CamposIndice.Length - 1 If sCampo.ToUpper = CamposIndice(j).ToUpper Then h += 1 sTipos(h - 1) = sTipo iInicio(h - 1) = iPosicion iLongitud(h - 1) = iLongitudCampo Exit For End If Next j iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" For j = 0 To CamposIndice.Length - 1 If sCampo.ToUpper = CamposIndice(j).ToUpper Then h += 1 sTipos(h - 1) = sTipo iInicio(h - 1) = iPosicion iLongitud(h - 1) = 25 Exit For End If Next j iPosicion += 25 Case "SYSTEM.DATETIME" iPosicion += 19 Case "SYSTEM.BOOLEAN" iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select If h = CamposIndice.Length Then Exit For End If Next End If Do If EOF(iFichero) Then Exit Do iPosicion = 0 sCadena = LineInput(iFichero) If Not IsNothing(CamposIndice) Then For j = 0 To CamposIndice.Length - 1 Select Case sTipos(j) Case "SYSTEM.STRING" If sSelect.Trim = "" Then sSelect = CamposIndice(j) & "='" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim & "'" Else sSelect &= " AND " & CamposIndice(j) & "='" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim & "'" End If Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" If sSelect.Trim = "" Then sSelect = CamposIndice(j) & "=" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim Else sSelect &= " AND " & CamposIndice(j) & "=" & sCadena.Substring(iInicio(j), iLongitud(j)).Trim End If Case Else Throw New Exception("Tipo del índice " & sTipos(j) & " no soportado") End Select drIndice = Tabla.Select(sSelect) If drIndice.Length > 0 Then dr = drIndice(0) ' dr.Delete() ' dr = Tabla.NewRow Else dr = Tabla.NewRow End If Next j Else dr = Tabla.NewRow End If For i = 0 To sCampos.Length - 1 If sCampos(i).Trim <> "" Then sCampo = sCampos(i).Split(":")(0) sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Select Case sTipo Case "SYSTEM.STRING" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = sCadena.Substring(iPosicion, iLongitudCampo).Trim iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = Val(sCadena.Substring(iPosicion, 25).Trim) iPosicion += 25 Case "SYSTEM.DATETIME" If Tabla.Columns.Contains(sCampo) Then sFecha = sCadena.Substring(iPosicion, 19).Trim.Replace("-", "/") If sFecha = "" Then dr(sCampo) = DBNull.Value Else 'iDia = sFecha.Split("/")(0) 'iMes = sFecha.Split("/")(1) 'iAño = sFecha.Split("/")(2).Split(" ")(0) 'iHora = sFecha.Split(" ")(1).Split(":")(0) 'iMinutos = sFecha.Split(" ")(1).Split(":")(1) 'iSegundos = sFecha.Split(" ")(1).Split(":")(2) iDia = sFecha.Substring(0, 2) iMes = sFecha.Substring(3, 2) iAño = sFecha.Substring(6, 4) iHora = sFecha.Substring(11, 2) iMinutos = sFecha.Substring(14, 2) iSegundos = sFecha.Substring(17, 2) dfecha = New Date(iAño, iMes, iDia, iHora, iMinutos, iSegundos) dr(sCampo) = dfecha End If End If iPosicion += 19 Case "SYSTEM.BOOLEAN" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = (sCadena.Substring(iPosicion, 1) = "V") iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select End If Next If IsNothing(drIndice) Then Tabla.Rows.Add(dr) Else If drIndice.Length = 0 Then Tabla.Rows.Add(dr) End If Loop Until EOF(iFichero) 'Adaptador.Update(Tabla) TSUpdate(Adaptador, Tabla) 'Tabla.AcceptChanges() FileClose(iFichero) Catch ex As Exception Throw New Exception(ex.Message, ex) 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") End Try End Sub Public Shared Function TxtATablaNueva(ByVal RutaFichero As String, Optional ByVal Roman8 As Boolean = False) As DataTable ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Pasa fichero txt a tabla nueva ' Fecha. Creacion: ??? ' Creada por: manmog ' Ultima Modificacion: 02/10/2009 ' ' Modificaciones: ' =============== ' 02/10/2009 DANMUN Corrección en la incorporación de fechas Try Dim sCadena As String Dim iFichero As Integer = FreeFile() Dim sCampos(), sCampo As String, sTipo As String = "" Dim iLongitudCampo As Integer Dim i As Integer If Roman8 Then CharConverter("ROMAN8", "WINDOWS", RutaFichero) FileOpen(iFichero, RutaFichero, OpenMode.Input, OpenAccess.Read, OpenShare.LockReadWrite) sCadena = LineInput(iFichero) sCampos = Ttag(sCadena, "CAMPOS").ToString.Split(",") Dim iPosicion As Integer = 0 Dim dr As DataRow = Nothing, drIndice() As DataRow = Nothing Dim sFecha As String Dim iDia, iMes, iAño, iHora, iMinutos, iSegundos As Integer Dim dfecha As DateTime Dim iInicio() As Integer = Nothing, iLongitud() As Integer = Nothing Dim sTipos() As String = Nothing Dim sSelect As String = "" Dim sLongitudCampo As String Dim Tabla As New DataTable Dim Columna As DataColumn = Nothing For i = 0 To sCampos.Length - 1 sCampo = sCampos(i).Split(":")(0) If sCampo.Trim <> "" Then sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Columna = New DataColumn(sCampo) Select Case sTipo Case "SYSTEM.STRING" Columna.DataType = GetType(System.String) Columna.MaxLength = iLongitudCampo iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE" Columna.DataType = GetType(System.Double) iPosicion += 25 Case "SYSTEM.DECIMAL" Columna.DataType = GetType(System.Decimal) iPosicion += 25 Case "SYSTEM.INT32" Columna.DataType = GetType(System.Int32) iPosicion += 25 Case "SYSTEM.INT16" Columna.DataType = GetType(System.Int16) iPosicion += 25 Case "SYSTEM.SINGLE" Columna.DataType = GetType(System.Single) iPosicion += 25 Case "SYSTEM.DATETIME" Columna.DataType = GetType(System.DateTime) iPosicion += 19 Case "SYSTEM.BOOLEAN" Columna.DataType = GetType(System.Boolean) iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select Tabla.Columns.Add(Columna) End If Next Do If EOF(iFichero) Then Exit Do iPosicion = 0 sCadena = LineInput(iFichero) dr = Tabla.NewRow For i = 0 To sCampos.Length - 1 If sCampos(i).Trim <> "" Then sCampo = sCampos(i).Split(":")(0) sTipo = sCampos(i).Split(":")(1).Split("(")(0) sLongitudCampo = sCampos(i).Split(":")(1).Split("(")(1).Split(")")(0) If sLongitudCampo.Contains(";") Then sLongitudCampo = sLongitudCampo.Split(";")(1) iLongitudCampo = Val(sLongitudCampo) Select Case sTipo Case "SYSTEM.STRING" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = sCadena.Substring(iPosicion, iLongitudCampo).Trim iPosicion += iLongitudCampo Case "SYSTEM.DOUBLE", "SYSTEM.DECIMAL", "SYSTEM.INT32", "SYSTEM.INT16", "SYSTEM.SINGLE" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = Val(sCadena.Substring(iPosicion, 25).Trim) iPosicion += 25 Case "SYSTEM.DATETIME" If Tabla.Columns.Contains(sCampo) Then sFecha = sCadena.Substring(iPosicion, 19).Trim If sFecha = "" Then dr(sCampo) = DBNull.Value Else iDia = sFecha.Substring(0, 2) iMes = sFecha.Substring(3, 2) iAño = sFecha.Substring(6, 4) iHora = sFecha.Substring(11, 2) iMinutos = sFecha.Substring(14, 2) iSegundos = sFecha.Substring(17, 2) dfecha = New Date(iAño, iMes, iDia, iHora, iMinutos, iSegundos) dr(sCampo) = dfecha End If End If iPosicion += 19 Case "SYSTEM.BOOLEAN" If Tabla.Columns.Contains(sCampo) Then dr(sCampo) = (sCadena.Substring(iPosicion, 1) = "V") iPosicion += 1 Case "SYSTEM.BYTE[]" Case Else Throw New Exception("Tipo " & sTipo & " no soportado") End Select End If Next Tabla.Rows.Add(dr) Loop Until EOF(iFichero) FileClose(iFichero) Return Tabla Catch ex As Exception Throw New Exception(ex.Message, ex) 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "TablaATxt") End Try End Function Public Shared Function ListaFicherosPorFecha(ByVal Directorio As String, ByVal searchPattern As String) As ArrayList Dim sFicheros(), Fecha, Fichero As String Dim alFichFecha As New ArrayList Dim alFicheros As New ArrayList Dim i As Integer Try alFichFecha.Clear() sFicheros = Directory.GetFiles(Directorio, searchPattern) For Each Fichero In sFicheros Fecha = File.GetLastWriteTime(Fichero).ToFileTime alFichFecha.Add(Fecha.ToString & "|" & Fichero) Next alFichFecha.Sort() alFicheros.Clear() For i = 0 To alFichFecha.Count - 1 Fichero = alFichFecha(i).ToString.Split("|")(1) alFicheros.Add(Fichero) Next Return alFicheros Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function Public Shared Function MesEnCastellano(ByVal Fecha As Date) As String Dim sMeses(11) As String sMeses(0) = "Enero" sMeses(1) = "Febrero" sMeses(2) = "Marzo" sMeses(3) = "Abril" sMeses(4) = "Mayo" sMeses(5) = "Junio" sMeses(6) = "Julio" sMeses(7) = "Agosto" sMeses(8) = "Septiembre" sMeses(9) = "Octubre" sMeses(10) = "Noviembre" sMeses(11) = "Diciembre" MesEnCastellano = sMeses(Now.Month - 1) End Function Public Shared Function CodTecnosis(ByVal CadenaACod As String) As String Dim i As Integer, lSumaCaracter As Long For i = 1 To Len(CadenaACod) lSumaCaracter = lSumaCaracter + Asc(Mid$(CadenaACod, i, 1)) Next CodTecnosis = ((Math.Sqrt((lSumaCaracter) / 13) * 100)) CodTecnosis = Int((CodTecnosis - (Int(CodTecnosis))) * 1000000.0) End Function Public Shared Sub TSFillSchema(ByVal Adaptador As System.Data.Common.DbDataAdapter, ByVal Datos As DataSet, ByVal TipoEsquema As SchemaType, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) If Adaptador.GetType Is GetType(OleDbDataAdapter) Then Dim ad As OleDbDataAdapter = Adaptador TSFillSchema(ad, Datos, TipoEsquema, NombreTabla, MiliSegundosReintentos) ElseIf Adaptador.GetType Is GetType(MySqlDataAdapter) Then Dim ad As MySqlDataAdapter = Adaptador TSFillSchemaMySQL(ad, Datos, TipoEsquema, NombreTabla, 2500) Else Throw New Exception("Tipo no soportado.") End If End Sub Public Shared Sub TSFillSchema(ByVal Adaptador As OleDbDataAdapter, ByVal Datos As DataSet, ByVal TipoEsquema As SchemaType, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try Do Try sw.Start() Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") Adaptador.FillSchema(Datos, TipoEsquema, NombreTabla) Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else 'Throw ex Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSFillSchema(ByVal Adaptador As SqlDataAdapter, ByVal Datos As DataSet, ByVal TipoEsquema As SchemaType, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") Do Try sw.Start() Adaptador.FillSchema(Datos, TipoEsquema, NombreTabla) Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSFillSchemaMySQL(ByVal Adaptador As MySqlDataAdapter, ByVal Datos As DataSet, ByVal TipoEsquema As SchemaType, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") Do Try sw.Start() Adaptador.FillSchema(Datos, TipoEsquema, NombreTabla) Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub 'Public Shared Sub TSFill(ByVal Adaptador As OleDbDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) ' Dim sw As New Stopwatch ' Try ' sw.Start() ' Do ' Try ' Adaptador.Fill(Datos, NombreTabla) ' Exit Do ' Catch ex As OleDb.OleDbException ' If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then ' If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) ' Else ' 'Throw ex ' Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) ' End If ' System.Threading.Thread.Sleep(100) ' Application.DoEvents() ' End Try ' Loop ' Finally ' Try ' sw.Stop() ' Catch ex As Exception ' End Try ' End Try 'End Sub Public Shared Sub TSFill(ByVal Adaptador As System.Data.Common.DbDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) If Adaptador.GetType Is GetType(OleDbDataAdapter) Then Dim ad As OleDbDataAdapter = Adaptador TSFill(ad, Datos, NombreTabla, MiliSegundosReintentos) ElseIf Adaptador.GetType Is GetType(MySqlDataAdapter) Then Dim ad As MySqlDataAdapter = Adaptador TSFillMySQL(ad, Datos, NombreTabla, 2500) Else Throw New Exception("Tipo no soportado") End If End Sub Public Shared Sub TSFill(ByVal Adaptador As OleDbDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try sw.Start() ' Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") Do Try Adaptador.Fill(Datos, NombreTabla) Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else 'Throw ex Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Catch ex As Exception Dim sCommandText As String = "" Try sCommandText = Adaptador.SelectCommand.CommandText Catch ex2 As Exception End Try Throw New Exception(ex.Message & vbCrLf & "Adaptador.Selectcommand.Commandtext= " & sCommandText & " Adaptador Nothing=" & (Adaptador Is Nothing).ToString & " Datos Nothing=" & (Datos Is Nothing).ToString & " NombreTabla = " & NombreTabla) Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSFill(ByVal Adaptador As SqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try Adaptador.Fill(Datos, NombreTabla) Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Catch ex As Exception Dim sCommandText As String = "" Try sCommandText = Adaptador.SelectCommand.CommandText Catch ex2 As Exception End Try Throw New Exception(ex.Message & vbCrLf & "Adaptador.Selectcommand.Commandtext= " & sCommandText & " Adaptador Nothing=" & (Adaptador Is Nothing).ToString & " Datos Nothing=" & (Datos Is Nothing).ToString & " NombreTabla = " & NombreTabla) Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSFillMySQL(ByVal Adaptador As MySqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch 'Dim bErrorConstraint As Boolean Try Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try Adaptador.Fill(Datos, NombreTabla) Exit Do Catch ex As System.Data.ConstraintException ' COMENTADO ESTO PORQUE AUNQUE DA ERROR LLENA LA TABLA 'If Not bErrorConstraint Then ' bErrorConstraint = True ' Adaptador.FillSchema(Datos, SchemaType.Mapped, NombreTabla) 'Else Throw ex 'End If Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Catch ex As Exception Dim sCommandText As String = "" Try sCommandText = Adaptador.SelectCommand.CommandText Catch ex2 As Exception End Try Throw New Exception(ex.Message & vbCrLf & "Adaptador.Selectcommand.Commandtext= " & sCommandText & " Adaptador Nothing=" & (Adaptador Is Nothing).ToString & " Datos Nothing=" & (Datos Is Nothing).ToString & " NombreTabla = " & NombreTabla) Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Overloads Shared Sub TSUpdateConTransaccion(ByVal Conexion As OleDbConnection, ByVal Adaptador As OleDbDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch, bCerrar, bTransaccionIniciada As Boolean Dim ts As OleDb.OleDbTransaction = Nothing Try sw.Start() Do Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") If Conexion.State = ConnectionState.Closed Then Conexion.Open() bCerrar = True End If ts = Conexion.BeginTransaction Adaptador.SelectCommand.Transaction = ts If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.Transaction = ts If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.Transaction = ts If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.Transaction = ts bTransaccionIniciada = True Adaptador.Update(Datos, NombreTabla) ts.Commit() Exit Do Catch ex As OleDb.OleDbException If bTransaccionIniciada Then ts.Rollback() End If If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally If bCerrar Then Try Conexion.Close() Catch ex As Exception End Try End If Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Overloads Shared Sub TSUpdateConTransaccion(ByVal Conexion As SqlConnection, ByVal Adaptador As SqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch, bCerrar, bTransaccionIniciada As Boolean Dim ts As SqlTransaction = Nothing Try If Not IsNothing(Adaptador.SelectCommand) Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try If Conexion.State = ConnectionState.Closed Then Conexion.Open() bCerrar = True End If ts = Conexion.BeginTransaction Adaptador.SelectCommand.Transaction = ts If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.Transaction = ts If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.Transaction = ts If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.Transaction = ts bTransaccionIniciada = True Adaptador.Update(Datos, NombreTabla) ts.Commit() Exit Do Catch ex As Exception If bTransaccionIniciada Then ts.Rollback() End If If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally If bCerrar Then Try Conexion.Close() Catch ex As Exception End Try End If Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Overloads Shared Sub TSUpdateConTransaccionMySQL(ByVal Conexion As MySqlConnection, ByVal Adaptador As MySqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch, bCerrar, bTransaccionIniciada As Boolean Dim ts As MySqlTransaction = Nothing Try If Not IsNothing(Adaptador.SelectCommand) Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try If Conexion.State = ConnectionState.Closed Then Conexion.Open() bCerrar = True End If ts = Conexion.BeginTransaction Adaptador.SelectCommand.Transaction = ts If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.Transaction = ts If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.Transaction = ts If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.Transaction = ts bTransaccionIniciada = True Adaptador.Update(Datos, NombreTabla) ts.Commit() Exit Do Catch ex As Exception If bTransaccionIniciada Then ts.Rollback() End If If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally If bCerrar Then Try Conexion.Close() Catch ex As Exception End Try End If Try sw.Stop() Catch ex As Exception End Try End Try End Sub Overloads Shared Sub TSUpdate(ByVal Adaptador As System.Data.Common.DataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) If Adaptador.GetType Is GetType(OleDbDataAdapter) Then Dim ad As OleDbDataAdapter = Adaptador TSUpdate(ad, Datos, NombreTabla, MiliSegundosReintentos) ElseIf Adaptador.GetType Is GetType(MySqlDataAdapter) Then Dim ad As MySqlDataAdapter = Adaptador TSUpdateMySQL(ad, Datos, NombreTabla, 2500) Else Throw New Exception("Tipo no soportado") End If End Sub Overloads Shared Sub TSUpdate(ByVal Adaptador As OleDbDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try sw.Start() Do Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") Adaptador.Update(Datos, NombreTabla) Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Overloads Shared Sub TSUpdate(ByVal Adaptador As SqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try Adaptador.Update(Datos, NombreTabla) Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Overloads Shared Sub TSUpdateMySQL(ByVal Adaptador As MySqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try Adaptador.Update(Datos, NombreTabla) Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Friend Overloads Shared Sub TSUpdateConTransaccion(ByVal Conexion As OleDbConnection, ByVal Adaptador As OleDbDataAdapter, ByVal Tabla As System.Data.DataTable, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch, bCerrar, bTransaccionIniciada As Boolean Dim ts As OleDb.OleDbTransaction = Nothing Try sw.Start() Do Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") If Conexion.State = ConnectionState.Closed Then Conexion.Open() bCerrar = True End If Conexion.BeginTransaction() bTransaccionIniciada = True Adaptador.SelectCommand.Transaction = ts If Not IsNothing(Adaptador.UpdateCommand) Then Adaptador.UpdateCommand.Transaction = ts If Not IsNothing(Adaptador.InsertCommand) Then Adaptador.InsertCommand.Transaction = ts If Not IsNothing(Adaptador.DeleteCommand) Then Adaptador.DeleteCommand.Transaction = ts Adaptador.Update(Tabla) Exit Do Catch ex As Exception If bTransaccionIniciada Then ts.Rollback() End If If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally If bCerrar Then Try Conexion.Close() Catch ex As Exception End Try End If Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Overloads Shared Sub TSUpdate(ByVal Adaptador As OleDbDataAdapter, ByVal Tabla As System.Data.DataTable, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try sw.Start() Do Try If Not Adaptador.SelectCommand Is Nothing Then Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.UpdateCommand Is Nothing Then Adaptador.UpdateCommand.CommandText = Adaptador.UpdateCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.InsertCommand Is Nothing Then Adaptador.InsertCommand.CommandText = Adaptador.InsertCommand.CommandText.Replace(Chr(34), "'") If Not Adaptador.DeleteCommand Is Nothing Then Adaptador.DeleteCommand.CommandText = Adaptador.DeleteCommand.CommandText.Replace(Chr(34), "'") Adaptador.Update(Tabla) Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSOpen(ByVal bd As OleDbConnection, Optional ByVal MiliSegundosReintentos As Integer = 20000) Dim sw As New Stopwatch Try sw.Start() Do Try bd.Open() Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSOpen(ByVal bd As SqlConnection, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try sw.Start() Do Try bd.Open() Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSOpenMySQL(ByVal bd As MySqlConnection) bd.Open() End Sub Public Shared Sub TSClose(ByVal bd As OleDbConnection, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try sw.Start() Do Try bd.Close() Exit Do Catch ex As OleDb.OleDbException If EsErrorTipoBloqueo(ex.Errors(0).NativeError) Then If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw New Exception("TS:TiempoSobrepasado|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) Else Throw New Exception("OledDbException|NativeError:" & ex.Errors(0).NativeError.ToString & "|" & ex.Message, ex) End If System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSClose(ByVal bd As SqlConnection, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try sw.Start() Do Try bd.Close() Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Public Shared Sub TSCloseMYSQL(ByVal bd As MySqlConnection, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Try sw.Start() Do Try bd.Close() Exit Do Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub Private Shared Function EsErrorTipoBloqueo(ByVal NumeroError As Integer) As Boolean EsErrorTipoBloqueo = NumeroError = -72156238 Or NumeroError = -67503111 Or NumeroError = -544083682 Or NumeroError = -69338147 Or NumeroError = -536544438 Or NumeroError = -544083682 Or NumeroError = -249630434 End Function Public Shared Sub AñadeStringACola(ByRef Matriz() As String, ByVal NuevoElemento As String) If IsNothing(Matriz) Then ReDim Matriz(0) Matriz(0) = NuevoElemento Else ReDim Preserve Matriz(Matriz.Length) Matriz(Matriz.Length - 1) = NuevoElemento End If End Sub Public Shared Function FechaHoraAString(ByVal Fecha As DateTime) As String 'Return Fecha.Year & "_" & Fecha.Month & "_" & Fecha.Day & "_" & Fecha.Hour & "_" & Fecha.Minute & "_" & Fecha.Second Return Fecha.Year & "_" & Fecha.Month.ToString.PadLeft(2, "0") & "_" & Fecha.Day.ToString.PadLeft(2, "0") & "_" & Fecha.Hour.ToString.PadLeft(2, "0") & "_" & Fecha.Minute.ToString.PadLeft(2, "0") & "_" & Fecha.Second.ToString.PadLeft(2, "0") End Function Public Shared Function StringAFechaHora(ByVal Fecha As String) As DateTime Dim sValores() As String = Fecha.Split("_") Dim dFecha As DateTime dFecha = New DateTime(sValores(0), sValores(1), sValores(2), sValores(3), sValores(4), sValores(5)) Return dFecha End Function Public Shared Function StringToStream(ByVal str As String) As System.IO.Stream Return New System.IO.MemoryStream(System.Text.Encoding.Default.GetBytes(str)) End Function Public Shared Function GetWinVersion() As String Dim SO_info As OperatingSystem SO_info = OSVersion With SO_info Select Case .Platform Case .Platform.Win32Windows Select Case (.Version.Minor) Case 0 GetWinVersion = "Windows 95" Case 10 If .Version.Revision.ToString() = "2222A" Then GetWinVersion = "Windows 98 SE" Else GetWinVersion = "Windows 98" End If Case 90 GetWinVersion = "Windows ME" Case Else GetWinVersion = "Desconocido" End Select Case .Platform.Win32NT Select Case (.Version.Major) Case 3 GetWinVersion = "Windows NT 3.51" Case 4 GetWinVersion = "Windows NT 4.0" Case 5 If .Version.Minor = 0 Then GetWinVersion = "Windows 2000" Else GetWinVersion = "Windows XP" End If Case 6 GetWinVersion = "Windows Vista" Case Else GetWinVersion = "Superior" End Select Case Else GetWinVersion = "S.O desconocido" End Select End With End Function Public Shared Function StringToHex(ByVal text As String) As String Dim shex As String = "" For i As Integer = 0 To text.Length - 1 shex &= Asc(text.Substring(i, 1)).ToString("x").ToUpper Next Return shex End Function Public Shared Function HexToString(ByVal hex As String) As String Dim text As New System.Text.StringBuilder(hex.Length \ 2) For i As Integer = 0 To hex.Length - 2 Step 2 text.Append(Chr(Convert.ToByte(hex.Substring(i, 2), 16))) Next Return text.ToString End Function Public Shared Function EnumToArrayString(ByVal tipo As Type) As String() Dim info() As System.Reflection.FieldInfo = tipo.GetFields() Dim inf As System.Reflection.FieldInfo Dim campos As New ArrayList For Each inf In info campos.Add(inf.Name) Next Return campos.ToArray End Function Public Shared Function EliminaElementoMatrizStrings(ByVal MatrizStrings() As String, ByVal ElementoAEliminar As Integer) As String() Dim NuevaMatriz(MatrizStrings.Length - 2) As String Dim i, j As Integer For i = 0 To MatrizStrings.Length - 1 If i <> ElementoAEliminar Then NuevaMatriz(j) = MatrizStrings(i) j += 1 End If Next Return NuevaMatriz End Function Public Shared Function ObtieneNumeroFicheros(ByVal Directory As String) As Integer Dim FileCount As Integer = 0 Dim SubDirectory() As String Dim i As Integer FileCount = System.IO.Directory.GetFiles(Directory).Length SubDirectory = System.IO.Directory.GetDirectories(Directory) For i = 0 To SubDirectory.Length - 1 FileCount = ObtieneNumeroFicheros(SubDirectory(i)) + FileCount Next Return FileCount End Function Public Shared Function NuevoAdaptador(ByVal CadenaSQL As String, ByVal Conexion As System.Data.Common.DbConnection) As System.Data.Common.DbDataAdapter If Conexion.GetType Is GetType(OleDbConnection) Then Return New OleDbDataAdapter(CadenaSQL, Conexion) ElseIf Conexion.GetType Is GetType(MySqlConnection) Then Return New MySqlDataAdapter(CadenaSQL, Conexion) Else Throw New Exception("Tipo no soportado.") End If End Function Public Shared Function NuevoCommandBuilder(ByVal Adaptador As System.Data.Common.DbDataAdapter, CampoAutonumericoTraspasado As String) As System.Data.Common.DbCommandBuilder If Adaptador.GetType Is GetType(OleDbDataAdapter) Then Return New OleDb.OleDbCommandBuilder(Adaptador) ElseIf Adaptador.GetType Is GetType(MySqlDataAdapter) Then Dim cb As New MySqlCommandBuilder(Adaptador) If CampoAutonumericoTraspasado <> "" Then ' Try Dim ic As New MySqlCommand ic = cb.GetInsertCommand.Clone ic.CommandText &= ";SELECT last_insert_id() as " & CampoAutonumericoTraspasado ic.UpdatedRowSource = UpdateRowSource.FirstReturnedRecord Adaptador.InsertCommand = ic 'Catch ex As Exception ' Adaptador.InsertCommand.CommandText &= "SELECT last_insert_id() as " & CampoAutonumericoTraspasado ' Adaptador.InsertCommand.UpdatedRowSource = UpdateRowSource.FirstReturnedRecord 'End Try End If Return cb Else Throw New Exception("Tipo no soportado.") End If End Function Public Shared Sub CharConverter(ByVal jcOrigen As String, ByVal jcDestino As String, ByVal Fichero_Origen As String, Optional ByVal Fichero_Destino As String = "") Try Dim Temporal As String = Fichero_Origen & ".tmp" Dim sBuffer As String Dim i, pos, fr, fw As Integer Dim Size As Long = FileLen(Fichero_Origen) Dim cAux(), cOrigen(), cDestino() As Char 'Inicializamos los juegos de caracteres origen y destino Select Case jcOrigen.ToUpper Case "WINDOWS" cOrigen = WINDOWS Case "ROMAN8" cOrigen = ROMAN8 Case "ROMAN8SA" cOrigen = ROMAN8SA Case Else ' MsgBox("Juegos de caracteres origen erróneo o no soportado.") ' Exit Sub Throw New Exception("Juego de caracteres origen erróneo.") End Select Select Case jcDestino.ToUpper Case "WINDOWS" cDestino = WINDOWS Case "ROMAN8" cDestino = ROMAN8 Case "ROMAN8SA" cDestino = ROMAN8SA Case Else Throw New Exception("Juego de caracteres destino erróneo.") 'MsgBox("Juegos de caracteres destino erróneo o no soportado.") 'Exit Sub End Select 'Abrimos Origen y Destino fr = FreeFile() fw = fr + 1 FileOpen(fr, Fichero_Origen, OpenMode.Input, OpenAccess.Read) FileOpen(fw, Temporal, OpenMode.Output, OpenAccess.Write) 'Guardamos el contenido del fichero en un Buffer sBuffer = InputString(fr, Size) 'Reemplazamos los caracteres especiales en Windows UTF8 por sus correspondientes en Roman8 cAux = sBuffer For i = 0 To NumChar - 1 pos = 0 Do pos = InStr(pos + 1, sBuffer, cOrigen(i), CompareMethod.Binary) If pos > 0 Then cAux(pos - 1) = cDestino(i) End If Loop Until pos = 0 Next sBuffer = cAux Print(fw, sBuffer) 'Cerramos los ficheros FileClose(fr, fw) 'Si el destino no viene especificado es que tomaremos el origen como destino 'y usaremos como destino para el proceso un fichero temporal If Fichero_Destino = "" Then File.Copy(Temporal, Fichero_Origen, True) Else File.Copy(Temporal, Fichero_Destino, True) End If 'Borramos el fichero temporal File.Delete(Temporal) Catch ex As Exception 'MsgBox(ex.Message, , "Error") Throw New Exception(ex.Message) End Try End Sub Public Shared Function LeeRegistrosSQLSQLServer(ByVal Conexion As SqlConnection, ByVal Clausula_SQL As String, Optional ByVal Sin_Errores As Boolean = True, Optional ByVal NombreDataset As String = "DATASET", Optional ByVal NombreTabla As String = "TABLA") As DataTable LeeRegistrosSQLSQLServer = Nothing Try Dim adAdaptador As SqlDataAdapter, dsDatos As New DataSet(NombreDataset) If Not Clausula_SQL.EndsWith(";") Then Clausula_SQL &= ";" Clausula_SQL = Clausula_SQL.Replace(Chr(34), "'") adAdaptador = New SqlDataAdapter(Clausula_SQL, Conexion) 'If Clausula_SQL.ToLower.StartsWith("select * from") Then TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, NombreTabla) TSFillSchema(adAdaptador, dsDatos, SchemaType.Mapped, NombreTabla) TSFillSQLServer(adAdaptador, dsDatos, NombreTabla) LeeRegistrosSQLSQLServer = dsDatos.Tables(0) Catch ex As Exception If Sin_Errores Or EsServicio Then Throw New Exception(ex.Message & vbCrLf & "SQL: " & Clausula_SQL) Else MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Lee_Registros_SQL") End If End Try End Function Public Shared Sub TSFillSQLServer(ByVal Adaptador As SqlDataAdapter, ByVal Datos As DataSet, ByVal NombreTabla As String, Optional ByVal MiliSegundosReintentos As Integer = 2500) Dim sw As New Stopwatch Dim bErrorConstraint As Boolean Try Adaptador.SelectCommand.CommandText = Adaptador.SelectCommand.CommandText.Replace(Chr(34), "'") sw.Start() Do Try Adaptador.Fill(Datos, NombreTabla) Exit Do Catch ex As System.Data.ConstraintException If Not bErrorConstraint Then bErrorConstraint = True Adaptador.FillSchema(Datos, SchemaType.Mapped, NombreTabla) Else Throw ex End If Catch ex As Exception If sw.ElapsedMilliseconds > MiliSegundosReintentos Then Throw ex System.Threading.Thread.Sleep(100) Application.DoEvents() End Try Loop Catch ex As Exception Dim sCommandText As String = "" Try sCommandText = Adaptador.SelectCommand.CommandText Catch ex2 As Exception End Try Throw New Exception(ex.Message & vbCrLf & "Adaptador.Selectcommand.Commandtext= " & sCommandText & " Adaptador Nothing=" & (Adaptador Is Nothing).ToString & " Datos Nothing=" & (Datos Is Nothing).ToString & " NombreTabla = " & NombreTabla) Finally Try sw.Stop() Catch ex As Exception End Try End Try End Sub End Class