Access and mysql - DAO (1 Viewer)

schakalaka · Oct 18, 2013

Hello.
i have a little problem..
i have found a demo, on the web. i want change it for use it with remote mysql, (for example on db4free.net). the demo use DAO, and i wan't change to ADO because it mean rewrite all program.
This is the code to change:

Code:

Option Compare Database
Option Explicit

' -----------------------------------------------------------
' La CONNECTIONSTRING sarebbe da salvare come KRYPTATA
' magari in un REGISTRY ma per semplificare il DEMO
' la riporto quì e genero la FUNZIONE:
'
'   getConnectionString()
'
' -----------------------------------------------------------
Public Const DB_SERVER      As String = "SERVERXP.mdb"

modificato in:

Public Const DB_SERVER      As String = "db4free.net"
' -----------------------------------------------------------
' Salvo in costanti il nome delle TABELLE BASE
' -----------------------------------------------------------
' [_TL]     ELENCO TABELLE DA LINKARE
' [_FP]     FORM PERMISSION
' [_USERS]  ELENCO UTENTI
' -----------------------------------------------------------
Public Const DB_LINKEDTABLE As String = "_TL"
Public Const DB_PERMESSI    As String = "_FP"
Public Const DB_USERTABLE   As String = "_USERS"

' -----------------------------------------------------------
' DataType personalizzato per le variabili AMBIENTE APPLICATIVO
' -----------------------------------------------------------
Public Type APP_AMB_TYPE
    USER_IDUSER             As Long
    USER_NAME               As String
    USER_LEVEL              As Integer
End Type
' -----------------------------------------------------------
' Variabile ambiente con i dati essenziali del LOGIN SALVATI
' -----------------------------------------------------------
Public APP_DATA             As APP_AMB_TYPE

' -----------------------------------------------------------
' METODI PUBLIC DI APPLICATIVO GESTIONE USERS
' -----------------------------------------------------------
Public Function getConnectionString() As String
    getConnectionString = CurrentProject.Path & "\" & DB_SERVER

modificato in:
getConnectionString = "DNS = mioDNs;Uid = miouser;Pwd = miapass;"

End Function

Public Function getUSER(strUSER As String, strPWD As String) As Boolean

    On Error GoTo ERR_USER
    Dim strSQL              As String
    Dim strUSER_C           As String
    Dim strPWD_C            As String
    Dim rs                  As DAO.Recordset
    Dim APP_DB_CONN         As DAO.Database
    
    strUSER_C = strUSER
    strPWD_C = strPWD
    ' ----------------------------------------------------------
    ' Quì metto l'algoritmo di CODIFICA, perchè
    ' nel DB_SERVER non scriverò MAI la PASSWORD in chiaro quindi
    ' il CHECK verrà fatto sul testo CRYTTOGRAFATO...!!!
    ' ----------------------------------------------------------
    strPWD_C = Transform(strPWD_C)
    ' ----------------------------------------------------------
    
    strUSER_C = "'" & Replace(strUSER_C, "'", "''") & "'"
    strPWD_C = "'" & Replace(strPWD_C, "'", "''") & "'"
    
    strSQL = "SELECT * FROM " & DB_USERTABLE & " "
    strSQL = strSQL & "WHERE USER=" & strUSER_C & " AND "
    strSQL = strSQL & "PWD=" & strPWD_C
    
    Set APP_DB_CONN = DBEngine.OpenDatabase(getConnectionString())

    Set rs = APP_DB_CONN.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
    ' Se il RS è vuoto significa LOGIN FALLITO
    If rs.EOF Then
        MsgBox "USER O PWD ERRATI"
        getUSER = False
    Else
        APP_DATA.USER_NAME = strUSER
        APP_DATA.USER_LEVEL = rs.Fields("LEVEL").Value
        APP_DATA.USER_IDUSER = rs.Fields("ID_USER").Value
        getUSER = True
    End If

EXIT_HERE:

    rs.Close
    Set rs = Nothing
    APP_DB_CONN.Close
    Set APP_DB_CONN = Nothing
    
    rs.Close
    Set rs = Nothing

    Exit Function
    
ERR_USER:
    ' ----------------------------------------------------------
    ' Intercetto l'errore derivato da RS/APP_DB_CONN non presenti
    ' ----------------------------------------------------------
    If Err.Number = 91 Then Resume Next
    getUSER = False
    Resume EXIT_HERE
End Function

Public Function getPermissionTable() As Boolean
    On Error Resume Next
    ' ----------------------------------------------------------
    ' Cancello la Tabella PERMESSI nel caso ci fosse
    ' ----------------------------------------------------------
    DoCmd.DeleteObject acTable, DB_PERMESSI
    
    On Error GoTo ERR_PERM
    Dim strSQL                  As String

    ' ----------------------------------------------------------
    ' COPIO IN LOCALE LA TABELLA [_FP]
    ' ----------------------------------------------------------
    strSQL = "SELECT * INTO " & DB_PERMESSI & " "
    strSQL = strSQL + "FROM " & DB_PERMESSI & " IN '" & getConnectionString() & "' "
    strSQL = strSQL + "WHERE ID_USER = " & APP_DATA.USER_IDUSER
    DBEngine(0)(0).Execute strSQL, dbFailOnError
    getPermissionTable = True
