Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: E N T E R en Octubre 17, 2014, 03:04:06 pm

Título: Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 17, 2014, 03:04:06 pm

Si como el titulo dice como harian ustedes para automatizar las consultas y los insert yo tengo de esta forma la idea es poder reutilizar las funciones en cada formulario para no repetir mucho codigo.

Esto en un Modulo.

Código: (VB) [Seleccionar]

Public cnADO As ADODB.Connection
Public rsADO As ADODB.Recordset
Public StrSQL As String
Public ComandoSQL As String


Código: (VB) [Seleccionar]

Public Sub ConectarADO(ByVal xHost As String, ByVal xBaseDatos As String, ByVal xUser As String, xPass As String)

    Set cnADO = New ADODB.Connection
    Set rsADO = New ADODB.Recordset
   
    rsADO.CursorLocation = adUseClient
    cnADO.ConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=" & xHost & ";Database=" & xBaseDatos & "; User=" & xUser & ";Password=" & xPass & ";Option=3;"
    cnADO.Open

End Sub


Código: (VB) [Seleccionar]

Public Sub CerrarADO()

    If Not cnADO Is Nothing Then
    Else
        cnADO.Close
        Set cnADO = Nothing
        Set rsADO = Nothing
    End If

End Sub



Código: (VB) [Seleccionar]

Public Sub Cargar_Datos(ByVal xHost As String, ByVal xBaseDatos As String, srtQuery As String)

    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
        Call ConectarADO(xHost, xBaseDatos, "root", "")
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
        StrSQL = srtQuery
        rsADO.Open StrSQL, cnADO, adOpenForwardOnly, adLockReadOnly, adCmdText

        Do Until rsADO.EOF
            With rsADO
                Debug.Print .Fields("id") & "|" & .Fields("nombre")
                rsADO.MoveNext
            End With
        Loop
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
        Call CerrarADO
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+

End Sub
Esto en el formulario.

Código: (VB) [Seleccionar]

Private Sub Command4_Click()
   
    Call Cargar_Datos("localhost", "gestion_banco", "SELECT * FROM lista_banco")
   
End Sub
Esto es para los Insert,Update, Delete

Código: (VB) [Seleccionar]

Private Sub Command1_Click()
   
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
        Call ConectarADO("localhost", "alumnos", "root", "")
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
       
        cnADO.BeginTrans
       
            ComandoSQL = "INSERT INTO clientes(nombre) VALUES (" & "'cliente1'" & ")"
            cnADO.Execute ComandoSQL
           
            ComandoSQL = "INSERT INTO modulos(nombre) VALUES (" & "'modulo1'" & ")"
            cnADO.Execute ComandoSQL
       
        cnADO.CommitTrans
       
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
        Call CerrarADO
    '+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+

   
End Sub

Si o si necesito conectar y desconectar por que voy a hacer las consultas y los insert a traves de internet.

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 17, 2014, 06:02:09 pm

Yo tengo este codigo para acceder a tablas y vistas (ej: select * from clientes order by fechaIngreso)

Código: (vb) [Seleccionar]

Function GetTable(Nombre As String) As Recordset
Dim com As ADODB.Command
Set com = New ADODB.Command
Set com.ActiveConnection = cnnDatos
com.CommandType = adCmdTable
com.CommandText = Nombre

Set GetTable = com.Execute
Set com = Nothing
End Function

' Uso:
rs = GetTable("clientes")
rs = GetTable("vw_pedidos_ordenados_Fecha")

También tengo un código para hacer más legible y fácil al modificar el modelo de datos (por cada columna agregada/modificada seria agregar unas pocas líneas)
De la época cuando no usaba procedimientos almacenados :P

Código: (vb) [Seleccionar]

Dim campos() As campo
ReDim campos(2)
campos(0) = CampoValue("Producto", txtNombre.Text)
campos(1) = CampoValue("PrecioBase", txtPrecio.Text, tipodouble)
campos(2) = CampoValue("IVA", cmbIVA.ListIndex + 1, tipodouble)

Dim ProductoNuevo As Long ' ID Del producto nuevo

If InsertarTabla("Productos", campos, cnnDatos) Then
ProductoNuevo = GetLastInsertId
Else
ProductoNuevo = -1
End If

