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

# User Rev Content
1 tony 371 (*
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 tony 374 constructor Create(aController: TFBUDRController; context: Firebird.IExternalContext);
89 tony 371 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 tony 373 end;
251    
252 tony 371 { 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 tony 374 constructor TFBUDRExternalContext.Create(aController: TFBUDRController;
553     context: Firebird.IExternalContext);
554 tony 371 begin
555 tony 374 inherited Create(aController);
556     FContext := context;
557     FirebirdAPI := TFB30ClientAPI.Create(context.getMaster);
558 tony 371 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 tony 373 Result := Controller.HasConfigFile;
635 tony 371 end;
636    
637     function TFBUDRExternalContext.ReadConfigString(Section, Ident,
638     DefaultValue: AnsiString): AnsiString;
639     begin
640 tony 373 Result := Controller.ReadConfigString(Section, Ident, DefaultValue);
641 tony 371 end;
642    
643     function TFBUDRExternalContext.ReadConfigInteger(Section, Ident: AnsiString;
644     DefaultValue: integer): integer;
645     begin
646 tony 373 Result := Controller.ReadConfigInteger(Section, Ident, DefaultValue);
647 tony 371 end;
648    
649     function TFBUDRExternalContext.ReadConfigBool(Section, Ident: AnsiString;
650     DefaultValue: boolean): boolean;
651     begin
652 tony 373 Result := Controller.ReadConfigBool(Section, Ident, DefaultValue);
653 tony 371 end;
654    
655     procedure TFBUDRExternalContext.WriteToLog(Msg: AnsiString);
656     begin
657 tony 373 Controller.WriteToLog(Msg);
658 tony 371 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