ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBIntf.pas
Revision: 35
Committed: Tue Jan 26 14:38:47 2016 UTC (8 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 21842 byte(s)
Log Message:
Committing updates for Release R1-3-2

File Contents

# Content
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_blob_lookup_desc: Tisc_blob_lookup_desc;
58 isc_open_blob2: Tisc_open_blob2;
59 isc_close_blob: Tisc_close_blob;
60 isc_get_segment: Tisc_get_segment;
61 isc_put_segment: Tisc_put_segment;
62 isc_create_blob2: Tisc_create_blob2;
63 isc_service_attach: Tisc_service_attach;
64 isc_service_detach: Tisc_service_detach;
65 isc_service_query: Tisc_service_query;
66 isc_service_start: Tisc_service_start;
67 isc_decode_date: Tisc_decode_date;
68 isc_decode_sql_date: Tisc_decode_sql_date;
69 isc_decode_sql_time: Tisc_decode_sql_time;
70 isc_decode_timestamp: Tisc_decode_timestamp;
71 isc_encode_date: Tisc_encode_date;
72 isc_encode_sql_date: Tisc_encode_sql_date;
73 isc_encode_sql_time: Tisc_encode_sql_time;
74 isc_encode_timestamp: Tisc_encode_timestamp;
75 isc_dsql_free_statement: Tisc_dsql_free_statement;
76 isc_dsql_execute2: Tisc_dsql_execute2;
77 isc_dsql_execute: Tisc_dsql_execute;
78 isc_dsql_set_cursor_name: Tisc_dsql_set_cursor_name;
79 isc_dsql_fetch: Tisc_dsql_fetch;
80 isc_dsql_sql_info: Tisc_dsql_sql_info;
81 isc_dsql_alloc_statement2: Tisc_dsql_alloc_statement2;
82 isc_dsql_prepare: Tisc_dsql_prepare;
83 isc_dsql_describe_bind: Tisc_dsql_describe_bind;
84 isc_dsql_describe: Tisc_dsql_describe;
85 isc_dsql_execute_immediate: Tisc_dsql_execute_immediate;
86 isc_drop_database: Tisc_drop_database;
87 isc_detach_database: Tisc_detach_database;
88 isc_attach_database: Tisc_attach_database;
89 isc_database_info: Tisc_database_info;
90 isc_start_multiple: Tisc_start_multiple;
91 isc_commit_transaction: Tisc_commit_transaction;
92 isc_commit_retaining: Tisc_commit_retaining;
93 isc_rollback_transaction: Tisc_rollback_transaction;
94 isc_rollback_retaining: Tisc_rollback_retaining;
95 isc_cancel_events: Tisc_cancel_events;
96 isc_que_events: Tisc_que_events;
97 isc_event_counts: Tisc_event_counts;
98 isc_event_block: Tisc_event_block;
99 isc_free: Tisc_free;
100 isc_add_user : Tisc_add_user;
101 isc_delete_user: Tisc_delete_user;
102 isc_modify_user: Tisc_modify_user;
103
104
105 { Library Initialization }
106 procedure LoadIBLibrary;
107 procedure FreeIBLibrary;
108 function TryIBLoad: Boolean;
109 procedure CheckIBLoaded;
110
111 { Stubs for 6.0 only functions }
112 function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
113 tran_handle : PISC_TR_HANDLE):
114 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
115 function isc_service_attach_stub(status_vector : PISC_STATUS;
116 isc_arg2 : UShort;
117 isc_arg3 : PChar;
118 service_handle : PISC_SVC_HANDLE;
119 isc_arg5 : UShort;
120 isc_arg6 : PChar):
121 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
122 function isc_service_detach_stub(status_vector : PISC_STATUS;
123 service_handle : PISC_SVC_HANDLE):
124 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
125 function isc_service_query_stub(status_vector : PISC_STATUS;
126 service_handle : PISC_SVC_HANDLE;
127 recv_handle : PISC_SVC_HANDLE;
128 isc_arg4 : UShort;
129 isc_arg5 : PChar;
130 isc_arg6 : UShort;
131 isc_arg7 : PChar;
132 isc_arg8 : UShort;
133 isc_arg9 : PChar):
134 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
135 function isc_service_start_stub(status_vector : PISC_STATUS;
136 service_handle : PISC_SVC_HANDLE;
137 recv_handle : PISC_SVC_HANDLE;
138 isc_arg4 : UShort;
139 isc_arg5 : PChar):
140 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
141
142 procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
143 ib_date : PISC_DATE);
144 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
145
146 procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
147 ib_time : PISC_TIME);
148 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
149
150 procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
151 ib_timestamp : PISC_TIMESTAMP);
152 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
153
154 procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
155 tm_date : PCTimeStructure);
156 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
157
158 procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
159 tm_date : PCTimeStructure);
160 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
161
162 procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
163 tm_date : PCTimeStructure);
164 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
165
166
167 var IBServiceAPIPresent: boolean;
168
169 type
170 TOnGetLibraryName = procedure(var libname: string);
171
172 const
173 OnGetLibraryName: TOnGetLibraryName = nil;
174
175
176 implementation
177
178 uses Sysutils, IB, Dynlibs, Classes
179 {$IFDEF WINDOWS}
180 , Registry
181 {$ENDIF}
182 ;
183
184 var
185 IBLibrary: TLibHandle;
186
187 procedure LoadIBLibrary;
188
189 function GetProcAddr(ProcName: PChar): Pointer;
190 begin
191 Result := GetProcAddress(IBLibrary, ProcName);
192 if not Assigned(Result) then
193 raise Exception.Create('Unable to load Firebird Client Library');
194 end;
195 {$IFDEF UNIX }
196 function FindLibrary(LibNameList: string): TLibHandle;
197 var LibNames: TStringList;
198 i: integer;
199 begin
200 Result := NilHandle;
201 LibNames := TStringList.Create;
202 try
203 LibNames.Delimiter := ':';
204 LibNames.StrictDelimiter := true;
205 LibNames.DelimitedText := LibNameList; {Split list on semi-colon}
206 for i := 0 to LibNames.Count - 1 do
207 begin
208 Result := LoadLibrary(LibNames[i]);
209 if Result <> NilHandle then Exit;
210 end;
211 finally
212 LibNames.Free;
213 end;
214 end;
215
216 function InternalLoadLibrary: TLibHandle;
217 var LibName: string;
218 begin
219 //Use default unless FBLIB overrides
220 LibName := GetEnvironmentVariable('FBLIB');
221 if LibName = '' then
222 begin
223 if assigned(OnGetLibraryName) then
224 OnGetLibraryName(LibName)
225 else
226 LibName := FIREBIRD_SO2;
227 end;
228 Result := FindLibrary(LibName);
229 {$IFDEF DARWIN}
230 if Result = NilHandle then
231 begin
232 {See http://paulbeachsblog.blogspot.co.uk/2008/03/where-is-libfbclientdylib-on-macosx.html
233 Try loading direct from Firebird Framework}
234
235 LibName := '/Library/Frameworks/Firebird.framework/Firebird';
236 Result := LoadLibrary(LibName);
237 end
238 {$ENDIF}
239 end;
240 {$ENDIF}
241 {$IFDEF WINDOWS}
242 function InternalLoadLibrary: TLibHandle;
243 var InstallDir: string;
244 dllPathName: string;
245 begin
246 if assigned(OnGetLibraryName) then
247 begin
248 OnGetLibraryName(dllPathName);
249 Result := LoadLibrary(dllPathName);
250 Exit
251 end;
252
253 //First look for Firebird Embedded Server in installation dir
254 InstallDir := ExtractFilePath(Paramstr(0)); {Using ParamStr(0) assumes windows conventions}
255 if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
256 begin
257 dllPathName := InstallDir + FIREBIRD_EMBEDDED;
258 Result := LoadLibrary(dllPathName)
259 end
260 else
261 //Otherwise look for Firebird Client in installation dir
262 if FileExists(InstallDir + FIREBIRD_CLIENT) then
263 begin
264 //assume firebird.conf and firebird.msg in same dir
265 SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
266 dllPathName := InstallDir +FIREBIRD_CLIENT;
267 Result := LoadLibrary(dllPathName)
268 end
269 else
270 //Use Registry key if it exists to locate library
271 begin
272 with TRegistry.Create do
273 try
274 RootKey := HKEY_LOCAL_MACHINE;
275 if OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
276 begin
277 if ValueExists('DefaultInstance') then
278 begin
279 dllPathName := ReadString('DefaultInstance') + 'bin' + DirectorySeparator + FIREBIRD_CLIENT;
280 if FileExists(dllPathName) then
281 begin
282 Result := LoadLibrary(dllPathName);
283 Exit
284 end
285 end
286 end
287 finally
288 Free
289 end;
290
291 //Otherwise see if Firebird client is in path
292 //and rely on registry for location of firebird.conf and firebird.msg
293 Result := LoadLibrary(FIREBIRD_CLIENT);
294 if Result <= HINSTANCE_ERROR then
295 //well maybe InterBase is present...
296 Result := LoadLibrary(IBASE_DLL);
297 end
298 end;
299 {$ENDIF}
300
301 begin
302 IBLibrary := InternalLoadLibrary;
303 if (IBLibrary <> NilHandle) then
304 begin
305 BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
306 BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
307 isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
308 isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
309 isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
310 isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
311 isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
312 isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
313 isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize}
314 isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
315 isc_close_blob := GetProcAddr('isc_close_blob'); {do not localize}
316 isc_get_segment := GetProcAddr('isc_get_segment'); {do not localize}
317 isc_put_segment := GetProcAddr('isc_put_segment'); {do not localize}
318 isc_create_blob2 := GetProcAddr('isc_create_blob2'); {do not localize}
319 isc_decode_date := GetProcAddr('isc_decode_date'); {do not localize}
320 isc_encode_date := GetProcAddr('isc_encode_date'); {do not localize}
321 isc_dsql_free_statement := GetProcAddr('isc_dsql_free_statement'); {do not localize}
322 isc_dsql_execute2 := GetProcAddr('isc_dsql_execute2'); {do not localize}
323 isc_dsql_execute := GetProcAddr('isc_dsql_execute'); {do not localize}
324 isc_dsql_set_cursor_name := GetProcAddr('isc_dsql_set_cursor_name'); {do not localize}
325 isc_dsql_fetch := GetProcAddr('isc_dsql_fetch'); {do not localize}
326 isc_dsql_sql_info := GetProcAddr('isc_dsql_sql_info'); {do not localize}
327 isc_dsql_alloc_statement2 := GetProcAddr('isc_dsql_alloc_statement2'); {do not localize}
328 isc_dsql_prepare := GetProcAddr('isc_dsql_prepare'); {do not localize}
329 isc_dsql_describe_bind := GetProcAddr('isc_dsql_describe_bind'); {do not localize}
330 isc_dsql_describe := GetProcAddr('isc_dsql_describe'); {do not localize}
331 isc_dsql_execute_immediate := GetProcAddr('isc_dsql_execute_immediate'); {do not localize}
332 isc_drop_database := GetProcAddr('isc_drop_database'); {do not localize}
333 isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize}
334 isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize}
335 isc_database_info := GetProcAddr('isc_database_info'); {do not localize}
336 isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize}
337 isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize}
338 isc_commit_retaining := GetProcAddr('isc_commit_retaining'); {do not localize}
339 isc_rollback_transaction := GetProcAddr('isc_rollback_transaction'); {do not localize}
340 isc_cancel_events := GetProcAddr('isc_cancel_events'); {do not localize}
341 isc_que_events := GetProcAddr('isc_que_events'); {do not localize}
342 isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
343 isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
344 isc_free := GetProcAddr('isc_free'); {do not localize}
345 isc_add_user := GetProcAddr('isc_add_user'); {do not localize}
346 isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
347 isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
348
349 IBServiceAPIPresent := true;
350 isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
351 if Assigned(isc_rollback_retaining) then
352 begin
353 isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
354 isc_service_detach := GetProcAddr('isc_service_detach'); {do not localize}
355 isc_service_query := GetProcAddr('isc_service_query'); {do not localize}
356 isc_service_start := GetProcAddr('isc_service_start'); {do not localize}
357 isc_decode_sql_date := GetProcAddr('isc_decode_sql_date'); {do not localize}
358 isc_decode_sql_time := GetProcAddr('isc_decode_sql_time'); {do not localize}
359 isc_decode_timestamp := GetProcAddr('isc_decode_timestamp'); {do not localize}
360 isc_encode_sql_date := GetProcAddr('isc_encode_sql_date'); {do not localize}
361 isc_encode_sql_time := GetProcAddr('isc_encode_sql_time'); {do not localize}
362 isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
363 end else
364 begin
365 IBServiceAPIPresent := false;
366 isc_rollback_retaining := isc_rollback_retaining_stub;
367 isc_service_attach := isc_service_attach_stub;
368 isc_service_detach := isc_service_detach_stub;
369 isc_service_query := isc_service_query_stub;
370 isc_service_start := isc_service_start_stub;
371 isc_decode_sql_date := isc_decode_sql_date_stub;
372 isc_decode_sql_time := isc_decode_sql_time_stub;
373 isc_decode_timestamp := isc_decode_timestamp_stub;
374 isc_encode_sql_date := isc_encode_sql_date_stub;
375 isc_encode_sql_time := isc_encode_sql_time_stub;
376 isc_encode_timestamp := isc_encode_timestamp_stub;
377 end;
378 end;
379 end;
380
381 procedure FreeIBLibrary;
382 begin
383 if IBLibrary <> NilHandle then
384 begin
385 FreeLibrary(IBLibrary);
386 IBLibrary := 0;
387 end;
388 end;
389
390 function TryIBLoad: Boolean;
391 begin
392 if (IBLibrary = NilHandle) then
393 LoadIBLibrary;
394 if (IBLibrary = NilHandle) then
395 result := False
396 else
397 result := True;
398 end;
399
400 procedure CheckIBLoaded;
401 begin
402 if not TryIBLoad then
403 IBError(ibxeInterBaseMissing, [nil]);
404 end;
405
406
407 function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
408 tran_handle : PISC_TR_HANDLE):
409 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
410 begin
411 Result := 0;
412 IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
413 end;
414
415 function isc_service_attach_stub(status_vector : PISC_STATUS;
416 isc_arg2 : UShort;
417 isc_arg3 : PChar;
418 service_handle : PISC_SVC_HANDLE;
419 isc_arg5 : UShort;
420 isc_arg6 : PChar):
421 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
422 begin
423 Result := 0;
424 IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
425 end;
426
427 function isc_service_detach_stub(status_vector : PISC_STATUS;
428 service_handle : PISC_SVC_HANDLE):
429 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
430 begin
431 Result := 0;
432 IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
433 end;
434
435 function isc_service_query_stub(status_vector : PISC_STATUS;
436 service_handle : PISC_SVC_HANDLE;
437 recv_handle : PISC_SVC_HANDLE;
438 isc_arg4 : UShort;
439 isc_arg5 : PChar;
440 isc_arg6 : UShort;
441 isc_arg7 : PChar;
442 isc_arg8 : UShort;
443 isc_arg9 : PChar):
444 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
445 begin
446 Result := 0;
447 IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
448 end;
449
450 function isc_service_start_stub(status_vector : PISC_STATUS;
451 service_handle : PISC_SVC_HANDLE;
452 recv_handle : PISC_SVC_HANDLE;
453 isc_arg4 : UShort;
454 isc_arg5 : PChar):
455 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
456 begin
457 Result := 0;
458 IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
459 end;
460
461 procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
462 ib_date : PISC_DATE);
463 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
464 begin
465 IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
466 end;
467
468 procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
469 ib_time : PISC_TIME);
470 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
471 begin
472 IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
473 end;
474
475 procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
476 ib_timestamp : PISC_TIMESTAMP);
477 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
478 begin
479 IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
480 end;
481
482 procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
483 tm_date : PCTimeStructure);
484 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
485 begin
486 IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
487 end;
488
489 procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
490 tm_date : PCTimeStructure);
491 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
492 begin
493 IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
494 end;
495
496 procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
497 tm_date : PCTimeStructure);
498 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
499 begin
500 IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
501 end;
502 initialization
503
504 finalization
505 FreeIBLibrary;
506 end.