1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Récupérer la liste des utilisateurs loggés sur une base access

Récupérer la liste des utilisateurs loggés sur une base access

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 013 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

Cette procédure vous permet de récupérer, pour une base Access donnée (ici le fichier porte le même nom que l'EXE) l'ensemble des utilisateurs qui y sont connectés grâce à la lecture du fichier de verrous .LDB

Source / Exemple : 


Public Function GetDBCurrentUsers(pDataBasePath as String, pUsersList As Control, Optional ByVal pClearListFirst As Boolean = False)
    Dim rep As Long, LDBFile  As String
    Dim FileID As Long, Buffer As String * 300
    Dim pos1 As Long, pos2 As Long
    
    'On Error GoTo GetDBCurrentUsersError
    
    If pClearListFirst Then pUsersList.Clear
    
    'Chemin du fichier de verrous de la base
    LDBFile = pDataBasePath & "\" & App.EXEName & ".LDB"

    'Envoi de l'erreur dans le fichier d'erreur de l'application
    FileID = FreeFile
    
    Open LDBFile For Binary Access Read As FileID
    
    'Lecture complète du fichier dans la structure
    Get FileID, , Buffer
    pos1 = 1
    Do
        pos2 = InStr(pos1 + 1, Buffer, Chr$(0))
        If pos2 > 0 Then If InStr(Mid$(Buffer, pos1, pos2 - pos1), " ") = 0 And pos2 - pos1 > 1 Then pUsersList.AddItem Mid$(Buffer, pos1, pos2 - pos1)
        pos1 = pos2 + 1
    Loop While pos1 > 0 And pos2 > 0
    Close FreeFile

GetDBCurrentUsersError:
    Exit Function
End Function

Conclusion :


Attention : certains utilisateurs peuvent être doublés s'ils ont ouvert implicitement plusieurs pages sur la base de données. Pour avoir une liste distincte, il faut mieux alors passer par un tableau avant de tout afficher dans la liste.

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
12
Date d'inscription
lundi 26 juillet 2004
Statut
Membre
Dernière intervention
25 août 2004
bonjour g un probleme de recuperation de données en fait je fais une recherche dans la base grace a une clé composée de trois champs operation, typeproduit et le codeproduit ce troisième champs me crée des probleme car il est de type texte :
voici la requete
Rq " SELECT * FROM produit , typeproduit_operation , operation WHERE CODEPROD " & var & " and produit.codeoper = " & Label3 & " and produit.codtyppr = typeproduit_operation.codtyppr and produit.codtyppr = " & Label4 & " and produit.codeoper = operation.codeoper and typeproduit_operation.codeoper = operation.codeoper "

ou var est une variable qui contient le codeproduit
quand je change le type de ce champs en numerique tout marche bien mais rien ne marche plus quand je reviens au type caractere
le message que le vb m'affiche c'est qu'il ya trop peu de parametre, 1 attendu
merci d'avance
c urgent
Signaler
Messages postés
468
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
30 août 2007
 2
eueuh bah moi jai pas reussi a la faire marcher je l'ai modifier un chouilla...

Public Function GetDBCurrentUsers(pDataBasePath As String, pUsersList As Control, Optional ByVal pClearListFirst As Boolean = False)
Dim rep As Long, LDBFile As String
Dim FileID As Long, Buffer As String * 300
Dim pos1 As Long, pos2 As Long

'On Error GoTo GetDBCurrentUsersError

If pClearListFirst Then pUsersList.Clear

'Chemin du fichier de verrous de la base
Mid(pDataBasePath, Len(pDataBasePath) - 2, 3) = "ldb"
'LDBFile = pDataBasePath & "" & App.EXEName & ".LDB"
LDBFile = pDataBasePath

'Envoi de l'erreur dans le fichier d'erreur de l'application
FileID = FreeFile

Open LDBFile For Binary Access Read As FileID

'Lecture complète du fichier dans la structure
Get FileID, , Buffer
pos1 = 1
Do
pos2 = InStr(pos1 + 1, Buffer, Chr$(0))
If pos2 > 0 Then If InStr(Mid$(Buffer, pos1, pos2 - pos1), " ") = 0 And pos2 - pos1 > 1 Then pUsersList.AddItem Mid$(Buffer, pos1, pos2 - pos1)
pos1 = pos2 + 1
Loop While pos1 > 0 And pos2 > 0
Close FreeFile

GetDBCurrentUsersError:
Exit Function
End Function

Private Sub Command1_Click()
toto = GetDBCurrentUsers("d:\visual_basic\mydb.mdb", List1, True)
End Sub


voila, avec le petit exemple ds le command1_click

pitit probleme aussi..le ldb se met ds le meme repertoire ke le mdb...ya pa a aller chercher le app.path!!

donc en tout cas merci pour cette source qui me sera très utile pour une appli qui se connecte a une base unique depuis une vingtaine de postes !!

(un 6/10 quand meme)

@+
juva
Signaler
Messages postés
129
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
12 février 2009
Pour être franc, pour une annonce débutant, cette source mériterait un petit exemple...
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Matesys)