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

Properties

Name Value
svn:eol-style native