' ... Ponele que se hacen más cambios...

If UpdateTabla("Productos", campos, "id=" & ProductoNuevo, cnnDatos) Then
Call MsgBox("Datos actualizados correctamente")
Else
Call MsgBox("Error al actualizar los datos")
End If

' ... Y para borrar
If BorrarTabla("Productos", "id=" & ProductoNuevo, cnnDatos) Then
Call MsgBox("Producto Borrado")
Else
Call MsgBox("No se borro nada.. ")
End If

' Para Rellenar algún LV, etc
Dim rs As Recordset
Select Case SQL_Ejecutar("SELECT * FROM tabla WHERE ID < 100", rs, cnnDatos)
Case eEstatus.QueryError
Call MsgBox("Hay un error en la consulta")
Case eEstatus.EmptyResults
' Recorset vacio. Avisar que no hay nada
Case eEstatus.OK
' Rellenar ListView o lo qeu sea
End Select


' Devuelve un String
Msgbox(SQL_ExecuteScalarS("SELECT nombre FROM clientes WHERE id = 1", cnnDatos))

' Devuelve un Long
Msgbox(SQL_ExecuteScalarL("SELECT id FROM clientes WHERE nombre = 'raul'", cnnDatos))

Para que funcione, simplemente pongan este codigo en un modulo (yo lo llamo dbm, lo uso con access y mysql, podria funcionar tranquilamente con ms sql)

Código: [Seleccionar]

Option Explicit
Public Enum EngineType
dbAccess
dbMySQL
End Enum
Public dbEngine As EngineType
Public Enum CampoTipo
tipoString = 0
tipoNumero
tipoDate
tipoBoolean
tipodouble
End Enum

Public Type campo
Nombre As String
tipo As CampoTipo
Valor As String
End Type

Public Enum eEstatus
OK
QueryError
EmptyResults
End Enum
'================================================
' Funciones genericas para insertar y actualizar. Por Raul338
'================================================

Public Function CampoValue(Nombre As String, Valor, Optional tipo As CampoTipo = tipoString) As campo
With CampoValue
.Nombre = Nombre
.tipo = tipo
.Valor = GetRowValue(Valor, tipo)
End With
End Function

Public Function GetRowValue(Valor, tipo As CampoTipo) As String
Select Case tipo
Case CampoTipo.tipoDate
Dim d As Date, limit As String, sep As String
d = Valor
Select Case dbEngine
Case dbAccess
limit = "#": sep = "/"
Case dbMySQL
limit = "'": sep = "-"
End Select
GetRowValue = limit & Year(d) & sep & Month(d) & sep & Day(d) & limit
Case CampoTipo.tipoNumero
GetRowValue = CLng(Valor)
Case CampoTipo.tipoString
GetRowValue = "'" & Valor & "'"
Case CampoTipo.tipoBoolean
If CBool(Valor) Then
GetRowValue = "1"
Else
GetRowValue = "0"
End If
Case CampoTipo.tipodouble
GetRowValue = Replace$(CDbl(Valor), ",", ".")
End Select
End Function
Public Function GetLastInsertId() As Long
Select Case dbEngine
Case EngineType.dbAccess
GetLastInsertId = SQL_ExecuteScalarL("SELECT @@IDENTITY")
Case EngineType.dbMySQL
GetLastInsertId = SQL_ExecuteScalarL("SELECT LAST_INSERT_ID();")
End Select
End Function
Public Function UpdateTabla(ByVal Tabla As String, campos() As campo, sWhere As String, cnn As ADODB.Connection) As Boolean
Dim sql As cStringBuilder
Dim i As Integer, j As Integer
Set sql = New cStringBuilder
Call sql.Append("UPDATE " & Tabla & " SET ")
j = UBound(campos)
For i = 0 To j
Call sql.Append(campos(i).Nombre & "=")
Call sql.Append(campos(i).Valor)
If Not i = j Then
Call sql.Append(",")
End If
Next
Call sql.Append(" WHERE " & sWhere & ";")
Call cnn.Execute(sql.Value, i)
Debug.Print sql.Value, "Rows Affected: " & i
UpdateTabla = i
Set sql = Nothing
End Function
Public Function InsertarTabla(ByVal Tabla As String, campos() As campo, cnn As ADODB.Connection) As Boolean
Dim sql As cStringBuilder, valores As cStringBuilder
Dim i As Integer, j As Integer
Set sql = New cStringBuilder
Set valores = New cStringBuilder

