ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBParamBlock.pas
Revision: 308
Committed: Sat Jul 18 10:26:30 2020 UTC (4 years, 4 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBParamBlock.pas
File size: 20230 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
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 public
77 constructor Create(api: TFBClientAPI);
78 destructor Destroy; override;
79 function getBuffer: PByte;
80 function getDataLength: integer;
81 function AvailableBufferSpace: integer;
82
83 public
84 function getCount: integer;
85 procedure Remove(ParamType: byte);
86 procedure PrintBuf;
87 end;
88
89 { TParamBlockItem }
90
91 TParamBlockItem = class(TFBInterfacedObject)
92 private
93 FOwner: TParamBlock;
94 FOwnerIntf: IUnknown;
95 FParamData: PParamBlockItemData;
96 FFirebirdClientAPI: TFBClientAPI;
97 protected
98 property ParamData: PParamBlockItemData read FParamData;
99 public
100 constructor Create(AOwner: TParamBlock; Data: PParamBlockItemData);
101 public
102 function getAsInteger: integer;
103 function getParamType: byte;
104 function getAsString: AnsiString;
105 function getAsByte: byte;
106 procedure addByte(aValue: byte);
107 procedure addShortInt(aValue: ShortInt);
108 procedure addShortInteger(aValue: integer);
109 procedure setAsByte(aValue: byte);
110 procedure setAsByte2(aValue: byte);
111 procedure SetAsInteger(aValue: integer);
112 procedure SetAsInteger1(aValue: integer);
113 procedure SetAsInteger2(aValue: integer);
114 procedure SetAsShortInteger(aValue: integer);
115 procedure SetAsTinyInteger(aValue: integer);
116 procedure SetAsString(aValue: AnsiString);
117 procedure SetAsString2(aValue: AnsiString);
118 procedure SetAsString0(aValue: AnsiString);
119 end;
120
121 { TDPBItem }
122
123 TDPBItem = class(TParamBlockItem,IDPBItem);
124
125 { TTPBItem }
126
127 TTPBItem = class(TParamBlockItem,ITPBItem);
128
129 { TSPBItem }
130
131 TSPBItem = class(TParamBlockItem,ISPBItem);
132
133 { TSRBItem }
134
135 TSRBItem = class(TParamBlockItem,ISRBItem)
136 public
137 {$IFDEF FPC}
138 procedure ISRBItem.SetAsString = SetAsString2;
139 procedure ISRBItem.SetAsByte = SetAsByte2;
140 {$ELSE}
141 procedure SetAsString(aValue: AnsiString) ;
142 procedure SetAsByte(aValue: byte);
143 {$ENDIF}
144 end;
145
146 { TSQPBItem }
147
148 TSQPBItem = class(TParamBlockItem,ISQPBItem)
149 public
150 function CopyFrom(source: TStream; count: integer): integer;
151 {$IFDEF FPC}
152 procedure ISQPBItem.SetAsInteger = SetAsInteger2;
153 procedure ISQPBItem.SetAsString = SetAsString2;
154 {$ELSE}
155 procedure SetAsString(aValue: AnsiString) ;
156 procedure SetAsInteger(aValue: integer);
157 {$ENDIF}
158 end;
159
160 { TBPBItem }
161
162 TBPBItem = class(TParamBlockItem,IBPBItem)
163 public
164 {$IFDEF FPC}
165 procedure IBPBItem.SetAsInteger = SetAsInteger1;
166 {$ELSE}
167 procedure SetAsInteger(aValue: integer);
168 {$ENDIF}
169 end;
170
171 { TDIRBItem }
172
173 TDIRBItem = class(TParamBlockItem,IDIRBItem)
174 public
175 {$IFDEF FPC}
176 procedure IDIRBItem.SetAsInteger = SetAsInteger2;
177 {$ELSE}
178 procedure SetAsInteger(aValue: integer);
179 {$ENDIF}
180 end;
181
182 { TCustomParamBlock }
183
184 {$IFDEF FPC}
185 TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
186 {$ELSE}
187 TParamBlockItemClass = class of TParamBlockItem;
188 TCustomParamBlock<_TItem: TParamBlockItem; _IItem: IParameterBlockItem> = class(TParamBlock)
189 {$ENDIF}
190 public
191 function Add(ParamType: byte): _IItem;
192 function Find(ParamType: byte): _IItem;
193 function GetItems(index: integer): _IItem;
194 end;
195
196 { TDPB }
197
198 TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
199 public
200 constructor Create(api: TFBClientAPI);
201 end;
202
203 { TTPB }
204
205 TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
206 public
207 constructor Create(api: TFBClientAPI);
208 end;
209
210 { TSPB }
211
212 TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
213 public
214 constructor Create(api: TFBClientAPI);
215 end;
216
217 { TSRB }
218
219 TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
220
221 { TSQPB }
222
223 TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
224
225 { TBPB }
226
227 TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
228 public
229 constructor Create(api: TFBClientAPI);
230 end;
231
232 TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);
233
234 implementation
235
236 uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
237
238 const
239 MaxBufferSize = 65535;
240
241 { TDIRBItem }
242 {$IFNDEF FPC}
243 procedure TDIRBItem.SetAsInteger(aValue: integer);
244 begin
245 SetAsInteger2(aValue);
246 end;
247 {$ENDIF}
248
249 { TBPBItem }
250 {$IFNDEF FPC}
251 procedure TBPBItem.SetAsInteger(aValue: integer);
252 begin
253 SetAsInteger1(aValue);
254 end;
255 {$ENDIF}
256
257 { TSRBItem }
258
259 {$IFNDEF FPC}
260 procedure TSRBItem.SetAsString(aValue: AnsiString);
261 begin
262 SetAsString2(aValue);
263 end;
264
265 procedure TSRBItem.SetAsByte(aValue: byte);
266 begin
267 SetAsByte2(aValue);
268 end;
269 {$ENDIF}
270
271 { TSQPBItem }
272
273 function TSQPBItem.CopyFrom(source: TStream; count: integer): integer;
274 begin
275 if count > (FOwner.AvailableBufferSpace - 4) then
276 count := FOwner.AvailableBufferSpace - 4;
277 with FParamData^ do
278 begin
279 FOwner.UpdateRequestItemSize(self,count + 4);
280 Result := source.Read((FBufPtr+3)^,count);
281 with FFirebirdClientAPI do
282 EncodeInteger(Result,2,FBufPtr+1);
283 (FBufPtr+Result + 3)^ := isc_info_end;
284 if Result <> count then
285 FOwner.UpdateRequestItemSize(self,Result + 4);
286 FDataType := dtString2;
287 end;
288 end;
289
290 {$IFNDEF FPC}
291 procedure TSQPBItem.SetAsString(aValue: AnsiString);
292 begin
293 SetAsString2(aValue);
294 end;
295
296 procedure TSQPBItem.SetAsInteger(aValue: integer);
297 begin
298 SetAsInteger2(aValue);
299 end;
300 {$ENDIF}
301
302 { TParamBlockItem }
303
304 constructor TParamBlockItem.Create(AOwner: TParamBlock;
305 Data: PParamBlockItemData);
306 begin
307 inherited Create;
308 FOwner := AOwner;
309 FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
310 FOwnerIntf := AOwner;
311 FParamData := Data;
312 end;
313
314 function TParamBlockItem.getAsInteger: integer;
315 begin
316 with FFirebirdClientAPI, FParamData^ do
317 case FDataType of
318 dtInteger:
319 Result := DecodeInteger(FBufPtr+1,4);
320 dtShortInteger:
321 Result := DecodeInteger(FBufPtr+1,2);
322 dtTinyInteger:
323 Result := DecodeInteger(FBufPtr+1,1);
324 dtInteger1:
325 Result := DecodeInteger(FBufPtr+2,2);
326 dtInteger2:
327 Result := DecodeInteger(FBufPtr+3,4);
328 else
329 IBError(ibxePBParamTypeError,[nil]);
330 end;
331 end;
332
333 function TParamBlockItem.getParamType: byte;
334 begin
335 Result := byte(FParamData^.FBufPtr^);
336 end;
337
338 function TParamBlockItem.getAsString: AnsiString;
339 var len: byte;
340 begin
341 Result := '';
342
343 with FParamData^ do
344 case FDataType of
345 dtInteger,
346 dtInteger1,
347 dtInteger2,
348 dtShortInteger,
349 dtTinyInteger:
350 Result := IntToStr(getAsInteger);
351 dtByte,
352 dtByte2:
353 Result := IntToStr(getAsByte);
354 dtString:
355 begin
356 len := (FBufPtr+1)^;
357 SetString(Result,PAnsiChar(FBufPtr+2),len);
358 end;
359 dtString2:
360 begin
361 with FFirebirdClientAPI do
362 len := DecodeInteger(FBufPtr+1,2);
363 SetString(Result,PAnsiChar(FBufPtr+3),len);
364 end;
365 dtString0:
366 Result := strpas(PAnsiChar(FBufPtr+1));
367 else
368 IBError(ibxeOutputBlockTypeError,[nil]);
369 end;
370 end;
371
372 function TParamBlockItem.getAsByte: byte;
373 begin
374 with FParamData^ do
375 if FDataType = dtByte then
376 Result := byte((FBufPtr+2)^)
377 else
378 if FDataType = dtByte2 then
379 Result := byte((FBufPtr+1)^)
380 else
381 IBError(ibxePBParamTypeError,[nil]);
382 end;
383
384 procedure TParamBlockItem.addByte(aValue: byte);
385 var len: integer;
386 P: PByte;
387 begin
388 with FParamData^ do
389 begin
390 P := FBufPtr + FBufLength;
391 len := FBufLength + 1;
392 FOwner.UpdateRequestItemSize(self,len);
393 P^ := aValue;
394 end;
395 end;
396
397 procedure TParamBlockItem.addShortInt(aValue: ShortInt);
398 var len: integer;
399 P: PByte;
400 begin
401 with FParamData^ do
402 begin
403 P := FBufPtr + FBufLength;
404 len := FBufLength + 1;
405 FOwner.UpdateRequestItemSize(self,len);
406 PShortInt(P)^ := aValue;
407 end;
408 end;
409
410 procedure TParamBlockItem.addShortInteger(aValue: integer);
411 var len: integer;
412 P: PByte;
413 begin
414 with FParamData^ do
415 begin
416 P := FBufPtr + FBufLength;
417 len := FBufLength + 2;
418 FOwner.UpdateRequestItemSize(self,len);
419 with FFirebirdClientAPI do
420 EncodeInteger(aValue,2,P);
421 end;
422 end;
423
424 procedure TParamBlockItem.setAsByte(aValue: byte);
425 begin
426 with FParamData^ do
427 begin
428 if FBufLength <> 3 then
429 FOwner.UpdateRequestItemSize(self,3);
430 FDataType := dtByte;
431 (FBufPtr+1)^ := $1;
432 (FBufPtr+2)^ := aValue;
433 end;
434 end;
435
436 procedure TParamBlockItem.setAsByte2(aValue: byte);
437 begin
438 with FParamData^ do
439 begin
440 if FBufLength <> 2 then
441 FOwner.UpdateRequestItemSize(self,2);
442 FDataType := dtByte2;
443 (FBufPtr+1)^ := aValue;
444 end;
445 end;
446
447 {Four byte integer - no length}
448
449 procedure TParamBlockItem.SetAsInteger(aValue: integer);
450 begin
451 with FParamData^ do
452 begin
453 if FBufLength <> 5 then
454 FOwner.UpdateRequestItemSize(self,5);
455 with FFirebirdClientAPI do
456 EncodeInteger(aValue,4,FBufPtr+1);
457 FDataType := dtInteger;
458 end;
459 end;
460
461 {Four byte integer - length byte}
462
463 procedure TParamBlockItem.SetAsInteger1(aValue: integer);
464 begin
465 with FParamData^ do
466 begin
467 if FBufLength <> 6 then
468 FOwner.UpdateRequestItemSize(self,6);
469 (FBufPtr+1)^ := $4;
470 with FFirebirdClientAPI do
471 EncodeInteger(aValue,4,FBufPtr+2);
472 FDataType := dtInteger1;
473 end;
474 end;
475
476 {Four byte integer - 2 byte length}
477
478 procedure TParamBlockItem.SetAsInteger2(aValue: integer);
479 begin
480 with FParamData^ do
481 begin
482 if FBufLength <> 7 then
483 FOwner.UpdateRequestItemSize(self,7);
484 with FFirebirdClientAPI do
485 begin
486 EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
487 EncodeInteger(aValue,4,FBufPtr+3);
488 end;
489 FDataType := dtInteger2
490 end;
491 end;
492
493 procedure TParamBlockItem.SetAsShortInteger(aValue: integer);
494 begin
495 with FParamData^ do
496 begin
497 if FBufLength <> 3 then
498 FOwner.UpdateRequestItemSize(self,3);
499 with FFirebirdClientAPI do
500 EncodeInteger(aValue,2,FBufPtr+1);
501 FDataType := dtShortInteger;
502 end;
503 end;
504
505 procedure TParamBlockItem.SetAsTinyInteger(aValue: integer);
506 begin
507 with FParamData^ do
508 begin
509 if FBufLength <> 2 then
510 FOwner.UpdateRequestItemSize(self,2);
511 with FFirebirdClientAPI do
512 EncodeInteger(aValue,1,FBufPtr+1);
513 FDataType := dtTinyInteger;
514 end;
515 end;
516
517 {Short string encoding}
518
519 procedure TParamBlockItem.SetAsString(aValue: AnsiString);
520 var len: integer;
521 begin
522 with FParamData^ do
523 begin
524 len := Length(aValue);
525 if len > 255 then
526 IBError(ibxStringTooLong,[aValue,255]);
527 FOwner.UpdateRequestItemSize(self,len+2);
528 (FBufPtr+1)^ := len;
529 if len > 0 then
530 Move(aValue[1],(FBufPtr+2)^,len);
531 FDataType := dtString;
532 end;
533 end;
534
535 {Long string up to 65535 encoding}
536
537 procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
538 var len: integer;
539 begin
540 with FParamData^ do
541 begin
542 len := Length(aValue);
543 if len > 65535 then
544 IBError(ibxStringTooLong,[aValue,65535]);
545 FOwner.UpdateRequestItemSize(self,len + 3);
546 with FFirebirdClientAPI do
547 EncodeInteger(len,2,FBufPtr+1);
548 if len > 0 then
549 Move(aValue[1],(FBufPtr+3)^,len);
550 FDataType := dtString2;
551 end;
552 end;
553
554 {Zero byte terminated string encoding}
555
556 procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
557 var len: integer;
558 begin
559 with FParamData^ do
560 begin
561 len := Length(aValue);
562 FOwner.UpdateRequestItemSize(self,len+2);
563 if len > 0 then
564 Move(aValue[1],(FBufPtr+1)^,len);
565 (FBufPtr+len+1)^ := 0;
566 FDataType := dtString0;
567 end;
568 end;
569
570 { TParamBlock }
571
572 procedure TParamBlock.AdjustBuffer;
573 var P: PByte;
574 i: integer;
575 headerLen: integer;
576 begin
577 if FDataLength > FBufferSize then
578 begin
579 if Length(FItems) > 0 then
580 headerLen := FItems[0]^.FBufPtr - FBuffer
581 else
582 headerLen := 0;
583 FBufferSize := 2*FDataLength;
584 ReallocMem(FBuffer,FBufferSize);
585 P := FBuffer + headerLen;
586 for i := 0 to Length(FItems) - 1 do
587 begin
588 FItems[i]^.FBufPtr := P;
589 Inc(P,FItems[i]^.FBuflength);
590 end;
591 end;
592 end;
593
594 procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
595 var src, dest: PByte;
596 i: integer;
597 begin
598 with Item^ do
599 begin
600 src := FBufptr;
601 dest := FBufptr + delta ;
602 if delta > 0 then
603 begin
604 for i := FBufLength - 1 downto 0 do
605 (dest +i)^ := (src+i)^;
606 end
607 else
608 begin
609 for i := 0 to FBufLength - 1 do
610 (dest +i)^ := (src+i)^;
611 end;
612 FBufPtr := FBufPtr + delta;
613 end;
614 end;
615
616 procedure TParamBlock.UpdateRequestItemSize(Item: TParamBlockItem;
617 NewSize: integer);
618 var i, delta: integer;
619 begin
620 delta := NewSize - Item.FParamData^.FBufLength;
621 Item.FParamData^.FBufLength := NewSize;
622 if delta > 0 then
623 begin
624 if FDataLength + delta > MaxBufferSize then
625 IBError(ibxeParamBufferOverflow,[nil]);
626 FDataLength := FDataLength + delta;
627 AdjustBuffer;
628 i := Length(FItems) - 1;
629 while i >= 0 do
630 begin
631 if FItems[i] = Item.FParamData then
632 break; {we're done}
633 Moveby(FItems[i],delta);
634 Dec(i);
635 end;
636 end
637 else
638 begin
639 i := 0;
640 while i < Length(FItems) do
641 begin
642 if FItems[i] = Item.FParamData then
643 break; {we're done}
644 Inc(i);
645 end;
646 Inc(i);
647 while i < Length(FItems) do
648 begin
649 Moveby(FItems[i],delta);
650 Inc(i);
651 end;
652 FDataLength := FDataLength + delta;
653 end;
654 end;
655
656 constructor TParamBlock.Create(api: TFBClientAPI);
657 begin
658 inherited Create;
659 FFirebirdClientAPI := api;
660 GetMem(FBuffer,128);
661 if FBuffer = nil then
662 OutOfMemoryError;
663 FBufferSize := 128;
664 FDataLength := 0;
665 end;
666
667 destructor TParamBlock.Destroy;
668 var i: integer;
669 begin
670 for i := 0 to Length(FItems) -1 do
671 dispose(FItems[i]);
672 Freemem(FBuffer);
673 inherited Destroy;
674 end;
675
676 function TParamBlock.getBuffer: PByte;
677 begin
678 if FDataLength = 0 then
679 Result := nil
680 else
681 Result := FBuffer;
682 end;
683
684 function TParamBlock.getDataLength: integer;
685 begin
686 Result := FDataLength
687 end;
688
689 function TParamBlock.AvailableBufferSpace: integer;
690 begin
691 Result := MaxBufferSize - FDataLength;
692 end;
693
694 function TParamBlock.Add(ParamType: byte): PParamBlockItemData;
695 begin
696 new(Result);
697 Result^.FBufPtr := FBuffer + FDataLength;
698 Result^.FBufLength := 1;
699 Result^.FBufPtr^ := ParamType;
700 Result^.FDataType := dtnone; {default}
701 Inc(FDataLength,1);
702 AdjustBuffer;
703 SetLength(FItems,Length(FItems)+1);
704 FItems[Length(FItems) - 1 ] := Result;
705 end;
706
707 function TParamBlock.Find(ParamType: byte): PParamBlockItemData;
708 var i: integer;
709 begin
710 Result := nil;
711 for i := 0 to getCount - 1 do
712 if byte(FItems[i]^.FBufPtr^) = ParamType then
713 begin
714 Result := FItems[i];
715 Exit;
716 end;
717 end;
718
719 function TParamBlock.GetItems(index: integer): PParamBlockItemData;
720 begin
721 if (index >= 0 ) and (index < Length(FItems)) then
722 Result := FItems[index]
723 else
724 IBError(ibxePBIndexError,[index]);
725 end;
726
727 function TParamBlock.getCount: integer;
728 begin
729 Result := Length(FItems);
730 end;
731
732 procedure TParamBlock.Remove(ParamType: byte);
733 var P: PParamBlockItemData;
734 i, j: integer;
735 begin
736 P := nil;
737 for i := 0 to getCount - 1 do
738 if byte(FItems[i]^.FBufPtr^) = ParamType then
739 begin
740 P := FItems[i];
741 for j := i + 1 to getCount - 1 do
742 begin
743 MoveBy(FItems[j],-P^.FBufLength);
744 FItems[j - 1] := FItems[j];
745 end;
746 FDataLength := FDataLength - P^.FBufLength;
747 dispose(P);
748 SetLength(FItems,Length(FItems)-1);
749 Exit;
750 end;
751 end;
752
753 procedure TParamBlock.PrintBuf;
754 var i: integer;
755 begin
756 write(ClassName,': ');
757 for i := 0 to getDataLength - 1 do
758 write(Format('%x ',[byte(FBuffer[i])]));
759 writeln
760 end;
761
762 { TCustomParamBlock }
763
764 {$IFDEF FPC}
765 function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
766 var Item: PParamBlockItemData;
767 begin
768 Item := inherited Add(ParamType);
769 Result := _TItem.Create(self,Item);
770 end;
771
772 function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
773 var Item: PParamBlockItemData;
774 begin
775 Result := nil;
776 Item := inherited Find(ParamType);
777 if Item <> nil then
778 Result := _TItem.Create(self,Item);
779 end;
780
781 function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
782 var Item: PParamBlockItemData;
783 begin
784 Item := inherited getItems(index);
785 Result := _TItem.Create(self,Item);
786 end;
787 {$ELSE}
788 function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
789 var Item: PParamBlockItemData;
790 Obj: TParamBlockItem;
791 begin
792 Item := inherited Add(ParamType);
793 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
794 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
795 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
796 end;
797
798 function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
799 var Item: PParamBlockItemData;
800 Obj: TParamBlockItem;
801 begin
802 FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
803 Item := inherited Find(ParamType);
804 if Item <> nil then
805 begin
806 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
807 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
808 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
809 end;
810 end;
811
812 function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
813 var Item: PParamBlockItemData;
814 Obj: TParamBlockItem;
815 begin
816 Item := inherited getItems(index);
817 Obj := TParamBlockItemClass(_TItem).Create(self,Item);
818 if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
819 IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
820 end;
821 {$ENDIF}
822
823 { TDPB }
824
825 constructor TDPB.Create(api: TFBClientAPI);
826 begin
827 inherited Create(api);
828 FDataLength := 1;
829 FBuffer^ := isc_dpb_version1;
830 end;
831
832 { TTPB }
833
834 constructor TTPB.Create(api: TFBClientAPI);
835 begin
836 inherited Create(api);
837 FDataLength := 1;
838 FBuffer^ := isc_tpb_version3;
839 end;
840
841 { TSPB }
842
843 constructor TSPB.Create(api: TFBClientAPI);
844 begin
845 inherited Create(api);
846 FDataLength := 2;
847 FBuffer^ := isc_spb_version;
848 (FBuffer+1)^ := isc_spb_current_version;
849 end;
850
851 { TBPB }
852
853 constructor TBPB.Create(api: TFBClientAPI);
854 begin
855 inherited Create(api);
856 FDataLength := 1;
857 FBuffer^ := isc_bpb_version1;
858 end;
859
860 end.
861