Discussion :

[Just-Soft]

Salut;
J'utilise une base de données access, j'aimerais tester si elle est déjà connectée ou pas si c'est le cas je la déconnecte pour ne pas avoir une violation. J'ai fais ç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
cheminBD := GetCurrentDir + '\DATA\'+Trim(FileListBox1.Items.Strings[ListDossier.ItemIndex]);
  try
    // comapctage auto
    CompactAccessDB(CheminBD, 'paie');
    // déconnexion
    DModule.bdPaie.Connected := False;
    // changement de la bd
    if change_bd_dsn('Microsoft Access Driver (*.mdb)' + #0, 'NobleSoft_Paie', CheminBD) then
       DModule.bdPaie.Connected := True
    else Application.Terminate;
    // écrire dans la base de registre le chemin complet de la bd en cours d'utilisation
    // écrire_cheminbd_reg
  except
    MessageDlg('La connexion à la base de données a échoué', mtError, [mbYes], 0);
    Application.Terminate;
  end;

Mais sans résultat. Où est le problème?

Merci d'avance.

[bigane]

Bonjour,

Je n'utilise pas Delphi, mais j'ai longtemps pratiqué Access et VB6...

Voici ce que je sais :
1) Access accepte jusqu'à 255 connexions d'utilisateurs en simultané (et en réseau), mais si le moteur plante, bonjours les dégâts.

2) On ne peut compacter une base que si on est seul et qu'on l'ouvre en mode exclusif.

3) Lorsqu'on ouvre une base Access, le moteur crée un fichier avec le même nom mais avec l'extension .mda. Il existe de nombreux fils de discussion sur ce fichier et plein d'astuce pour l'explorer. C'est de cette manière que tu peux connaitre la présence ou non d'un utilisateur.

Je vais tenter de te faire comprendre le principe :

Le moteur ouvre le fichier
Il demande au système de verouiller (poser un lock) un octet (numéro 1) bien précis du fichier à une adresse très lointaine (c'est du genre 0x1000000 + 1 ). Si il réussi, c'est que l'utilisateur 1 n'existe pas, il peut donc prendre cette place dans le fichier mda. Sinon, il tente de verrouiller l'adresse 0x1000000 + 2, pour prendre la place de l'utilisateur numéro 2. etc jusqu'à 255 .

Pour savoir si une connexion est toujours vivante (et un utilisateur toujours connecté) il suffit de parcourir les 255 positions et d'y mettre un verrou.

J'ai programmé un truc du genre en 98...99 sous VB6.

Code vb :

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Public Type T_AccessUser
    UserId          As Byte    ' de 1 à 255
    CommitByte      As Integer 'Valeur du mot de commit dans la base Access
    ComputerName    As String
    SecurityName    As String
    isLogOn         As Boolean 'Vrai si utilisateur encore connecté
    'Ces autres renseignements sont propres à mon application
    DatConnect      As Date    'date de création des fichiers tmp
    Version         As String  'Dernière version du logiciel utilisé
    UserName        As String  'Nom de connexion de l'utilisateur du logiciel
    ComputerBase    As String  'Nom de l'ordinateur ayant la base de production (si connu)
End Type
Public Type T_AccessConnexions
    Nbr             As Long
    CommitByte(256) As Integer
    User()          As T_AccessUser
End Type
 
Private Declare Function LockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Private Declare Function UnlockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" _
                              (ByVal hFile As Long, _
                               lpBuffer As Any, _
                               ByVal nNumberOfBytesToRead As Long, _
                               lpNumberOfBytesRead As Long, _
                               ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32" _
                                Alias "CreateFileA" (ByVal lpFileName As String, _
                                ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
                                ByVal lpSecurityAttributes As Long, _
                                ByVal dwCreationDisposition As Long, _
                                ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
                                As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const LOCKFILE_FAIL_IMMEDIATELY = &H1
Private Const LOCKFILE_EXCLUSIVE_LOCK = &H2
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_BEGIN = 0
Private Const FILE_END = 2
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Public Const OF_SHARE_EXCLUSIVE = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const OPENCHANNEL = 4110
 
'---------------------------------------------------------------
' Lecture de toutes les informations disponibles dans les
' fichier mdb et ldb pour remplir la structure Config.Connexions
'---------------------------------------------------------------
 
Public Sub LireConnexions(BaseName As String, ByRef Connexions As T_AccessConnexions)
    Dim LdbName     As String
    Dim hFile       As Long
 
    Dim dwPos       As Long
    Dim res         As Long
    Dim i           As Long
    Dim nbrConnect  As Long
    Dim iFicIn As Integer
 
    'Création du nom du ldb
    '(en espèrant que le BaseName est du type ~.XYZ)
    LdbName = Left$(BaseName, Len(BaseName) - 3) & "ldb"
    Connexions.Nbr = 0
    ReDim Connexions.User(0)
    'Tente de lire les commitBytes du mdb :
 
    iFicIn = FreeFile
    If Dir$(BaseName) <> vbNullString Then
        Open BaseName For Binary Access Read As #iFicIn
        Get #iFicIn, &H600, Connexions.CommitByte
        Close #iFicIn
 
        'Tente d'ouvrir le ldb
        hFile = CreateFile(LdbName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
        If hFile <> INVALID_HANDLE_VALUE Then
            dwPos = SetFilePointer(hFile, 0, 0, FILE_END)
            For i = 1 To 255
                dwPos = &H10000000 + i
                res = LockFile(hFile, dwPos, 0, 1, 0)
                'Si impossible à locker, c'est que la  connexion existe déjà !
                If res = 0 Then
                    Connexions.Nbr = Connexions.Nbr + 1
                    ReDim Preserve Connexions.User(Connexions.Nbr)
                    With Connexions.User(Connexions.Nbr)
                        SeekAbsolute hFile, 0, 64 * i - 64
                        .UserId = i
                        .ComputerName = ReadBytes(hFile, 32)
                        .SecurityName = ReadBytes(hFile, 32)
                        .CommitByte = Connexions.CommitByte(i)
 
                        'Les données suivantes sont fournies par défaut
                        .isLogOn = True
                        .DatConnect = Now 'Par défaut !
                        .UserName = Config.User.UserName
                        .Version = Config.User.Version
                        .ComputerBase = RetrouveComputerBase()
                        If UCase$(.ComputerBase) = "C:" Then
                            .ComputerBase = .ComputerName
                        End If
                    End With
                Else
                    res = UnlockFile(hFile, dwPos, 0, 1, 0)
                End If
            Next
            'Refermer ce fichier
            Call CloseHandle(hFile)
        End If
    End If
End Sub
 
'--------------------------------------------------------------------------
' Retourne le nombre d'utilisateurs connectés actuellement à la base
'--------------------------------------------------------------------------
Private Function GetNombreConnexions(BaseName As String) As Long
    Dim C As T_AccessConnexions
    'lecture utilisateurs actuellement connectés à la base
    On Error Resume Next
    If Dir$(BaseName) <> vbNullString Then
        C.Nbr = 0
        Call LireConnexions(BaseName, C)
        GetNombreConnexions = C.Nbr
    End If
    Err.Clear
End Function

Voilà,
je suis certain qu'il y a déjà un source de ce genre en Delphi, sinon cela peut te donner une idée de la procédure à réécrire en Pascal. En cherchant bien sous Google (recherche de code) : http://www.google.com/codesearch?hl=fr
tu devrais trouver de bons exemples.

Bon courage,
a+

[Just-Soft]

Merci Bigane, très sympa ton explication j'essayerai de réécrire tout ça en pascal comme tu la bien dis et puis je vais voir ce que ça va donner comme résultat.