60 |
|
{ } |
61 |
|
{************************************************************************} |
62 |
|
unit FB25ClientAPI; |
63 |
+ |
{$IFDEF MSWINDOWS} |
64 |
+ |
{$DEFINE WINDOWS} |
65 |
+ |
{$ENDIF} |
66 |
|
|
67 |
|
{$IFDEF FPC} |
68 |
|
{$mode delphi} |
74 |
|
uses |
75 |
|
Classes, SysUtils, FBClientAPI, IBHeader, IBExternals, IB; |
76 |
|
|
74 |
– |
const |
75 |
– |
FBClientInterfaceVersion = '2.5'; |
76 |
– |
|
77 |
|
type |
78 |
|
|
79 |
|
{ TFB25Status } |
92 |
|
FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy |
93 |
|
when this class is freed and last reference to IStatus |
94 |
|
goes out of scope.} |
95 |
– |
protected |
96 |
– |
{$IFDEF UNIX} |
97 |
– |
function GetFirebirdLibList: string; override; |
98 |
– |
{$ENDIF} |
99 |
– |
procedure LoadInterface; override; |
95 |
|
public |
96 |
< |
constructor Create; |
96 |
> |
constructor Create(aFBLibrary: TFBLibrary); |
97 |
|
destructor Destroy; override; |
98 |
|
function StatusVector: PISC_STATUS; |
99 |
+ |
function LoadInterface: boolean; override; |
100 |
+ |
function GetAPI: IFirebirdAPI; override; |
101 |
+ |
{$IFDEF UNIX} |
102 |
+ |
function GetFirebirdLibList: string; override; |
103 |
+ |
{$ENDIF} |
104 |
|
property IBServiceAPIPresent: boolean read FIBServiceAPIPresent; |
105 |
|
property Status: TFB25Status read FStatus; |
106 |
|
|
111 |
|
BLOB_put: TBLOB_put; |
112 |
|
isc_wait_for_event: Tisc_wait_for_event; |
113 |
|
isc_vax_integer: Tisc_vax_integer; |
114 |
– |
isc_portable_integer: Tisc_portable_integer; |
114 |
|
isc_blob_info: Tisc_blob_info; |
115 |
|
isc_blob_lookup_desc: Tisc_blob_lookup_desc; |
116 |
|
isc_open_blob2: Tisc_open_blob2; |
146 |
|
isc_detach_database: Tisc_detach_database; |
147 |
|
isc_attach_database: Tisc_attach_database; |
148 |
|
isc_database_info: Tisc_database_info; |
149 |
+ |
isc_transaction_info: Tisc_transaction_info; |
150 |
|
isc_start_transaction: Tisc_start_transaction; |
151 |
|
isc_start_multiple: Tisc_start_multiple; |
152 |
|
isc_commit_transaction: Tisc_commit_transaction; |
162 |
|
isc_array_get_slice: Tisc_array_get_slice; |
163 |
|
isc_array_put_slice: Tisc_array_put_slice; |
164 |
|
isc_prepare_transaction: Tisc_prepare_transaction; |
165 |
+ |
isc_version: Tisc_Version; |
166 |
+ |
isc_interprete: Tisc_interprete; |
167 |
|
|
168 |
|
public |
169 |
|
{Helper Functions} |
170 |
< |
function DecodeInteger(bufptr: PChar; len: short): integer; override; |
171 |
< |
procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override; |
172 |
< |
function SQLDecodeDate(bufptr: PChar): TDateTime; override; |
173 |
< |
procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override; |
174 |
< |
function SQLDecodeTime(bufptr: PChar): TDateTime; override; |
175 |
< |
procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override; |
176 |
< |
function SQLDecodeDateTime(bufptr: PChar): TDateTime; override; |
175 |
< |
|
170 |
> |
procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override; |
171 |
> |
function SQLDecodeDate(bufptr: PByte): TDateTime; override; |
172 |
> |
procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override; |
173 |
> |
function SQLDecodeTime(bufptr: PByte): TDateTime; override; |
174 |
> |
procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override; |
175 |
> |
function SQLDecodeDateTime(bufptr: PByte): TDateTime; override; |
176 |
> |
function FormatStatus(Status: TFBStatus): AnsiString; override; |
177 |
|
public |
178 |
|
{IFirebirdAPI} |
179 |
|
|
180 |
|
{Database connections} |
181 |
|
function AllocateDPB: IDPB; |
182 |
< |
function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment; |
183 |
< |
function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload; |
184 |
< |
function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload; |
182 |
> |
function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment; |
183 |
> |
function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload; |
184 |
> |
function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload; |
185 |
|
|
186 |
|
{Start Transaction against multiple databases} |
187 |
|
function AllocateTPB: ITPB; |
188 |
|
function StartTransaction(Attachments: array of IAttachment; |
189 |
< |
TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; |
189 |
> |
TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; overload; |
190 |
|
function StartTransaction(Attachments: array of IAttachment; |
191 |
< |
TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; |
191 |
> |
TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; overload; |
192 |
|
|
193 |
|
{Service Manager} |
194 |
|
function AllocateSPB: ISPB; |
195 |
|
function HasServiceAPI: boolean; |
196 |
< |
function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager; |
196 |
> |
function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload; |
197 |
> |
function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload; |
198 |
|
|
199 |
|
{Information} |
200 |
|
function GetStatus: IStatus; override; |
201 |
|
function HasRollbackRetaining: boolean; |
202 |
|
function IsEmbeddedServer: boolean; override; |
203 |
< |
function GetImplementationVersion: string; |
203 |
> |
function GetClientMajor: integer; override; |
204 |
> |
function GetClientMinor: integer; override; |
205 |
|
|
206 |
|
{Firebird 3 API} |
207 |
|
function HasMasterIntf: boolean; |
209 |
|
|
210 |
|
end; |
211 |
|
|
209 |
– |
const |
210 |
– |
Firebird25ClientAPI: TFB25ClientAPI = nil; |
211 |
– |
|
212 |
|
implementation |
213 |
|
|
214 |
< |
uses FBMessages, dynlibs, FB25Attachment, FB25Transaction, FB25Services, FBParamBlock, |
215 |
< |
IBUtils; |
214 |
> |
uses FBMessages, |
215 |
> |
{$IFDEF WINDOWS}Windows, {$ENDIF} |
216 |
> |
{$IFDEF FPC} Dynlibs, {$ENDIF} |
217 |
> |
FB25Attachment, FB25Transaction, FB25Services, |
218 |
> |
IBUtils, FBAttachment, FBTransaction, FBServices; |
219 |
|
|
220 |
|
{ Stubs for 6.0 only functions } |
221 |
|
function isc_rollback_retaining_stub(status_vector : PISC_STATUS; |
228 |
|
|
229 |
|
function isc_service_attach_stub(status_vector : PISC_STATUS; |
230 |
|
isc_arg2 : UShort; |
231 |
< |
isc_arg3 : PChar; |
231 |
> |
isc_arg3 : PAnsiChar; |
232 |
|
service_handle : PISC_SVC_HANDLE; |
233 |
|
isc_arg5 : UShort; |
234 |
< |
isc_arg6 : PChar): |
234 |
> |
isc_arg6 : PAnsiChar): |
235 |
|
ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF} |
236 |
|
begin |
237 |
|
Result := 0; |
250 |
|
service_handle : PISC_SVC_HANDLE; |
251 |
|
recv_handle : PISC_SVC_HANDLE; |
252 |
|
isc_arg4 : UShort; |
253 |
< |
isc_arg5 : PChar; |
253 |
> |
isc_arg5 : PAnsiChar; |
254 |
|
isc_arg6 : UShort; |
255 |
< |
isc_arg7 : PChar; |
255 |
> |
isc_arg7 : PAnsiChar; |
256 |
|
isc_arg8 : UShort; |
257 |
< |
isc_arg9 : PChar): |
257 |
> |
isc_arg9 : PAnsiChar): |
258 |
|
ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF} |
259 |
|
begin |
260 |
|
Result := 0; |
265 |
|
service_handle : PISC_SVC_HANDLE; |
266 |
|
recv_handle : PISC_SVC_HANDLE; |
267 |
|
isc_arg4 : UShort; |
268 |
< |
isc_arg5 : PChar): |
268 |
> |
isc_arg5 : PAnsiChar): |
269 |
|
ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF} |
270 |
|
begin |
271 |
|
Result := 0; |
319 |
|
threadvar |
320 |
|
FStatusVector: TStatusVector; |
321 |
|
|
322 |
+ |
{ TFB25ActivityReporter } |
323 |
+ |
|
324 |
|
function TFB25Status.StatusVector: PStatusVector; |
325 |
|
begin |
326 |
|
Result := @FStatusVector; |
336 |
|
end; |
337 |
|
{$ENDIF} |
338 |
|
|
339 |
< |
procedure TFB25ClientAPI.LoadInterface; |
339 |
> |
function TFB25ClientAPI.LoadInterface: boolean; |
340 |
|
begin |
341 |
< |
inherited LoadInterface; |
341 |
> |
Result := inherited LoadInterface; |
342 |
|
BLOB_get := GetProcAddr('BLOB_get'); {do not localize} |
343 |
|
BLOB_put := GetProcAddr('BLOB_put'); {do not localize} |
344 |
|
isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize} |
345 |
|
isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize} |
341 |
– |
isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize} |
346 |
|
isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize} |
347 |
|
isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize} |
348 |
|
isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize} |
368 |
|
isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize} |
369 |
|
isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize} |
370 |
|
isc_database_info := GetProcAddr('isc_database_info'); {do not localize} |
371 |
+ |
isc_transaction_info := GetProcAddr('isc_transaction_info'); {do not localize} |
372 |
|
isc_start_transaction := GetProcAddr('isc_start_transaction'); {do not localize} |
373 |
|
isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize} |
374 |
|
isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize} |
383 |
|
isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize} |
384 |
|
isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize} |
385 |
|
isc_prepare_transaction := GetProcAddr('isc_prepare_transaction'); {do not localize} |
386 |
+ |
isc_version := GetProcAddr('isc_version'); {do not localize} |
387 |
+ |
isc_interprete := GetProcAddr('isc_interprete'); {do not localize} |
388 |
|
|
389 |
|
FIBServiceAPIPresent := true; |
390 |
< |
isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize} |
390 |
> |
isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize} |
391 |
|
if Assigned(isc_rollback_retaining) then |
392 |
|
begin |
393 |
|
isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize} |
415 |
|
isc_encode_sql_time := @isc_encode_sql_time_stub; |
416 |
|
isc_encode_timestamp := @isc_encode_timestamp_stub; |
417 |
|
end; |
418 |
+ |
Result := Result and assigned(isc_attach_database); |
419 |
+ |
end; |
420 |
+ |
|
421 |
+ |
function TFB25ClientAPI.GetAPI: IFirebirdAPI; |
422 |
+ |
begin |
423 |
+ |
Result := self; |
424 |
|
end; |
425 |
|
|
426 |
< |
constructor TFB25ClientAPI.Create; |
426 |
> |
constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary); |
427 |
|
begin |
428 |
< |
inherited; |
428 |
> |
inherited Create(aFBLibrary); |
429 |
|
FStatus := TFB25Status.Create(self); |
430 |
|
FStatusIntf := FStatus; |
418 |
– |
Firebird25ClientAPI := self; |
431 |
|
end; |
432 |
|
|
433 |
|
destructor TFB25ClientAPI.Destroy; |
434 |
|
begin |
435 |
|
FStatusIntf := nil; |
424 |
– |
Firebird25ClientAPI := nil; |
436 |
|
inherited Destroy; |
437 |
|
end; |
438 |
|
|
449 |
|
|
450 |
|
function TFB25ClientAPI.AllocateDPB: IDPB; |
451 |
|
begin |
452 |
< |
Result := TDPB.Create; |
452 |
> |
Result := TDPB.Create(self); |
453 |
|
end; |
454 |
|
|
455 |
< |
function TFB25ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB; |
455 |
> |
function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; |
456 |
|
RaiseExceptionOnConnectError: boolean): IAttachment; |
457 |
|
begin |
458 |
< |
Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError); |
458 |
> |
Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError); |
459 |
|
if not Result.IsConnected then |
460 |
|
Result := nil; |
461 |
|
end; |
462 |
|
|
463 |
< |
function TFB25ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB; |
463 |
> |
function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; |
464 |
|
RaiseExceptionOnError: boolean): IAttachment; |
465 |
|
begin |
466 |
< |
Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError ); |
466 |
> |
Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError ); |
467 |
|
if (Result <> nil) and not Result.IsConnected then |
468 |
|
Result := nil; |
469 |
|
end; |
470 |
|
|
471 |
< |
function TFB25ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer; |
471 |
> |
function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer; |
472 |
|
RaiseExceptionOnError: boolean): IAttachment; |
473 |
|
begin |
474 |
< |
Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError ); |
474 |
> |
Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError ); |
475 |
|
if (Result <> nil) and not Result.IsConnected then |
476 |
|
Result := nil; |
477 |
|
end; |
478 |
|
|
479 |
|
function TFB25ClientAPI.AllocateSPB: ISPB; |
480 |
|
begin |
481 |
< |
Result := TSPB.Create; |
481 |
> |
Result := TSPB.Create(self); |
482 |
|
end; |
483 |
|
|
484 |
|
function TFB25ClientAPI.AllocateTPB: ITPB; |
485 |
|
begin |
486 |
< |
Result := TTPB.Create; |
486 |
> |
Result := TTPB.Create(self); |
487 |
|
end; |
488 |
|
|
489 |
< |
function TFB25ClientAPI.GetServiceManager(ServerName: string; |
489 |
> |
function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString; |
490 |
|
Protocol: TProtocol; SPB: ISPB): IServiceManager; |
491 |
|
begin |
492 |
|
if HasServiceAPI then |
493 |
< |
Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB) |
493 |
> |
Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB) |
494 |
> |
else |
495 |
> |
Result := nil; |
496 |
> |
end; |
497 |
> |
|
498 |
> |
function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString; |
499 |
> |
Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; |
500 |
> |
begin |
501 |
> |
if HasServiceAPI then |
502 |
> |
Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port) |
503 |
|
else |
504 |
|
Result := nil; |
505 |
|
end; |
506 |
|
|
507 |
|
function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment; |
508 |
< |
TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; |
508 |
> |
TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction; |
509 |
|
begin |
510 |
< |
Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion); |
510 |
> |
Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion,aName); |
511 |
|
end; |
512 |
|
|
513 |
|
function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment; |
514 |
< |
TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; |
514 |
> |
TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction; |
515 |
|
begin |
516 |
< |
Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion); |
516 |
> |
Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion, aName); |
517 |
|
end; |
518 |
|
|
519 |
|
function TFB25ClientAPI.HasServiceAPI: boolean; |
530 |
|
begin |
531 |
|
Result := false; |
532 |
|
{$IFDEF UNIX} |
533 |
< |
Result := Pos('libfbembed',FFBLibraryName) = 1; |
533 |
> |
Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1; |
534 |
|
{$ENDIF} |
535 |
|
{$IFDEF WINDOWS} |
536 |
< |
Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0; |
536 |
> |
Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0; |
537 |
|
{$ENDIF} |
538 |
|
end; |
539 |
|
|
540 |
< |
function TFB25ClientAPI.HasMasterIntf: boolean; |
540 |
> |
function TFB25ClientAPI.GetClientMajor: integer; |
541 |
|
begin |
542 |
< |
Result := false; |
542 |
> |
Result := 2; |
543 |
|
end; |
544 |
|
|
545 |
< |
function TFB25ClientAPI.GetIMaster: TObject; |
545 |
> |
function TFB25ClientAPI.GetClientMinor: integer; |
546 |
|
begin |
547 |
< |
Result := nil; |
547 |
> |
Result := 5; |
548 |
|
end; |
549 |
|
|
550 |
< |
function TFB25ClientAPI.GetImplementationVersion: string; |
550 |
> |
function TFB25ClientAPI.HasMasterIntf: boolean; |
551 |
|
begin |
552 |
< |
Result := FBClientInterfaceVersion; |
552 |
> |
Result := false; |
553 |
|
end; |
554 |
|
|
555 |
< |
function TFB25ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer; |
555 |
> |
function TFB25ClientAPI.GetIMaster: TObject; |
556 |
|
begin |
557 |
< |
Result := isc_portable_integer(bufptr,len); |
557 |
> |
Result := nil; |
558 |
|
end; |
559 |
|
|
560 |
< |
procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar); |
560 |
> |
procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte); |
561 |
|
var |
562 |
|
tm_date: TCTimeStructure; |
563 |
|
Yr, Mn, Dy: Word; |
574 |
|
isc_encode_sql_date(@tm_date, PISC_DATE(bufptr)); |
575 |
|
end; |
576 |
|
|
577 |
< |
function TFB25ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime; |
577 |
> |
function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime; |
578 |
|
var |
579 |
|
tm_date: TCTimeStructure; |
580 |
|
begin |
589 |
|
end; |
590 |
|
end; |
591 |
|
|
592 |
< |
procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar); |
592 |
> |
procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte); |
593 |
|
var |
594 |
|
tm_date: TCTimeStructure; |
595 |
< |
Hr, Mt, S, Ms: Word; |
595 |
> |
Hr, Mt, S: Word; |
596 |
> |
DMs: cardinal; {DMs = decimilliseconds} |
597 |
|
begin |
598 |
< |
DecodeTime(aTime, Hr, Mt, S, Ms); |
598 |
> |
FBDecodeTime(aTime, Hr, Mt, S, DMs); |
599 |
|
with tm_date do begin |
600 |
|
tm_sec := S; |
601 |
|
tm_min := Mt; |
604 |
|
tm_mon := 0; |
605 |
|
tm_year := 0; |
606 |
|
end; |
607 |
< |
with Firebird25ClientAPI do |
608 |
< |
isc_encode_sql_time(@tm_date, PISC_TIME(bufptr)); |
609 |
< |
if Ms > 0 then |
589 |
< |
Inc(PISC_TIME(bufptr)^,Ms*10); |
607 |
> |
isc_encode_sql_time(@tm_date, PISC_TIME(bufptr)); |
608 |
> |
if DMs > 0 then |
609 |
> |
Inc(PISC_TIME(bufptr)^,DMs); |
610 |
|
end; |
611 |
|
|
612 |
< |
function TFB25ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime; |
612 |
> |
function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime; |
613 |
|
var |
614 |
|
tm_date: TCTimeStructure; |
615 |
< |
msecs: Word; |
615 |
> |
DMs: cardinal; {DMs = decimilliseconds} |
616 |
|
begin |
617 |
|
isc_decode_sql_time(PISC_TIME(bufptr), @tm_date); |
618 |
|
try |
619 |
< |
msecs := (PISC_TIME(bufptr)^ mod 10000) div 10; |
620 |
< |
result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
621 |
< |
Word(tm_date.tm_sec), msecs) |
619 |
> |
DMs := PISC_TIME(bufptr)^ mod 10000; |
620 |
> |
result := FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
621 |
> |
Word(tm_date.tm_sec), DMs) |
622 |
|
except |
623 |
|
on E: EConvertError do begin |
624 |
|
IBError(ibxeInvalidDataConversion, [nil]); |
626 |
|
end; |
627 |
|
end; |
628 |
|
|
629 |
< |
procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); |
629 |
> |
procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); |
630 |
|
var |
631 |
|
tm_date: TCTimeStructure; |
632 |
|
Yr, Mn, Dy, Hr, Mt, S, Ms: Word; |
633 |
+ |
DMs: cardinal; |
634 |
|
begin |
635 |
|
DecodeDate(aDateTime, Yr, Mn, Dy); |
636 |
< |
DecodeTime(aDateTime, Hr, Mt, S, Ms); |
636 |
> |
FBDecodeTime(aDateTime, Hr, Mt, S, DMs); |
637 |
|
with tm_date do begin |
638 |
|
tm_sec := S; |
639 |
|
tm_min := Mt; |
643 |
|
tm_year := Yr - 1900; |
644 |
|
end; |
645 |
|
isc_encode_date(@tm_date, PISC_QUAD(bufptr)); |
646 |
< |
if Ms > 0 then |
647 |
< |
Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10); |
646 |
> |
if DMs > 0 then |
647 |
> |
Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,DMs); |
648 |
|
end; |
649 |
|
|
650 |
< |
function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime; |
650 |
> |
function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime; |
651 |
|
var |
652 |
|
tm_date: TCTimeStructure; |
653 |
< |
msecs: Word; |
653 |
> |
Dmsecs: Word; |
654 |
|
begin |
655 |
|
isc_decode_date(PISC_QUAD(bufptr), @tm_date); |
656 |
|
try |
657 |
|
result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1), |
658 |
|
Word(tm_date.tm_mday)); |
659 |
< |
msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10; |
659 |
> |
Dmsecs := PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000; |
660 |
|
if result >= 0 then |
661 |
< |
result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
662 |
< |
Word(tm_date.tm_sec), msecs) |
661 |
> |
result := result + FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
662 |
> |
Word(tm_date.tm_sec), Dmsecs) |
663 |
|
else |
664 |
< |
result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
665 |
< |
Word(tm_date.tm_sec), msecs) |
664 |
> |
result := result - FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min), |
665 |
> |
Word(tm_date.tm_sec), Dmsecs) |
666 |
|
except |
667 |
|
on E: EConvertError do begin |
668 |
|
IBError(ibxeInvalidDataConversion, [nil]); |
670 |
|
end; |
671 |
|
end; |
672 |
|
|
673 |
+ |
function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString; |
674 |
+ |
var psb: PStatusVector; |
675 |
+ |
local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar; |
676 |
+ |
begin |
677 |
+ |
psb := Status.StatusVector; |
678 |
+ |
Result := ''; |
679 |
+ |
while isc_interprete(@local_buffer,@psb) > 0 do |
680 |
+ |
begin |
681 |
+ |
if (Result <> '') and (Result[Length(Result)] <> LF) then |
682 |
+ |
Result := Result + LineEnding + '-'; |
683 |
+ |
Result := Result + strpas(local_buffer); |
684 |
+ |
end; |
685 |
+ |
end; |
686 |
+ |
|
687 |
|
end. |
688 |
|
|
689 |
+ |
|