j = UBound(campos)
Call sql.Append("INSERT INTO " & Tabla & "(")
Call valores.Append("VALUES (")
For i = 0 To j
Call sql.Append(campos(i).Nombre)
Call valores.Append(campos(i).Valor)
If Not i = j Then
Call valores.Append(",")
Call sql.Append(",")
End If
Next
Call valores.Append(");")
Call sql.Append(") ")
Call sql.Append(valores.Value)
Set valores = Nothing
Debug.Print sql.Value
Call cnn.Execute(sql.Value, i)
InsertarTabla = i
Set sql = Nothing
End Function
Public Function BorrarTabla(Tabla As String, where As String, cnn As ADODB.Connection) As Boolean
Dim i As Integer
Debug.Print "DELETE FROM " & Tabla & " WHERE " & where
Call cnn.Execute("DELETE FROM " & Tabla & " WHERE " & where, i)
BorrarTabla = i
End Function

Function SQL_Ejecutar(consulta As String, rsDatos As Recordset, cnnDatos As ADODB.Connection) As eEstatus
Debug.Print Month(Now) & "/" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & " | " & consulta
If cnnDatos.State = adStateClosed Then
SQL_Ejecutar = QueryError
Exit Function
End If
Set rsDatos = New Recordset
Set rsDatos.ActiveConnection = cnnDatos

Call rsDatos.Open(consulta, cnnDatos, adOpenDynamic, adLockOptimistic)
If Not rsDatos Is Nothing Then
If rsDatos.State = adStateOpen Then
If rsDatos.RecordCount Then SQL_Ejecutar = OK Else SQL_Ejecutar = EmptyResults
Else
SQL_Ejecutar = EmptyResults
End If
Else
SQL_Ejecutar = QueryError
End If
End Function
Function SQL_ExecuteScalarS(consulta As String, cnnDatos As ADODB.Connection) As String
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarS = vbNullString Else SQL_ExecuteScalarS = rs(0)
Else
SQL_ExecuteScalarS = vbNullString
End If
Set rs = Nothing
End Function
Function SQL_ExecuteScalarL(consulta As String, cnnDatos As ADODB.Connection) As Long
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarL = -1 Else SQL_ExecuteScalarL = CLng(rs(0))
Else
SQL_ExecuteScalarL = -1
End If
Set rs = Nothing
End Function

