MS Access FE Mysql BE with login
Posted by: pincobillo schubidu
Date: September 28, 2013 07:52AM
Date: September 28, 2013 07:52AM
hello all.
this is my first time here.
i'm doing a database with MSAccess as front-end and Mysql as Back-end.
I have install XAMPP for try it as localhost.
I' haven't whrite the code, but i have found it here:
http://forum.masterdrive.it/access-79/login-sicurezza-form-44771/
The code is:
I need to open a DBconnection first to extract the user's rs, after for relink the tables.
Please help!
this is my first time here.
i'm doing a database with MSAccess as front-end and Mysql as Back-end.
I have install XAMPP for try it as localhost.
I' haven't whrite the code, but i have found it here:
http://forum.masterdrive.it/access-79/login-sicurezza-form-44771/
The code is:
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" ' ----------------------------------------------------------- ' 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 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 FunctionThis demo is based as DAO-JET, and i don't know how correct it for ODBC or OleDB...
I need to open a DBconnection first to extract the user's rs, after for relink the tables.
Please help!
Subject
Written By
Posted
Sorry, you can't reply to this topic. It has been closed.
Content reproduced on this site is the property of the respective copyright holders. It is not reviewed in advance by Oracle and does not necessarily represent the opinion of Oracle or any other party.