ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/source/FBUDRUtils.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 26750 byte(s)
Log Message:
Release Candidate 1

File Contents

# Content
1 (*
2 * Firebird UDR Support (fbudr). The fbudr components provide a set of
3 * Pascal language bindings for the Firebird API in support of server
4 * side User Defined Routines (UDRs). The fbudr package is an extension
5 * to the Firebird Pascal API.
6 *
7 * The contents of this file are subject to the Initial Developer's
8 * Public License Version 1.0 (the "License"); you may not use this
9 * file except in compliance with the License. You may obtain a copy
10 * of the License here:
11 *
12 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
13 *
14 * Software distributed under the License is distributed on an "AS
15 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
16 * implied. See the License for the specific language governing rights
17 * and limitations under the License.
18 *
19 * The Initial Developer of the Original Code is Tony Whyman.
20 *
21 * The Original Code is (C) 2021 Tony Whyman, MWA Software
22 * (http://www.mwasoftware.co.uk).
23 *
24 * All Rights Reserved.
25 *
26 * Contributor(s): ______________________________________.
27 *
28 *)
29 unit FBUDRUtils;
30
31 {$IFDEF MSWINDOWS}
32 {$DEFINE WINDOWS}
33 {$ENDIF}
34
35 {$IFDEF FPC}
36 {$mode delphi}
37 {$codepage UTF8}
38 {$interfaces COM}
39 {$ENDIF}
40
41 interface
42
43 uses
44 Classes, SysUtils, Firebird, FBActivityMonitor, IB, FBUDRController, FBUDRIntf;
45
46 const
47 {$IFDEF WINDOWS}
48 NewLineTAB = #$0D#$0A' ';
49 {$ELSE}
50 NewLineTAB = #$0A' ';
51 {$ENDIF}
52 {$if not declared(LineEnding)}
53 LineEnding = #$0D#$0A;
54 {$ifend}
55
56 type
57
58 { TFBUDRObject }
59
60 TFBUDRObject = class(TFBInterfacedObject)
61 private
62 FFirebirdAPI: IFirebirdAPI;
63 FController: TFBUDRController;
64 procedure SetFirebirdAPI(AValue: IFirebirdAPI);
65 protected
66 FStatus: Firebird.IStatus;
67 public
68 constructor Create(aController: TFBUDRController);
69 destructor Destroy; override;
70 procedure Clear; {IStatus}
71 procedure CheckStatus;
72 function getStatus: Firebird.IStatus;
73 property FirebirdAPI: IFirebirdAPI read FFirebirdAPI write SetFirebirdAPI;
74 property Controller: TFBUDRController read FController;
75 end;
76
77 {An External Context is provided when a factory object or an instance of an
78 external function, procedure or trigger is called}
79
80 { TFBUDRExternalContext }
81
82 TFBUDRExternalContext = class(TFBUDRObject, IFBUDRExternalContext)
83 private
84 FContext: Firebird.IExternalContext;
85 FAttachment: IAttachment;
86 FTransaction: ITransaction;
87 public
88 constructor Create(aController: TFBUDRController; context: Firebird.IExternalContext);
89 function AsText: AnsiString;
90 public
91 {IFBUDRExternalContext}
92 function GetFirebirdAPI: IFirebirdAPI;
93 function GetAttachment: IAttachment;
94 function GetTransaction: ITransaction;
95 function GetUserName: AnsiString;
96 function GetDatabaseName: AnsiString;
97 function GetClientCharSet: AnsiString;
98 function obtainInfoCode: Integer;
99 function getInfo(code: Integer): Pointer;
100 function setInfo(code: Integer; value: Pointer): Pointer;
101 function HasConfigFile: boolean;
102 function ReadConfigString(Section, Ident, DefaultValue: AnsiString): AnsiString;
103 function ReadConfigInteger(Section, Ident: AnsiString; DefaultValue: integer): integer;
104 function ReadConfigBool(Section, Ident: AnsiString; DefaultValue: boolean): boolean;
105 procedure WriteToLog(Msg: AnsiString);
106 end;
107
108 { The Routine metadata is provided when a factory object or an instance of an
109 external function, procedure or trigger is called and provides the input
110 and output metadata}
111
112 { TFBUDRRoutineMetadata }
113
114 TFBUDRRoutineMetadata = class(TFBUDRObject,IFBUDRRoutineMetadata,IFBUDRProcMetadata,IFBUDRTriggerMetaData)
115 private
116 FRoutineMetadata: firebird.IRoutineMetadata;
117 FInputMetadata: firebird.IMessageMetadata;
118 FOutputMetadata: firebird.IMessageMetadata;
119 FTriggerMetadata: firebird.IMessageMetadata;
120 FContext: IFBUDRExternalContext;
121 FFBInputMetadata: IFBUDRMessageMetadata;
122 FFBOutputMetadata: IFBUDRMessageMetadata;
123 FFBTriggerMetadata: IFBUDRMessageMetadata;
124 FModuleName: AnsiString;
125 FRoutineName: AnsiString;
126 FInfo: AnsiString;
127 public
128 constructor Create(context: IFBUDRExternalContext; routineMetadata: firebird.IRoutineMetadata);
129 destructor Destroy; override;
130 function AsText: AnsiString;
131 function getInputMetadata: firebird.IMessageMetadata;
132 function getOutputMetadata: firebird.IMessageMetadata;
133 function getTriggerMetadata: firebird.IMessageMetadata;
134 class procedure ParseEntryPoint(aEntryPoint: AnsiString; var aModuleName, aRoutineName, aInfo: AnsiString);
135 public
136 {IFBUDRRoutineMetadata}
137 function getPackage: AnsiString;
138 function getName: AnsiString;
139 function getEntryPoint: AnsiString;
140 function getModuleName: AnsiString;
141 function getRoutineName: AnsiString;
142 function getInfo: AnsiString;
143 function getBody: AnsiString;
144 function HasInputMetadata: boolean;
145 function HasOutputMetadata: boolean;
146 function HasTriggerMetadata: boolean;
147 function getFBInputMetadata: IFBUDRMessageMetadata;
148 function getFBOutputMetadata: IFBUDRMessageMetadata;
149 function getFBTriggerMetadata: IFBUDRMessageMetadata;
150 function getTriggerTable: AnsiString;
151 function getTriggerType: TFBUDRTriggerType;
152 end;
153
154 { TFBUDRMetadataBuilder }
155
156 TFBUDRMetadataBuilder = class(TFBUDRObject,IFBUDRMetadataBuilder)
157 private
158 FMetadataBuilder: Firebird.IMetadataBuilder;
159 public
160 constructor Create(context: IFBUDRExternalContext;
161 metadataBuilder: Firebird.IMetadataBuilder);
162 destructor Destroy; override;
163 property Builder: Firebird.IMetadataBuilder read FMetadataBuilder;
164 public
165 {IFBUDRMetadataBuilder}
166 procedure setType(index: Cardinal; type_: Cardinal);
167 procedure setSubType(index: Cardinal; subType: Integer);
168 procedure setLength(index: Cardinal; length: Cardinal);
169 procedure setCharSet(index: Cardinal; charSet: Cardinal);
170 procedure setScale(index: Cardinal; scale: Integer);
171 procedure truncate(count: Cardinal);
172 procedure moveNameToIndex(name: AnsiString; index: Cardinal);
173 procedure remove(index: Cardinal);
174 function addField:Cardinal;
175 procedure setField(index: Cardinal; field: AnsiString);
176 procedure setRelation(index: Cardinal; relation: AnsiString);
177 procedure setOwner(index: Cardinal; owner: AnsiString);
178 procedure setAlias(index: Cardinal; alias: AnsiString);
179 end;
180
181 { TFBUDRMessageMetadata }
182
183 TFBUDRMessageMetadata = class(TFBUDRObject,IFBUDRMessageMetadata)
184 private
185 FMetadata: Firebird.IMessageMetadata;
186 FContext: IFBUDRExternalContext;
187 public
188 constructor Create(context: IFBUDRExternalContext;
189 metadata: Firebird.IMessageMetadata);
190 destructor Destroy; override;
191 function AsText: AnsiString;
192 public
193 function getCount: Cardinal;
194 function getField(index: Cardinal): AnsiString;
195 function getRelation(index: Cardinal): AnsiString;
196 function getOwner(index: Cardinal): AnsiString;
197 function getAlias(index: Cardinal): AnsiString;
198 function getType(index: Cardinal): Cardinal;
199 function isNullable(index: Cardinal): Boolean;
200 function getSubType(index: Cardinal): Integer;
201 function getLength(index: Cardinal): Cardinal;
202 function getScale(index: Cardinal): Integer;
203 function getCharSet(index: Cardinal): Cardinal;
204 function getOffset(index: Cardinal): Cardinal;
205 function getNullOffset(index: Cardinal): Cardinal;
206 function getBuilder: IFBUDRMetadataBuilder;
207 function getMessageLength: Cardinal;
208 function getAlignment: Cardinal;
209 function getAlignedLength: Cardinal;
210 end;
211
212 { EFBUDRException }
213
214 EFBUDRException = class(Exception)
215 private
216 FStatus: Firebird.IStatus;
217 public
218 constructor Create(aStatus: Firebird.IStatus);
219 destructor Destroy; override;
220 property Status: Firebird.IStatus read FStatus;
221 end;
222
223 {$IFDEF MSWINDOWS}
224 function GetTempDir: AnsiString;
225 {$ENDIF}
226
227 function BooleanToStr(boolValue: boolean; ValTrue, ValFalse: AnsiString): AnsiString;
228
229 implementation
230
231 uses FBClientLib, FBClientAPI, FB30ClientAPI, FB30Attachment, FB30Transaction,
232 FBUDRMessage, FBSQLData {$IFDEF MSWINDOWS}, Windows{$ENDIF};
233
234 {$IFDEF MSWINDOWS}
235 function GetTempDir: AnsiString;
236 var
237 tempFolder: array[0..MAX_PATH] of Char;
238 begin
239 GetTempPath(MAX_PATH, @tempFolder);
240 result := StrPas(tempFolder);
241 end;
242 {$ENDIF}
243
244 function BooleanToStr(boolValue: boolean; ValTrue, ValFalse: AnsiString): AnsiString;
245 begin
246 if boolValue then
247 Result := ValTrue
248 else
249 Result := ValFalse;
250 end;
251
252 { TFBUDRMessageMetadata }
253
254 constructor TFBUDRMessageMetadata.Create(context: IFBUDRExternalContext;
255 metadata: Firebird.IMessageMetadata);
256 begin
257 inherited Create((context as TFBUDRExternalContext).Controller);
258 FirebirdAPI := context.GetFirebirdAPI;
259 FContext := context;
260 FMetadata := metadata;
261 FMetadata.addRef;
262 end;
263
264 destructor TFBUDRMessageMetadata.Destroy;
265 begin
266 if FMetadata <> nil then
267 FMetadata.release;
268 inherited Destroy;
269 end;
270
271 function TFBUDRMessageMetadata.AsText: AnsiString;
272
273 function CharsetIDToText(id: integer): AnsiString;
274 begin
275 if FContext.GetAttachment <> nil then
276 Result := FContext.GetAttachment.GetCharsetName(id)
277 else
278 Result := IntToStr(id);
279 end;
280
281 var i: integer;
282 begin
283 Result := Format('Field Count = %d' + NewLineTAB,[getCount]);
284 if FMetadata.vTable.version >= 4 then
285 begin
286 Result := Result + Format('Alignment = %d' + NewLineTAB,[getAlignment]) +
287 Format('Aligned Length = %d' + NewLineTAB,[getAlignedLength]);
288 end;
289 for i := 0 to getCount - 1 do
290 begin
291 Result := Result +
292 Format('Field No. %d' + NewLineTAB,[i]) +
293 Format('Field Name = %s' + NewLineTAB,[getField(i)]) +
294 Format('Relation Name = %s' + NewLineTAB,[getRelation(i)]) +
295 Format('Alias Name = %s' + NewLineTAB,[getAlias(i)]) +
296 Format('SQLType = %s' + NewLineTAB,[TSQLDataItem.GetSQLTypeName(getType(i))]) +
297 Format('IsNullable = %s' + NewLineTAB,[BooleanToStr(isNullable(i),'yes','no')]) +
298 Format('SubType = %d' + NewLineTAB,[getSubType(i)]) +
299 Format('Length = %d' + NewLineTAB,[getLength(i)]) +
300 Format('Scale = %d' + NewLineTAB,[getScale(i)]) +
301 Format('Offset = %d' + NewLineTAB,[getOffset(i)]) +
302 Format('Null Offset = %d' + NewLineTAB,[getNullOffset(i)]) +
303 Format('Message Length = %d' + NewLineTAB,[getLength(i)]);
304 end;
305 end;
306
307 function TFBUDRMessageMetadata.getCount: Cardinal;
308 begin
309 Result := FMetadata.getCount(FStatus);
310 CheckStatus;
311 end;
312
313 function TFBUDRMessageMetadata.getField(index: Cardinal): AnsiString;
314 begin
315 Result := strpas(FMetadata.getField(FStatus,index));
316 CheckStatus;
317 end;
318
319 function TFBUDRMessageMetadata.getRelation(index: Cardinal): AnsiString;
320 begin
321 Result := strpas(FMetadata.getRelation(FStatus,index));
322 CheckStatus;
323 end;
324
325 function TFBUDRMessageMetadata.getOwner(index: Cardinal): AnsiString;
326 begin
327 Result := strpas(FMetadata.getOwner(FStatus,index));
328 CheckStatus;
329 end;
330
331 function TFBUDRMessageMetadata.getAlias(index: Cardinal): AnsiString;
332 begin
333 Result := strpas(FMetadata.getAlias(FStatus,index));
334 CheckStatus;
335 end;
336
337 function TFBUDRMessageMetadata.getType(index: Cardinal): Cardinal;
338 begin
339 Result := FMetadata.getType(FStatus,index);
340 CheckStatus;
341 end;
342
343 function TFBUDRMessageMetadata.isNullable(index: Cardinal): Boolean;
344 begin
345 Result := FMetadata.isNullable(FStatus,index);
346 CheckStatus;
347 end;
348
349 function TFBUDRMessageMetadata.getSubType(index: Cardinal): Integer;
350 begin
351 Result := FMetadata.getSubType(FStatus,index);
352 CheckStatus;
353 end;
354
355 function TFBUDRMessageMetadata.getLength(index: Cardinal): Cardinal;
356 begin
357 Result := FMetadata.getLength(FStatus,index);
358 CheckStatus;
359 end;
360
361 function TFBUDRMessageMetadata.getScale(index: Cardinal): Integer;
362 begin
363 Result := FMetadata.getScale(FStatus,index);
364 CheckStatus;
365 end;
366
367 function TFBUDRMessageMetadata.getCharSet(index: Cardinal): Cardinal;
368 begin
369 Result := FMetadata.getCharSet(FStatus,index);
370 CheckStatus;
371 end;
372
373 function TFBUDRMessageMetadata.getOffset(index: Cardinal): Cardinal;
374 begin
375 Result := FMetadata.getOffset(FStatus,index);
376 CheckStatus;
377 end;
378
379 function TFBUDRMessageMetadata.getNullOffset(index: Cardinal): Cardinal;
380 begin
381 Result := FMetadata.getNullOffset(FStatus,index);
382 CheckStatus;
383 end;
384
385 function TFBUDRMessageMetadata.getBuilder: IFBUDRMetadataBuilder;
386 var builder: Firebird.IMetadataBuilder;
387 begin
388 builder := FMetadata.getBuilder(FStatus);
389 try
390 CheckStatus;
391 Result := TFBUDRMetadataBuilder.Create(FContext,builder);
392 finally
393 builder.release;
394 end;
395 end;
396
397 function TFBUDRMessageMetadata.getMessageLength: Cardinal;
398 begin
399 Result := FMetadata.getMessageLength(FStatus);
400 CheckStatus;
401 end;
402
403 function TFBUDRMessageMetadata.getAlignment: Cardinal;
404 begin
405 Result := FMetadata.getAlignment(FStatus);
406 CheckStatus;
407 end;
408
409 function TFBUDRMessageMetadata.getAlignedLength: Cardinal;
410 begin
411 Result := FMetadata.getAlignedLength(FStatus);
412 CheckStatus;
413 end;
414
415 { TFBUDRMetadataBuilder }
416
417 constructor TFBUDRMetadataBuilder.Create(context: IFBUDRExternalContext;
418 metadataBuilder: Firebird.IMetadataBuilder);
419 begin
420 inherited Create((context as TFBUDRExternalContext).Controller);
421 FirebirdAPI := context.GetFirebirdAPI;
422 FMetadataBuilder := metadataBuilder;
423 FMetadataBuilder.addRef;
424 end;
425
426 destructor TFBUDRMetadataBuilder.Destroy;
427 begin
428 if FMetadataBuilder <> nil then
429 FMetadataBuilder.release;
430 inherited Destroy;
431 end;
432
433 procedure TFBUDRMetadataBuilder.setType(index: Cardinal; type_: Cardinal);
434 begin
435 FMetadataBuilder.setType(FStatus,index,type_);
436 CheckStatus;
437 end;
438
439 procedure TFBUDRMetadataBuilder.setSubType(index: Cardinal; subType: Integer);
440 begin
441 FMetadataBuilder.setSubType(FStatus,index,subType);
442 CheckStatus;
443 end;
444
445 procedure TFBUDRMetadataBuilder.setLength(index: Cardinal; length: Cardinal);
446 begin
447 FMetadataBuilder.setLength(FStatus,index,Length);
448 CheckStatus;
449 end;
450
451 procedure TFBUDRMetadataBuilder.setCharSet(index: Cardinal; charSet: Cardinal);
452 begin
453 FMetadataBuilder.setCharSet(FStatus,index,charSet);
454 CheckStatus;
455 end;
456
457 procedure TFBUDRMetadataBuilder.setScale(index: Cardinal; scale: Integer);
458 begin
459 FMetadataBuilder.SetScale(FStatus,index,scale);
460 CheckStatus;
461 end;
462
463 procedure TFBUDRMetadataBuilder.truncate(count: Cardinal);
464 begin
465 FMetadataBuilder.truncate(FStatus,count);
466 CheckStatus;
467 end;
468
469 procedure TFBUDRMetadataBuilder.moveNameToIndex(name: AnsiString; index: Cardinal);
470 begin
471 FMetadataBuilder.moveNameToIndex(FStatus,PAnsiChar(name),index);
472 CheckStatus;
473 end;
474
475 procedure TFBUDRMetadataBuilder.remove(index: Cardinal);
476 begin
477 FMetadataBuilder.remove(FStatus,index);
478 CheckStatus;
479 end;
480
481 function TFBUDRMetadataBuilder.addField: Cardinal;
482 begin
483 Result := FMetadataBuilder.addField(FStatus);
484 CheckStatus;
485 end;
486
487 procedure TFBUDRMetadataBuilder.setField(index: Cardinal; field: AnsiString);
488 begin
489 FMetadataBuilder.setField(FStatus,index,PAnsiChar(field));
490 CheckStatus;
491 end;
492
493 procedure TFBUDRMetadataBuilder.setRelation(index: Cardinal; relation: AnsiString);
494 begin
495 FMetadataBuilder.setRelation(FStatus,index,PAnsiChar(relation));
496 CheckStatus;
497 end;
498
499 procedure TFBUDRMetadataBuilder.setOwner(index: Cardinal; owner: AnsiString);
500 begin
501 FMetadataBuilder.setOwner(FStatus,index,PAnsiChar(owner));
502 CheckStatus;
503 end;
504
505 procedure TFBUDRMetadataBuilder.setAlias(index: Cardinal; alias: AnsiString);
506 begin
507 FMetadataBuilder.setAlias(FStatus,index,PAnsiChar(alias));
508 end;
509
510 { TFBUDRObject }
511
512 procedure TFBUDRObject.SetFirebirdAPI(AValue: IFirebirdAPI);
513 var MasterProvider: IFBIMasterProvider;
514 begin
515 if FFirebirdAPI = AValue then Exit;
516 FFirebirdAPI := AValue;
517 if (FStatus = nil) and
518 FirebirdAPI.HasMasterIntf and (FirebirdAPI.QueryInterface(IFBIMasterProvider,MasterProvider) = S_OK) then
519 FStatus := MasterProvider.GetIMasterIntf.getStatus;
520 end;
521
522 procedure TFBUDRObject.CheckStatus;
523 begin
524 with FStatus do
525 if (getState and STATE_ERRORS) <> 0 then
526 raise EFBUDRException.Create(FStatus);
527 end;
528
529 function TFBUDRObject.getStatus: Firebird.IStatus;
530 begin
531 Result := FStatus;
532 end;
533
534 constructor TFBUDRObject.Create(aController: TFBUDRController);
535 begin
536 inherited Create;
537 FController := aController;
538 end;
539
540 destructor TFBUDRObject.Destroy;
541 begin
542 if FStatus <> nil then
543 FStatus.dispose;
544 inherited Destroy;
545 end;
546
547 procedure TFBUDRObject.Clear;
548 begin
549 if FStatus <> nil then
550 FStatus.Init;
551 end;
552
553 { TFBUDRExternalContext }
554
555 constructor TFBUDRExternalContext.Create(aController: TFBUDRController;
556 context: Firebird.IExternalContext);
557 begin
558 inherited Create(aController);
559 FContext := context;
560 FirebirdAPI := TFB30ClientAPI.Create(context.getMaster);
561 end;
562
563 function TFBUDRExternalContext.AsText: AnsiString;
564 begin
565 Result := 'External Context: ' + NewLineTAB +
566 Format('Attachment ID = %d' + NewLineTAB,[GetAttachment.GetAttachmentID]) +
567 Format('Transaction ID = %d' + NewLineTAB,[GetTransaction.GetTransactionID]) +
568 Format('User Name = %s' + NewLineTAB,[GetUserName]) +
569 Format('Database Name = %s' + NewLineTAB,[GetDatabaseName]) +
570 Format('Client Character Set = %s' + NewLineTAB,[GetClientCharSet]);
571 end;
572
573 function TFBUDRExternalContext.GetFirebirdAPI: IFirebirdAPI;
574 begin
575 Result := FirebirdAPI;
576 end;
577
578 function TFBUDRExternalContext.GetAttachment: IAttachment;
579 var att: Firebird.IAttachment;
580 begin
581 if FAttachment = nil then
582 begin
583 att := FContext.getAttachment(FStatus);
584 CheckStatus;
585 FAttachment := TFB30Attachment.Create(FirebirdAPI as TFB30ClientAPI,
586 att,
587 GetDatabaseName);
588 end;
589 Result := FAttachment;
590 end;
591
592 function TFBUDRExternalContext.GetTransaction: ITransaction;
593 var tr: Firebird.ITransaction;
594 begin
595 Result := nil;
596 if FTransaction = nil then
597 begin
598 tr := FContext.getTransaction(FStatus);
599 CheckStatus;
600 FTransaction := TFB30Transaction.Create(FirebirdAPI as TFB30ClientAPI,GetAttachment,tr);
601 end;
602 Result := FTransaction;
603 end;
604
605 function TFBUDRExternalContext.GetUserName: AnsiString;
606 begin
607 Result := strpas(FContext.getUserName);
608 end;
609
610 function TFBUDRExternalContext.GetDatabaseName: AnsiString;
611 begin
612 Result := strpas(FContext.getDatabaseName);
613 end;
614
615 function TFBUDRExternalContext.GetClientCharSet: AnsiString;
616 begin
617 Result := strpas(FContext.getClientCharSet);
618 end;
619
620 function TFBUDRExternalContext.obtainInfoCode: Integer;
621 begin
622 Result := FContext.obtainInfoCode;
623 end;
624
625 function TFBUDRExternalContext.getInfo(code: Integer): Pointer;
626 begin
627 Result := FContext.getInfo(code);
628 end;
629
630 function TFBUDRExternalContext.setInfo(code: Integer; value: Pointer): Pointer;
631 begin
632 Result := FContext.setInfo(code,value);
633 end;
634
635 function TFBUDRExternalContext.HasConfigFile: boolean;
636 begin
637 Result := Controller.HasConfigFile;
638 end;
639
640 function TFBUDRExternalContext.ReadConfigString(Section, Ident,
641 DefaultValue: AnsiString): AnsiString;
642 begin
643 Result := Controller.ReadConfigString(Section, Ident, DefaultValue);
644 end;
645
646 function TFBUDRExternalContext.ReadConfigInteger(Section, Ident: AnsiString;
647 DefaultValue: integer): integer;
648 begin
649 Result := Controller.ReadConfigInteger(Section, Ident, DefaultValue);
650 end;
651
652 function TFBUDRExternalContext.ReadConfigBool(Section, Ident: AnsiString;
653 DefaultValue: boolean): boolean;
654 begin
655 Result := Controller.ReadConfigBool(Section, Ident, DefaultValue);
656 end;
657
658 procedure TFBUDRExternalContext.WriteToLog(Msg: AnsiString);
659 begin
660 Controller.WriteToLog(Msg);
661 end;
662
663
664 { TFBUDRRoutineMetadata }
665
666 class procedure TFBUDRRoutineMetadata.ParseEntryPoint(aEntryPoint: AnsiString;
667 var aModuleName, aRoutineName, aInfo: AnsiString);
668 var p1,p2: integer;
669 begin
670 aModuleName := '';
671 aRoutineName := '';
672 aInfo := '';
673 p1 := 1;
674 P2 := 1;
675 while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
676 Inc(p2);
677 if p2 = length(aEntryPoint) then
678 begin
679 aModuleName := aEntryPoint;
680 Exit;
681 end;
682 aModuleName := system.copy(aEntryPoint,1,p2-1);
683 Inc(p2);
684 p1 := p2;
685 while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
686 Inc(p2);
687 if p2 = length(aEntryPoint) then
688 begin
689 aRoutineName := system.copy(aEntryPoint,p1,maxint);
690 Exit;
691 end;
692 aRoutineName := system.copy(aEntryPoint,p1,p2-p1);
693 aInfo := system.copy(aEntryPoint,p2+1,maxint);
694 end;
695
696 constructor TFBUDRRoutineMetadata.Create(context: IFBUDRExternalContext;
697 routineMetadata: firebird.IRoutineMetadata);
698 var TriggerType: cardinal;
699 begin
700 inherited Create((context as TFBUDRExternalContext).Controller);
701 FirebirdAPI := context.GetFirebirdAPI;
702 FContext := context;
703 FRoutineMetadata := routineMetadata;
704
705 TriggerType := FRoutineMetadata.getTriggerType(FStatus);
706 CheckStatus;
707
708 if TriggerType = 0 then
709 begin
710 FInputMetadata := FRoutineMetadata.getInputMetadata(FStatus);
711 CheckStatus;
712 if FInputMetadata <> nil then
713 FInputMetadata.addRef;
714
715 FOutputMetadata := FRoutineMetadata.getOutputMetadata(FStatus);
716 CheckStatus;
717 if FOutputMetadata <> nil then
718 FOutputMetadata.addRef;
719 end
720 else
721 begin
722 FTriggerMetadata := FRoutineMetadata.getTriggerMetadata(FStatus);
723 CheckStatus;
724 if FTriggerMetadata <> nil then
725 FTriggerMetadata.addRef;
726 end;
727 ParseEntryPoint(getEntryPoint,FModuleName,FRoutineName,FInfo);
728 end;
729
730 destructor TFBUDRRoutineMetadata.Destroy;
731 begin
732 if FInputMetadata <> nil then
733 FInputMetadata.release;
734 if FOutputMetadata <> nil then
735 FOutputMetadata.release;
736 if FTriggerMetadata <> nil then
737 FTriggerMetadata.release;
738 inherited Destroy;
739 end;
740
741 function TFBUDRRoutineMetadata.AsText: AnsiString;
742
743 function MetadataToText(metadata: Firebird.IMessageMetadata): AnsiString;
744 var fbMetadata: TFBUDRMessageMetadata;
745 begin
746 if metadata = nil then
747 Result := '(nil)'
748 else
749 begin
750 fbMetadata := TFBUDRMessageMetadata.Create(FContext,metadata);
751 try
752 Result := fbMetadata.AsText;
753 finally
754 fbMetadata.Free;
755 end;
756 end;
757 end;
758
759 function TriggerTypeToText(TriggerType: TFBUDRTriggerType): AnsiString;
760 begin
761 case TriggerType of
762 ttAfter:
763 Result := 'After';
764 ttBefore:
765 Result := 'Before';
766 ttDatabase:
767 Result := 'Database';
768 end;
769 end;
770
771 begin
772 Result := Format('Package Name = %s' + NewLineTAB,[getPackage]) +
773 Format('Name = %s' + NewLineTAB,[getName]) +
774 Format('Entry Point = %s (%s,%s,%s)' + NewLineTAB,[getEntryPoint,getModuleName,getRoutineName,getInfo]) +
775 Format('Body = %s' + NewLineTAB,[getBody]);
776 if HasInputMetaData then
777 Result := Result + Format('Input Metadata:' + NewLineTAB + '%s',[MetadataToText(FInputMetaData)]) + LineEnding;
778 if HasOutputMetaData then
779 Result := Result + Format('Output Metadata:' + NewLineTAB + '%s',[MetadataToText(FOutputMetaData)]);
780 if FRoutineMetadata.getTriggerType(FStatus) > 0 then
781 begin
782 if HasTriggerMetaData then
783 Result := Result + Format('Trigger Metadata:' + NewLineTAB + '%s',[MetadataToText(FTriggerMetaData)]);
784 Result := Result +
785 Format('Trigger Table = %s' + NewLineTAB,[getTriggerTable]) +
786 Format('Trigger Type = %s' + NewLineTAB,[TriggerTypeToText(getTriggerType)]);
787 end;
788 CheckStatus;
789 end;
790
791 function TFBUDRRoutineMetadata.getPackage: AnsiString;
792 begin
793 Result := strpas(FRoutineMetadata.getPackage(FStatus));
794 CheckStatus;
795 end;
796
797 function TFBUDRRoutineMetadata.getName: AnsiString;
798 begin
799 Result := strpas(FRoutineMetadata.getName(FStatus));
800 CheckStatus;
801 end;
802
803 function TFBUDRRoutineMetadata.getModuleName: AnsiString;
804 begin
805 Result := FModuleName;
806 end;
807
808 function TFBUDRRoutineMetadata.getRoutineName: AnsiString;
809 begin
810 Result := FRoutineName;
811 end;
812
813 function TFBUDRRoutineMetadata.getInfo: AnsiString;
814 begin
815 Result := FInfo;
816 end;
817
818 function TFBUDRRoutineMetadata.getEntryPoint: AnsiString;
819 begin
820 Result := strpas(FRoutineMetadata.getEntryPoint(FStatus));
821 CheckStatus;
822 end;
823
824 function TFBUDRRoutineMetadata.getBody: AnsiString;
825 begin
826 Result := strpas(FRoutineMetadata.getBody(FStatus));
827 CheckStatus;
828 end;
829
830 function TFBUDRRoutineMetadata.HasInputMetadata: boolean;
831 begin
832 Result := FInputMetadata <> nil;
833 end;
834
835 function TFBUDRRoutineMetadata.HasOutputMetadata: boolean;
836 begin
837 Result := FOutputMetadata <> nil;
838 end;
839
840 function TFBUDRRoutineMetadata.HasTriggerMetadata: boolean;
841 begin
842 Result := FTriggerMetadata <> nil;
843 end;
844
845 function TFBUDRRoutineMetadata.getFBInputMetadata: IFBUDRMessageMetadata;
846 begin
847 Result := nil;
848 if (FFBInputMetadata = nil) and (FInputMetadata <> nil) then
849 FFBInputMetadata := TFBUDRMessageMetadata.Create(FContext,FInputMetadata);
850 Result := FFBInputMetadata;
851 end;
852
853 function TFBUDRRoutineMetadata.getFBOutputMetadata: IFBUDRMessageMetadata;
854 begin
855 Result := nil;
856 if (FFBOutputMetadata = nil) and (FOutputMetadata <> nil) then
857 FFBOutputMetadata := TFBUDRMessageMetadata.Create(FContext,FOutputMetadata);
858 Result := FFBOutputMetadata;
859 end;
860
861 function TFBUDRRoutineMetadata.getFBTriggerMetadata: IFBUDRMessageMetadata;
862 begin
863 Result := nil;
864 if (FFBTriggerMetadata = nil) and (FTriggerMetadata <> nil) then
865 FFBTriggerMetadata := TFBUDRMessageMetadata.Create(FContext,FTriggerMetadata);
866 Result := FFBTriggerMetadata;
867 end;
868
869 function TFBUDRRoutineMetadata.getInputMetadata: firebird.IMessageMetadata;
870 begin
871 Result := FInputMetaData;
872 if Result <> nil then
873 Result.addRef;
874 end;
875
876 function TFBUDRRoutineMetadata.getOutputMetadata: firebird.IMessageMetadata;
877 begin
878 Result := FOutputMetadata;
879 if Result <> nil then
880 Result.addRef;
881 end;
882
883 function TFBUDRRoutineMetadata.getTriggerMetadata: firebird.IMessageMetadata;
884 begin
885 Result := FTriggerMetadata;
886 if Result <> nil then
887 Result.addRef;
888 end;
889
890 function TFBUDRRoutineMetadata.getTriggerTable: AnsiString;
891 begin
892 Result := strpas(FRoutineMetadata.getTriggerTable(FStatus));
893 CheckStatus;
894 end;
895
896 function TFBUDRRoutineMetadata.getTriggerType: TFBUDRTriggerType;
897 var TriggerType: cardinal;
898 begin
899 TriggerType := FRoutineMetadata.getTriggerType(FStatus);
900 CheckStatus;
901 with Firebird.IExternalTrigger do
902 case TriggerType of
903 TYPE_BEFORE:
904 Result := ttBefore;
905 TYPE_AFTER:
906 Result := ttAfter;
907 TYPE_DATABASE:
908 Result := ttDatabase;
909 else
910 FBUDRError(ibxeUnknownTriggerType,[TriggerType]);
911 end;
912 end;
913
914 { EFBUDRException }
915
916 constructor EFBUDRException.Create(aStatus: Firebird.IStatus);
917 begin
918 inherited Create(SFirebirdStatusError);
919 FStatus := aStatus.clone;
920 end;
921
922 destructor EFBUDRException.Destroy;
923 begin
924 FStatus.dispose;
925 inherited Destroy;
926 end;
927
928 end.
929

Properties

Name Value
svn:eol-style native