EXIT_HERE:
    Exit Function
    
ERR_PERM:
    getPermissionTable = False
End Function

Public Function getLinkedTable() As Boolean
    Dim rs                      As DAO.Recordset
    Dim strConnection           As String
    
    On Error GoTo ERR_LINKED
    ' ----------------------------------------------------------
    ' Cancello la Tabella LINKED nel caso ci fosse prima di ricopiarla
    ' ----------------------------------------------------------
    DoCmd.DeleteObject acTable, DB_LINKEDTABLE

    getLinkedTable = False
    strConnection = getConnectionString()
    
    Dim strSQL                  As String
    ' ----------------------------------------------------------
    ' STRINGA SQL di creazione TABELLA da DB(REMOTO)
    ' Copio il locale la Tabella con l'elenco delle Tabelle
    ' da LINKARE.
    ' ----------------------------------------------------------
    strSQL = "SELECT * INTO " & DB_LINKEDTABLE & " "
    strSQL = strSQL + "FROM " & DB_LINKEDTABLE & " IN '" & strConnection & "'"

    DBEngine(0)(0).Execute strSQL, dbFailOnError
    
    ' ----------------------------------------------------------
    ' APRO UN RS CON L'ELENCO DELLE TABELLE DA LINKARE
    ' CONTENUTO NELLA TABELLA COPIATA [_TL]
    ' ----------------------------------------------------------
    Set rs = DBEngine(0)(0).OpenRecordset(DB_LINKEDTABLE, dbOpenDynaset, dbReadOnly)
    If rs.EOF Then
        Exit Function
    End If
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF
        ' ----------------------------------------------------------
        ' Prima di LINKARLE le cancello per sicurezza
        ' Ho disabilitato la gestione errori proprio per
        ' evitare anomalia in caso la tabella non fosse presente
        ' ----------------------------------------------------------
        DoCmd.DeleteObject acTable, rs.Fields("TABLENAME").Value
        DoEvents
        DoCmd.TransferDatabase acLink, _
                               "Microsoft Access", _
                               strConnection, _
                               acTable, _
                               rs.Fields("TABLENAME").Value, _
                               rs.Fields("TABLENAME").Value
        rs.MoveNext
    Loop
    getLinkedTable = True
    
EXIT_HERE:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Exit Function
    
ERR_LINKED:
    ' ----------------------------------------------------------
    ' Se non trova la Tabella da ELIMINARE riprende ERR=7874
    ' ----------------------------------------------------------
    If Err.Number = 7874 Then Resume Next
    Resume EXIT_HERE
End Function

Public Function SetPermissionProperties(frm As Access.Form) As Boolean
    ' ----------------------------------------------------------
    ' IMPOSTA LE PROPRIETA' DELLA FORM PASSATA
    ' ----------------------------------------------------------
    
    On Error GoTo ERR_PROP
    
    Dim strSQL                  As String
    Dim rs                      As DAO.Recordset
    Dim blAllowAddition         As Boolean
    Dim blAllowEdits            As Boolean
    Dim blAllowDeletions        As Boolean
    
    strSQL = "SELECT * FROM _FP "
    strSQL = strSQL + "WHERE FORM_NAME='" & frm.Name & "' "
    strSQL = strSQL + "AND ID_USER=" & APP_DATA.USER_IDUSER
    
    Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
    blAllowAddition = rs.Fields("pALLOWADDITIONS").Value
    blAllowEdits = rs.Fields("pALLOWDELETIONS").Value
    blAllowDeletions = rs.Fields("pALLOWEDITS").Value
    rs.Close
    Set rs = Nothing
    
    Call FormPermissionRicorsiva(frm, blAllowAddition, blAllowEdits, blAllowDeletions)
    
    Exit Function
    
ERR_PROP:
    MsgBox "Errore grave...!", vbCritical, "AVVISO"
    DoCmd.Quit acQuitSaveNone

End Function

Public Function FormPermissionRicorsiva(mFrm As Access.Form, _
                                        blAllowAddition As Boolean, _
                                        blAllowEdits As Boolean, _
                                        blAllowDeletions As Boolean)
                                        
    Dim ctl                     As Access.Control
    
    mFrm.ALLOWADDITIONS = blAllowAddition
    mFrm.ALLOWDELETIONS = blAllowEdits
    mFrm.ALLOWEDITS = blAllowDeletions

    For Each ctl In mFrm.Controls
        If ctl.ControlType = acSubform Then
            Call FormPermissionRicorsiva(ctl.Form, blAllowAddition, blAllowEdits, blAllowDeletions)
        End If
    Next