Tambíen para funcionar deben incluir la clase cStringBuilder que esta en el primer post de este hilo (http://leandroascierto.com/foro/index.php?topic=1237.msg7092#msg7092)

Saludos

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 18, 2014, 09:52:07 am

Hola Raul, podrias mostrar como tenes esta funcion: cnnDatos

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 18, 2014, 11:40:42 am

cnnDatos es el objeto conexion.

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 18, 2014, 11:56:00 am

Si se pero no se como armar ese
vos decis por este?

Public Sub ConectarADO(ByVal xHost As String, ByVal xBaseDatos As String, ByVal xUser As String, xPass As String)
 
    Set cnADO = New ADODB.Connection
    Set rsADO = New ADODB.Recordset
   
    rsADO.CursorLocation = adUseClient
    cnADO.ConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=" & xHost & ";Database=" & xBaseDatos & "; User=" & xUser & ";Password=" & xPass & ";Option=3;"
    cnADO.Open
 
End Sub

y como le hago pasar al tuyo ese

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 18, 2014, 12:47:35 pm

Cuando llames a alguna de las funciones que puse... simplemente llamalo así

If UpdateTabla("Productos", campos, "id=" & ProductoNuevo, cnADO) Then

El 3er parametro es la Conexion

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 20, 2014, 10:35:02 am

Raul muy bueno la forma de resolver la data de los campos con un array, indicando cada tipo de campo, para despues no andar concatenando el string y viendo que tipo de campo es.
Algo parecido a usar un command de ado.
La clase stringbuilder es el primer post de la hoja 2?
la que tiene este codigo?

Código: (VB) [Seleccionar]

Private Function AllocString04(ByVal lSize As Long) As String
  ' http://www.xbeat.net/vbspeed/
  ' by Jory, jory@joryanick.com, 20011023
  RtlMoveMemory ByVal VarPtr(AllocString04), SysAllocStringByteLen(0&, lSize + lSize), 4&
End Function

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 20, 2014, 12:14:42 pm

Si si es el primer post de la hoja 2.

El link envia hacia ese post

http://leandroascierto.com/foro/index.php?topic=1237.msg7092#msg7092

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 20, 2014, 03:27:48 pm

Incluyo esta parte de código que es para devolver recordsets a partir de consultas. Sin este codigo GetLastInsertID no funciona :P
Incluí este código y ejemplos en el post anterior donde estaba todo.
Me doy cuenta recién porque estaba en otro módulo.

Código: (vb) [Seleccionar]

Public Enum eEstatus
OK
QueryError
EmptyResults
End Enum
Function SQL_Ejecutar(consulta As String, rsDatos As Recordset, cnnDatos As ADODB.Connection) As eEstatus
Debug.Print Month(Now) & "/" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & " | " & consulta
If cnnDatos.State = adStateClosed Then
SQL_Ejecutar = QueryError
Exit Function
End If
Set rsDatos = New Recordset
Set rsDatos.ActiveConnection = cnnDatos

Call rsDatos.Open(consulta, cnnDatos, adOpenDynamic, adLockOptimistic)
If Not rsDatos Is Nothing Then
If rsDatos.State = adStateOpen Then
If rsDatos.RecordCount Then SQL_Ejecutar = OK Else SQL_Ejecutar = EmptyResults
Else
SQL_Ejecutar = EmptyResults
End If
Else
SQL_Ejecutar = QueryError
End If
End Function
Function SQL_ExecuteScalarS(consulta As String, cnnDatos As ADODB.Connection) As String
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarS = vbNullString Else SQL_ExecuteScalarS = rs(0)
Else
SQL_ExecuteScalarS = vbNullString
End If
Set rs = Nothing
End Function
Function SQL_ExecuteScalarL(consulta As String, cnnDatos As ADODB.Connection) As Long
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarL = -1 Else SQL_ExecuteScalarL = CLng(rs(0))
Else
SQL_ExecuteScalarL = -1
End If
Set rs = Nothing
End Function


Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 20, 2014, 04:16:10 pm

muy bueno el ExecuteScalar, similar a .net, yo me habia hecho algo asi tamb.

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: gasafonso en Octubre 20, 2014, 04:29:09 pm

PEdon para que es esta funcion ?

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 21, 2014, 12:02:36 am

Cita de: gasafonso en Octubre 20, 2014, 04:29:09 pm

PEdon para que es esta funcion ?

cual de todas?

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: gasafonso en Octubre 21, 2014, 08:09:25 am

Cita de: raul338 en Octubre 20, 2014, 03:27:48 pm

Incluyo esta parte de código que es para devolver recordsets a partir de consultas. Sin este codigo GetLastInsertID no funciona :P
Incluí este código y ejemplos en el post anterior donde estaba todo.
Me doy cuenta recién porque estaba en otro módulo.

Código: (vb) [Seleccionar]

Public Enum eEstatus
OK
QueryError
EmptyResults
End Enum
Function SQL_Ejecutar(consulta As String, rsDatos As Recordset, cnnDatos As ADODB.Connection) As eEstatus
Debug.Print Month(Now) & "/" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & " | " & consulta
If cnnDatos.State = adStateClosed Then
SQL_Ejecutar = QueryError
Exit Function
End If
Set rsDatos = New Recordset
Set rsDatos.ActiveConnection = cnnDatos

Call rsDatos.Open(consulta, cnnDatos, adOpenDynamic, adLockOptimistic)
If Not rsDatos Is Nothing Then
If rsDatos.State = adStateOpen Then
If rsDatos.RecordCount Then SQL_Ejecutar = OK Else SQL_Ejecutar = EmptyResults
Else
SQL_Ejecutar = EmptyResults
End If
Else
SQL_Ejecutar = QueryError
End If
End Function
Function SQL_ExecuteScalarS(consulta As String, cnnDatos As ADODB.Connection) As String
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarS = vbNullString Else SQL_ExecuteScalarS = rs(0)
Else
SQL_ExecuteScalarS = vbNullString
End If
Set rs = Nothing
End Function
Function SQL_ExecuteScalarL(consulta As String, cnnDatos As ADODB.Connection) As Long
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarL = -1 Else SQL_ExecuteScalarL = CLng(rs(0))
Else
SQL_ExecuteScalarL = -1
End If
Set rs = Nothing
End Function


y esta

Código: (vb) [Seleccionar]

Private Function AllocString04(ByVal lSize As Long) As String
  ' http://www.xbeat.net/vbspeed/
  ' by Jory, jory@joryanick.com, 20011023
  RtlMoveMemory ByVal VarPtr(AllocString04), SysAllocStringByteLen(0&, lSize + lSize), 4&
End Function[quote author=raul338 link=topic=2775.msg15353#msg15353 date=1413579729]
Yo tengo este codigo para acceder a tablas y vistas (ej: select * from clientes order by fechaIngreso)[code=vb]

[code=vb]Function GetTable(Nombre As String) As Recordset
Dim com As ADODB.Command
Set com = New ADODB.Command
Set com.ActiveConnection = cnnDatos
com.CommandType = adCmdTable
com.CommandText = Nombre

Set GetTable = com.Execute
Set com = Nothing
End Function

' Uso:
rs = GetTable("clientes")
rs = GetTable("vw_pedidos_ordenados_Fecha")

También tengo un código para hacer más legible y fácil al modificar el modelo de datos (por cada columna agregada/modificada seria agregar unas pocas líneas)
De la época cuando no usaba procedimientos almacenados :P

Código: (vb) [Seleccionar]

Dim campos() As campo
ReDim campos(2)
campos(0) = CampoValue("Producto", txtNombre.Text)
campos(1) = CampoValue("PrecioBase", txtPrecio.Text, tipodouble)
campos(2) = CampoValue("IVA", cmbIVA.ListIndex + 1, tipodouble)

Dim ProductoNuevo As Long ' ID Del producto nuevo

If InsertarTabla("Productos", campos, cnnDatos) Then
ProductoNuevo = GetLastInsertId
Else
ProductoNuevo = -1
End If

' ... Ponele que se hacen más cambios...

If UpdateTabla("Productos", campos, "id=" & ProductoNuevo, cnnDatos) Then
Call MsgBox("Datos actualizados correctamente")
Else
Call MsgBox("Error al actualizar los datos")
End If

' ... Y para borrar
If BorrarTabla("Productos", "id=" & ProductoNuevo, cnnDatos) Then
Call MsgBox("Producto Borrado")
Else
Call MsgBox("No se borro nada.. ")
End If

' Para Rellenar algún LV, etc
Dim rs As Recordset
Select Case SQL_Ejecutar("SELECT * FROM tabla WHERE ID < 100", rs, cnnDatos)
Case eEstatus.QueryError
Call MsgBox("Hay un error en la consulta")
Case eEstatus.EmptyResults
' Recorset vacio. Avisar que no hay nada
Case eEstatus.OK
' Rellenar ListView o lo qeu sea
End Select


' Devuelve un String
Msgbox(SQL_ExecuteScalarS("SELECT nombre FROM clientes WHERE id = 1", cnnDatos))

' Devuelve un Long
Msgbox(SQL_ExecuteScalarL("SELECT id FROM clientes WHERE nombre = 'raul'", cnnDatos))

Para que funcione, simplemente pongan este codigo en un modulo (yo lo llamo dbm, lo uso con access y mysql, podria funcionar tranquilamente con ms sql)

Código: [Seleccionar]

Option Explicit
Public Enum EngineType
dbAccess
dbMySQL
End Enum
Public dbEngine As EngineType
Public Enum CampoTipo
tipoString = 0
tipoNumero
tipoDate
tipoBoolean
tipodouble
End Enum

Public Type campo
Nombre As String
tipo As CampoTipo
Valor As String
End Type

Public Enum eEstatus
OK
QueryError
EmptyResults
End Enum
'================================================
' Funciones genericas para insertar y actualizar. Por Raul338
'================================================

Public Function CampoValue(Nombre As String, Valor, Optional tipo As CampoTipo = tipoString) As campo
With CampoValue
.Nombre = Nombre
.tipo = tipo
.Valor = GetRowValue(Valor, tipo)
End With
End Function

Public Function GetRowValue(Valor, tipo As CampoTipo) As String
Select Case tipo
Case CampoTipo.tipoDate
Dim d As Date, limit As String, sep As String
d = Valor
Select Case dbEngine
Case dbAccess
limit = "#": sep = "/"
Case dbMySQL
limit = "'": sep = "-"
End Select
GetRowValue = limit & Year(d) & sep & Month(d) & sep & Day(d) & limit
Case CampoTipo.tipoNumero
GetRowValue = CLng(Valor)
Case CampoTipo.tipoString
GetRowValue = "'" & Valor & "'"
Case CampoTipo.tipoBoolean
If CBool(Valor) Then
GetRowValue = "1"
Else
GetRowValue = "0"
End If
Case CampoTipo.tipodouble
GetRowValue = Replace$(CDbl(Valor), ",", ".")
End Select
End Function
Public Function GetLastInsertId() As Long
Select Case dbEngine
Case EngineType.dbAccess
GetLastInsertId = SQL_ExecuteScalarL("SELECT @@IDENTITY")
Case EngineType.dbMySQL
GetLastInsertId = SQL_ExecuteScalarL("SELECT LAST_INSERT_ID();")
End Select
End Function
Public Function UpdateTabla(ByVal Tabla As String, campos() As campo, sWhere As String, cnn As ADODB.Connection) As Boolean
Dim sql As cStringBuilder
Dim i As Integer, j As Integer
Set sql = New cStringBuilder
Call sql.Append("UPDATE " & Tabla & " SET ")
j = UBound(campos)
For i = 0 To j
Call sql.Append(campos(i).Nombre & "=")
Call sql.Append(GetRowValue(campos(i).Valor, campos(i).tipo))
If Not i = j Then
Call sql.Append(",")
End If
Next
Call sql.Append(" WHERE " & sWhere & ";")
Call cnn.Execute(sql.Value, i)
Debug.Print sql.Value, "Rows Affected: " & i
UpdateTabla = i
Set sql = Nothing
End Function
Public Function InsertarTabla(ByVal Tabla As String, campos() As campo, cnn As ADODB.Connection) As Boolean
Dim sql As cStringBuilder, valores As cStringBuilder
Dim i As Integer, j As Integer
Set sql = New cStringBuilder
Set valores = New cStringBuilder

j = UBound(campos)
Call sql.Append("INSERT INTO " & Tabla & "(")
Call valores.Append("VALUES (")
For i = 0 To j
Call sql.Append(campos(i).Nombre)
Call valores.Append(GetRowValue(campos(i).Valor, campos(i).tipo))
If Not i = j Then
Call valores.Append(",")
Call sql.Append(",")
End If
Next
Call valores.Append(");")
Call sql.Append(") ")
Call sql.Append(valores.Value)
Set valores = Nothing
Debug.Print sql.Value
Call cnn.Execute(sql.Value, i)
InsertarTabla = i
Set sql = Nothing
End Function
Public Function BorrarTabla(Tabla As String, where As String, cnn As ADODB.Connection) As Boolean
Dim i As Integer
Debug.Print "DELETE FROM " & Tabla & " WHERE " & where
Call cnn.Execute("DELETE FROM " & Tabla & " WHERE " & where, i)
BorrarTabla = i
End Function

Function SQL_Ejecutar(consulta As String, rsDatos As Recordset, cnnDatos As ADODB.Connection) As eEstatus
Debug.Print Month(Now) & "/" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & " | " & consulta
If cnnDatos.State = adStateClosed Then
SQL_Ejecutar = QueryError
Exit Function
End If
Set rsDatos = New Recordset
Set rsDatos.ActiveConnection = cnnDatos

Call rsDatos.Open(consulta, cnnDatos, adOpenDynamic, adLockOptimistic)
If Not rsDatos Is Nothing Then
If rsDatos.State = adStateOpen Then
If rsDatos.RecordCount Then SQL_Ejecutar = OK Else SQL_Ejecutar = EmptyResults
Else
SQL_Ejecutar = EmptyResults
End If
Else
SQL_Ejecutar = QueryError
End If
End Function
Function SQL_ExecuteScalarS(consulta As String, cnnDatos As ADODB.Connection) As String
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarS = vbNullString Else SQL_ExecuteScalarS = rs(0)
Else
SQL_ExecuteScalarS = vbNullString
End If
Set rs = Nothing
End Function
Function SQL_ExecuteScalarL(consulta As String, cnnDatos As ADODB.Connection) As Long
Dim rs As Recordset, res As eEstatus
res = SQL_Ejecutar(consulta, rs, cnnDatos)
If res = OK Then
If IsNull(rs(0)) Then SQL_ExecuteScalarL = -1 Else SQL_ExecuteScalarL = CLng(rs(0))
Else
SQL_ExecuteScalarL = -1
End If
Set rs = Nothing
End Function

Tambíen para funcionar deben incluir la clase cStringBuilder que esta en el primer post de este hilo (http://leandroascierto.com/foro/index.php?topic=1237.msg7092#msg7092)

Saludos
[/quote]


gracias

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 21, 2014, 09:18:08 am

Espectacular amigo Raul, y como se usa estas funciones, podrias poner algun ejemplito por favor

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 21, 2014, 06:53:25 pm

La verdad no entiendo como es el uso de estas funciones amigo.

Código: (VB) [Seleccionar]

Call SQL_Ejecutar("SELECT * FROM clientes", "aca no se que poner", "tampoco aca")

Código: (VB) [Seleccionar]

Call SQL_ExecuteScalarS("SELECT * FROM clientes", "que va aca")

Código: (VB) [Seleccionar]

Call SQL_ExecuteScalarL("SELECT * FROM clientes", "que va aca")

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 21, 2014, 07:18:21 pm

SQL_Ejecutar (no es muy intuitivo el nombre) lo que hace es ejecutar una consulta select (primer parametro), en un recordset (segundo parametro, con una conexíon (3º parametro)
y devuelve un entero/enumeracion que indica si salio bien (hay resultado), si no devolvio nada (no se selecciono ninguna fila) o si hubo un error en la ejecución

SQL_ExecuteScalarS y SQL_ExecuteScalarL sirve para lo mismo, solo que uno devuelve string y otro devuelve Long. Como parámetros toman una consulta que deba devolver UNA Y SOLO UNA CELDA (si devuelven más solo se toma la primera) y una conexión

En el 2º post al final de los ejemplos estan ejemplos a estas llamadas.

Por las dudas lo reposteo acá

Código: (vb) [Seleccionar]

' Para Rellenar algún LV, etc
Dim rs As Recordset
Select Case SQL_Ejecutar("SELECT * FROM tabla WHERE ID < 100", rs, cnnDatos)
        Case eEstatus.QueryError
                Call MsgBox("Hay un error en la consulta")
        Case eEstatus.EmptyResults
                ' Recorset vacio. Avisar que no hay nada
        Case eEstatus.OK
                ' Rellenar ListView o lo que sea usando rs (recordset)
End Select
 
 
' Devuelve un String
Msgbox(SQL_ExecuteScalarS("SELECT nombre FROM clientes WHERE id = 1", cnnDatos))
 
' Devuelve un Long
Msgbox(SQL_ExecuteScalarL("SELECT id FROM clientes WHERE nombre = 'raul'", cnnDatos))


Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 22, 2014, 02:28:15 pm

ya que estamos con ADO y base de datos, lo que tambien hay que tener en cuenta son los Errores de ADO, pero no solo el error interceptable, sino que si hubo error, revisar la colecccion de errores de ado, ya que puede venir mas de un error y el On Error solo capturamos el primero.
Algo asi:

Código: (VB) [Seleccionar]

Dim oErr As adodb.Error

    If oCNN.Errors.Count > 0 Then
       
        For Each oErr In oCNN.Errors
       
            With oErr
                ErrNum = .Number
                ErrDesc = .Description
                ErrNative = .NativeError
                ErrSource = .Source
                SqlState = .SqlState
            End With

        Next
   
        'limpiar coleccion de errores
        oCNN.Errors.Clear
   
    End If


Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: E N T E R en Octubre 22, 2014, 03:07:35 pm

Que bueno es esto amigo Waldo, yo la idea con este post es juntar funciones utiles para nuestro sistemas y asi poder reutilizar el mismo codigo en casi cualquier formulario.

Y si hay alguien que tiene funciones que agilice mas todo lo que sea sobre ADO bienvenido sea.

Gracias por el aporte.

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: gasafonso en Octubre 22, 2014, 03:10:29 pm

Siiiii E NT E R    es justo lo que estoy buscando para mi tema de informes, vos no tenes nada armado ?ya que tenes una forma facil y ordenada de programar


Saludos

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 23, 2014, 02:07:31 pm

Bueno, termine poniendo las funciones de Raul en un modulo, en honor a Raul el modulo se llama "modAdoRaul"  ;)

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 30, 2014, 02:12:23 pm

Estaba probando las funciones de Raul y encontré un error.
En la funcion UpdateTabla

Código: (VB) [Seleccionar]


'cargo un valor tipo string
campos(0) = CampoValue("Producto", "PEPE")

'esta funcion carga el valor, y GetRowValue formatea el dato, en este caso un string, entonces los encierra entre ' '
Public Function CampoValue(Nombre As String, Valor, Optional tipo As CampoTipo = tipoString) As campo
With CampoValue
.Nombre = Nombre
.tipo = tipo
.Valor = GetRowValue(Valor, tipo)
End With
End Function

Public Function GetRowValue(Valor, tipo As CampoTipo) As String
Select Case tipo
Case CampoTipo.tipoDate
Dim d As Date, limit As String, sep As String
d = Valor
Select Case dbEngine
Case dbAccess
limit = "#": sep = "/"
Case dbMySQL
limit = "'": sep = "-"
End Select
GetRowValue = limit & Year(d) & sep & Month(d) & sep & Day(d) & limit
Case CampoTipo.tipoNumero
GetRowValue = CLng(Valor)
Case CampoTipo.tipoString
GetRowValue = "'" & Valor & "'"
Case CampoTipo.tipoBoolean
If CBool(Valor) Then
GetRowValue = "1"
Else
GetRowValue = "0"
End If
Case CampoTipo.tipodouble
GetRowValue = Replace$(CDbl(Valor), ",", ".")
End Select
End Function


'ahora campos(0).valor = 'PEPE'

'y cuando llamamos a UPDATETABLA, vuelve a formatear el valor

Public Function UpdateTabla(ByVal Tabla As String, campos() As campo, sWhere As String, cnn As ADODB.Connection) As Boolean
Dim sql As cStringBuilder
Dim i As Integer, j As Integer
Set sql = New cStringBuilder
Call sql.Append("UPDATE " & Tabla & " SET ")
j = UBound(campos)
For i = 0 To j
Call sql.Append(campos(i).Nombre & "=")
                'aca cuando se concatena, se vuelve a formatear el campo
                'agregar un ''PEPE'' (es decir doble comilla simple, a ambos lados)
Call sql.Append(GetRowValue(campos(i).Valor, campos(i).tipo))
               
                'creo que lo correcto seria:
Call sql.Append(campos(i).valor)

If Not i = j Then
Call sql.Append(",")
End If
Next
Call sql.Append(" WHERE " & sWhere & ";")
Call cnn.Execute(sql.Value, i)
Debug.Print sql.Value, "Rows Affected: " & i
UpdateTabla = i
Set sql = Nothing
End Function







Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 30, 2014, 02:54:17 pm

:O Cierto! Gracias por la aclaración, ahora los corrijo en los posts anteriores

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: Waldo en Octubre 30, 2014, 02:55:58 pm

Probalo bien, pero creo que la explicacion es esa, se formatea dos veces el valor del campo

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: raul338 en Octubre 30, 2014, 05:43:19 pm

En realidad no lo uso más (uso procedimientos almacenados siempre y casi que ni uso vb6)

Pero actualize la llamada en updateTabla e InsertarTabla (http://leandroascierto.com/foro/index.php?topic=2775.0)

Título: Re:Como mejorarian ustedes esta Funcion
Publicado por: YAcosta en Octubre 30, 2014, 07:39:12 pm

Cita de: raul338 en Octubre 30, 2014, 05:43:19 pm

.... y casi que ni uso vb6)

Muchachos... estamos perdiendo a uno

(http://i.snag.gy/sgebV.jpg)