#Region "IMPORTS - REFERENCIAS" Imports System.Data.SqlClient ' >> .NET >> System.data Imports System.Data.OleDb #End Region Public Class BD #Region "VARIABLES" Public Conex As SqlConnection, SqlComm As SqlCommand, SqlComm2 As SqlCommand, CadenaConex As String Private DyC_RS As Dictionary(Of Integer, SqlDataReader) #End Region Public Sub New(StrServidor As String, _ StrBaseDatos As String, _ StrUsuario As String, _ StrPass As String, _ Optional StrUbicacion As String = "") _sError = "" _Servidor = StrServidor : _BaseDatos = StrBaseDatos : _Usuario = StrUsuario : _Pass = StrPass _Ubicacion = StrUbicacion CadenaConex = "server=" & _Servidor & ";uid=" & _Usuario & ";pwd=" & _Pass & ";database=" & _BaseDatos ' _BDAbierta = False _VersionSQL = DameVersionSQL() End Sub #Region "PROPIEDADES" Private _Ubicacion As String Public Property Ubicacion() As String Get Return _Ubicacion End Get Set(ByVal value As String) _Ubicacion = value End Set End Property Private _Servidor As String Public Property Servidor() As String Get Return _Servidor End Get Set(ByVal value As String) _Servidor = value End Set End Property Private _VersionSQL As String Public Property VersionSQL() As String Get Return _VersionSQL End Get Set(ByVal value As String) _VersionSQL = value End Set End Property Private _BaseDatos As String Public Property BaseDatos() As String Get Return _BaseDatos End Get Set(ByVal value As String) _BaseDatos = value End Set End Property Private _Usuario As String Public Property Usuario() As String Get Return _Usuario End Get Set(ByVal value As String) _Usuario = value End Set End Property Private _Pass As String Public Property Pass() As String Get Return _Pass End Get Set(ByVal value As String) _Pass = value End Set End Property Private _Sql As String Public Property Sql() As String Get Return _Sql End Get Set(ByVal value As String) _Sql = value End Set End Property Private _Tabla As String Public Property Tabla() As String Get Return _Tabla End Get Set(ByVal value As String) _Tabla = value End Set End Property Private _RutaFichero As String Public Property RutaFichero() As String Get Return _RutaFichero End Get Set(ByVal value As String) _RutaFichero = value End Set End Property Private _Fichero As String Public Property Fichero() As String Get Return _Fichero End Get Set(ByVal value As String) _Fichero = value End Set End Property Private _BDAbierta As Boolean Public Property BDAbierta() As Boolean Get Return _BDAbierta End Get Set(ByVal value As Boolean) _BDAbierta = value End Set End Property Private _sError As String Public Property sError() As String Get Return _sError End Get Set(ByVal value As String) _sError = value End Set End Property #End Region #Region "MÉTODOS PÚBLICOS" Public Sub Abrir() Try Conex = New SqlConnection(CadenaConex) Conex.Open() _BDAbierta = True 'If _VersionSQL = "" Then _VersionSQL = DameVersionSQL() Catch ex As Exception _sError = "BD.Abrir() : " & ex.Message _BDAbierta = False End Try End Sub Public Sub Cerrar() Try Conex.Close() Conex = Nothing _BDAbierta = False Catch ex As Exception _sError = "BD.Cerrar() : " & ex.Message End Try End Sub Public Sub CambiarBD(StrBD As String) Try Conex.ChangeDatabase(StrBD) Catch ex As Exception _sError = "BD.CambiarBD() : " & ex.Message End Try End Sub ''' ''' Ejecutar Sentencia SQL,Previamente hay que dar valor a la Variable BD.SQL con la Sentencia a Ejecutar ''' ''' ''' Public Sub EjecutaSQL(Optional sSQL As String = "", Optional TiempoEspera As Integer = 500) If sSQL = "" Then sSQL = _Sql Try SqlComm = New SqlCommand(sSQL) SqlComm.Connection = Conex SqlComm.CommandTimeout = TiempoEspera SqlComm.ExecuteNonQuery() Catch ex As Exception _sError = "BD.EjecutaSQL() : " & ex.Message End Try SqlComm.Dispose() : SqlComm = Nothing End Sub '******************** DATA READER Public Function CrearDReader(StrSql) As SqlDataReader CrearDReader = Nothing Try SqlComm = New SqlCommand(StrSql, Conex) CrearDReader = SqlComm.ExecuteReader Catch ex As Exception _sError = "BD.CrearDReader() : " & ex.Message End Try SqlComm.Dispose() : SqlComm = Nothing End Function Public Sub CerrarDReader(oReader As SqlDataReader) oReader.Close() : oReader = Nothing End Sub '********************* DATA TABLE Public Function CrearDTable(StrSql As String) As DataTable Dim SqlAdapter As New SqlDataAdapter() SqlComm = New SqlCommand(StrSql) SqlComm.Connection = Conex SqlAdapter.SelectCommand = SqlComm CrearDTable = New DataTable Try SqlAdapter.Fill(CrearDTable) Catch ex As Exception _sError = "BD.CrearDTable() : " & ex.Message End Try SqlAdapter.Dispose() SqlComm.Dispose() : SqlComm = Nothing End Function Public Sub CerrarDTable(oDTable As DataTable) oDTable.Dispose() : oDTable = Nothing End Sub ''' ''' Importa Fichero de Texto a Tabla SQL Opcional usar Fichero de Formato FMT ''' ''' Opcional,Si es true Truca la Tabla SQL de destino ''' Fila de inicio en el Txt ''' Opciona,Ruta del Fichero de Formato FMT ''' Public Sub ImportarFichero(Optional bBorrar As Boolean = True, Optional FilaIni As Integer = 2, Optional FicheroFormato As String = "") Try If bBorrar Then _Sql = "TRUNCATE TABLE " & _Tabla EjecutaSQL() : If _sError <> "" Then Exit Sub End If _Sql = "BULK INSERT " & _Tabla & " " _Sql = _Sql & "FROM " & "'" & _RutaFichero & _Fichero & "' " If FicheroFormato = "" Then _Sql = _Sql & "WITH (ROWTERMINATOR ='\n',FIRSTROW = " & FilaIni & ")" Else _Sql = _Sql & "WITH (FIRSTROW = " & FilaIni & ",FORMATFILE = '" & FicheroFormato & "')" End If EjecutaSQL() Catch ex As Exception _sError = "BD.ImportarFichero() : " & ex.Message End Try End Sub Public Sub ImportarAccess(sBDAccess As String, TablaAccess As String, TablaSQL As String, Optional bBorrar As Boolean = False) Dim Tabla As DataTable = New DataTable Dim AccessConex As OleDb.OleDbConnection Dim AccessAdapter As OleDb.OleDbDataAdapter Dim StrConex As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sBDAccess & ";" AccessConex = New OleDb.OleDbConnection(StrConex) Try If bBorrar Then EjecutaSQL("TRUNCATE TABLE " & TablaSQL) If _sError <> "" Then Exit Sub AccessConex.Open() AccessAdapter = New OleDb.OleDbDataAdapter("SELECT * FROM " & TablaAccess, AccessConex) AccessAdapter.Fill(Tabla) AccessConex.Close() : AccessConex = Nothing Dim bulkCopy As SqlBulkCopy = New SqlBulkCopy(Conex) bulkCopy.DestinationTableName = TablaSQL bulkCopy.BulkCopyTimeout = 900 'For Each Col As SqlBulkCopyColumnMapping In bulkCopy.ColumnMappings ' Debug.Print(Col.SourceColumn.ToString) 'Next bulkCopy.WriteToServer(Tabla) Catch ex As Exception _sError = "BD.ImportarAccess() : " & ex.Message End Try End Sub Public Sub ImportarExcel(RutaExcel As String, FicExcel As String, HojaExcel As String, TablaSQL As String, Optional bBorrar As Boolean = False) Dim Tabla As DataTable = New DataTable Dim ExcelConex As New OleDb.OleDbConnection Dim ExcelAdapter As OleDb.OleDbDataAdapter 'Dim StrConex As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & RutaExcel & FicExcel & ";Extended Properties=""Excel 8.0;" 'Dim StrConex As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ ' "Data Source= " & RutaExcel & FicExcel & _ ' ";Extended Properties=""Excel 8.0;""" Dim StrConex As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & RutaExcel & FicExcel & ";Extended Properties=Excel 8.0;" 'ExcelConex.ConnectionString = StrConex ExcelConex = New OleDb.OleDbConnection(StrConex) Try If bBorrar Then EjecutaSQL("TRUNCATE TABLE " & TablaSQL) If _sError <> "" Then Exit Sub ExcelConex.Open() ExcelAdapter = New OleDb.OleDbDataAdapter("SELECT * FROM " & HojaExcel, ExcelConex) ExcelAdapter.Fill(Tabla) ExcelConex.Close() : ExcelConex = Nothing Dim bulkCopy As SqlBulkCopy = New SqlBulkCopy(Conex) bulkCopy.DestinationTableName = TablaSQL bulkCopy.BulkCopyTimeout = 900 'For Each Col As SqlBulkCopyColumnMapping In bulkCopy.ColumnMappings ' Debug.Print(Col.SourceColumn.ToString) 'Next bulkCopy.WriteToServer(Tabla) Catch ex As Exception _sError = "BD.ImportarExcel() : " & ex.Message End Try End Sub 'Public Function CrearDSet(StrSql As String) As DataSet ' Dim adapter As New SqlDataAdapter() ' adapter.TableMappings.Add("Table", "TEMP_PELICULAS") ' SqlComm = New SqlCommand(StrSql) ' SqlComm.Connection = Conn ' adapter.SelectCommand = SqlComm ' CrearDSet = New DataSet("TEMP_PELICULAS") ' adapter.Fill(CrearDSet) 'End Function #End Region #Region "MÉTODOS PRIVADOS" Private Function DameVersionSQL() As String On Error GoTo TrataError Dim StrVersion As String Dim oRs As SqlDataReader Abrir() _Sql = "Select @@version" oRs = CrearDReader(_Sql) oRs.Read() StrVersion = oRs(0) CerrarDReader(oRs) Cerrar() Return StrVersion Exit Function TrataError: _sError = "BD.DameVersionSQL() : " & Err.Description Return _sError End Function #End Region #Region "TEST" Private Sub test() 'Dim temp_RS As SqlDataReader ' DyC_RS.Add(0, End Sub #End Region End Class #Region "REFERENCIAS" '******************************** SQL BULKCOPY ************************************************ 'http://msdn.microsoft.com/es-es/library/System.Data.SqlClient.SqlBulkCopy%28v=vs.110%29.aspx '**************************** FICHERO DE FORMATO FMT ******************************************* '8.0 '39 '1 SQLCHAR 0 50 "\t" 1 ID_OT Modern_Spanish_CI_AS '2 SQLCHAR 0 50 "\t" 2 LUPA Modern_Spanish_CI_AS '3 SQLCHAR 0 50 "\t" 3 MATRICULA_AUTOR Modern_Spanish_CI_AS '4 SQLCHAR 0 255 "\t" 4 USUARIO_AUTOR Modern_Spanish_CI_AS '5 SQLCHAR 0 500 "\t" 5 GRUPO_AUTOR Modern_Spanish_CI_AS '6 SQLCHAR 0 50 "\t" 6 CIF Modern_Spanish_CI_AS '7 SQLCHAR 0 255 "\t" 7 NOMBRE_CLIENTE Modern_Spanish_CI_AS '8 SQLCHAR 0 500 "\t" 8 DESCRIPCION Modern_Spanish_CI_AS '9 SQLCHAR 0 7000 "\t" 9 OBSERVACIONES Modern_Spanish_CI_AS '10 SQLCHAR 0 500 "\t" 10 ESTADO Modern_Spanish_CI_AS '11 SQLCHAR 0 500 "\t" 11 PRIORITARIO Modern_Spanish_CI_AS '12 SQLCHAR 0 500 "\t" 12 MACROLAN Modern_Spanish_CI_AS '13 SQLCHAR 0 500 "\t" 13 VPN_IP Modern_Spanish_CI_AS '14 SQLCHAR 0 500 "\t" 14 N_CONEXIONES Modern_Spanish_CI_AS '15 SQLCHAR 0 500 "\t" 15 FASE_ARGOS Modern_Spanish_CI_AS '16 SQLCHAR 0 500 "\t" 16 TAREAS_ARGOS_PTES Modern_Spanish_CI_AS '17 SQLCHAR 0 500 "\t" 17 FASE_ODPV Modern_Spanish_CI_AS '18 SQLCHAR 0 500 "\t" 18 TAREAS_RTB_PTES Modern_Spanish_CI_AS '19 SQLCHAR 0 500 "\t" 19 FASE_CAV Modern_Spanish_CI_AS '20 SQLCHAR 0 500 "\t" 20 TAREAS_CAV_PTES Modern_Spanish_CI_AS '21 SQLCHAR 0 500 "\t" 21 MATRICULA_RESPONSABLE Modern_Spanish_CI_AS '22 SQLCHAR 0 500 "\t" 22 USUARIO_RESPONSABLE Modern_Spanish_CI_AS '23 SQLCHAR 0 500 "\t" 23 GRUPO_RESPONSABLE Modern_Spanish_CI_AS '24 SQLCHAR 0 500 "\t" 24 PFI Modern_Spanish_CI_AS '25 SQLCHAR 0 500 "\t" 25 PFA Modern_Spanish_CI_AS '26 SQLCHAR 0 500 "\t" 26 OFERTA Modern_Spanish_CI_AS '27 SQLCHAR 0 500 "\t" 27 SOLICITUD_PEDIDO Modern_Spanish_CI_AS '28 SQLCHAR 0 500 "\t" 28 FECHA_ALTA Modern_Spanish_CI_AS '29 SQLCHAR 0 500 "\t" 29 FECHA_ENTRADA Modern_Spanish_CI_AS '30 SQLCHAR 0 500 "\t" 30 FECHA_EN_ELABORACION Modern_Spanish_CI_AS '31 SQLCHAR 0 500 "\t" 31 FECHA_PTE_INFRAESTRUCTURA Modern_Spanish_CI_AS '32 SQLCHAR 0 500 "\t" 32 DIAS_PTE_INFRAESTRUCTURA Modern_Spanish_CI_AS '33 SQLCHAR 0 500 "\t" 33 FECHA_PTE_RFS Modern_Spanish_CI_AS '34 SQLCHAR 0 500 "\t" 34 DIAS_PTE_RFS Modern_Spanish_CI_AS '35 SQLCHAR 0 500 "\t" 35 FECHA_PTE_VENDEDOR Modern_Spanish_CI_AS '36 SQLCHAR 0 500 "\t" 36 FECHA_ANULADO Modern_Spanish_CI_AS '37 SQLCHAR 0 500 "\t" 37 FECHA_FINALIZADO Modern_Spanish_CI_AS '38 SQLCHAR 0 500 "\t" 38 F_CONV_SIMPLE Modern_Spanish_CI_AS '39 SQLCHAR 0 5000 "\n" 39 ULTIMO_COMENTARIO Modern_Spanish_CI_AS ''**************** SQL PROCEDIMIENTO ALMACENADO PARA GENERAR FICHERO DESDE TABLA ******************** '-- SELECT * FROM syscolumns WHERE ID = 738101670 '--EXEC SYS_TABLA_FICHERO_FMT 'A_MIDAS_COMPLEJOS_PEDIDOS' 'CREATE PROCEDURE SYS_TABLA_FICHERO_FMT ' @TABLA VARCHAR(100) 'AS 'DECLARE @nColumnas INT 'DECLARE @iCOLUMNA INT 'DECLARE @ID_TABLA INT '--DECLARE @TABLA CHAR(200) 'DECLARE @VERSION CHAR(5) 'DECLARE @sFILA VARCHAR(500) 'DECLARE @SEPARADOR CHAR(5) '-- *********** VARIABLES PARA LOS CAMPOS DE LA TABLA 'DECLARE @CAMPO CHAR(150) 'DECLARE @LONGITUD INT 'SELECT @VERSION = '8.0' '--SELECT @TABLA = 'A_MIDAS_COMPLEJOS_PEDIDOS' 'SELECT @ID_TABLA = id FROM sysobjects WHERE name = @TABLA 'SELECT @nColumnas = COUNT(*) FROM SysColumns WHERE id = @ID_TABLA '--PRINT @ID_TABLA 'PRINT @VERSION 'PRINT @nColumnas '-- ******************** CURSOR PARA RECORRER LOS CAMPOS 'DECLARE RS CURSOR 'FOR SELECT Name,LENGTH FROM SysColumns WHERE ID = @ID_TABLA 'OPEN RS 'SELECT @iCOLUMNA = 1 'FETCH NEXT FROM RS 'INTO @CAMPO,@LONGITUD; 'WHILE @@FETCH_STATUS = 0 'BEGIN ' IF @iCOLUMNA = @nColumnas SELECT @SEPARADOR = '"\n"' ELSE SELECT @SEPARADOR = '"\t"' ' SELECT @sFILA = LTRIM(RTRIM(CONVERT(CHAR,@iCOLUMNA))) + CHAR(9) ' SELECT @sFILA = @sFILA + 'SQLCHAR' + CHAR(9) ' SELECT @sFILA = @sFILA + '0' + CHAR(9) ' SELECT @sFILA = @sFILA + LTRIM(RTRIM(CONVERT(CHAR,@LONGITUD))) + CHAR(9) ' SELECT @sFILA = @sFILA + @SEPARADOR + CHAR(9) ' SELECT @sFILA = @sFILA + LTRIM(RTRIM(CONVERT(CHAR,@iCOLUMNA))) + CHAR(9) ' SELECT @sFILA = @sFILA + LTRIM(RTRIM(@CAMPO)) + CHAR(9) ' SELECT @sFILA = @sFILA + 'Modern_Spanish_CI_AS' ' PRINT @sFILA ' --PRINT CONVERT(CHAR,@iCOLUMNA) + CHAR(9) + 'SQLCHAR' 0 50 "\t" 1 CODIGO Modern_Spanish_CI_AS ' SELECT @iCOLUMNA = @iCOLUMNA + 1 'FETCH NEXT FROM RS 'INTO @CAMPO,@LONGITUD; 'END 'CLOSE RS; 'DEALLOCATE RS; #End Region