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
|
Function ConnexionBase(DSN As String, CheminFichierMDB As String, Provider As String, GenererErreur As Boolean, Optional DSN_Manuel As Boolean = False, Optional LectureSeule As Boolean = False) As Boolean
' COnnexion à une base de données soit par DSN soit sur un fichier directement.
' 3 méthodes:
' DSN normal: on fourni uniquement un DSN
' Direct: on fourni un CheminFichierMDB et un Provider
' Manuel: on fourni en lieu et place du DSN la chaine de connexion à utiliser, sans manipulation par le programme. Il faut activer DSN_Manuel
' Si DSN et CheminFichier+Provier fournis, tente en priorité le DSN, sinon, tente le fichier+Provider (pilote)
' Renvoit Vrai si reussite.
On Error GoTo Erreur
Dim ParametresConnexionOK As Boolean, ConnectionString As String
ParametresConnexionOK = False
'Cree l'objet au moment de la connexion
Set BDD = New ADODB.Connection
If DSN <> "" Then
'Utilise le DSN
'Connexion au DSN (Pas besoin de fournir le fichier ni le pilote (défini dans Panneau de Config, Outils d'administration, Sources de données (ODBC))
If DSN_Manuel Then
ConnectionString = DSN 'Mode manuel (DSN contient la chaine de connexion originale)
Else
ConnectionString = "DSN=" & DSN 'Mode assisté: DSN est uniquement le nom de la base de donnée
End If
ParametresConnexionOK = True
ElseIf (CheminFichierMDB <> "") And (Provider <> "") Then
'Utilise le fichier directement avec le pilote specifié
If FileObject.FileExists(CheminFichierMDB) Then
'Définition du pilote de connexion
' Si chaine incorrecte (min/maj, version..), il y aura une erreur
' Pour info, si on arrive à connecter GeoConcept à une base, il suffit de copier la chaine "Provider" qu'il utilise.
BDD.Provider = Provider
'Connexion au fichier MDB:
ConnectionString = CheminFichierMDB
ParametresConnexionOK = True
Else
Erreur "ConnexionBase", 0, "Infos d'accès à la base de données incorrectes:" & Chr(10) & "Fichier: '" & CheminFichierMDB & "'" & Chr(10) & "Provider: '" & Provider & "'" & Chr(10) & "Vérifiez ces paramètres dans la configuration de ce programme.", vbExclamation
End If
Else
End If
If ParametresConnexionOK Then 'Tente de se connecter?
If Not LectureSeule Then
BDD.Mode = adModeShareDenyWrite 'Acces en ecriture, restreindre en ecriture
Else
BDD.Mode = adModeRead 'Lecture seule
End If
BDD.CursorLocation = adUseServer 'Demande une connexion coté serveur (par defaut, deja coté serveur...)
BDD.ConnectionString = ConnectionString
BDD.Errors.Clear
BDD.Open
If BDD.State = 1 Then
ConnexionBase = True 'en cas d'erreur on n'arrive meme pa sici
If LectureSeule Then Erreur "ConnexionBase", 1, "La base est actuellement inaccessible en écriture, un accès en lecture seule a cependant été ouvert..." & Chr(10) & "Vous ne pourrez pas effectuer de modification!", vbInformation, True
End If
End If
Erreur:
If Err Then
Dim ErreurN As Long
ErreurN = BDD.Errors.Item(BDD.Errors.Count - 1).NativeError
Erreur "ConnexionBase", Err.Number, Err.Description & " (" & ErreurN & ")" & Chr(10) & "ConnectionString=""" & ConnectionString & """", vbExclamation, GenererErreur
' Je ne suis pas bien sur du fait que le code -2147467259 signifie que l'acces est refusé en ecriture...meme ca semble marcher malgré tout.
If (ErreurN = -536937472) And (LectureSeule = False) Then 'Tente de se connecter avec memes parametres en lecture seule
ConnexionBase = ConnexionBase(DSN, CheminFichierMDB, Provider, GenererErreur, DSN_Manuel, True)
End If
End If
End Function |
