Discussion :

[hottnikks_79]

Bonjour,

J'ai 13 usagers utilisant une application pour laquelle je n'ai que 5 licences.
J'aimerais à l'aide d'une Macro Access ou autre démarrer cette application et qu'à chaque fois qu'un usager l'ouvre(in) ou la ferme (out) ça écrit un enregistrement dans la BD. Je sais commet l'ouvrir par Access mais pas commet la fermer. Donc par exemple, quand j'aurais 5 enregistrements IN et 0 OUT ça voudrait dire que mes 5 licences sont utilisées et qu'un 6e ouverture de l'application ne la démarrerait pas.

merci

[Invité]

Bonjour

Je ne comprends pas tu as 5 licences et 13 utilisateurs, cela vourdrait-il dire que tu à installer Access 13 fois ?

Starec

[hottnikks_79]

Non, l'application pour laquelle je n'ai que 5 licences n'est pas Access c'est un autre produit

[Kloun]

J'utilise ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Option Compare Database
Option Explicit
 
Private Type Un_Connecté
    ' --nom PC
    PC(1 To 32) As Byte
     ' --nom utilisateur
    User(1 To 32) As Byte
End Type
 
Function NbConnecte() As Integer
    NbConnecte = UBound(Split(WHO_IS, ";"))
End Function
 
Private Function WHO_IS() As String
 ' -- retourne une liste séparée par des points virgules indiquant le nom de l'ordinateur ainsi que
 ' -- l'utilisateur connecté à la base.
Dim Mon_LDB As Integer, i As Integer
Dim Mon_Chemin As String
Dim Mon_Log As String, Ma_Connexion As String
Dim Nom_PC As String, Nom_Utilisateur As String
Dim utilisateur As Un_Connecté
On Error GoTo Err_WHO_IS
    Mon_Chemin = CurrentDb.Name
    CurrentDb.Close
    ' --Aller chercher le LDB
    Mon_Chemin = left(Mon_Chemin, InStr(1, Mon_Chemin, ".")) + "LDB"
    Mon_LDB = FreeFile
    ' --Ouvrir le LDB
    Open Mon_Chemin For Binary Access Read Shared As Mon_LDB
    ' -- Lire le LDB
    Do While Not EOF(Mon_LDB)
        ' -- Chaque enregistrement lu est placé dans la variable utilisateur pour y être traité.
        Get Mon_LDB, , utilisateur
        With utilisateur
            i = 1
            Nom_PC = ""
            ' -- nom du PC
            While .PC(i) <> 0
                Nom_PC = Nom_PC & Chr(.PC(i))
                i = i + 1
            Wend
            i = 1
            Nom_Utilisateur = ""
            ' -- nom de l'utilisateur
            While .User(i) <> 0
                Nom_Utilisateur = Nom_Utilisateur & Chr(.User(i))
                i = i + 1
            Wend
        End With
        Mon_Log = Nom_PC & " | " & Nom_Utilisateur
        If InStr(Ma_Connexion, Mon_Log) = 0 Then
        Ma_Connexion = Ma_Connexion & Mon_Log & ";"
        End If
    Loop
    Close Mon_LDB
    ' --WHO_IS contient la liste des utilisateurs
    WHO_IS = Ma_Connexion
Exit_WHO_IS:
    Exit Function
Err_WHO_IS:
    MsgBox Err.Number & vbCrLf & Err.Description, vbInformation, "Erreur"
    Close Mon_LDB
    Resume Exit_WHO_IS
End Function

Pour récupérer le nombre de connectés à ma base access.
Ensuite, tu peux utiliser ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Option Compare Database
Option Explicit
 
Type strucPROCESSENTRY32
    dwSize As Long              ' DWORD : Size of the structure, in bytes
    cntUsage As Long            ' DWORD : not used (0)
    th32ProcessID As Long       ' DWORD : PID
    th32DefaultHeapID As Long   ' ULONG_PTR : not used (0)
    th32ModuleID As Long        ' DWORD : not used (0)
    cntThreads As Long          ' DWORD : Threads
    th32ParentProcessID As Long ' DWORD : parent process ID
    pcPriClassBase As Long      ' LONG
    dwFlags As Long             ' LONG : not longer used (0)
    szExeFile As String * 512   ' TCHAR szExeFile[MAX_PATH] name of the executable file for the process
End Type
 
Const TH32CS_SNAPPROCESS As Long = &H2
Const PROCESS_TERMINATE As Long = &H1
Const PROCESS_QUERY_INFORMATION As Long = &H400
 
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As strucPROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As strucPROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal dwExitCode As Long) As Long
 
Sub TermProcess(strProcessName As String)
Dim hSnapshot As Long
Dim lppe As strucPROCESSENTRY32
Dim hProc As Long
Dim Retval As Long
Dim strPrcsName As String
 
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    lppe.dwSize = Len(lppe)
    Retval = Process32First(hSnapshot, lppe)
 
    Do While Retval
        strPrcsName = left(lppe.szExeFile, InStr(1, lppe.szExeFile, vbNullChar) - 1)
        ' Debug.Print strPrcsName, lppe.th32ProcessID
        If strPrcsName Like strProcessName Then
            hProc = OpenProcess(PROCESS_TERMINATE, 0, lppe.th32ProcessID)
            If hProc <> 0 Then
                Retval = TerminateProcess(hProc, 0)
                ' Si Retval=0 échec de la fonction TerminateProcess(..)
                Call CloseHandle(hProc)
            End If
        End If
        ' Process Suivant
        Retval = Process32Next(hSnapshot, lppe)
    Loop
 
    Call CloseHandle(hSnapshot)
 
End Sub
Private Sub test()
    TermProcess "EXCEL.EXE"
End Sub
 
Function KillProcess(pLng_ProcessId As Long)
Dim hProc As Long
Dim Retval As Long
 
    hProc = OpenProcess(PROCESS_TERMINATE, 0, pLng_ProcessId)
    If hProc <> 0 Then
        Retval = TerminateProcess(hProc, 0)
        ' Si Retval=0 échec de la fonction TerminateProcess(..)
        Call CloseHandle(hProc)
    End If
End Function

Pour tuer un process à la fermeture d'access.

En gros, à l'ouverture de la base access, tu comptes le nombre de connectés. Si c'est sup au max, tu fermes la base.
A la fermeture de la base, tu tues le process de ton appli.
Si c'est inf au max, tu ouvres l'appli.

[hottnikks_79]

Merci Beaucoup