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