ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBIntf.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (6 years, 6 months ago) by tony
File size: 21624 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 }
31 { }
32 {************************************************************************}
33
34 unit IBIntf;
35
36 {$Mode Delphi}
37
38 interface
39
40 uses
41 {$IFDEF WINDOWS }
42 Windows,
43 {$ELSE}
44 unix,
45 {$ENDIF}
46 IBHeader,IBExternals;
47
48 var
49 BLOB_get: TBLOB_get;
50 BLOB_put: TBLOB_put;
51 isc_sqlcode: Tisc_sqlcode;
52 isc_sql_interprete: Tisc_sql_interprete;
53 isc_interprete: Tisc_interprete;
54 isc_vax_integer: Tisc_vax_integer;
55 isc_portable_integer: Tisc_portable_integer;
56 isc_blob_info: Tisc_blob_info;
57 isc_open_blob2: Tisc_open_blob2;
58 isc_close_blob: Tisc_close_blob;
59 isc_get_segment: Tisc_get_segment;
60 isc_put_segment: Tisc_put_segment;
61 isc_create_blob2: Tisc_create_blob2;
62 isc_service_attach: Tisc_service_attach;
63 isc_service_detach: Tisc_service_detach;
64 isc_service_query: Tisc_service_query;
65 isc_service_start: Tisc_service_start;
66 isc_decode_date: Tisc_decode_date;
67 isc_decode_sql_date: Tisc_decode_sql_date;
68 isc_decode_sql_time: Tisc_decode_sql_time;
69 isc_decode_timestamp: Tisc_decode_timestamp;
70 isc_encode_date: Tisc_encode_date;
71 isc_encode_sql_date: Tisc_encode_sql_date;
72 isc_encode_sql_time: Tisc_encode_sql_time;
73 isc_encode_timestamp: Tisc_encode_timestamp;
74 isc_dsql_free_statement: Tisc_dsql_free_statement;
75 isc_dsql_execute2: Tisc_dsql_execute2;
76 isc_dsql_execute: Tisc_dsql_execute;
77 isc_dsql_set_cursor_name: Tisc_dsql_set_cursor_name;
78 isc_dsql_fetch: Tisc_dsql_fetch;
79 isc_dsql_sql_info: Tisc_dsql_sql_info;
80 isc_dsql_alloc_statement2: Tisc_dsql_alloc_statement2;
81 isc_dsql_prepare: Tisc_dsql_prepare;
82 isc_dsql_describe_bind: Tisc_dsql_describe_bind;
83 isc_dsql_describe: Tisc_dsql_describe;
84 isc_dsql_execute_immediate: Tisc_dsql_execute_immediate;
85 isc_drop_database: Tisc_drop_database;
86 isc_detach_database: Tisc_detach_database;
87 isc_attach_database: Tisc_attach_database;
88 isc_database_info: Tisc_database_info;
89 isc_start_multiple: Tisc_start_multiple;
90 isc_commit_transaction: Tisc_commit_transaction;
91 isc_commit_retaining: Tisc_commit_retaining;
92 isc_rollback_transaction: Tisc_rollback_transaction;
93 isc_rollback_retaining: Tisc_rollback_retaining;
94 isc_cancel_events: Tisc_cancel_events;
95 isc_que_events: Tisc_que_events;
96 isc_event_counts: Tisc_event_counts;
97 isc_event_block: Tisc_event_block;
98 isc_free: Tisc_free;
99 isc_add_user : Tisc_add_user;
100 isc_delete_user: Tisc_delete_user;
101 isc_modify_user: Tisc_modify_user;
102
103
104 { Library Initialization }
105 procedure LoadIBLibrary;
106 procedure FreeIBLibrary;
107 function TryIBLoad: Boolean;
108 procedure CheckIBLoaded;
109
110 { Stubs for 6.0 only functions }
111 function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
112 tran_handle : PISC_TR_HANDLE):
113 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
114 function isc_service_attach_stub(status_vector : PISC_STATUS;
115 isc_arg2 : UShort;
116 isc_arg3 : PChar;
117 service_handle : PISC_SVC_HANDLE;
118 isc_arg5 : UShort;
119 isc_arg6 : PChar):
120 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
121 function isc_service_detach_stub(status_vector : PISC_STATUS;
122 service_handle : PISC_SVC_HANDLE):
123 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
124 function isc_service_query_stub(status_vector : PISC_STATUS;
125 service_handle : PISC_SVC_HANDLE;
126 recv_handle : PISC_SVC_HANDLE;
127 isc_arg4 : UShort;
128 isc_arg5 : PChar;
129 isc_arg6 : UShort;
130 isc_arg7 : PChar;
131 isc_arg8 : UShort;
132 isc_arg9 : PChar):
133 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
134 function isc_service_start_stub(status_vector : PISC_STATUS;
135 service_handle : PISC_SVC_HANDLE;
136 recv_handle : PISC_SVC_HANDLE;
137 isc_arg4 : UShort;
138 isc_arg5 : PChar):
139 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
140
141 procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
142 ib_date : PISC_DATE);
143 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
144
145 procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
146 ib_time : PISC_TIME);
147 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
148
149 procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
150 ib_timestamp : PISC_TIMESTAMP);
151 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
152
153 procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
154 tm_date : PCTimeStructure);
155 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
156
157 procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
158 tm_date : PCTimeStructure);
159 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
160
161 procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
162 tm_date : PCTimeStructure);
163 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
164
165
166 var IBServiceAPIPresent: boolean;
167
168 type
169 TOnGetLibraryName = procedure(var libname: string);
170
171 const
172 OnGetLibraryName: TOnGetLibraryName = nil;
173
174
175 implementation
176
177 uses Sysutils, IB, Dynlibs
178 {$IFDEF WINDOWS}
179 ,Forms, Registry
180 {$ENDIF}
181 ;
182
183 var
184 IBLibrary: TLibHandle;
185
186 procedure LoadIBLibrary;
187
188 function GetProcAddr(ProcName: PChar): Pointer;
189 begin
190 Result := GetProcAddress(IBLibrary, ProcName);
191 if not Assigned(Result) then
192 raise Exception.Create('Unable to load Firebird Client Library');
193 end;
194 {$IFDEF UNIX }
195 function InternalLoadLibrary: TLibHandle;
196 var LibName: string;
197 begin
198 //Use default unless FBLIB overrides
199 LibName := GetEnvironmentVariable('FBLIB');
200 if LibName = '' then
201 begin
202 if assigned(OnGetLibraryName) then
203 OnGetLibraryName(LibName)
204 else
205 LibName := FIREBIRD_SO2;
206 end;
207 Result := LoadLibrary(LibName);
208 {$IFDEF DARWIN}
209 if Result = NilHandle then
210 begin
211 {See http://paulbeachsblog.blogspot.co.uk/2008/03/where-is-libfbclientdylib-on-macosx.html
212 Try loading direct from Firebird Framework}
213
214 LibName := '/Library/Frameworks/Firebird.framework/Firebird';
215 Result := LoadLibrary(LibName);
216 end
217 {$ENDIF}
218 end;
219 {$ENDIF}
220 {$IFDEF WINDOWS}
221 function InternalLoadLibrary: TLibHandle;
222 var InstallDir: string;
223 dllPathName: string;
224 begin
225 if assigned(OnGetLibraryName) then
226 begin
227 OnGetLibraryName(dllPathName);
228 Result := LoadLibrary(dllPathName);
229 Exit
230 end;
231
232 //First look for Firebird Embedded Server in installation dir
233 InstallDir := ExtractFilePath(Application.ExeName);
234 if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
235 begin
236 dllPathName := InstallDir + FIREBIRD_EMBEDDED;
237 Result := LoadLibrary(dllPathName)
238 end
239 else
240 //Otherwise look for Firebird Client in installation dir
241 if FileExists(InstallDir + FIREBIRD_CLIENT) then
242 begin
243 //assume firebird.conf and firebird.msg in same dir
244 SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
245 dllPathName := InstallDir +FIREBIRD_CLIENT;
246 Result := LoadLibrary(dllPathName)
247 end
248 else
249 //Use Registry key if it exists to locate library
250 begin
251 with TRegistry.Create do
252 try
253 RootKey := HKEY_LOCAL_MACHINE;
254 if OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
255 begin
256 if ValueExists('DefaultInstance') then
257 begin
258 dllPathName := ReadString('DefaultInstance') + 'bin' + DirectorySeparator + FIREBIRD_CLIENT;
259 if FileExists(dllPathName) then
260 begin
261 Result := LoadLibrary(dllPathName);
262 Exit
263 end
264 end
265 end
266 finally
267 Free
268 end;
269
270 //Otherwise see if Firebird client is in path
271 //and rely on registry for location of firebird.conf and firebird.msg
272 Result := LoadLibrary(FIREBIRD_CLIENT);
273 if Result <= HINSTANCE_ERROR then
274 //well maybe InterBase is present...
275 Result := LoadLibrary(IBASE_DLL);
276 end
277 end;
278 {$ENDIF}
279
280 begin
281 IBLibrary := InternalLoadLibrary;
282 if (IBLibrary <> NilHandle) then
283 begin
284 BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
285 BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
286 isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
287 isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
288 isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
289 isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
290 isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
291 isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
292 isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
293 isc_close_blob := GetProcAddr('isc_close_blob'); {do not localize}
294 isc_get_segment := GetProcAddr('isc_get_segment'); {do not localize}
295 isc_put_segment := GetProcAddr('isc_put_segment'); {do not localize}
296 isc_create_blob2 := GetProcAddr('isc_create_blob2'); {do not localize}
297 isc_decode_date := GetProcAddr('isc_decode_date'); {do not localize}
298 isc_encode_date := GetProcAddr('isc_encode_date'); {do not localize}
299 isc_dsql_free_statement := GetProcAddr('isc_dsql_free_statement'); {do not localize}
300 isc_dsql_execute2 := GetProcAddr('isc_dsql_execute2'); {do not localize}
301 isc_dsql_execute := GetProcAddr('isc_dsql_execute'); {do not localize}
302 isc_dsql_set_cursor_name := GetProcAddr('isc_dsql_set_cursor_name'); {do not localize}
303 isc_dsql_fetch := GetProcAddr('isc_dsql_fetch'); {do not localize}
304 isc_dsql_sql_info := GetProcAddr('isc_dsql_sql_info'); {do not localize}
305 isc_dsql_alloc_statement2 := GetProcAddr('isc_dsql_alloc_statement2'); {do not localize}
306 isc_dsql_prepare := GetProcAddr('isc_dsql_prepare'); {do not localize}
307 isc_dsql_describe_bind := GetProcAddr('isc_dsql_describe_bind'); {do not localize}
308 isc_dsql_describe := GetProcAddr('isc_dsql_describe'); {do not localize}
309 isc_dsql_execute_immediate := GetProcAddr('isc_dsql_execute_immediate'); {do not localize}
310 isc_drop_database := GetProcAddr('isc_drop_database'); {do not localize}
311 isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize}
312 isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize}
313 isc_database_info := GetProcAddr('isc_database_info'); {do not localize}
314 isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize}
315 isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize}
316 isc_commit_retaining := GetProcAddr('isc_commit_retaining'); {do not localize}
317 isc_rollback_transaction := GetProcAddr('isc_rollback_transaction'); {do not localize}
318 isc_cancel_events := GetProcAddr('isc_cancel_events'); {do not localize}
319 isc_que_events := GetProcAddr('isc_que_events'); {do not localize}
320 isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
321 isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
322 isc_free := GetProcAddr('isc_free'); {do not localize}
323 isc_add_user := GetProcAddr('isc_add_user'); {do not localize}
324 isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
325 isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
326
327 IBServiceAPIPresent := true;
328 isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
329 if Assigned(isc_rollback_retaining) then
330 begin
331 isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
332 isc_service_detach := GetProcAddr('isc_service_detach'); {do not localize}
333 isc_service_query := GetProcAddr('isc_service_query'); {do not localize}
334 isc_service_start := GetProcAddr('isc_service_start'); {do not localize}
335 isc_decode_sql_date := GetProcAddr('isc_decode_sql_date'); {do not localize}
336 isc_decode_sql_time := GetProcAddr('isc_decode_sql_time'); {do not localize}
337 isc_decode_timestamp := GetProcAddr('isc_decode_timestamp'); {do not localize}
338 isc_encode_sql_date := GetProcAddr('isc_encode_sql_date'); {do not localize}
339 isc_encode_sql_time := GetProcAddr('isc_encode_sql_time'); {do not localize}
340 isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
341 end else
342 begin
343 IBServiceAPIPresent := false;
344 isc_rollback_retaining := isc_rollback_retaining_stub;
345 isc_service_attach := isc_service_attach_stub;
346 isc_service_detach := isc_service_detach_stub;
347 isc_service_query := isc_service_query_stub;
348 isc_service_start := isc_service_start_stub;
349 isc_decode_sql_date := isc_decode_sql_date_stub;
350 isc_decode_sql_time := isc_decode_sql_time_stub;
351 isc_decode_timestamp := isc_decode_timestamp_stub;
352 isc_encode_sql_date := isc_encode_sql_date_stub;
353 isc_encode_sql_time := isc_encode_sql_time_stub;
354 isc_encode_timestamp := isc_encode_timestamp_stub;
355 end;
356 end;
357 end;
358
359 procedure FreeIBLibrary;
360 begin
361 if IBLibrary <> NilHandle then
362 begin
363 FreeLibrary(IBLibrary);
364 IBLibrary := 0;
365 end;
366 end;
367
368 function TryIBLoad: Boolean;
369 begin
370 if (IBLibrary = NilHandle) then
371 LoadIBLibrary;
372 if (IBLibrary = NilHandle) then
373 result := False
374 else
375 result := True;
376 end;
377
378 procedure CheckIBLoaded;
379 begin
380 if not TryIBLoad then
381 IBError(ibxeInterBaseMissing, [nil]);
382 end;
383
384
385 function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
386 tran_handle : PISC_TR_HANDLE):
387 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
388 begin
389 Result := 0;
390 IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
391 end;
392
393 function isc_service_attach_stub(status_vector : PISC_STATUS;
394 isc_arg2 : UShort;
395 isc_arg3 : PChar;
396 service_handle : PISC_SVC_HANDLE;
397 isc_arg5 : UShort;
398 isc_arg6 : PChar):
399 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
400 begin
401 Result := 0;
402 IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
403 end;
404
405 function isc_service_detach_stub(status_vector : PISC_STATUS;
406 service_handle : PISC_SVC_HANDLE):
407 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
408 begin
409 Result := 0;
410 IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
411 end;
412
413 function isc_service_query_stub(status_vector : PISC_STATUS;
414 service_handle : PISC_SVC_HANDLE;
415 recv_handle : PISC_SVC_HANDLE;
416 isc_arg4 : UShort;
417 isc_arg5 : PChar;
418 isc_arg6 : UShort;
419 isc_arg7 : PChar;
420 isc_arg8 : UShort;
421 isc_arg9 : PChar):
422 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
423 begin
424 Result := 0;
425 IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
426 end;
427
428 function isc_service_start_stub(status_vector : PISC_STATUS;
429 service_handle : PISC_SVC_HANDLE;
430 recv_handle : PISC_SVC_HANDLE;
431 isc_arg4 : UShort;
432 isc_arg5 : PChar):
433 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
434 begin
435 Result := 0;
436 IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
437 end;
438
439 procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
440 ib_date : PISC_DATE);
441 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
442 begin
443 IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
444 end;
445
446 procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
447 ib_time : PISC_TIME);
448 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
449 begin
450 IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
451 end;
452
453 procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
454 ib_timestamp : PISC_TIMESTAMP);
455 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
456 begin
457 IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
458 end;
459
460 procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
461 tm_date : PCTimeStructure);
462 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
463 begin
464 IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
465 end;
466
467 procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
468 tm_date : PCTimeStructure);
469 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
470 begin
471 IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
472 end;
473
474 procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
475 tm_date : PCTimeStructure);
476 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
477 begin
478 IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
479 end;
480 initialization
481
482 finalization
483 FreeIBLibrary;
484 end.