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, 3 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

# User Rev Content
1 tony 33 {************************************************************************}
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 tony 35 isc_blob_lookup_desc: Tisc_blob_lookup_desc;
58 tony 33 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 tony 35 isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize}
314 tony 33 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.