ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBIntf.pas
Revision: 7
Committed: Sun Aug 5 18:28:19 2012 UTC (11 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 21140 byte(s)
Log Message:
Committing updates for Release R1-0-0

File Contents

# User Rev Content
1 tony 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 tony 7 { 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 tony 1 {************************************************************************}
33    
34     unit IBIntf;
35    
36 tony 5 {$Mode Delphi}
37    
38 tony 1 interface
39    
40 tony 5 uses
41 tony 7 {$IFDEF WINDOWS }
42     Windows,
43     {$ELSE}
44 tony 5 unix,
45     {$ENDIF}
46     IBHeader,IBExternals;
47 tony 1
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 tony 7 isc_portable_integer: Tisc_portable_integer;
56 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
114 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
121 tony 1 function isc_service_detach_stub(status_vector : PISC_STATUS;
122     service_handle : PISC_SVC_HANDLE):
123 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
124 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
134 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
140 tony 1
141     procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
142     ib_date : PISC_DATE);
143 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
144 tony 1
145     procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
146     ib_time : PISC_TIME);
147 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
148 tony 1
149     procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
150     ib_timestamp : PISC_TIMESTAMP);
151 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
152 tony 1
153     procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
154     tm_date : PCTimeStructure);
155 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
156 tony 1
157     procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
158     tm_date : PCTimeStructure);
159 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
160 tony 1
161     procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
162     tm_date : PCTimeStructure);
163 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
164 tony 1
165    
166 tony 5 var IBServiceAPIPresent: boolean;
167    
168 tony 7 type
169     TOnGetLibraryName = procedure(var libname: string);
170    
171     const
172     OnGetLibraryName: TOnGetLibraryName = nil;
173    
174    
175 tony 1 implementation
176    
177 tony 7 uses Sysutils, IB, Dynlibs
178     {$IFDEF WINDOWS}
179     ,Forms, Registry
180     {$ENDIF}
181     ;
182 tony 1
183     var
184 tony 5 IBLibrary: TLibHandle;
185 tony 1
186     procedure LoadIBLibrary;
187    
188     function GetProcAddr(ProcName: PChar): Pointer;
189     begin
190     Result := GetProcAddress(IBLibrary, ProcName);
191     if not Assigned(Result) then
192 tony 5 raise Exception.Create('Unable to load Firebird Client Library');
193 tony 1 end;
194 tony 7 {$IFDEF UNIX }
195 tony 5 function InternalLoadLibrary: TLibHandle;
196     var LibName: string;
197     begin
198     //Use default unless FBLIB overrides
199     LibName := GetEnvironmentVariable('FBLIB');
200 tony 7 if LibName = '' then
201     begin
202     if assigned(OnGetLibraryName) then
203     OnGetLibraryName(LibName)
204     else
205     LibName := FIREBIRD_SO2;
206     end;
207 tony 5 Result := LoadLibrary(LibName);
208 tony 7 {$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 tony 5 end;
219 tony 7 {$ENDIF}
220     {$IFDEF WINDOWS}
221 tony 5 function InternalLoadLibrary: TLibHandle;
222     var InstallDir: string;
223     dllPathName: string;
224     begin
225 tony 7 if assigned(OnGetLibraryName) then
226     begin
227     OnGetLibraryName(dllPathName);
228     Result := LoadLibrary(dllPathName);
229     Exit
230     end;
231    
232 tony 5 //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 tony 7 SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
245 tony 5 dllPathName := InstallDir +FIREBIRD_CLIENT;
246     Result := LoadLibrary(dllPathName)
247     end
248     else
249 tony 7 //Use Registry key if it exists to locate library
250 tony 5 begin
251 tony 7 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 tony 5 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 tony 1
280     begin
281 tony 5 IBLibrary := InternalLoadLibrary;
282     if (IBLibrary <> NilHandle) then
283 tony 1 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 tony 7 isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
291 tony 1 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 tony 5 IBServiceAPIPresent := true;
328 tony 1 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 tony 5 IBServiceAPIPresent := false;
344 tony 1 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 tony 5 if IBLibrary <> NilHandle then
362 tony 1 begin
363     FreeLibrary(IBLibrary);
364     IBLibrary := 0;
365     end;
366     end;
367    
368     function TryIBLoad: Boolean;
369     begin
370 tony 5 if (IBLibrary = NilHandle) then
371 tony 1 LoadIBLibrary;
372 tony 5 if (IBLibrary = NilHandle) then
373 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
388 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
400 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
408 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
423 tony 1 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 tony 7 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
434 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
442 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
449 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
456 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
463 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
470 tony 1 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 tony 7 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
477 tony 1 begin
478     IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
479     end;
480     initialization
481    
482     finalization
483     FreeIBLibrary;
484     end.