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