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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
unit UDm;
{Exemple de connexion avec Firedac sous package embedded correspondant à la version FB2.5.
Construit en dynamique pour que tous les paramètres de connexion soient visibles.
Rien ne vous empêche de déposer les deux composants TFDPhysFBDriverLink et TFDConnection
d'être déposés dans le datamodule.}
interface
uses
System.SysUtils,
System.Classes,
FireDAC.Stan.Intf,
FireDAC.Stan.Option,
FireDAC.Stan.Error,
FireDAC.UI.Intf,
FireDAC.Phys.Intf,
FireDAC.Stan.Def,
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Phys,
FireDAC.Phys.FBDef,
FireDAC.Phys.IBBase,
FireDAC.Phys.FB,
Data.DB,
FireDAC.Comp.Client,
vcl.dialogs,
forms
;
const
kudf = 'udf\';
kintl = 'intl\';
TEmbFiles: array[0..9] of string = ('fbclient.dll','fbembed.dll','icuuc30.dll','icuin30.dll', 'icudt30.dll', 'ib_util.dll',
kudf + 'fbudf.dll', kudf + 'ib_udf.dll', kintl + 'fbintl.conf', kintl + 'fbintl.dll');
type
TDM = class(TDataModule)
procedure DataModuleDestroy(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
private
{ Déclarations privées }
FDPhysFBDriverLinkDyn: TFDPhysFBDriverLink;
FDConnectionDyn: TFDConnection;
function CtrlPackEmbed: boolean;
public
{ Déclarations publiques }
PathWorks: string;
function ConnectDBDyn: boolean;
end;
var
DM: TDM;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure WaitSeconde(value: integer);
var
compteur: integer;
begin
//value en seconde
value:= value * 10;
for compteur:= 1 to value do begin
sleep(100);
application.ProcessMessages;
end;
end;
function TDM.CtrlPackEmbed: boolean;
const
kudf = 'udf\';
kintl = 'intl\';
Entete = 'Le(s) fichier(s) suivant sont manquants:'#13;
var
compteur: integer;
msg: string;
begin
result:= true;
try
msg:= '';
if not FileExists(PathWorks + TEmbFiles[1]) then begin
msg:= msg + #13 + PathWorks + TEmbFiles[1];
if not FileExists(PathWorks + TEmbFiles[0]) then begin
msg:= msg + #13 + PathWorks + TEmbFiles[0];
result:= false;
end;
end;
for compteur:= 2 to 9 do begin
if not FileExists(PathWorks + TEmbFiles[compteur]) then begin
msg:= msg + #13 + PathWorks + TEmbFiles[compteur];
result:= false;
end;
end;
if not result then
raise EFileNotFoundException.Create(Entete + msg);
except
showmessage(Exception(exceptobject).message);
end;
end;
function TDM.ConnectDBDyn: boolean;
begin
result:= false;
try
if not CtrlPackEmbed then exit;
FDPhysFBDriverLinkDyn:= TFDPhysFBDriverLink.Create(self);
FDConnectionDyn:= TFDConnection.Create(self);
with FDPhysFBDriverLinkDyn do begin
DriverID:= 'FB25';
VendorHome:= '';
{D'après la doc RAD il semble préférable de renommer fbembed.dll en fbclient.dll,
car certains packages imposent de trouver le nom de la lib d'origine.}
VendorLib:= PathWorks + 'fbclient.dll';
end;
with FDConnectionDyn, params do begin
close;
Tstringlist(FDConnectionDyn.Params).Clear;
DriverName:= 'FB25';
params.Database:= PathWorks + 'FDCOPY.FDB';
params.UserName:= 'SYSDBA';
params.Password:= 'masterke';
open;
result:= Connected;
end;
except
result:= false;
showmessage(exception(exceptobject).Message);
end;
end;
procedure TDM.DataModuleCreate(Sender: TObject);
begin
PathWorks:= IncludeTrailingPathDelimiter(extractfilepath(application.exename));
end;
procedure TDM.DataModuleDestroy(Sender: TObject);
{Routine qui donne le temps à la libération de se terminer
sans violation. Cette violation se produit également lorsque
que les composants ne sont pas créés dynamiquement comme
dans cet exemple, c'est à dire en statiques déposés dans le datamodule.'}
begin
try
if FDPhysFBDriverLinkDyn <> nil then begin
if FDConnectionDyn <> nil then begin
FDConnectionDyn.Close;
try
freeandnil(FDConnectionDyn);
except
showmessage(exception(exceptobject).Message);
end;
end;
WaitSeconde(1);
FDPhysFBDriverLinkDyn.Release;
try
freeandnil(FDPhysFBDriverLinkDyn);
except
showmessage(exception(exceptobject).Message);
end;
end;
except
showmessage(exception(exceptobject).Message);
end;
end;
end. |
Firedac et fbembed, travail en local
Répondre avec citation
Envoyé par castorcharly
c'est où ça, dans le OnDestroy je suppose (
Partager