ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBParamBlock.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 11 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBParamBlock.pas
File size: 19915 byte(s)
Log Message:
Release 2.3.2 committed

File Contents

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