Blóg Indómita

Una funcioncita bastante simple que devuelve caracteres aleatorios de una cadena.

'cadena de la que tomamos los caracteres
Private Const c_caracteres = "ABCDEFGHIJKLMNÑOPQRSTUVWXYZ1234567890abcdefghijklmnñopqrstuvwxyz"

'parámetros opcionales'cuantos caracteres necesitas y la ubicación de la cadena de donde sacarlos
Private Function dame_text_rnd(optional cuantos As Integer=1, optional cadena as string=c_caracteres) As String
Dim i As Integer
Dim longitud as integer
longitud=Len(cadena)
Randomize   For i = 1 To cuantos
dame_text_rnd = dame_text_rnd && Mid(cadena, Int((longitud * Rnd) + 1), 1)
Next i
End Function

Largo ha sido el camino transitado hasta encontrar la solución a uno de mis grandes dilemas.
Ahora que ya he conseguido hacerlo, lo comparto con el mundo.

El crear DSN’s de forma dinámica en tiempo de ejecución nos permite configurar y utilizar las conexiones de los controles y data reports sin miedo a futuros cambios.

El código lo he organizado en un módulo.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Autor: Roberto Herrero                       '''''''''''''''''''''''''''''''
''' Fecha: 05/Junio/2008                         '''''''''''''''''''''''''''''''
'''        http://blog-indomita.blogspot.com/    '''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Origen : Brian Plano Abad                    '''''''''''''''''''''''''''''''
''' Fecha:   20/Dic/2006 (18 Diciembre 2006)     '''''''''''''''''''''''''''''''
'''          bplano@ solingest.com               '''''''''''''''''''''''''''''''
'''          http://www.elguille.info/colabora/vb2006/jesus_Ejemplo_Report_Manager2.htm
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Option Explicit

'Constantes
Private Const ODBC_ADD_DSN = 1 ' Nuevo DSN
Private Const ODBC_CONFIG_DSN = 2 ' Modificar DSN
Private Const ODBC_REMOVE_DSN = 3 ' Eliminar DSN
Private Const ODBC_ADD_SYS_DSN = 4 ' Nuevo DSN de sistema
Private Const ODBC_CONFIG_SYS_DSN = 5 ' Modificar DSN de sistema
Private Const ODBC_REMOVE_SYS_DSN = 6 ' Eliminar DSN de sistema
Private Const vbAPINull As Long = 0 ' Null Pointer
Private Const SQL_SUCCESS As Long = 0
Private Const SQL_FETCH_NEXT As Long = 1

'Declaración de funciones de API
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer
Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (Env As Long) As Integer

'Constantes
'ruta hasta el servidor (ip/nombre/ruta)
Private Const C_Server = "localhost"
'usuario
Private Const C_User = "usuario"
'contraseña
Private Const C_Pass = "contraseña"
'base de datos
Private Const C_BD = "nombre base de datos"
'puerto
Private Const C_Port = 3306
'Nombre ODBC de MySql
'(si no tienes ninguno instalado http://dev.mysql.com/downloads/connector/odbc/5.1.html)
Public Const C_MYSQL_ODBC = "MySQL ODBC 5.1 Driver"



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' FUNCIONES
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Crea el DSN para las conexiones
'(utiliza las constantes por defecto para conectarse a un servidor MySql)
'Si deseas personalizarlo o dinamizarlo deberás utilizar el resto de funciones
Public Function IniciaDSN(sDSNname As String) As Boolean
    'Comprobamos si existe
    If ExisteDSN(sDSNname) = True Then
        'Si existe lo eliminamos previamente.
        If BorrarDSN(sDSNname, C_MYSQL_ODBC) = False Then
            IniciaDSN = False
            Exit Function
        End If
    End If
    
    'Creamos el nuevo DSN.
    IniciaDSN = MySQLCrearDSN(sDSNname)
End Function
 

'Crea un DSN del sistema.
Public Function CrearDSN(sDSN As String, sDriver As String, sAtributos As String, Optional sHwnd As Long = vbAPINull) As Boolean
    'Creamos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
    CrearDSN = CBool(SQLConfigDataSource(sHwnd, ODBC_ADD_SYS_DSN, sDriver, sAtributos))
End Function


'Crea un DSN MySQL con los atributos bien seteados.
Public Function MySQLCrearDSN(sDSN As String, _
 Optional sServer As String = C_Server, Optional sBD As String = C_BD, _
 Optional sUser As String = C_User, Optional sPass As String = C_Pass, _
 Optional sPort As Integer = C_Port) As Boolean
 
    Dim sDriver As String
    Dim sAtributos As String
    
    sDriver = C_MYSQL_ODBC
    sAtributos = "DSN=" & sDSN & Chr(0)
    sAtributos = sAtributos & "SERVER=" & sServer & Chr(0)
    
    sAtributos = sAtributos & "PORT=" & sPort & Chr(0)
    
    sAtributos = sAtributos & "DATABASE=" & sBD & Chr(0)
    
    sAtributos = sAtributos & "USER=" & sUser & Chr(0)
    
    sAtributos = sAtributos & "PASSWORD=" & sPass & Chr(0)
    
    sAtributos = sAtributos & "OPTION=3" & Chr(0)
    
    'Si queremos resetear la conexión de datos, debemos borrarlo antes
    If ExisteDSN(sDSN) Then
        Call BorrarDSN(sDSN, sDriver)
    End If
    
    MySQLCrearDSN = CrearDSN(sDSN, sDriver, sAtributos)

End Function


'Elimina un DSN del sistema.
Public Function BorrarDSN(sDSN As String, sDriver As String, Optional sHwnd As Long = vbAPINull) As Boolean
    Dim sAtributos As String
    ' Borramos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
    If ExisteDSN(sDSN) Then
        sAtributos = "DSN=" & sDSN & Chr(0)
        BorrarDSN = CBool(SQLConfigDataSource(sHwnd, ODBC_REMOVE_SYS_DSN, sDriver, sAtributos))
    Else
        MsgBox ExIdioma("ModDSN_Contr1")
        BorrarDSN = False
    End If
End Function


'Comprueba si existe un DSN en el sistema.
Public Function ExisteDSN(sDSN As String) As Boolean
    Dim I As Integer, j As Integer
    Dim sDSNItem As String * 1024
    Dim sDRVItem As String * 1024
    Dim sDSNActual As String
    Dim sDRV As String
    Dim iDSNLen As Integer
    Dim iDRVLen As Integer
    Dim lHenv As Long 'controlador del entorno
    Dim DSNLISTA(100)
    ExisteDSN = False
    For j = 1 To 52
        DSNLISTA(j) = ""
    Next j
    
    j = 1
    If SQLAllocEnv(lHenv) <> -1 Then
        Do Until I <> SQL_SUCCESS
            sDSNItem = Space(1024)
            sDRVItem = Space(1024)
            I = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
            sDSNActual = VBA.Left(sDSNItem, iDSNLen)
            sDRV = VBA.Left(sDRVItem, iDRVLen)
            If sDSN <> Space(iDSNLen) Then
                DSNLISTA(j) = sDSN
                If UCase(sDSN) = UCase(sDSNActual) Then
                    ExisteDSN = True
                    Exit Do
                End If
            End If
        Loop
    End If
End Function

Hoy subo una funcioncita que me hice hace bastante tiempo para cambiar la contraseña de una base de datos en access desde visual basic 6.

    'CAMBIA LA PASS DE LA BASE DE DATOS
    Public Sub cambia_pass(NewClave As String, Optional OldClave As String = "")
    On Error GoTo actimel
    Dim sDBTmp As String
    Dim NombreMdb As String

    ' en Proyecto->Referencias: Microsof Jet and Replication objects 2.6 Library
    Dim je As JRO.JetEngine
    Set je = New JRO.JetEngine

    ' BD a la que vamos a poner/modificar la contraseña
    NombreMdb = "mibasededatos.mdb"
    sDBTmp = "DBTemp.mdb" ' creamos una BD temporal
    ' si existe la borramos
    If Len(Dir$(sDBTmp)) Then Kill sDBTmp
    sDBTmp = App.Path && "\" && sDBTmp
    ' compactamos la BD y le asignamos la contraseña
    je.CompactDatabase "Data Source=" && NombreMdb && ";" && _
    "Jet OLEDB:Database Password=" && OldClave && ";" && _
    "Data Source=" && sDBTmp && ";" && _
    "Jet OLEDB:Database Password=" && NewClave

    'eliminamos la BD original y renombramos la temporal
    Kill NombreMdb
    Name sDBTmp As NombreMdb
    Exit Sub
    actimel:
    End Sub

Ésto es algo bastante sencillo y muy útil para personalizar/dinamizar los encabezados de los datareports desde visual basic 6.0.

'con with evitamos el tener que repetir todo el rato la ruta

'en ReportHeader pones la sección en la que se encuentra el control

With DataReport1.Sections("ReportHeader")

'cualquier etiqueta

.Controls.Item("Etiqueta1").Caption = "loquesea 1"

'etiqueta n

.Controls.Item("Etiquetan").Caption = "loquesea n"

'imagen

Set .Controls("Image1").Picture = LoadPicture("ruta de la imagen")

End With

El artículo actual es la continuación del Tutorial: Generar etiquetas con Datareport desde Visual Basic 6.0 Creamos un nuevo botón en el formulario (con éste ya vamos por el command4) realizamos su evento click.

Private Sub Command4_Click()
'presentamos el datareport con unión triple de las campañas
DataEnvironment1.cmd_campañas
End Sub

Creamos a continuación tres commands en el dataenviroment1 mismamente. Vamos a renombrarlos porque sino va a ser mucho lío. (más que nada para mi que no estoy acostumbrado a esos nombres xD) cmd_campañas, cmd_chicas, cmd_citas mismamente Ahora generamos las consultas con las nuevas tablas que he añadido: campañas, chicas y citas… ejem (solamente tres ya lo se soy un vago pero no tengo ganas de entrelazar siete tablas para un ejemplo sencillito xD) Mirar un poco la estructura de las tablas y veréis que campañas se enlaza con chicas y que chicas con citas. Bueno generemos las consultas (click derecho encima del command/propiedades/… no voy a entrar en detalles) cmd_campañas

SELECT id_temporada, eslogan, ini_fecha, lugar_apertura FROM campañas

cmd_chicas

SELECT nombre, id_chica, descripcion, dato3, dato2, dato1 FROM chicas where temporada=ident_temporada

cmd_citas

SELECT duracion, id_chica, id_cita, tipo, inc_fecha FROM citas WHERE id_chica=ident_chica

además añadiremos en la pestaña relación: comando primario: cmd_chicas definición de relación: id_chica to ident_chica, agregar, aceptar y listo xD Creamos el data report (DRcampañas) lo asociamos, DataSource=DataEnvironment1 DataMember=cmd_campañas Quitamos forzar a la cuadrícula y le damos a obtener estructura y tenemos un monton de encabezados y pie de grupos xD Posicionamos los campos que queremos mostrar (arrastrandolos desde el dataenviroment mismamente. Cada uno en su posición. Veréis que no os dejará meter los detalles de cmd_citas en encabezados y tal. En cmd_camapañas_header irán los datos de la campaña. En sus propiedades ForcePageBreak le metemos la opción 1- rptPageBreakBefore, para que haga divisiones(saltos de página) por cada campaña diferente. En cmd_chicas_header metemos los datos de las chicas. En cmd_citas_Detail los datos de las chicas y en cmd_chicas_footer meteremos un función count para contar sus citas y una sum para contar sus duraciones globalos mismamente, ave cuál ha soportado a más tios xD Acordaros de poner en el queryclose del data report esto

Private Sub DataReport_QueryClose(Cancel As Integer, CloseMode As Integer)
DataEnvironment1.rscmd_campañas.Close
End Sub

Ala ya hemos terminado, igual hago otro tuto dentro de un par de días en el que enviemos en vez de un parámetro varios y creo que poco más se puede hacer con un data report xD P.D. Visual Basic da un montón de problemas al trabajar con bases de datos y data reports amén de command dialogs de rutas. Ya que se hace la picha un lío y guarda la última ruta que maneja como la raíz del programa. Por lo tango es recomendable guardar la ruta en el load del programa en una variable general o pública si usamos más de un formulario/módulos

Mi_ruta=app.path

y luego al hacer algún cambio en command dialog o al abrir data reports meterle después

ChDir Mi_ruta

Así lograremos que no de problemas, yo en el ejemplo no lo he hecho ya que en los ejemplos de prueba no me ha dado ningún problema xD Subo el códido y el ejemplo: DESCARGAR Ejemplo Data Report Visual Basic 6.0 by RobiHm