ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/source/FBUDRUtils.pas
Revision: 373
Committed: Thu Jan 6 14:14:57 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 27411 byte(s)
Log Message:
Fixes Merged

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     procedure Assign(src: 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 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     procedure TFBUDRExternalContext.Assign(src: Firebird.IExternalContext);
553    
554     function SameTransaction: boolean;
555     var tr1, tr2: Firebird.ITransaction;
556     begin
557     Result := false;
558     if FContext = nil then Exit;
559     tr1 := src.getTransaction(FStatus);
560     CheckStatus;
561     tr2 := FContext.getTransaction(FStatus);
562     CheckStatus;
563     Result := tr1 = tr2;
564     end;
565    
566     function SameAttachment: boolean;
567     var at1, at2: Firebird.IAttachment;
568     begin
569     Result := false;
570     if FContext = nil then Exit;
571     at1 := src.getAttachment(FStatus);
572     CheckStatus;
573     at2 := FContext.getAttachment(FStatus);
574     CheckStatus;
575     Result := at1 = at2;
576     end;
577    
578     begin
579     if src = FContext then Exit;
580    
581     if src = nil then
582     begin
583     FirebirdAPI := nil;
584     FTransaction := nil;
585     FAttachment := nil;
586     FContext := nil;
587     end
588     else
589     begin
590     if (FContext = nil) or (src.getMaster() <> FContext.getMaster) then
591     FirebirdAPI := TFB30ClientAPI.Create(src.getMaster);
592    
593     if not SameTransaction then
594     FTransaction := nil;
595    
596     if not SameAttachment then
597     FAttachment := nil;
598    
599     FContext := src;
600     end;
601     end;
602    
603     function TFBUDRExternalContext.AsText: AnsiString;
604     begin
605     Result := 'External Context: ' + NewLineTAB +
606     Format('Attachment ID = %d' + NewLineTAB,[GetAttachment.GetAttachmentID]) +
607     Format('Transaction ID = %d' + NewLineTAB,[GetTransaction.GetTransactionID]) +
608     Format('User Name = %s' + NewLineTAB,[GetUserName]) +
609     Format('Database Name = %s' + NewLineTAB,[GetDatabaseName]) +
610     Format('Client Character Set = %s' + NewLineTAB,[GetClientCharSet]);
611     end;
612    
613     function TFBUDRExternalContext.GetFirebirdAPI: IFirebirdAPI;
614     begin
615     Result := FirebirdAPI;
616     end;
617    
618     function TFBUDRExternalContext.GetAttachment: IAttachment;
619     var att: Firebird.IAttachment;
620     begin
621     if FAttachment = nil then
622     begin
623     att := FContext.getAttachment(FStatus);
624     CheckStatus;
625     FAttachment := TFB30Attachment.Create(FirebirdAPI as TFB30ClientAPI,
626     att,
627     GetDatabaseName);
628     end;
629     Result := FAttachment;
630     end;
631    
632     function TFBUDRExternalContext.GetTransaction: ITransaction;
633     var tr: Firebird.ITransaction;
634     begin
635     Result := nil;
636     if FTransaction = nil then
637     begin
638     tr := FContext.getTransaction(FStatus);
639     CheckStatus;
640     FTransaction := TFB30Transaction.Create(FirebirdAPI as TFB30ClientAPI,GetAttachment,tr);
641     end;
642     Result := FTransaction;
643     end;
644    
645     function TFBUDRExternalContext.GetUserName: AnsiString;
646     begin
647     Result := strpas(FContext.getUserName);
648     end;
649    
650     function TFBUDRExternalContext.GetDatabaseName: AnsiString;
651     begin
652     Result := strpas(FContext.getDatabaseName);
653     end;
654    
655     function TFBUDRExternalContext.GetClientCharSet: AnsiString;
656     begin
657     Result := strpas(FContext.getClientCharSet);
658     end;
659    
660     function TFBUDRExternalContext.obtainInfoCode: Integer;
661     begin
662     Result := FContext.obtainInfoCode;
663     end;
664    
665     function TFBUDRExternalContext.getInfo(code: Integer): Pointer;
666     begin
667     Result := FContext.getInfo(code);
668     end;
669    
670     function TFBUDRExternalContext.setInfo(code: Integer; value: Pointer): Pointer;
671     begin
672     Result := FContext.setInfo(code,value);
673     end;
674    
675     function TFBUDRExternalContext.HasConfigFile: boolean;
676     begin
677 tony 373 Result := Controller.HasConfigFile;
678 tony 371 end;
679    
680     function TFBUDRExternalContext.ReadConfigString(Section, Ident,
681     DefaultValue: AnsiString): AnsiString;
682     begin
683 tony 373 Result := Controller.ReadConfigString(Section, Ident, DefaultValue);
684 tony 371 end;
685    
686     function TFBUDRExternalContext.ReadConfigInteger(Section, Ident: AnsiString;
687     DefaultValue: integer): integer;
688     begin
689 tony 373 Result := Controller.ReadConfigInteger(Section, Ident, DefaultValue);
690 tony 371 end;
691    
692     function TFBUDRExternalContext.ReadConfigBool(Section, Ident: AnsiString;
693     DefaultValue: boolean): boolean;
694     begin
695 tony 373 Result := Controller.ReadConfigBool(Section, Ident, DefaultValue);
696 tony 371 end;
697    
698     procedure TFBUDRExternalContext.WriteToLog(Msg: AnsiString);
699     begin
700 tony 373 Controller.WriteToLog(Msg);
701 tony 371 end;
702    
703    
704     { TFBUDRRoutineMetadata }
705    
706     class procedure TFBUDRRoutineMetadata.ParseEntryPoint(aEntryPoint: AnsiString;
707     var aModuleName, aRoutineName, aInfo: AnsiString);
708     var p1,p2: integer;
709     begin
710     aModuleName := '';
711     aRoutineName := '';
712     aInfo := '';
713     p1 := 1;
714     P2 := 1;
715     while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
716     Inc(p2);
717     if p2 = length(aEntryPoint) then
718     begin
719     aModuleName := aEntryPoint;
720     Exit;
721     end;
722     aModuleName := system.copy(aEntryPoint,1,p2-1);
723     Inc(p2);
724     p1 := p2;
725     while (p2 < length(aEntryPoint)) and (aEntryPoint[p2] <> '!') do
726     Inc(p2);
727     if p2 = length(aEntryPoint) then
728     begin
729     aRoutineName := system.copy(aEntryPoint,p1,maxint);
730     Exit;
731     end;
732     aRoutineName := system.copy(aEntryPoint,p1,p2-p1);
733     aInfo := system.copy(aEntryPoint,p2+1,maxint);
734     end;
735    
736     constructor TFBUDRRoutineMetadata.Create(context: IFBUDRExternalContext;
737     routineMetadata: firebird.IRoutineMetadata);
738     var TriggerType: cardinal;
739     begin
740     inherited Create((context as TFBUDRExternalContext).Controller);
741     FirebirdAPI := context.GetFirebirdAPI;
742     FContext := context;
743     FRoutineMetadata := routineMetadata;
744    
745     TriggerType := FRoutineMetadata.getTriggerType(FStatus);
746     CheckStatus;
747    
748     if TriggerType = 0 then
749     begin
750     FInputMetadata := FRoutineMetadata.getInputMetadata(FStatus);
751     CheckStatus;
752     if FInputMetadata <> nil then
753     FInputMetadata.addRef;
754    
755     FOutputMetadata := FRoutineMetadata.getOutputMetadata(FStatus);
756     CheckStatus;
757     if FOutputMetadata <> nil then
758     FOutputMetadata.addRef;
759     end
760     else
761     begin
762     FTriggerMetadata := FRoutineMetadata.getTriggerMetadata(FStatus);
763     CheckStatus;
764     if FTriggerMetadata <> nil then
765     FTriggerMetadata.addRef;
766     end;
767     ParseEntryPoint(getEntryPoint,FModuleName,FRoutineName,FInfo);
768     end;
769    
770     destructor TFBUDRRoutineMetadata.Destroy;
771     begin
772     if FInputMetadata <> nil then
773     FInputMetadata.release;
774     if FOutputMetadata <> nil then
775     FOutputMetadata.release;
776     if FTriggerMetadata <> nil then
777     FTriggerMetadata.release;
778     inherited Destroy;
779     end;
780    
781     function TFBUDRRoutineMetadata.AsText: AnsiString;
782    
783     function MetadataToText(metadata: Firebird.IMessageMetadata): AnsiString;
784     var fbMetadata: TFBUDRMessageMetadata;
785     begin
786     if metadata = nil then
787     Result := '(nil)'
788     else
789     begin
790     fbMetadata := TFBUDRMessageMetadata.Create(FContext,metadata);
791     try
792     Result := fbMetadata.AsText;
793     finally
794     fbMetadata.Free;
795     end;
796     end;
797     end;
798    
799     function TriggerTypeToText(TriggerType: TFBUDRTriggerType): AnsiString;
800     begin
801     case TriggerType of
802     ttAfter:
803     Result := 'After';
804     ttBefore:
805     Result := 'Before';
806     ttDatabase:
807     Result := 'Database';
808     end;
809     end;
810    
811     begin
812     Result := Format('Package Name = %s' + NewLineTAB,[getPackage]) +
813     Format('Name = %s' + NewLineTAB,[getName]) +
814     Format('Entry Point = %s (%s,%s,%s)' + NewLineTAB,[getEntryPoint,getModuleName,getRoutineName,getInfo]) +
815     Format('Body = %s' + NewLineTAB,[getBody]) +
816     Format('Input Metadata:' + NewLineTAB + '%s',[MetadataToText(FInputMetaData)]) + LineEnding +
817     Format('Output Metadata:' + NewLineTAB + '%s',[MetadataToText(FOutputMetaData)]);
818     if FRoutineMetadata.getTriggerType(FStatus) > 0 then
819     begin
820     Result := Result +
821     Format('Trigger Metadata:' + NewLineTAB + '%s',[MetadataToText(FTriggerMetaData)]) +
822     Format('Trigger Table = %s' + NewLineTAB,[getTriggerTable]) +
823     Format('Trigger Type = %s' + NewLineTAB,[TriggerTypeToText(getTriggerType)]);
824     end;
825     CheckStatus;
826     end;
827    
828     function TFBUDRRoutineMetadata.getPackage: AnsiString;
829     begin
830     Result := strpas(FRoutineMetadata.getPackage(FStatus));
831     CheckStatus;
832     end;
833    
834     function TFBUDRRoutineMetadata.getName: AnsiString;
835     begin
836     Result := strpas(FRoutineMetadata.getName(FStatus));
837     CheckStatus;
838     end;
839    
840     function TFBUDRRoutineMetadata.getModuleName: AnsiString;
841     begin
842     Result := FModuleName;
843     end;
844    
845     function TFBUDRRoutineMetadata.getRoutineName: AnsiString;
846     begin
847     Result := FRoutineName;
848     end;
849    
850     function TFBUDRRoutineMetadata.getInfo: AnsiString;
851     begin
852     Result := FInfo;
853     end;
854    
855     function TFBUDRRoutineMetadata.getEntryPoint: AnsiString;
856     begin
857     Result := strpas(FRoutineMetadata.getEntryPoint(FStatus));
858     CheckStatus;
859     end;
860    
861     function TFBUDRRoutineMetadata.getBody: AnsiString;
862     begin
863     Result := strpas(FRoutineMetadata.getBody(FStatus));
864     CheckStatus;
865     end;
866    
867     function TFBUDRRoutineMetadata.HasInputMetadata: boolean;
868     begin
869     Result := FInputMetadata <> nil;
870     end;
871    
872     function TFBUDRRoutineMetadata.HasOutputMetadata: boolean;
873     begin
874     Result := FOutputMetadata <> nil;
875     end;
876    
877     function TFBUDRRoutineMetadata.HasTriggerMetadata: boolean;
878     begin
879     Result := FTriggerMetadata <> nil;
880     end;
881    
882     function TFBUDRRoutineMetadata.getFBInputMetadata: IFBUDRMessageMetadata;
883     begin
884     Result := nil;
885     if (FFBInputMetadata = nil) and (FInputMetadata <> nil) then
886     FFBInputMetadata := TFBUDRMessageMetadata.Create(FContext,FInputMetadata);
887     Result := FFBInputMetadata;
888     end;
889    
890     function TFBUDRRoutineMetadata.getFBOutputMetadata: IFBUDRMessageMetadata;
891     begin
892     Result := nil;
893     if (FFBOutputMetadata = nil) and (FOutputMetadata <> nil) then
894     FFBOutputMetadata := TFBUDRMessageMetadata.Create(FContext,FOutputMetadata);
895     Result := FFBOutputMetadata;
896     end;
897    
898     function TFBUDRRoutineMetadata.getFBTriggerMetadata: IFBUDRMessageMetadata;
899     begin
900     Result := nil;
901     if (FFBTriggerMetadata = nil) and (FTriggerMetadata <> nil) then
902     FFBTriggerMetadata := TFBUDRMessageMetadata.Create(FContext,FTriggerMetadata);
903     Result := FFBTriggerMetadata;
904     end;
905    
906     function TFBUDRRoutineMetadata.getInputMetadata: firebird.IMessageMetadata;
907     begin
908     Result := FInputMetaData;
909     if Result <> nil then
910     Result.addRef;
911     end;
912    
913     function TFBUDRRoutineMetadata.getOutputMetadata: firebird.IMessageMetadata;
914     begin
915     Result := FOutputMetadata;
916     if Result <> nil then
917     Result.addRef;
918     end;
919    
920     function TFBUDRRoutineMetadata.getTriggerMetadata: firebird.IMessageMetadata;
921     begin
922     Result := FTriggerMetadata;
923     if Result <> nil then
924     Result.addRef;
925     end;
926    
927     function TFBUDRRoutineMetadata.getTriggerTable: AnsiString;
928     begin
929     Result := strpas(FRoutineMetadata.getTriggerTable(FStatus));
930     CheckStatus;
931     end;
932    
933     function TFBUDRRoutineMetadata.getTriggerType: TFBUDRTriggerType;
934     var TriggerType: cardinal;
935     begin
936     TriggerType := FRoutineMetadata.getTriggerType(FStatus);
937     CheckStatus;
938     with Firebird.IExternalTrigger do
939     case TriggerType of
940     TYPE_BEFORE:
941     Result := ttBefore;
942     TYPE_AFTER:
943     Result := ttAfter;
944     TYPE_DATABASE:
945     Result := ttDatabase;
946     else
947     FBUDRError(ibxeUnknownTriggerType,[TriggerType]);
948     end;
949     end;
950    
951     { EFBUDRException }
952    
953     constructor EFBUDRException.Create(aStatus: Firebird.IStatus);
954     begin
955     inherited Create(SFirebirdStatusError);
956     FStatus := aStatus.clone;
957     end;
958    
959     destructor EFBUDRException.Destroy;
960     begin
961     FStatus.dispose;
962     inherited Destroy;
963     end;
964    
965     end.
966