ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/source/FBUDRUtils.pas
Revision: 374
Committed: Sun Jan 9 23:39:28 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 26572 byte(s)
Log Message:
Fixes

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 Format('Alignment = %d' + NewLineTAB,[getAlignment]) +
285 Format('Aligned Length = %d' + NewLineTAB,[getAlignedLength]);
286 for i := 0 to getCount - 1 do
287 begin
288 Result := Result +
289 Format('Field No. %d' + NewLineTAB,[i]) +
290 Format('Field Name = %s' + NewLineTAB,[getField(i)]) +
291 Format('Relation Name = %s' + NewLineTAB,[getRelation(i)]) +
292 Format('Alias Name = %s' + NewLineTAB,[getAlias(i)]) +
293 Format('SQLType = %s' + NewLineTAB,[TSQLDataItem.GetSQLTypeName(getType(i))]) +
294 Format('IsNullable = %s' + NewLineTAB,[BoolToStr(isNullable(i){$ifdef FPC},'yes','no'{$endif})]) +
295 Format('SubType = %d' + NewLineTAB,[getSubType(i)]) +
296 Format('Length = %d' + NewLineTAB,[getLength(i)]) +
297 Format('Scale = %d' + NewLineTAB,[getScale(i)]) +
298 Format('Offset = %d' + NewLineTAB,[getOffset(i)]) +
299 Format('Null Offset = %d' + NewLineTAB,[getNullOffset(i)]) +
300 Format('Message Length = %d' + NewLineTAB,[getLength(i)]);
301 end;
302 end;
303
304 function TFBUDRMessageMetadata.getCount: Cardinal;
305 begin
306 Result := FMetadata.getCount(FStatus);
307 CheckStatus;
308 end;
309
310 function TFBUDRMessageMetadata.getField(index: Cardinal): AnsiString;
311 begin
312 Result := strpas(FMetadata.getField(FStatus,index));
313 CheckStatus;
314 end;
315
316 function TFBUDRMessageMetadata.getRelation(index: Cardinal): AnsiString;
317 begin
318 Result := strpas(FMetadata.getRelation(FStatus,index));
319 CheckStatus;
320 end;
321
322 function TFBUDRMessageMetadata.getOwner(index: Cardinal): AnsiString;
323 begin
324 Result := strpas(FMetadata.getOwner(FStatus,index));
325 CheckStatus;
326 end;
327
328 function TFBUDRMessageMetadata.getAlias(index: Cardinal): AnsiString;
329 begin
330 Result := strpas(FMetadata.getAlias(FStatus,index));
331 CheckStatus;
332 end;
333
334 function TFBUDRMessageMetadata.getType(index: Cardinal): Cardinal;
335 begin
336 Result := FMetadata.getType(FStatus,index);
337 CheckStatus;
338 end;
339
340 function TFBUDRMessageMetadata.isNullable(index: Cardinal): Boolean;
341 begin
342 Result := FMetadata.isNullable(FStatus,index);
343 CheckStatus;
344 end;
345
346 function TFBUDRMessageMetadata.getSubType(index: Cardinal): Integer;
347 begin
348 Result := FMetadata.getSubType(FStatus,index);
349 CheckStatus;
350 end;
351
352 function TFBUDRMessageMetadata.getLength(index: Cardinal): Cardinal;
353 begin
354 Result := FMetadata.getLength(FStatus,index);
355 CheckStatus;
356 end;
357
358 function TFBUDRMessageMetadata.getScale(index: Cardinal): Integer;
359 begin
360 Result := FMetadata.getScale(FStatus,index);
361 CheckStatus;
362 end;
363
364 function TFBUDRMessageMetadata.getCharSet(index: Cardinal): Cardinal;
365 begin
366 Result := FMetadata.getCharSet(FStatus,index);
367 CheckStatus;
368 end;
369
370 function TFBUDRMessageMetadata.getOffset(index: Cardinal): Cardinal;
371 begin
372 Result := FMetadata.getOffset(FStatus,index);
373 CheckStatus;
374 end;
375
376 function TFBUDRMessageMetadata.getNullOffset(index: Cardinal): Cardinal;
377 begin
378 Result := FMetadata.getNullOffset(FStatus,index);
379 CheckStatus;
380 end;
381
382 function TFBUDRMessageMetadata.getBuilder: IFBUDRMetadataBuilder;
383 var builder: Firebird.IMetadataBuilder;
384 begin
385 builder := FMetadata.getBuilder(FStatus);
386 try
387 CheckStatus;
388 Result := TFBUDRMetadataBuilder.Create(FContext,builder);
389 finally
390 builder.release;
391 end;
392 end;
393
394 function TFBUDRMessageMetadata.getMessageLength: Cardinal;
395 begin
396 Result := FMetadata.getMessageLength(FStatus);
397 CheckStatus;
398 end;
399
400 function TFBUDRMessageMetadata.getAlignment: Cardinal;
401 begin
402 Result := FMetadata.getAlignment(FStatus);
403 CheckStatus;
404 end;
405
406 function TFBUDRMessageMetadata.getAlignedLength: Cardinal;
407 begin
408 Result := FMetadata.getAlignedLength(FStatus);
409 CheckStatus;
410 end;
411
412 { TFBUDRMetadataBuilder }
413
414 constructor TFBUDRMetadataBuilder.Create(context: IFBUDRExternalContext;
415 metadataBuilder: Firebird.IMetadataBuilder);
416 begin
417 inherited Create((context as TFBUDRExternalContext).Controller);
418 FirebirdAPI := context.GetFirebirdAPI;
419 FMetadataBuilder := metadataBuilder;
420 FMetadataBuilder.addRef;
421 end;
422
423 destructor TFBUDRMetadataBuilder.Destroy;
424 begin
425 if FMetadataBuilder <> nil then
426 FMetadataBuilder.release;
427 inherited Destroy;
428 end;
429
430 procedure TFBUDRMetadataBuilder.setType(index: Cardinal; type_: Cardinal);
431 begin
432 FMetadataBuilder.setType(FStatus,index,type_);
433 CheckStatus;
434 end;
435
436 procedure TFBUDRMetadataBuilder.setSubType(index: Cardinal; subType: Integer);
437 begin
438 FMetadataBuilder.setSubType(FStatus,index,subType);
439 CheckStatus;
440 end;
441
442 procedure TFBUDRMetadataBuilder.setLength(index: Cardinal; length: Cardinal);
443 begin
444 FMetadataBuilder.setLength(FStatus,index,Length);
445 CheckStatus;
446 end;
447
448 procedure TFBUDRMetadataBuilder.setCharSet(index: Cardinal; charSet: Cardinal);
449 begin
450 FMetadataBuilder.setCharSet(FStatus,index,charSet);
451 CheckStatus;
452 end;
453
454 procedure TFBUDRMetadataBuilder.setScale(index: Cardinal; scale: Integer);
455 begin
456 FMetadataBuilder.SetScale(FStatus,index,scale);
457 CheckStatus;
458 end;
459
460 procedure TFBUDRMetadataBuilder.truncate(count: Cardinal);
461 begin
462 FMetadataBuilder.truncate(FStatus,count);
463 CheckStatus;
464 end;
465
466 procedure TFBUDRMetadataBuilder.moveNameToIndex(name: AnsiString; index: Cardinal);
467 begin
468 FMetadataBuilder.moveNameToIndex(FStatus,PAnsiChar(name),index);
469 CheckStatus;
470 end;
471
472 procedure TFBUDRMetadataBuilder.remove(index: Cardinal);
473 begin
474 FMetadataBuilder.remove(FStatus,index);
475 CheckStatus;
476 end;
477
478 function TFBUDRMetadataBuilder.addField: Cardinal;
479 begin
480 Result := FMetadataBuilder.addField(FStatus);
481 CheckStatus;
482 end;
483
484 procedure TFBUDRMetadataBuilder.setField(index: Cardinal; field: AnsiString);
485 begin
486 FMetadataBuilder.setField(FStatus,index,PAnsiChar(field));
487 CheckStatus;
488 end;
489
490 procedure TFBUDRMetadataBuilder.setRelation(index: Cardinal; relation: AnsiString);
491 begin
492 FMetadataBuilder.setRelation(FStatus,index,PAnsiChar(relation));
493 CheckStatus;
494 end;
495
496 procedure TFBUDRMetadataBuilder.setOwner(index: Cardinal; owner: AnsiString);
497 begin
498 FMetadataBuilder.setOwner(FStatus,index,PAnsiChar(owner));
499 CheckStatus;
500 end;
501
502 procedure TFBUDRMetadataBuilder.setAlias(index: Cardinal; alias: AnsiString);
503 begin
504 FMetadataBuilder.setAlias(FStatus,index,PAnsiChar(alias));
505 end;
506
507 { TFBUDRObject }
508
509 procedure TFBUDRObject.SetFirebirdAPI(AValue: IFirebirdAPI);
510 var MasterProvider: IFBIMasterProvider;
511 begin
512 if FFirebirdAPI = AValue then Exit;
513 FFirebirdAPI := AValue;
514 if (FStatus = nil) and
515 FirebirdAPI.HasMasterIntf and (FirebirdAPI.QueryInterface(IFBIMasterProvider,MasterProvider) = S_OK) then
516 FStatus := MasterProvider.GetIMasterIntf.getStatus;
517 end;
518
519 procedure TFBUDRObject.CheckStatus;
520 begin
521 with FStatus do
522 if (getState and STATE_ERRORS) <> 0 then
523 raise EFBUDRException.Create(FStatus);
524 end;
525
526 function TFBUDRObject.getStatus: Firebird.IStatus;
527 begin
528 Result := FStatus;
529 end;
530
531 constructor TFBUDRObject.Create(aController: TFBUDRController);
532 begin
533 inherited Create;
534 FController := aController;
535 end;
536
537 destructor TFBUDRObject.Destroy;
538 begin
539 if FStatus <> nil then
540 FStatus.dispose;
541 inherited Destroy;
542 end;
543
544 procedure TFBUDRObject.Clear;
545 begin
546 if FStatus <> nil then
547 FStatus.Init;
548 end;
549
550 { TFBUDRExternalContext }
551
552 constructor TFBUDRExternalContext.Create(aController: TFBUDRController;
553 context: Firebird.IExternalContext);
554 begin
555 inherited Create(aController);
556 FContext := context;
557 FirebirdAPI := TFB30ClientAPI.Create(context.getMaster);
558 end;
559
560 function TFBUDRExternalContext.AsText: AnsiString;
561 begin
562 Result := 'External Context: ' + NewLineTAB +
563 Format('Attachment ID = %d' + NewLineTAB,[GetAttachment.GetAttachmentID]) +
564 Format('Transaction ID = %d' + NewLineTAB,[GetTransaction.GetTransactionID]) +
565 Format('User Name = %s' + NewLineTAB,[GetUserName]) +
566 Format('Database Name = %s' + NewLineTAB,[GetDatabaseName]) +
567 Format('Client Character Set = %s' + NewLineTAB,[GetClientCharSet]);
568 end;
569
570 function TFBUDRExternalContext.GetFirebirdAPI: IFirebirdAPI;
571 begin
572 Result := FirebirdAPI;
573 end;
574
575 function TFBUDRExternalContext.GetAttachment: IAttachment;
576 var att: Firebird.IAttachment;
577 begin
578 if FAttachment = nil then
579 begin
580 att := FContext.getAttachment(FStatus);
581 CheckStatus;
582 FAttachment := TFB30Attachment.Create(FirebirdAPI as TFB30ClientAPI,
583 att,
584 GetDatabaseName);
585 end;
586 Result := FAttachment;
587 end;
588
589 function TFBUDRExternalContext.GetTransaction: ITransaction;
590 var tr: Firebird.ITransaction;
591 begin
592 Result := nil;
593 if FTransaction = nil then
594 begin
595 tr := FContext.getTransaction(FStatus);
596 CheckStatus;
597 FTransaction := TFB30Transaction.Create(FirebirdAPI as TFB30ClientAPI,GetAttachment,tr);
598 end;
599 Result := FTransaction;
600 end;
601
602 function TFBUDRExternalContext.GetUserName: AnsiString;
603 begin
604 Result := strpas(FContext.getUserName);
605 end;
606
607 function TFBUDRExternalContext.GetDatabaseName: AnsiString;
608 begin
609 Result := strpas(FContext.getDatabaseName);
610 end;
611
612 function TFBUDRExternalContext.GetClientCharSet: AnsiString;
613 begin
614 Result := strpas(FContext.getClientCharSet);
615 end;
616
617 function TFBUDRExternalContext.obtainInfoCode: Integer;
618 begin
619 Result := FContext.obtainInfoCode;
620 end;
621
622 function TFBUDRExternalContext.getInfo(code: Integer): Pointer;
623 begin
624 Result := FContext.getInfo(code);
625 end;
626
627 function TFBUDRExternalContext.setInfo(code: Integer; value: Pointer): Pointer;
628 begin
629 Result := FContext.setInfo(code,value);
630 end;
631
632 function TFBUDRExternalContext.HasConfigFile: boolean;
633 begin
634 Result := Controller.HasConfigFile;
635 end;
636
637 function TFBUDRExternalContext.ReadConfigString(Section, Ident,
638 DefaultValue: AnsiString): AnsiString;
639 begin
640 Result := Controller.ReadConfigString(Section, Ident, DefaultValue);
641 end;
642
643 function TFBUDRExternalContext.ReadConfigInteger(Section, Ident: AnsiString;
644 DefaultValue: integer): integer;
645 begin
646 Result := Controller.ReadConfigInteger(Section, Ident, DefaultValue);
647 end;
648
649 function TFBUDRExternalContext.ReadConfigBool(Section, Ident: AnsiString;
650 DefaultValue: boolean): boolean;
651 begin
652 Result := Controller.ReadConfigBool(Section, Ident, DefaultValue);
653 end;
654
655 procedure TFBUDRExternalContext.WriteToLog(Msg: AnsiString);
656 begin
657 Controller.WriteToLog(Msg);
658 end;
659
660
661 { TFBUDRRoutineMetadata }
662
663 class procedure TFBUDRRoutineMetadata.ParseEntryPoint(aEntryPoint: AnsiString;
664 var aModuleName, aRoutineName, aInfo: AnsiString);
665 var p1,p2: integer;
666 begin
667 aModuleName := '';
668 aRoutineName := '';
669 aInfo := '';
670 p1 := 1;
671 P2 := 1;
672 while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
673 Inc(p2);
674 if p2 = length(aEntryPoint) then
675 begin
676 aModuleName := aEntryPoint;
677 Exit;
678 end;
679 aModuleName := system.copy(aEntryPoint,1,p2-1);
680 Inc(p2);
681 p1 := p2;
682 while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
683 Inc(p2);
684 if p2 = length(aEntryPoint) then
685 begin
686 aRoutineName := system.copy(aEntryPoint,p1,maxint);
687 Exit;
688 end;
689 aRoutineName := system.copy(aEntryPoint,p1,p2-p1);
690 aInfo := system.copy(aEntryPoint,p2+1,maxint);
691 end;
692
693 constructor TFBUDRRoutineMetadata.Create(context: IFBUDRExternalContext;
694 routineMetadata: firebird.IRoutineMetadata);
695 var TriggerType: cardinal;
696 begin
697 inherited Create((context as TFBUDRExternalContext).Controller);
698 FirebirdAPI := context.GetFirebirdAPI;
699 FContext := context;
700 FRoutineMetadata := routineMetadata;
701
702 TriggerType := FRoutineMetadata.getTriggerType(FStatus);
703 CheckStatus;
704
705 if TriggerType = 0 then
706 begin
707 FInputMetadata := FRoutineMetadata.getInputMetadata(FStatus);
708 CheckStatus;
709 if FInputMetadata <> nil then
710 FInputMetadata.addRef;
711
712 FOutputMetadata := FRoutineMetadata.getOutputMetadata(FStatus);
713 CheckStatus;
714 if FOutputMetadata <> nil then
715 FOutputMetadata.addRef;
716 end
717 else
718 begin
719 FTriggerMetadata := FRoutineMetadata.getTriggerMetadata(FStatus);
720 CheckStatus;
721 if FTriggerMetadata <> nil then
722 FTriggerMetadata.addRef;
723 end;
724 ParseEntryPoint(getEntryPoint,FModuleName,FRoutineName,FInfo);
725 end;
726
727 destructor TFBUDRRoutineMetadata.Destroy;
728 begin
729 if FInputMetadata <> nil then
730 FInputMetadata.release;
731 if FOutputMetadata <> nil then
732 FOutputMetadata.release;
733 if FTriggerMetadata <> nil then
734 FTriggerMetadata.release;
735 inherited Destroy;
736 end;
737
738 function TFBUDRRoutineMetadata.AsText: AnsiString;
739
740 function MetadataToText(metadata: Firebird.IMessageMetadata): AnsiString;
741 var fbMetadata: TFBUDRMessageMetadata;
742 begin
743 if metadata = nil then
744 Result := '(nil)'
745 else
746 begin
747 fbMetadata := TFBUDRMessageMetadata.Create(FContext,metadata);
748 try
749 Result := fbMetadata.AsText;
750 finally
751 fbMetadata.Free;
752 end;
753 end;
754 end;
755
756 function TriggerTypeToText(TriggerType: TFBUDRTriggerType): AnsiString;
757 begin
758 case TriggerType of
759 ttAfter:
760 Result := 'After';
761 ttBefore:
762 Result := 'Before';
763 ttDatabase:
764 Result := 'Database';
765 end;
766 end;
767
768 begin
769 Result := Format('Package Name = %s' + NewLineTAB,[getPackage]) +
770 Format('Name = %s' + NewLineTAB,[getName]) +
771 Format('Entry Point = %s (%s,%s,%s)' + NewLineTAB,[getEntryPoint,getModuleName,getRoutineName,getInfo]) +
772 Format('Body = %s' + NewLineTAB,[getBody]) +
773 Format('Input Metadata:' + NewLineTAB + '%s',[MetadataToText(FInputMetaData)]) + LineEnding +
774 Format('Output Metadata:' + NewLineTAB + '%s',[MetadataToText(FOutputMetaData)]);
775 if FRoutineMetadata.getTriggerType(FStatus) > 0 then
776 begin
777 Result := Result +
778 Format('Trigger Metadata:' + NewLineTAB + '%s',[MetadataToText(FTriggerMetaData)]) +
779 Format('Trigger Table = %s' + NewLineTAB,[getTriggerTable]) +
780 Format('Trigger Type = %s' + NewLineTAB,[TriggerTypeToText(getTriggerType)]);
781 end;
782 CheckStatus;
783 end;
784
785 function TFBUDRRoutineMetadata.getPackage: AnsiString;
786 begin
787 Result := strpas(FRoutineMetadata.getPackage(FStatus));
788 CheckStatus;
789 end;
790
791 function TFBUDRRoutineMetadata.getName: AnsiString;
792 begin
793 Result := strpas(FRoutineMetadata.getName(FStatus));
794 CheckStatus;
795 end;
796
797 function TFBUDRRoutineMetadata.getModuleName: AnsiString;
798 begin
799 Result := FModuleName;
800 end;
801
802 function TFBUDRRoutineMetadata.getRoutineName: AnsiString;
803 begin
804 Result := FRoutineName;
805 end;
806
807 function TFBUDRRoutineMetadata.getInfo: AnsiString;
808 begin
809 Result := FInfo;
810 end;
811
812 function TFBUDRRoutineMetadata.getEntryPoint: AnsiString;
813 begin
814 Result := strpas(FRoutineMetadata.getEntryPoint(FStatus));
815 CheckStatus;
816 end;
817
818 function TFBUDRRoutineMetadata.getBody: AnsiString;
819 begin
820 Result := strpas(FRoutineMetadata.getBody(FStatus));
821 CheckStatus;
822 end;
823
824 function TFBUDRRoutineMetadata.HasInputMetadata: boolean;
825 begin
826 Result := FInputMetadata <> nil;
827 end;
828
829 function TFBUDRRoutineMetadata.HasOutputMetadata: boolean;
830 begin
831 Result := FOutputMetadata <> nil;
832 end;
833
834 function TFBUDRRoutineMetadata.HasTriggerMetadata: boolean;
835 begin
836 Result := FTriggerMetadata <> nil;
837 end;
838
839 function TFBUDRRoutineMetadata.getFBInputMetadata: IFBUDRMessageMetadata;
840 begin
841 Result := nil;
842 if (FFBInputMetadata = nil) and (FInputMetadata <> nil) then
843 FFBInputMetadata := TFBUDRMessageMetadata.Create(FContext,FInputMetadata);
844 Result := FFBInputMetadata;
845 end;
846
847 function TFBUDRRoutineMetadata.getFBOutputMetadata: IFBUDRMessageMetadata;
848 begin
849 Result := nil;
850 if (FFBOutputMetadata = nil) and (FOutputMetadata <> nil) then
851 FFBOutputMetadata := TFBUDRMessageMetadata.Create(FContext,FOutputMetadata);
852 Result := FFBOutputMetadata;
853 end;
854
855 function TFBUDRRoutineMetadata.getFBTriggerMetadata: IFBUDRMessageMetadata;
856 begin
857 Result := nil;
858 if (FFBTriggerMetadata = nil) and (FTriggerMetadata <> nil) then
859 FFBTriggerMetadata := TFBUDRMessageMetadata.Create(FContext,FTriggerMetadata);
860 Result := FFBTriggerMetadata;
861 end;
862
863 function TFBUDRRoutineMetadata.getInputMetadata: firebird.IMessageMetadata;
864 begin
865 Result := FInputMetaData;
866 if Result <> nil then
867 Result.addRef;
868 end;
869
870 function TFBUDRRoutineMetadata.getOutputMetadata: firebird.IMessageMetadata;
871 begin
872 Result := FOutputMetadata;
873 if Result <> nil then
874 Result.addRef;
875 end;
876
877 function TFBUDRRoutineMetadata.getTriggerMetadata: firebird.IMessageMetadata;
878 begin
879 Result := FTriggerMetadata;
880 if Result <> nil then
881 Result.addRef;
882 end;
883
884 function TFBUDRRoutineMetadata.getTriggerTable: AnsiString;
885 begin
886 Result := strpas(FRoutineMetadata.getTriggerTable(FStatus));
887 CheckStatus;
888 end;
889
890 function TFBUDRRoutineMetadata.getTriggerType: TFBUDRTriggerType;
891 var TriggerType: cardinal;
892 begin
893 TriggerType := FRoutineMetadata.getTriggerType(FStatus);
894 CheckStatus;
895 with Firebird.IExternalTrigger do
896 case TriggerType of
897 TYPE_BEFORE:
898 Result := ttBefore;
899 TYPE_AFTER:
900 Result := ttAfter;
901 TYPE_DATABASE:
902 Result := ttDatabase;
903 else
904 FBUDRError(ibxeUnknownTriggerType,[TriggerType]);
905 end;
906 end;
907
908 { EFBUDRException }
909
910 constructor EFBUDRException.Create(aStatus: Firebird.IStatus);
911 begin
912 inherited Create(SFirebirdStatusError);
913 FStatus := aStatus.clone;
914 end;
915
916 destructor EFBUDRException.Destroy;
917 begin
918 FStatus.dispose;
919 inherited Destroy;
920 end;
921
922 end.
923