ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBIntf.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBIntf.pas (file contents):
Revision 4 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC

# Line 23 | Line 23
23   {    Portions created by Inprise Corporation are Copyright (C) Inprise   }
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26 + {                    Tony Whyman, MWA Software (Ported to Lazarus)       }
27 + {                    http://www.mwasoftware.co.uk                        }
28   {                                                                        }
29   {************************************************************************}
30  
31   unit IBIntf;
32  
33 + {$Mode Delphi}
34 +
35   interface
36  
37 < uses Windows, IBHeader, IBInstallHeader, IBExternals;
37 > uses
38 > {$IFDEF LINUX }
39 >  unix,
40 > {$ELSE}
41 >  Windows,
42 > {$ENDIF}
43 >  IBHeader,IBExternals;
44  
45   var
46    BLOB_get: TBLOB_get;
# Line 86 | Line 96 | var
96    isc_delete_user: Tisc_delete_user;
97    isc_modify_user: Tisc_modify_user;
98  
89  isc_install_clear_options: Tisc_install_clear_options;
90  isc_install_execute: Tisc_install_execute;
91  isc_install_get_info: Tisc_install_get_info;
92  isc_install_get_message: Tisc_install_get_message;
93  isc_install_load_external_text: Tisc_install_load_external_text;
94  isc_install_precheck: Tisc_install_precheck;
95  isc_install_set_option: Tisc_install_set_option;
96  isc_uninstall_execute: Tisc_uninstall_execute;
97  isc_uninstall_precheck: Tisc_uninstall_precheck;
98  isc_install_unset_option: Tisc_install_unset_option;
99  
100   { Library Initialization }
101   procedure LoadIBLibrary;
102   procedure FreeIBLibrary;
103 procedure LoadIBInstallLibrary;
104 procedure FreeIBInstallLibrary;
103   function TryIBLoad: Boolean;
104   procedure CheckIBLoaded;
107 function GetIBClientVersion: Integer;
108 procedure CheckIBInstallLoaded;
105  
106   { Stubs for 6.0 only functions }
107   function isc_rollback_retaining_stub(status_vector   : PISC_STATUS;
108                tran_handle     : PISC_TR_HANDLE):
109 <                                     ISC_STATUS; stdcall;
109 >                                     ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
110   function isc_service_attach_stub(status_vector      : PISC_STATUS;
111                                   isc_arg2           : UShort;
112                                   isc_arg3           : PChar;
113                                   service_handle     : PISC_SVC_HANDLE;
114                                   isc_arg5           : UShort;
115                                   isc_arg6           : PChar):
116 <                                 ISC_STATUS; stdcall;
116 >                                 ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
117   function isc_service_detach_stub(status_vector      : PISC_STATUS;
118                                   service_handle     : PISC_SVC_HANDLE):
119 <                                 ISC_STATUS; stdcall;
119 >                                 ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
120   function isc_service_query_stub(status_vector        : PISC_STATUS;
121                                  service_handle       : PISC_SVC_HANDLE;
122                                  recv_handle          : PISC_SVC_HANDLE;
# Line 130 | Line 126 | function isc_service_query_stub(status_v
126                                  isc_arg7             : PChar;
127                                  isc_arg8             : UShort;
128                                  isc_arg9             : PChar):
129 <                                ISC_STATUS; stdcall;
129 >                                ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
130   function isc_service_start_stub(status_vector        : PISC_STATUS;
131                                  service_handle       : PISC_SVC_HANDLE;
132                                  recv_handle          : PISC_SVC_HANDLE;
133                                  isc_arg4             : UShort;
134                                  isc_arg5             : PChar):
135 <                                ISC_STATUS; stdcall;
135 >                                ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
136  
137   procedure isc_encode_sql_date_stub(tm_date           : PCTimeStructure;
138                   ib_date           : PISC_DATE);
139 <                                   stdcall;
139 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
140  
141   procedure isc_encode_sql_time_stub(tm_date           : PCTimeStructure;
142                     ib_time           : PISC_TIME);
143 <                                   stdcall;
143 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
144  
145   procedure isc_encode_timestamp_stub(tm_date          : PCTimeStructure;
146                    ib_timestamp     : PISC_TIMESTAMP);
147 <                                    stdcall;
147 >                                    {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
148  
149   procedure isc_decode_sql_date_stub(ib_date           : PISC_DATE;
150                                     tm_date           : PCTimeStructure);
151 <                                   stdcall;
151 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
152  
153   procedure isc_decode_sql_time_stub(ib_time           : PISC_TIME;
154                                     tm_date           : PCTimeStructure);
155 <                                   stdcall;
155 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
156  
157   procedure isc_decode_timestamp_stub(ib_timestamp     : PISC_TIMESTAMP;
158                                      tm_date          : PCTimeStructure);
159 <                                    stdcall;
159 >                                    {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
160 >
161  
162 < { stubs for install functions }
166 < function isc_install_clear_options_stub(hOption: POPTIONS_HANDLE):MSG_NO; stdcall;
167 < function isc_install_execute_stub(hOption: OPTIONS_HANDLE;
168 <                             src_dir: TEXT;
169 <                             dest_dir: TEXT;
170 <                             status_func: FP_STATUS;
171 <                             status_data: pointer;
172 <                             error_func: FP_ERROR;
173 <                             error_data: pointer;
174 <                             uninstal_file_name: TEXT):MSG_NO; stdcall;
175 < function isc_install_get_info_stub(info_type :integer;
176 <                              option :OPT;
177 <                              info_buffer : Pointer;
178 <                              buf_len : Cardinal): MSG_NO; stdcall;
179 < function isc_install_get_message_stub(hOption: OPTIONS_HANDLE;
180 <                                 message_no: MSG_NO;
181 <                                 message_txt: Pointer;
182 <                                 message_len: Cardinal):MSG_NO; stdcall;
183 < function isc_install_load_external_text_stub(msg_file_name: TEXT):MSG_NO; stdcall;
184 < function isc_install_precheck_stub(hOption: OPTIONS_HANDLE;
185 <                              src_dir: TEXT;
186 <                              dest_dir: TEXT):MSG_NO; stdcall;
187 < function isc_install_set_option_stub(hOption: POPTIONS_HANDLE;
188 <                                option: OPT):MSG_NO; stdcall;
189 < function isc_uninstall_execute_stub(uninstall_file_name: TEXT;
190 <                               status_func: FP_STATUS;
191 <                               status_data: pointer;
192 <                               error_func: FP_ERROR;
193 <                               error_data: pointer):MSG_NO; stdcall;
194 < function isc_uninstall_precheck_stub(uninstall_file_name: TEXT):MSG_NO; stdcall;
195 < function isc_install_unset_option_stub(hOption: POPTIONS_HANDLE;
196 <                                  option: OPT):MSG_NO; stdcall;
162 > var  IBServiceAPIPresent: boolean;
163  
164   implementation
165  
166 < uses Sysutils, IB;
166 > uses Sysutils, IB, Dynlibs;
167  
168   var
169 <  IBLibrary: THandle;
204 <  IBInstallLibrary: THandle;
205 <  IBClientVersion: Integer;
169 >  IBLibrary: TLibHandle;
170  
171   procedure LoadIBLibrary;
172  
# Line 210 | Line 174 | procedure LoadIBLibrary;
174    begin
175      Result := GetProcAddress(IBLibrary, ProcName);
176      if not Assigned(Result) then
177 <      RaiseLastWin32Error;
177 >      raise Exception.Create('Unable to load Firebird Client Library');
178 >  end;
179 > {$IFDEF LINUX }
180 >  function InternalLoadLibrary: TLibHandle;
181 >  var LibName: string;
182 >  begin
183 >    //Use default unless FBLIB overrides
184 >    LibName := GetEnvironmentVariable('FBLIB');
185 >    if LibName = '' then LibName := FIREBIRD_SO;
186 >    Result := LoadLibrary(LibName);
187 >  end;
188 > {$ELSE}
189 > // "Else" is currently Windozze
190 >  function InternalLoadLibrary: TLibHandle;
191 >  var InstallDir: string;
192 >      dllPathName: string;
193 >  begin
194 >    //First look for Firebird Embedded Server in installation dir
195 >    InstallDir := ExtractFilePath(Application.ExeName);
196 >    if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
197 >    begin
198 >         dllPathName := InstallDir + FIREBIRD_EMBEDDED;
199 >         Result := LoadLibrary(dllPathName)
200 >    end
201 >    else
202 >    //Otherwise look for Firebird Client in installation dir
203 >    if FileExists(InstallDir + FIREBIRD_CLIENT) then
204 >    begin
205 >      //assume firebird.conf and firebird.msg in same dir
206 >      SetEnvironmentVariable('FIREBIRD',InstallDir);
207 >      dllPathName := InstallDir +FIREBIRD_CLIENT;
208 >      Result := LoadLibrary(dllPathName)
209 >    end
210 >    else
211 >    //Otherwise see if Firebird client is in path
212 >    //and rely on registry for location of firebird.conf and firebird.msg
213 >    begin
214 >      Result := LoadLibrary(FIREBIRD_CLIENT);
215 >      if Result <= HINSTANCE_ERROR then
216 >         //well maybe InterBase is present...
217 >         Result := LoadLibrary(IBASE_DLL);
218 >    end
219    end;
220 + {$ENDIF}
221  
222   begin
223 <  IBLibrary := LoadLibrary(PChar(IBASE_DLL));
224 <  if (IBLibrary > HINSTANCE_ERROR) then
223 >  IBLibrary := InternalLoadLibrary;
224 >  if (IBLibrary <> NilHandle) then
225    begin
226      BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
227      BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
# Line 259 | Line 265 | begin
265      isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
266      isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
267  
268 <    IBClientVersion := 6;
268 >    IBServiceAPIPresent := true;
269      isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
270      if Assigned(isc_rollback_retaining) then
271      begin
# Line 275 | Line 281 | begin
281        isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
282      end else
283      begin
284 <      IBClientVersion := 5;
284 >      IBServiceAPIPresent := false;
285        isc_rollback_retaining := isc_rollback_retaining_stub;
286        isc_service_attach := isc_service_attach_stub;
287        isc_service_detach := isc_service_detach_stub;
# Line 293 | Line 299 | end;
299  
300   procedure FreeIBLibrary;
301   begin
302 <  if IBLibrary > HINSTANCE_ERROR then
302 >  if IBLibrary <> NilHandle then
303    begin
304      FreeLibrary(IBLibrary);
305      IBLibrary := 0;
306    end;
307   end;
308  
303 procedure LoadIBInstallLibrary;
304
305  function GetProcAddr(ProcName: PChar): Pointer;
306  begin
307    Result := GetProcAddress(IBInstallLibrary, ProcName);
308    if not Assigned(Result) then RaiseLastWin32Error;
309  end;
310
311 begin
312  IBInstallLibrary := LoadLibrary(PChar(IB_INSTALL_DLL));
313  if (IBInstallLibrary > HINSTANCE_ERROR) then
314  begin
315    isc_install_clear_options := GetProcAddr('isc_install_clear_options'); {do not localize}
316    isc_install_execute := GetProcAddr('isc_install_execute'); {do not localize}
317    isc_install_get_info := GetProcAddr('isc_install_get_info'); {do not localize}
318    isc_install_get_message := GetProcAddr('isc_install_get_message'); {do not localize}
319    isc_install_load_external_text := GetProcAddr('isc_install_load_external_text'); {do not localize}
320    isc_install_precheck := GetProcAddr('isc_install_precheck'); {do not localize}
321    isc_install_set_option := GetProcAddr('isc_install_set_option'); {do not localize}
322    isc_uninstall_execute := GetProcAddr('isc_uninstall_execute'); {do not localize}
323    isc_uninstall_precheck := GetProcAddr('isc_uninstall_precheck'); {do not localize}
324    isc_install_unset_option := GetProcAddr('isc_install_unset_option'); {do not localize}
325  end
326  else begin
327    isc_install_clear_options := isc_install_clear_options_stub;
328    isc_install_execute := isc_install_execute_stub;
329    isc_install_get_info := isc_install_get_info_stub;
330    isc_install_get_message := isc_install_get_message_stub;
331    isc_install_load_external_text := isc_install_load_external_text_stub;
332    isc_install_precheck := isc_install_precheck_stub;
333    isc_install_set_option := isc_install_set_option_stub;
334    isc_uninstall_execute := isc_uninstall_execute_stub;
335    isc_uninstall_precheck := isc_uninstall_precheck_stub;
336    isc_install_unset_option := isc_install_unset_option_stub;
337  end;
338 end;
339
340 procedure FreeIBInstallLibrary;
341 begin
342  if IBInstallLibrary > HINSTANCE_ERROR then
343  begin
344    FreeLibrary(IBInstallLibrary);
345    IBInstallLibrary := 0;
346  end;
347 end;
348
309   function TryIBLoad: Boolean;
310   begin
311 <  if (IBLibrary <= HINSTANCE_ERROR) then
311 >  if (IBLibrary = NilHandle) then
312      LoadIBLibrary;
313 <  if (IBLibrary <= HINSTANCE_ERROR) then
313 >  if (IBLibrary = NilHandle) then
314      result := False
315    else
316      result := True;
# Line 362 | Line 322 | begin
322      IBError(ibxeInterBaseMissing, [nil]);
323   end;
324  
365 function GetIBClientVersion: Integer;
366 begin
367  CheckIBLoaded;
368  result := IBClientVersion;
369 end;
370
371 procedure CheckIBInstallLoaded;
372 begin
373  if (IBInstallLibrary <= HINSTANCE_ERROR) then
374    LoadIBInstallLibrary;
375  if (IBInstallLibrary <= HINSTANCE_ERROR) then
376    IBError(ibxeInterBaseInstallMissing, [nil]);
377 end;
325  
326   function isc_rollback_retaining_stub(status_vector   : PISC_STATUS;
327                tran_handle     : PISC_TR_HANDLE):
328 <                                     ISC_STATUS; stdcall;
328 >                                     ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
329   begin
330    Result := 0;
331    IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
# Line 390 | Line 337 | function isc_service_attach_stub(status_
337                                   service_handle     : PISC_SVC_HANDLE;
338                                   isc_arg5           : UShort;
339                                   isc_arg6           : PChar):
340 <                                 ISC_STATUS; stdcall;
340 >                                 ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
341   begin
342    Result := 0;
343    IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
# Line 398 | Line 345 | end;
345  
346   function isc_service_detach_stub(status_vector      : PISC_STATUS;
347                                   service_handle     : PISC_SVC_HANDLE):
348 <                                 ISC_STATUS; stdcall;
348 >                                 ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
349   begin
350    Result := 0;
351    IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
# Line 413 | Line 360 | function isc_service_query_stub(status_v
360                                  isc_arg7             : PChar;
361                                  isc_arg8             : UShort;
362                                  isc_arg9             : PChar):
363 <                                ISC_STATUS; stdcall;
363 >                                ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
364   begin
365    Result := 0;
366    IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
# Line 424 | Line 371 | function isc_service_start_stub(status_v
371                                  recv_handle          : PISC_SVC_HANDLE;
372                                  isc_arg4             : UShort;
373                                  isc_arg5             : PChar):
374 <                                ISC_STATUS; stdcall;
374 >                                ISC_STATUS; {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
375   begin
376    Result := 0;
377    IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
# Line 432 | Line 379 | end;
379  
380   procedure isc_encode_sql_date_stub(tm_date           : PCTimeStructure;
381                   ib_date           : PISC_DATE);
382 <                                   stdcall;
382 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
383   begin
384    IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
385   end;
386  
387   procedure isc_encode_sql_time_stub(tm_date           : PCTimeStructure;
388                     ib_time           : PISC_TIME);
389 <                                   stdcall;
389 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
390   begin
391    IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
392   end;
393  
394   procedure isc_encode_timestamp_stub(tm_date          : PCTimeStructure;
395                    ib_timestamp     : PISC_TIMESTAMP);
396 <                                    stdcall;
396 >                                    {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
397   begin
398    IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
399   end;
400  
401   procedure isc_decode_sql_date_stub(ib_date           : PISC_DATE;
402                                     tm_date           : PCTimeStructure);
403 <                                   stdcall;
403 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
404   begin
405    IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
406   end;
407  
408   procedure isc_decode_sql_time_stub(ib_time           : PISC_TIME;
409                                     tm_date           : PCTimeStructure);
410 <                                   stdcall;
410 >                                   {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
411   begin
412    IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
413   end;
414  
415   procedure isc_decode_timestamp_stub(ib_timestamp     : PISC_TIMESTAMP;
416                                      tm_date          : PCTimeStructure);
417 <                                    stdcall;
417 >                                    {$IFDEF LINUX} cdecl; {$ELSE} stdcall; {$ENDIF}
418   begin
419    IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
420   end;
474
475 function isc_install_clear_options_stub(hOption: POPTIONS_HANDLE):MSG_NO; stdcall;
476 begin
477  Result := 0;
478  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
479 end;
480
481 function isc_install_execute_stub(hOption: OPTIONS_HANDLE;
482                             src_dir: TEXT;
483                             dest_dir: TEXT;
484                             status_func: FP_STATUS;
485                             status_data: pointer;
486                             error_func: FP_ERROR;
487                             error_data: pointer;
488                             uninstal_file_name: TEXT):MSG_NO; stdcall;
489 begin
490  Result := 0;
491  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
492 end;
493
494 function isc_install_get_info_stub(info_type :integer;
495                              option :OPT;
496                              info_buffer : Pointer;
497                              buf_len : Cardinal): MSG_NO; stdcall;
498 begin
499  Result := 0;
500  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
501 end;
502
503 function isc_install_get_message_stub(hOption: OPTIONS_HANDLE;
504                                 message_no: MSG_NO;
505                                 message_txt: Pointer;
506                                 message_len: Cardinal):MSG_NO; stdcall;
507 begin
508  Result := 0;
509  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
510 end;
511
512 function isc_install_load_external_text_stub(msg_file_name: TEXT):MSG_NO; stdcall;
513 begin
514  Result := 0;
515  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
516 end;
517
518 function isc_install_precheck_stub(hOption: OPTIONS_HANDLE;
519                              src_dir: TEXT;
520                              dest_dir: TEXT):MSG_NO; stdcall;
521 begin
522  Result := 0;
523  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
524 end;
525
526 function isc_install_set_option_stub(hOption: POPTIONS_HANDLE;
527                                option: OPT):MSG_NO; stdcall;
528 begin
529  Result := 0;
530  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
531 end;
532
533 function isc_uninstall_execute_stub(uninstall_file_name: TEXT;
534                               status_func: FP_STATUS;
535                               status_data: pointer;
536                               error_func: FP_ERROR;
537                               error_data: pointer):MSG_NO; stdcall;
538 begin
539  Result := 0;
540  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
541 end;
542
543 function isc_uninstall_precheck_stub(uninstall_file_name: TEXT):MSG_NO; stdcall;
544 begin
545  Result := 0;
546  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
547 end;
548
549 function isc_install_unset_option_stub(hOption: POPTIONS_HANDLE;
550                                  option: OPT):MSG_NO; stdcall;
551 begin
552  Result := 0;
553  IBError(ibxeIB60feature, ['isc_install_xxx ']); {do not localize}
554 end;
555
421   initialization
422  
423   finalization
424    FreeIBLibrary;
560  FreeIBInstallLibrary;
425   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines