Autor Tema: Como mejorarian ustedes esta Funcion  (Leído 13019 veces)

0 Usuarios y 1 Visitante están viendo este tema.

E N T E R

  • Petabyte
  • ******
  • Mensajes: 1062
  • Reputación: +57/-13
  • www.enterpy.com
    • Ver Perfil
    • www.enterpy.com
Como mejorarian ustedes esta Funcion
« 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.
CIBER GOOGLE - CONCEPCIÓN PARAGUAY
www.enterpy.com
Primera regla de la programacion, para que vas a hacerlo complicado si lo puedes hacer sencillo

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #1 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

Saludos
« última modificación: Octubre 30, 2014, 02:55:38 pm por raul338 »

E N T E R

  • Petabyte
  • ******
  • Mensajes: 1062
  • Reputación: +57/-13
  • www.enterpy.com
    • Ver Perfil
    • www.enterpy.com
Re:Como mejorarian ustedes esta Funcion
« Respuesta #2 en: Octubre 18, 2014, 09:52:07 am »
Hola Raul, podrias mostrar como tenes esta funcion: cnnDatos
CIBER GOOGLE - CONCEPCIÓN PARAGUAY
www.enterpy.com
Primera regla de la programacion, para que vas a hacerlo complicado si lo puedes hacer sencillo

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #3 en: Octubre 18, 2014, 11:40:42 am »
cnnDatos es el objeto conexion.

E N T E R

  • Petabyte
  • ******
  • Mensajes: 1062
  • Reputación: +57/-13
  • www.enterpy.com
    • Ver Perfil
    • www.enterpy.com
Re:Como mejorarian ustedes esta Funcion
« Respuesta #4 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
CIBER GOOGLE - CONCEPCIÓN PARAGUAY
www.enterpy.com
Primera regla de la programacion, para que vas a hacerlo complicado si lo puedes hacer sencillo

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #5 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

Waldo

  • Gigabyte
  • ****
  • Mensajes: 264
  • Reputación: +22/-0
    • Ver Perfil
Re:Como mejorarian ustedes esta Funcion
« Respuesta #6 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

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #7 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

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #8 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
« última modificación: Octubre 20, 2014, 03:33:21 pm por raul338 »

Waldo

  • Gigabyte
  • ****
  • Mensajes: 264
  • Reputación: +22/-0
    • Ver Perfil
Re:Como mejorarian ustedes esta Funcion
« Respuesta #9 en: Octubre 20, 2014, 04:16:10 pm »
muy bueno el ExecuteScalar, similar a .net, yo me habia hecho algo asi tamb.

gasafonso

  • Megabyte
  • ***
  • Mensajes: 175
  • Reputación: +4/-10
    • Ver Perfil
Re:Como mejorarian ustedes esta Funcion
« Respuesta #10 en: Octubre 20, 2014, 04:29:09 pm »
PEdon para que es esta funcion ?

raul338

  • Terabyte
  • *****
  • Mensajes: 894
  • Reputación: +62/-8
  • xD fan!!!!! xD
    • Ver Perfil
    • Raul's Weblog
Re:Como mejorarian ustedes esta Funcion
« Respuesta #11 en: Octubre 21, 2014, 12:02:36 am »
PEdon para que es esta funcion ?
cual de todas?

gasafonso

  • Megabyte
  • ***
  • Mensajes: 175
  • Reputación: +4/-10
    • Ver Perfil
Re:Como mejorarian ustedes esta Funcion
« Respuesta #12 en: Octubre 21, 2014, 08:09:25 am »
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

Saludos
[/quote]


gracias
« última modificación: Octubre 21, 2014, 08:12:00 am por gasafonso »

E N T E R

  • Petabyte
  • ******
  • Mensajes: 1062
  • Reputación: +57/-13
  • www.enterpy.com
    • Ver Perfil
    • www.enterpy.com
Re:Como mejorarian ustedes esta Funcion
« Respuesta #13 en: Octubre 21, 2014, 09:18:08 am »
Espectacular amigo Raul, y como se usa estas funciones, podrias poner algun ejemplito por favor
CIBER GOOGLE - CONCEPCIÓN PARAGUAY
www.enterpy.com
Primera regla de la programacion, para que vas a hacerlo complicado si lo puedes hacer sencillo

E N T E R

  • Petabyte
  • ******
  • Mensajes: 1062
  • Reputación: +57/-13
  • www.enterpy.com
    • Ver Perfil
    • www.enterpy.com
Re:Como mejorarian ustedes esta Funcion
« Respuesta #14 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")
« última modificación: Octubre 21, 2014, 07:02:35 pm por E N T E R »
CIBER GOOGLE - CONCEPCIÓN PARAGUAY
www.enterpy.com
Primera regla de la programacion, para que vas a hacerlo complicado si lo puedes hacer sencillo