Mi estimado Bet7o entendi muy bien tu pregunta , (Al parecer los otros Jaimes NO).
Yo uso una dll Standar que me sirve tanto para mis aplicaciones VB como ASP.
1.- Creas un proyecto DLL en VB6.0
2.- Luego esta dll tiene que tener un modulo .bas con la cadena de conexion y una variable de conexion :
Ejemplo:
Global Const cnn = "provider=sqloledb;data source=BE02;uid=contable;database=BASE;pwd=contable;"
Global cn As New ADODB.Connection
3.-Crear tus Clases .Cls con los metodos de acceso a datos que crees convenientes yo tengo unos standares y que me sirven para todas las operaciones de transaccion con SQL como dar mantenimiento , listar registros , actualizar, ejecutar sql , etc. (Copias y pegas el siguiente codigo en tu clase .cls)
Public Function pListarRS(Arr As Variant, GsStoreProcedure As String, GsNumParameters As Long) As ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim Cmd As New ADODB.Command
Dim i As Long
'<>
On Error GoTo Msj_error
rs.CursorLocation = adUseClient
gtxtSQL = "EXEC " & GsStoreProcedure & " "
If GsNumParameters <> -1 Then ' Si es -1 significa que el store proce. no tiene parametros
For i = 0 To GsNumParameters
If Arr(i) = VACIO Then Arr(i) = "Null"
If Arr(i) = "''" Then Arr(i) = "'Null'"
If Arr(i) = VACIO Then
Arr(i) = "Null"
End If
If i = GsNumParameters Then
gtxtSQL = gtxtSQL & Arr(i)
Else
gtxtSQL = gtxtSQL & Arr(i) & ","
End If
Next
End If
gtxtSQL = Trim(gtxtSQL)
With Cmd
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = gtxtSQL
.Execute
End With
rs.Open Cmd, , adOpenDynamic, adLockOptimistic
Set Listar_Registros = rs
Set rs = Nothing
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "INVENTARIOS"
End If
End Function
Public Sub pMantenimientoTabla(Arr As Variant, GsStoreProcedure As String, GsNumParameters As Long)
On Error Resume Next
Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim i As Long
'<>
On Error GoTo Msj_error
rs.CursorLocation = adUseClient
If Left(Trim(GsStoreProcedure), 2) = "sp" Or Left(Trim(GsStoreProcedure), 2) = "Sp" Or Left(Trim(GsStoreProcedure), 2) = "sP" Or Left(Trim(GsStoreProcedure), 2) = "SP" Then
gtxtSQL = "EXEC " & GsStoreProcedure & " "
Else
gtxtSQL = GsStoreProcedure & " "
End If
For i = 0 To GsNumParameters
If Arr(i) = VACIO Then Arr(i) = "Null"
If Arr(i) = "''" Then Arr(i) = "Null"
If Arr(i) = "' '" Then Arr(i) = "Null"
If IsNull(Arr(i)) = True Then Arr(i) = "Null"
If i = GsNumParameters Then
gtxtSQL = gtxtSQL & Arr(i)
Else
gtxtSQL = gtxtSQL & Arr(i) & ","
End If
Next
gtxtSQL = Trim(gtxtSQL)
With Cmd
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = gtxtSQL
.Execute
End With
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "SISTEMA"
End If
End Sub
Public Function fRetornaValor(GsSentenciaSQL As String) As String
On Error GoTo Msj_error
Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
With Cmd
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = GsSentenciaSQL
.Execute
End With
rs.Open Cmd, , adOpenDynamic, adLockBatchOptimistic
If IsNull(rs(0)) = True Then
fRetornaValor = ""
' If Len(Trim(rs(0))) <= 0 Then
' fRetornaValor = ""
' Else
' fRetornaValor = rs(0)
' End If
ElseIf Str(rs(0)) = "" Then
fRetornaValor = ""
' If Len(Trim(rs(0))) <= 0 Then
' fRetornaValor = ""
' Else
' fRetornaValor = rs(0)
' End If
Else
fRetornaValor = rs(0)
End If
rs.Close
Set rs = Nothing
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "SISTEMA"
End If
End Function
Public Function fRetornaRS(GsSentenciaSQL As String) As ADODB.Recordset
Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
On Error GoTo Msj_error
rs.CursorLocation = adUseClient
With Cmd
.CommandTimeout = 0
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = GsSentenciaSQL
.Execute
End With
rs.Open Cmd, , adOpenDynamic, adLockOptimistic
Set fRetornaRS = rs
Set rs = Nothing
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "SISTEMA"
End If
End Function
Public Function fRetornaRSMultiple(GsSentenciaSQL As String) As ADODB.Recordset
Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Set cnn = New ADODB.Connection
On Error GoTo Msj_error
rs.CursorLocation = adUseClient
With cnn
.Provider = "sqloledb"
.ConnectionString = cn '"Data Source=" & Ruta_archivo_excel
.Open
Set rs = cnn.Execute(GsSentenciaSQL)
End With
'rs.Open CMD, , adOpenDynamic, adLockOptimistic
Set fRetornaRSMultiple = rs
Set rs = Nothing
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "SISTEMA"
End If
End Function
Public Sub pEjecutaSQL(GsSentenciaSQL As String)
On Error GoTo Msj_error
Dim Cmd As New ADODB.Command
With Cmd
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = GsSentenciaSQL
.Execute
End With
Set Cmd = Nothing
Msj_error:
If Err.Number <> 32755 Then
If Len(Err.Description) > 1 Then MsgBox "Ocurrió el Siguiente Error:" + Chr(13) + Err.Description, vbCritical, "SISTEMA"
End If
End Sub
Public Sub ConectaSQL()
On Error GoTo ControlaErrores
Dim vgServer As String
Dim vgUser As String
Dim vgPwd As String
Dim vgBD As String
vgServer = "BBMPE02"
vgUser = "contable"
vgPwd = "contable"
vgBD = "INFO"
With cn
'.ConnectionString = "provider=sqloledb;data source=BBMPE02;uid=contable;database=INFOPRUEBAS;pwd=contable;"
.ConnectionString = "driver={SQL Server};" & _
"server=" & vgServer & _
";uid=" & vgUser & _
";pwd=" & vgPwd & _
";database=" & vgBD
.CursorLocation = adUseClient
.ConnectionTimeout = 60000: .CommandTimeout = 60000
.Open
'Cargar la fecha y hora del servidor
'Call vgClsOpr.FechaHoraServidor
End With
Exit Sub
ControlaErrores:
MsgBox _
prompt:=" Error en el Inicio de Sesión " + Chr(13) + _
" Comuníquese con el Area de Sistemas..!!!", _
Buttons:=vbCritical + vbOKOnly, _
Title:="Error"
End Sub
3. Compilas tu DLL y lo publicas como servicio , tienes que tener una ruta como "servidor" de componentes.
4.Instanciar la dll a tus aplicaciones (para el inicio podria estar solo localmente, para hacer las pruebas)
Espero te sirva.
Saludos.
Rolando
PD: Lo unico "ignorante" que he leido son los 2 posteos anterior a este.
y por ultimo este no es un foro de "solo para expertos" sino para cualquiera que necesite ayuda o apoyo.
Para mi colegas "expertos" , si lo son , se podria demostrar ayudando a los demas , no dicendo de uno mismo que lo son.
