Comunes/tsl5
10
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
840c215d28375f1e93cce9e42190209df0790bac
tsl5/clFuncionesGenericas.vb
manuel f8102dd7f1 Agregar archivos de proyecto.
2026-05-14 09:52:12 +02:00

3886 lines
191 KiB
VB.net
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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
<System.Diagnostics.DebuggerStepThrough()> 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 <xx>
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
Reference in New Issue View Git Blame Copy Permalink