ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBParamBlock.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 19899 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FBParamBlock;
28 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$ENDIF}
36
37 interface
38
39 {Provides common handling for the DPB, TPB, SPB and Service Request Block (SRB)}
40
41 uses
42 Classes, SysUtils, IB, FBClientAPI, FBActivityMonitor;
43
44 type
45 TParamDataType = (dtString, dtString2, dtString0, dtByte, dtByte2, dtInteger, dtInteger1,
46 dtInteger2, dtShortInteger,dtTinyInteger,dtnone);
47
48 PParamBlockItemData = ^TParamBlockItemData;
49 TParamBlockItemData = record
50 {Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
51 the rest of the clumplet up to the FBufLength is data. The data format is
52 given by FDataType}
53 FBufPtr: PByte;
54 FBuflength: integer;
55 FDataType: TParamDataType;
56 end;
57
58 TParamBlockItem = class;
59
60 { TParamBlock }
61
62 TParamBlock = class(TFBInterfacedObject)
63 private
64 FItems: array of PParamBlockItemData;
65 FBufferSize: integer;
66 FFirebirdClientAPI: TFBClientAPI;
67 procedure AdjustBuffer;
68 procedure MoveBy(Item: PParamBlockItemData; delta: integer);
69 procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
70 protected
71 FBuffer: PByte;
72 FDataLength: integer;
73 function Add(ParamType: byte): PParamBlockItemData;
74 function Find(ParamType: byte): PParamBlockItemData;
75 function GetItems(index: integer): PParamBlockItemData;
76 function LookupItemType(ParamTypeName: AnsiString): byte; virtual;
77 public
78 constructor Create(api: TFBClientAPI);
79 destructor Destroy; override;
80 function getBuffer: PByte;
81 function getDataLength: integer;
82 function AvailableBufferSpace: integer;
83
84 public
85 function getCount: integer;
86 procedure Remove(ParamType: byte);
87 procedure PrintBuf;
88 end;
89
90 { TParamBlockItem }
91
92 TParamBlockItem = class(TFBInterfacedObject)
93 private
94 FOwner: TParamBlock;
95 FOwnerIntf: IUnknown;
96 FParamData: PParamBlockItemData;
97 FFirebirdClientAPI: TFBClientAPI;
98 protected
99 property ParamData: PParamBlockItemData read FParamData;
100 public
101 constructor Create(AOwner: TParamBlock; Data: PParamBlockItemData);
102 public
103 function getAsInteger: integer;
104 function getParamType: byte;
105 function getParamTypeName: AnsiString; virtual;
106 function getAsString: AnsiString;
107 function getAsByte: byte;
108 procedure addByte(aValue: byte);
109 procedure addShortInt(aValue: ShortInt);
110 procedure addShortInteger(aValue: integer);
111 procedure setAsByte(aValue: byte);
112 procedure setAsByte2(aValue: byte);
113 procedure SetAsInteger(aValue: integer);
114 procedure SetAsInteger1(aValue: integer);
115 procedure SetAsInteger2(aValue: integer);
116 procedure SetAsShortInteger(aValue: integer);
117 procedure SetAsTinyInteger(aValue: integer);
118 procedure SetAsString(aValue: AnsiString);
119 procedure SetAsString2(aValue: AnsiString);
120 procedure SetAsString0(aValue: AnsiString);
121 end;
122
123 { TSRBItem }
124
125 TSRBItem = class(TParamBlockItem,ISRBItem)
126 public
127 {$IFDEF FPC}
128 procedure ISRBItem.SetAsString = SetAsString2;
129 procedure ISRBItem.SetAsByte = SetAsByte2;
130 {$ELSE}
131 procedure SetAsString(aValue: AnsiString) ;
132 procedure SetAsByte(aValue: byte);
133 {$ENDIF}
134 end;
135
136 { TSQPBItem }
137
138 TSQPBItem = class(TParamBlockItem,ISQPBItem)
139 public
140 function CopyFrom(source: TStream; count: integer): integer;
141 {$IFDEF FPC}
142 procedure ISQPBItem.SetAsInteger = SetAsInteger2;
143 procedure ISQPBItem.SetAsString = SetAsString2;
144 {$ELSE}
145 procedure SetAsString(aValue: AnsiString) ;
146 procedure SetAsInteger(aValue: integer);
147 {$ENDIF}
148 end;
149
150 { TBPBItem }
151
152 TBPBItem = class(TParamBlockItem,IBPBItem)
153 public
154 {$IFDEF FPC}
155 procedure IBPBItem.SetAsInteger = SetAsInteger1;
156 {$ELSE}
157 procedure SetAsInteger(aValue: integer);
158 {$ENDIF}
159 end;
160
161 { TDIRBItem }
162
163 TDIRBItem = class(TParamBlockItem,IDIRBItem)
164 public
165 {$IFDEF FPC}
166 procedure IDIRBItem.SetAsInteger = SetAsInteger2;
167 {$ELSE}
168 procedure SetAsInteger(aValue: integer);
169 {$ENDIF}
170 end;
171
172 { TCustomParamBlock }
173
174 {$IFDEF FPC}
175 TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
176 {$ELSE}
177 TParamBlockItemClass = class of TParamBlockItem;
178 TCustomParamBlock<_TItem: TParamBlockItem; _IItem: IParameterBlockItem> = class(TParamBlock)
179 {$ENDIF}
180 public
181 function Add(ParamType: byte): _IItem;
182 function AddByTypeName(ParamTypeName: AnsiString): _IItem;
183 function Find(ParamType: byte): _IItem;
184 function GetItems(index: integer): _IItem;
185 end;
186
187 { TSRB }
188
189 TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
190
191 { TSQPB }
192
193 TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
194
195 { TBPB }
196
197 TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
198 public
199 constructor Create(api: TFBClientAPI);
200 end;
201
202 TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);
203
204 implementation
205
206 uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
207
208 const
209 MaxBufferSize = 65535;
210
211 { TDIRBItem }
212 {$IFNDEF FPC}
213 procedure TDIRBItem.SetAsInteger(aValue: integer);
214 begin
215 SetAsInteger2(aValue);
216 end;
217 {$ENDIF}
218
219 { TBPBItem }
220 {$IFNDEF FPC}
221 procedure TBPBItem.SetAsInteger(aValue: integer);
222 begin
223 SetAsInteger1(aValue);
224 end;
225 {$ENDIF}
226
227 { TSRBItem }
228
229 {$IFNDEF FPC}
230 procedure TSRBItem.SetAsString(aValue: AnsiString);
231 begin
232 SetAsString2(aValue);
233 end;
234
235 procedure TSRBItem.SetAsByte(aValue: byte);
236 begin
237 SetAsByte2(aValue);
238 end;
239 {$ENDIF}
240
241 { TSQPBItem }
242
243 function TSQPBItem.CopyFrom(source: TStream; count: integer): integer;
244 begin
245 if count > (FOwner.AvailableBufferSpace - 4) then
246 count := FOwner.AvailableBufferSpace - 4;
247 with FParamData^ do
248 begin
249 FOwner.UpdateRequestItemSize(self,count + 4);
250 Result := source.Read((FBufPtr+3)^,count);
251 with FFirebirdClientAPI do
252 EncodeInteger(Result,2,FBufPtr+1);
253 (FBufPtr+Result + 3)^ := isc_info_end;
254 if Result <> count then
255 FOwner.UpdateRequestItemSize(self,Result + 4);
256 FDataType := dtString2;
257 end;
258 end;
259
260 {$IFNDEF FPC}
261 procedure TSQPBItem.SetAsString(aValue: AnsiString);
262 begin
263 SetAsString2(aValue);
264 end;
265
266 procedure TSQPBItem.SetAsInteger(aValue: integer);
267 begin
268 SetAsInteger2(aValue);
269 end;
270 {$ENDIF}
271
272 { TParamBlockItem }
273
274 constructor TParamBlockItem.Create(AOwner: TParamBlock;
275 Data: PParamBlockItemData);
276 begin
277 inherited Create;
278 FOwner := AOwner;
279 FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
280 FOwnerIntf := AOwner;
281 FParamData := Data;
282 end;
283
284 function TParamBlockItem.getAsInteger: integer;
285 begin
286 with FFirebirdClientAPI, FParamData^ do
287 case FDataType of
288 dtInteger:
289 Result := DecodeInteger(FBufPtr+1,4);
290 dtShortInteger:
291 Result := DecodeInteger(FBufPtr+1,2);
292 dtTinyInteger:
293 Result := DecodeInteger(FBufPtr+1,1);
294 dtInteger1:
295 Result := DecodeInteger(FBufPtr+2,2);
296 dtInteger2:
297 Result := DecodeInteger(FBufPtr+3,4);
298 else
299 IBError(ibxePBParamTypeError,[nil]);
300 end;
301 end;
302
303 function TParamBlockItem.getParamType: byte;
304 begin
305 Result := byte(FParamData^.FBufPtr^);
306 end;
307
308 function TParamBlockItem.getParamTypeName: AnsiString;
309 begin
310 Result := '';
311 end;
312
313 function TParamBlockItem.getAsString: AnsiString;
314 var len: byte;
315 begin
316 Result := '';
317
318 with FParamData^ do
319 case FDataType of
320 dtInteger,
321 dtInteger1,
322 dtInteger2,
323 dtShortInteger,
324 dtTinyInteger:
325 Result := IntToStr(getAsInteger);
326 dtByte,
327 dtByte2:
328 Result := IntToStr(getAsByte);
329 dtString:
330 begin
331 len := (FBufPtr+1)^;
332 SetString(Result,PAnsiChar(FBufPtr+2),len);
333 end;
334 dtString2:
335 begin
336 with FFirebirdClientAPI do
337 len := DecodeInteger(FBufPtr+1,2);
338 SetString(Result,PAnsiChar(FBufPtr+3),len);
339 end;
340 dtString0:
341 Result := strpas(PAnsiChar(FBufPtr+1));
342 dtNone:
343 Result := '';
344 else
345 IBError(ibxeOutputBlockTypeError,[nil]);
346 end;
347 end;
348
349 function TParamBlockItem.getAsByte: byte;
350 begin
351 with FParamData^ do
352 if FDataType = dtByte then
353 Result := byte((FBufPtr+2)^)
354 else
355 if FDataType = dtByte2 then
356 Result := byte((FBufPtr+1)^)
357 else
358 IBError(ibxePBParamTypeError,[nil]);
359 end;
360
361 procedure TParamBlockItem.addByte(aValue: byte);
362 var len: integer;
363 P: PByte;
364 begin
365 with FParamData^ do
366 begin
367 P := FBufPtr + FBufLength;
368 len := FBufLength + 1;
369 FOwner.UpdateRequestItemSize(self,len);
370 P^ := aValue;
371 end;
372 end;
373
374 procedure TParamBlockItem.addShortInt(aValue: ShortInt);
375 var len: integer;
376 P: PByte;
377 begin
378 with FParamData^ do
379 begin
380 P := FBufPtr + FBufLength;
381 len := FBufLength + 1;
382 FOwner.UpdateRequestItemSize(self,len);
383 PShortInt(P)^ := aValue;
384 end;
385 end;
386
387 procedure TParamBlockItem.addShortInteger(aValue: integer);
388 var len: integer;
389 P: PByte;
390 begin
391 with FParamData^ do
392 begin
393 P := FBufPtr + FBufLength;
394 len := FBufLength + 2;
395 FOwner.UpdateRequestItemSize(self,len);
396 with FFirebirdClientAPI do
397 EncodeInteger(aValue,2,P);
398 end;
399 end;
400
401 procedure TParamBlockItem.setAsByte(aValue: byte);
402 begin
403 with FParamData^ do
404 begin
405 if FBufLength <> 3 then
406 FOwner.UpdateRequestItemSize(self,3);
407 FDataType := dtByte;
408 (FBufPtr+1)^ := $1;
409 (FBufPtr+2)^ := aValue;
410 end;
411 end;
412
413 procedure TParamBlockItem.setAsByte2(aValue: byte);
414 begin
415 with FParamData^ do
416 begin
417 if FBufLength <> 2 then
418 FOwner.UpdateRequestItemSize(self,2);
419 FDataType := dtByte2;
420 (FBufPtr+1)^ := aValue;
421 end;
422 end;
423
424 {Four byte integer - no length}
425
426 procedure TParamBlockItem.SetAsInteger(aValue: integer);
427 begin
428 with FParamData^ do
429 begin
430 if FBufLength <> 5 then
431 FOwner.UpdateRequestItemSize(self,5);
432 with FFirebirdClientAPI do
433 EncodeInteger(aValue,4,FBufPtr+1);
434 FDataType := dtInteger;
435 end;
436 end;
437
438 {Four byte integer - length byte}
439
440 procedure TParamBlockItem.SetAsInteger1(aValue: integer);
441 begin
442 with FParamData^ do
443 begin
444 if FBufLength <> 6 then
445 FOwner.UpdateRequestItemSize(self,6);
446 (FBufPtr+1)^ := $4;
447 with FFirebirdClientAPI do
448 EncodeInteger(aValue,4,FBufPtr+2);
449 FDataType := dtInteger1;
450 end;
451 end;
452
453 {Four byte integer - 2 byte length}
454
455 procedure TParamBlockItem.SetAsInteger2(aValue: integer);
456 begin
457 with FParamData^ do
458 begin
459 if FBufLength <> 7 then
460 FOwner.UpdateRequestItemSize(self,7);
461 with FFirebirdClientAPI do
462 begin
463 EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
464 EncodeInteger(aValue,4,FBufPtr+3);
465 end;
466 FDataType := dtInteger2
467 end;
468 end;
469
470 procedure TParamBlockItem.SetAsShortInteger(aValue: integer);
471 begin
472 with FParamData^ do
473 begin
474 if FBufLength <> 3 then
475 FOwner.UpdateRequestItemSize(self,3);
476 with FFirebirdClientAPI do
477 EncodeInteger(aValue,2,FBufPtr+1);
478 FDataType := dtShortInteger;
479 end;
480 end;
481
482 procedure TParamBlockItem.SetAsTinyInteger(aValue: integer);
483 begin
484 with FParamData^ do
485 begin
486 if FBufLength <> 2 then
487 FOwner.UpdateRequestItemSize(self,2);
488 with FFirebirdClientAPI do
489 EncodeInteger(aValue,1,FBufPtr+1);
490 FDataType := dtTinyInteger;
491 end;
492 end;
493
494 {Short string encoding}
495
496 procedure TParamBlockItem.SetAsString(aValue: AnsiString);
497 var len: integer;
498 begin
499 with FParamData^ do
500 begin
501 len := Length(aValue);
502 if len > 255 then
503 IBError(ibxStringTooLong,[aValue,255]);
504 FOwner.UpdateRequestItemSize(self,len+2);
505 (FBufPtr+1)^ := len;
506 if len > 0 then
507 Move(aValue[1],(FBufPtr+2)^,len);
508 FDataType := dtString;
509 end;
510 end;
511
512 {Long string up to 65535 encoding}
513
514 procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
515 var len: integer;
516 begin
517 with FParamData^ do
518 begin
519 len := Length(aValue);
520 if len > 65535 then
521 IBError(ibxStringTooLong,[aValue,65535]);
522 FOwner.UpdateRequestItemSize(self,len + 3);
523 with FFirebirdClientAPI do
524 EncodeInteger(len,2,FBufPtr+1);
525 if len > 0 then
526 Move(aValue[1],(FBufPtr+3)^,len);
527 FDataType := dtString2;
528 end;
529 end;
530
531 {Zero byte terminated string encoding}
532
533 procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
534 var len: integer;
535 begin
536 with FParamData^ do
537 begin
538 len := Length(aValue);
539 FOwner.UpdateRequestItemSize(self,len+2);
540 if len > 0 then
541 Move(aValue[1],(FBufPtr+1)^,len);
542 (FBufPtr+len+1)^ := 0;
543 FDataType := dtString0;
544 end;
545 end;
546
547 { TParamBlock }
548
549 procedure TParamBlock.AdjustBuffer;
550 var P: PByte;
551 i: integer;
552 headerLen: integer;
553 begin
554 if FDataLength > FBufferSize then
555 begin
556 if Length(FItems) > 0 then
557 headerLen := FItems[0]^.FBufPtr - FBuffer
558 else
559 headerLen := 0;
560 FBufferSize := 2*FDataLength;
561 ReallocMem(FBuffer,FBufferSize);
562 P := FBuffer + headerLen;
563 for i := 0 to Length(FItems) - 1 do
564 begin
565 FItems[i]^.FBufPtr := P;
566 Inc(P,FItems[i]^.FBuflength);
567 end;
568 end;
569 end;
570
571 procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
572 var src, dest: PByte;
573 i: integer;
574 begin
575 with Item^ do
576 begin
577 src := FBufptr;
578 dest := FBufptr + delta ;
579 if delta > 0 then
580 begin
581 for i := FBufLength - 1 downto 0 do
582 (dest +i)^ := (src+i)^;
583 end
584 else
585 begin
586 for i := 0 to FBufLength - 1 do
587 (dest +i)^ := (src+i)^;
588 end;
589 FBufPtr := FBufPtr + delta;
590 end;
591 end;
592
593 procedure TParamBlock.UpdateRequestItemSize(Item: TParamBlockItem;
594 NewSize: integer);
595 var i, delta: integer;
596 begin
597 delta := NewSize - Item.FParamData^.FBufLength;
598 Item.FParamData^.FBufLength := NewSize;
599 if delta > 0 then
600 begin
601 if FDataLength + delta > MaxBufferSize then
602 IBError(ibxeParamBufferOverflow,[nil]);
603 FDataLength := FDataLength + delta;
604 AdjustBuffer;
605 i := Length(FItems) - 1;
606 while i >= 0 do
607 begin
608 if FItems[i] = Item.FParamData then
609 break; {we're done}
610 Moveby(FItems[i],delta);
611 Dec(i);
612 end;
613 end
614 else
615 begin
616 i := 0;
617 while i < Length(FItems) do
618 begin
619 if FItems[i] = Item.FParamData then
620 break; {we're done}
621 Inc(i);
622 end;
623 Inc(i);
624 while i < Length(FItems) do
625 begin
626 Moveby(FItems[i],delta);
627 Inc(i);
628 end;
629 FDataLength := FDataLength + delta;
630 end;
631 end;
632
633 constructor TParamBlock.Create(api: TFBClientAPI);
634 begin
635 inherited Create;
636 FFirebirdClientAPI := api;
637 GetMem(FBuffer,128);
638 if FBuffer = nil then
639 OutOfMemoryError;
640 FBufferSize := 128;
641 FDataLength := 0;
642 end;
643
644 destructor TParamBlock.Destroy;
645 var i: integer;
646 begin
647 for i := 0 to Length(FItems) -1 do
648 dispose(FItems[i]);
649 Freemem(FBuffer);
650 inherited Destroy;
651 end;
652
653 function TParamBlock.getBuffer: PByte;
654 begin
655 if FDataLength = 0 then
656 Result := nil
657 else
658 Result := FBuffer;
659 end;
660
661 function TParamBlock.getDataLength: integer;
662 begin
663 Result := FDataLength;
664 end;
665
666 function TParamBlock.AvailableBufferSpace: integer;
667 begin
668 Result := MaxBufferSize - FDataLength;
669 end;
670
671 function TParamBlock.Add(ParamType: byte): PParamBlockItemData;
672 begin
673 new(Result);
674 Result^.FBufPtr := FBuffer + FDataLength;
675 Result^.FBufLength := 1;
676 Result^.FBufPtr^ := ParamType;
677 Result^.FDataType := dtnone; {default}
678 Inc(FDataLength,1);
679 AdjustBuffer;
680 SetLength(FItems,Length(FItems)+1);
681 FItems[Length(FItems) - 1 ] := Result;
682 end;
683
684 function TParamBlock.Find(ParamType: byte): PParamBlockItemData;
685 var i: integer;
686 begin
687 Result := nil;
688 for i := 0 to getCount - 1 do
689 if byte(FItems[i]^.FBufPtr^) = ParamType then
690 begin
691 Result := FItems[i];
692 Exit;
693 end;
694 end;
695
696 function TParamBlock.GetItems(index: integer): PParamBlockItemData;
697 begin
698 if (index >= 0 ) and (index < Length(FItems)) then
699 Result := FItems[index]
700 else
701 IBError(ibxePBIndexError,[index]);
702 end;
703
704 function TParamBlock.LookupItemType(ParamTypeName: AnsiString): byte;
705 begin
706 IBError(ibxeNotSupported,[]);
707 end;
708
709 function TParamBlock.getCount: integer;
710 begin
711 Result := Length(FItems);
712 end;
713
714 procedure TParamBlock.Remove(ParamType: byte);
715 var P: PParamBlockItemData;
716 i, j: integer;
717 begin
718 P := nil;
719 for i := 0 to getCount - 1 do
720 if byte(FItems[i]^.FBufPtr^) = ParamType then
721 begin
722 P := FItems[i];
723 for j := i + 1 to getCount - 1 do
724 begin
725 MoveBy(FItems[j],-P^.FBufLength);
726 FItems[j - 1] := FItems[j];
727 end;
728 FDataLength := FDataLength - P^.FBufLength;
729 dispose(P);
730 SetLength(FItems,Length(FItems)-1);
731 Exit;
732 end;
733 end;
734
735 procedure TParamBlock.PrintBuf;
736 var i: integer;
737 begin
738 write(ClassName,': (',getDataLength,') ');
739 for i := 0 to getDataLength - 1 do
740 write(Format('%x ',[byte(FBuffer[i])]));
741 writeln
742 end;
743
744 { TCustomParamBlock }
745
746 function TCustomParamBlock<_TItem, _IItem>.AddByTypeName(ParamTypeName: AnsiString
747 ): _IItem;
748 var ParamType: byte;
749 begin
750 ParamType := LookupItemType(ParamTypeName);
751 if ParamType = 0 then
752 IBError(ibxeUnknownParamTypeName,[ClassName,ParamTypeName]);
753 Result := Add(ParamType);
754 end;
755
756 {$IFDEF FPC}
757 function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
758 var Item: PParamBlockItemData;
759 begin
760 Item := inherited Add(ParamType);
761 Result := _TItem.Create(self,Item);
762 end;
763
764 function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
765 var Item: PParamBlockItemData;
766 begin
767 Result := nil;
768 Item := inherited Find(ParamType);
769 if Item <> nil then
770 Result := _TItem.Create(self,Item);
771 end;
772
773 function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
774 var Item: PParamBlockItemData;
775 begin
776 Item := inherited getItems(index);
777 Result := _TItem.Create(self,Item);
778 end;
779
780 {$ELSE}
781 function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
782 var Item: PParamBlockItemData;
783 Obj: TParamBlockItem;
784 begin
785 Item := inherited Add(ParamType);
786 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
787 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
788 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
789 end;
790
791 function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
792 var Item: PParamBlockItemData;
793 Obj: TParamBlockItem;
794 begin
795 FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
796 Item := inherited Find(ParamType);
797 if Item <> nil then
798 begin
799 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
800 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
801 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
802 end;
803 end;
804
805 function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
806 var Item: PParamBlockItemData;
807 Obj: TParamBlockItem;
808 begin
809 Item := inherited getItems(index);
810 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
811 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
812 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
813 end;
814 {$ENDIF}
815
816 { TBPB }
817
818 constructor TBPB.Create(api: TFBClientAPI);
819 begin
820 inherited Create(api);
821 FDataLength := 1;
822 FBuffer^ := isc_bpb_version1;
823 end;
824
825 end.
826