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 |
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 |
end;
|
251 |
|
252 |
{ TFBUDRMessageMetadata }
|
253 |
|
254 |
constructor TFBUDRMessageMetadata.Create(context: IFBUDRExternalContext;
|
255 |
metadata: Firebird.IMessageMetadata);
|
256 |
begin
|
257 |
inherited Create((context as TFBUDRExternalContext).Controller);
|
258 |
FirebirdAPI := context.GetFirebirdAPI;
|
259 |
FContext := context;
|
260 |
FMetadata := metadata;
|
261 |
FMetadata.addRef;
|
262 |
end;
|
263 |
|
264 |
destructor TFBUDRMessageMetadata.Destroy;
|
265 |
begin
|
266 |
if FMetadata <> nil then
|
267 |
FMetadata.release;
|
268 |
inherited Destroy;
|
269 |
end;
|
270 |
|
271 |
function TFBUDRMessageMetadata.AsText: AnsiString;
|
272 |
|
273 |
function CharsetIDToText(id: integer): AnsiString;
|
274 |
begin
|
275 |
if FContext.GetAttachment <> nil then
|
276 |
Result := FContext.GetAttachment.GetCharsetName(id)
|
277 |
else
|
278 |
Result := IntToStr(id);
|
279 |
end;
|
280 |
|
281 |
var i: integer;
|
282 |
begin
|
283 |
Result := Format('Field Count = %d' + NewLineTAB,[getCount]) +
|
284 |
Format('Alignment = %d' + NewLineTAB,[getAlignment]) +
|
285 |
Format('Aligned Length = %d' + NewLineTAB,[getAlignedLength]);
|
286 |
for i := 0 to getCount - 1 do
|
287 |
begin
|
288 |
Result := Result +
|
289 |
Format('Field No. %d' + NewLineTAB,[i]) +
|
290 |
Format('Field Name = %s' + NewLineTAB,[getField(i)]) +
|
291 |
Format('Relation Name = %s' + NewLineTAB,[getRelation(i)]) +
|
292 |
Format('Alias Name = %s' + NewLineTAB,[getAlias(i)]) +
|
293 |
Format('SQLType = %s' + NewLineTAB,[TSQLDataItem.GetSQLTypeName(getType(i))]) +
|
294 |
Format('IsNullable = %s' + NewLineTAB,[BoolToStr(isNullable(i){$ifdef FPC},'yes','no'{$endif})]) +
|
295 |
Format('SubType = %d' + NewLineTAB,[getSubType(i)]) +
|
296 |
Format('Length = %d' + NewLineTAB,[getLength(i)]) +
|
297 |
Format('Scale = %d' + NewLineTAB,[getScale(i)]) +
|
298 |
Format('Offset = %d' + NewLineTAB,[getOffset(i)]) +
|
299 |
Format('Null Offset = %d' + NewLineTAB,[getNullOffset(i)]) +
|
300 |
Format('Message Length = %d' + NewLineTAB,[getLength(i)]);
|
301 |
end;
|
302 |
end;
|
303 |
|
304 |
function TFBUDRMessageMetadata.getCount: Cardinal;
|
305 |
begin
|
306 |
Result := FMetadata.getCount(FStatus);
|
307 |
CheckStatus;
|
308 |
end;
|
309 |
|
310 |
function TFBUDRMessageMetadata.getField(index: Cardinal): AnsiString;
|
311 |
begin
|
312 |
Result := strpas(FMetadata.getField(FStatus,index));
|
313 |
CheckStatus;
|
314 |
end;
|
315 |
|
316 |
function TFBUDRMessageMetadata.getRelation(index: Cardinal): AnsiString;
|
317 |
begin
|
318 |
Result := strpas(FMetadata.getRelation(FStatus,index));
|
319 |
CheckStatus;
|
320 |
end;
|
321 |
|
322 |
function TFBUDRMessageMetadata.getOwner(index: Cardinal): AnsiString;
|
323 |
begin
|
324 |
Result := strpas(FMetadata.getOwner(FStatus,index));
|
325 |
CheckStatus;
|
326 |
end;
|
327 |
|
328 |
function TFBUDRMessageMetadata.getAlias(index: Cardinal): AnsiString;
|
329 |
begin
|
330 |
Result := strpas(FMetadata.getAlias(FStatus,index));
|
331 |
CheckStatus;
|
332 |
end;
|
333 |
|
334 |
function TFBUDRMessageMetadata.getType(index: Cardinal): Cardinal;
|
335 |
begin
|
336 |
Result := FMetadata.getType(FStatus,index);
|
337 |
CheckStatus;
|
338 |
end;
|
339 |
|
340 |
function TFBUDRMessageMetadata.isNullable(index: Cardinal): Boolean;
|
341 |
begin
|
342 |
Result := FMetadata.isNullable(FStatus,index);
|
343 |
CheckStatus;
|
344 |
end;
|
345 |
|
346 |
function TFBUDRMessageMetadata.getSubType(index: Cardinal): Integer;
|
347 |
begin
|
348 |
Result := FMetadata.getSubType(FStatus,index);
|
349 |
CheckStatus;
|
350 |
end;
|
351 |
|
352 |
function TFBUDRMessageMetadata.getLength(index: Cardinal): Cardinal;
|
353 |
begin
|
354 |
Result := FMetadata.getLength(FStatus,index);
|
355 |
CheckStatus;
|
356 |
end;
|
357 |
|
358 |
function TFBUDRMessageMetadata.getScale(index: Cardinal): Integer;
|
359 |
begin
|
360 |
Result := FMetadata.getScale(FStatus,index);
|
361 |
CheckStatus;
|
362 |
end;
|
363 |
|
364 |
function TFBUDRMessageMetadata.getCharSet(index: Cardinal): Cardinal;
|
365 |
begin
|
366 |
Result := FMetadata.getCharSet(FStatus,index);
|
367 |
CheckStatus;
|
368 |
end;
|
369 |
|
370 |
function TFBUDRMessageMetadata.getOffset(index: Cardinal): Cardinal;
|
371 |
begin
|
372 |
Result := FMetadata.getOffset(FStatus,index);
|
373 |
CheckStatus;
|
374 |
end;
|
375 |
|
376 |
function TFBUDRMessageMetadata.getNullOffset(index: Cardinal): Cardinal;
|
377 |
begin
|
378 |
Result := FMetadata.getNullOffset(FStatus,index);
|
379 |
CheckStatus;
|
380 |
end;
|
381 |
|
382 |
function TFBUDRMessageMetadata.getBuilder: IFBUDRMetadataBuilder;
|
383 |
var builder: Firebird.IMetadataBuilder;
|
384 |
begin
|
385 |
builder := FMetadata.getBuilder(FStatus);
|
386 |
try
|
387 |
CheckStatus;
|
388 |
Result := TFBUDRMetadataBuilder.Create(FContext,builder);
|
389 |
finally
|
390 |
builder.release;
|
391 |
end;
|
392 |
end;
|
393 |
|
394 |
function TFBUDRMessageMetadata.getMessageLength: Cardinal;
|
395 |
begin
|
396 |
Result := FMetadata.getMessageLength(FStatus);
|
397 |
CheckStatus;
|
398 |
end;
|
399 |
|
400 |
function TFBUDRMessageMetadata.getAlignment: Cardinal;
|
401 |
begin
|
402 |
Result := FMetadata.getAlignment(FStatus);
|
403 |
CheckStatus;
|
404 |
end;
|
405 |
|
406 |
function TFBUDRMessageMetadata.getAlignedLength: Cardinal;
|
407 |
begin
|
408 |
Result := FMetadata.getAlignedLength(FStatus);
|
409 |
CheckStatus;
|
410 |
end;
|
411 |
|
412 |
{ TFBUDRMetadataBuilder }
|
413 |
|
414 |
constructor TFBUDRMetadataBuilder.Create(context: IFBUDRExternalContext;
|
415 |
metadataBuilder: Firebird.IMetadataBuilder);
|
416 |
begin
|
417 |
inherited Create((context as TFBUDRExternalContext).Controller);
|
418 |
FirebirdAPI := context.GetFirebirdAPI;
|
419 |
FMetadataBuilder := metadataBuilder;
|
420 |
FMetadataBuilder.addRef;
|
421 |
end;
|
422 |
|
423 |
destructor TFBUDRMetadataBuilder.Destroy;
|
424 |
begin
|
425 |
if FMetadataBuilder <> nil then
|
426 |
FMetadataBuilder.release;
|
427 |
inherited Destroy;
|
428 |
end;
|
429 |
|
430 |
procedure TFBUDRMetadataBuilder.setType(index: Cardinal; type_: Cardinal);
|
431 |
begin
|
432 |
FMetadataBuilder.setType(FStatus,index,type_);
|
433 |
CheckStatus;
|
434 |
end;
|
435 |
|
436 |
procedure TFBUDRMetadataBuilder.setSubType(index: Cardinal; subType: Integer);
|
437 |
begin
|
438 |
FMetadataBuilder.setSubType(FStatus,index,subType);
|
439 |
CheckStatus;
|
440 |
end;
|
441 |
|
442 |
procedure TFBUDRMetadataBuilder.setLength(index: Cardinal; length: Cardinal);
|
443 |
begin
|
444 |
FMetadataBuilder.setLength(FStatus,index,Length);
|
445 |
CheckStatus;
|
446 |
end;
|
447 |
|
448 |
procedure TFBUDRMetadataBuilder.setCharSet(index: Cardinal; charSet: Cardinal);
|
449 |
begin
|
450 |
FMetadataBuilder.setCharSet(FStatus,index,charSet);
|
451 |
CheckStatus;
|
452 |
end;
|
453 |
|
454 |
procedure TFBUDRMetadataBuilder.setScale(index: Cardinal; scale: Integer);
|
455 |
begin
|
456 |
FMetadataBuilder.SetScale(FStatus,index,scale);
|
457 |
CheckStatus;
|
458 |
end;
|
459 |
|
460 |
procedure TFBUDRMetadataBuilder.truncate(count: Cardinal);
|
461 |
begin
|
462 |
FMetadataBuilder.truncate(FStatus,count);
|
463 |
CheckStatus;
|
464 |
end;
|
465 |
|
466 |
procedure TFBUDRMetadataBuilder.moveNameToIndex(name: AnsiString; index: Cardinal);
|
467 |
begin
|
468 |
FMetadataBuilder.moveNameToIndex(FStatus,PAnsiChar(name),index);
|
469 |
CheckStatus;
|
470 |
end;
|
471 |
|
472 |
procedure TFBUDRMetadataBuilder.remove(index: Cardinal);
|
473 |
begin
|
474 |
FMetadataBuilder.remove(FStatus,index);
|
475 |
CheckStatus;
|
476 |
end;
|
477 |
|
478 |
function TFBUDRMetadataBuilder.addField: Cardinal;
|
479 |
begin
|
480 |
Result := FMetadataBuilder.addField(FStatus);
|
481 |
CheckStatus;
|
482 |
end;
|
483 |
|
484 |
procedure TFBUDRMetadataBuilder.setField(index: Cardinal; field: AnsiString);
|
485 |
begin
|
486 |
FMetadataBuilder.setField(FStatus,index,PAnsiChar(field));
|
487 |
CheckStatus;
|
488 |
end;
|
489 |
|
490 |
procedure TFBUDRMetadataBuilder.setRelation(index: Cardinal; relation: AnsiString);
|
491 |
begin
|
492 |
FMetadataBuilder.setRelation(FStatus,index,PAnsiChar(relation));
|
493 |
CheckStatus;
|
494 |
end;
|
495 |
|
496 |
procedure TFBUDRMetadataBuilder.setOwner(index: Cardinal; owner: AnsiString);
|
497 |
begin
|
498 |
FMetadataBuilder.setOwner(FStatus,index,PAnsiChar(owner));
|
499 |
CheckStatus;
|
500 |
end;
|
501 |
|
502 |
procedure TFBUDRMetadataBuilder.setAlias(index: Cardinal; alias: AnsiString);
|
503 |
begin
|
504 |
FMetadataBuilder.setAlias(FStatus,index,PAnsiChar(alias));
|
505 |
end;
|
506 |
|
507 |
{ TFBUDRObject }
|
508 |
|
509 |
procedure TFBUDRObject.SetFirebirdAPI(AValue: IFirebirdAPI);
|
510 |
var MasterProvider: IFBIMasterProvider;
|
511 |
begin
|
512 |
if FFirebirdAPI = AValue then Exit;
|
513 |
FFirebirdAPI := AValue;
|
514 |
if (FStatus = nil) and
|
515 |
FirebirdAPI.HasMasterIntf and (FirebirdAPI.QueryInterface(IFBIMasterProvider,MasterProvider) = S_OK) then
|
516 |
FStatus := MasterProvider.GetIMasterIntf.getStatus;
|
517 |
end;
|
518 |
|
519 |
procedure TFBUDRObject.CheckStatus;
|
520 |
begin
|
521 |
with FStatus do
|
522 |
if (getState and STATE_ERRORS) <> 0 then
|
523 |
raise EFBUDRException.Create(FStatus);
|
524 |
end;
|
525 |
|
526 |
function TFBUDRObject.getStatus: Firebird.IStatus;
|
527 |
begin
|
528 |
Result := FStatus;
|
529 |
end;
|
530 |
|
531 |
constructor TFBUDRObject.Create(aController: TFBUDRController);
|
532 |
begin
|
533 |
inherited Create;
|
534 |
FController := aController;
|
535 |
end;
|
536 |
|
537 |
destructor TFBUDRObject.Destroy;
|
538 |
begin
|
539 |
if FStatus <> nil then
|
540 |
FStatus.dispose;
|
541 |
inherited Destroy;
|
542 |
end;
|
543 |
|
544 |
procedure TFBUDRObject.Clear;
|
545 |
begin
|
546 |
if FStatus <> nil then
|
547 |
FStatus.Init;
|
548 |
end;
|
549 |
|
550 |
{ TFBUDRExternalContext }
|
551 |
|
552 |
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 |
|
678 |
end;
|
679 |
|
680 |
function TFBUDRExternalContext.ReadConfigString(Section, Ident,
|
681 |
DefaultValue: AnsiString): AnsiString;
|
682 |
begin
|
683 |
Result := FController.ReadConfigString(Section, Ident, DefaultValue);
|
684 |
end;
|
685 |
|
686 |
function TFBUDRExternalContext.ReadConfigInteger(Section, Ident: AnsiString;
|
687 |
DefaultValue: integer): integer;
|
688 |
begin
|
689 |
Result := FController.ReadConfigInteger(Section, Ident, DefaultValue);
|
690 |
end;
|
691 |
|
692 |
function TFBUDRExternalContext.ReadConfigBool(Section, Ident: AnsiString;
|
693 |
DefaultValue: boolean): boolean;
|
694 |
begin
|
695 |
Result := FController.ReadConfigBool(Section, Ident, DefaultValue);
|
696 |
end;
|
697 |
|
698 |
procedure TFBUDRExternalContext.WriteToLog(Msg: AnsiString);
|
699 |
begin
|
700 |
FController.WriteToLog(Msg);
|
701 |
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 |
|