End Function

Public Sub msgBoxPermission(frm As Access.Form)
    ' ----------------------------------------------------------
    ' GENERA UN MSGBOX CON L'INFORMATIVA DEI PRIVILEGI
    ' ----------------------------------------------------------
    Dim strMSG              As String
    Dim rs As DAO.Recordset
    Set rs = DBEngine(0)(0).OpenRecordset("SELECT * FROM _FP WHERE FORM_NAME='" & frm.Name & "' AND ID_USER=" & APP_DATA.USER_IDUSER, dbOpenDynaset, dbReadOnly)
    strMSG = "I Privilegi attivi per l'Utente ---> [" & APP_DATA.USER_NAME & "]"
    strMSG = strMSG + vbCrLf
    strMSG = strMSG + "nella Maschera [" & frm.Name & "] sono:" + vbCrLf + vbCrLf
    strMSG = strMSG + "1 - CONSENTI AGGIUNTE = " & IIf(rs.Fields("pALLOWADDITIONS").Value = True, "VERO", "FALSO") + vbCrLf
    strMSG = strMSG + "2 - CONSENTI MODIFICHE = " & IIf(rs.Fields("pALLOWEDITS").Value = True, "VERO", "FALSO") + vbCrLf
    strMSG = strMSG + "3 - CONSENTI ELIMINAZIONE = " & IIf(rs.Fields("pALLOWDELETIONS").Value = True, "VERO", "FALSO") + vbCrLf + vbCrLf
    strMSG = strMSG + "LIVELLO = " & APP_DATA.USER_LEVEL
    
    rs.Close
    Set rs = Nothing
    MsgBox strMSG, vbInformation, "..:: AVVISO ::.."
End Sub

Public Function getAllowOpen(strFROM2OPEN As String) As Boolean
    On Error GoTo ERR_ALLOWOPEN
    ' ----------------------------------------------------------
    ' Funzione che restituisce un BOOLEAN di permissivo
    ' TRUE se la FORM passata rientra nelle FORM concesse
    ' ----------------------------------------------------------
    Dim rs As DAO.Recordset
    Set rs = DBEngine(0)(0).OpenRecordset("SELECT COUNT(*) FROM _FP WHERE FORM_NAME='" & strFROM2OPEN & "' AND ID_USER=" & APP_DATA.USER_IDUSER, dbOpenDynaset, dbReadOnly)
    getAllowOpen = rs.Fields(0) > 0
EXIT_HERE:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Exit Function
    
ERR_ALLOWOPEN:
    getAllowOpen = False
    Resume EXIT_HERE
End Function

Public Function CLOSE_DB()
    ' ----------------------------------------------------------
    ' FUNZIONE CHE RIMUOVE TUTTE LE CONNESSIONI E LE
    ' TABELLE COPIATE IN LOCALE
    ' ----------------------------------------------------------
    On Error GoTo Err_Close
    Dim rs                      As DAO.Recordset
    
    
    Set rs = DBEngine(0)(0).OpenRecordset(DB_LINKEDTABLE, dbOpenDynaset, dbReadOnly)
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF
        DoCmd.DeleteObject acTable, rs.Fields("TABLENAME").Value
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
ERR_SECOND_STEP:
    On Error Resume Next
    DoCmd.DeleteObject acTable, DB_PERMESSI
    DoCmd.DeleteObject acTable, DB_LINKEDTABLE
    
    Exit Function
    
Err_Close:
    Resume ERR_SECOND_STEP
End Function

Public Function CloseAllForms(Optional strForm As String = vbNullString) As Boolean
    On Error GoTo Err_Close
    Dim n               As Integer
    Dim x               As Integer
    
    n = Forms.Count
    For x = n - 1 To 0 Step -1
        If Forms(x).Name <> strForm Then DoCmd.Close acForm, Forms(x).Name
    Next
    CloseAllForms = True

EXIT_HERE:
    Exit Function
Err_Close:
    CloseAllForms = False
    Resume EXIT_HERE
End Function

The changements to do are 2:
First, open a db connection before extract the user's rs,
Second, where the demo select a PATH, change it, with a ODBC-DIRECT options.
the demo is here:

Code:

http://forum.masterdrive.it/attachments/access-79/852d1267532198-login-sicurezza-form-login_permission.zip

Thenks for all!!!!!!!!!!!!!

Rx_ · Oct 22, 2013

http://dev.mysql.com/doc/connector-...examples-tools-with-access-linked-tables.html
I have never used mysql. I think it is just another ISAM data structure.
At any rate, you will need to create Linked Tables from MS Access to MySQL
Looking at the web link posted above, it appears to be possible. Hopefully you can find other web links like this one to accomplish the Linked Table to MySQL.

Once the Linked Tables are in place, be sure to step through the code one line at a time to see what happens.

Access and mysql - DAO (1 Viewer)

schakalaka

New member

Rx_

Nothing In Moderation

Similar threads

Users who are viewing this thread