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