ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBParamBlock.pas
Revision: 308
Committed: Sat Jul 18 10:26:30 2020 UTC (4 years, 5 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

# 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 tony 308 procedure addShortInt(aValue: ShortInt);
108 tony 45 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 tony 56 procedure SetAsString(aValue: AnsiString);
117     procedure SetAsString2(aValue: AnsiString);
118     procedure SetAsString0(aValue: AnsiString);
119 tony 45 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 tony 56 {$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 tony 45 end;
145    
146     { TSQPBItem }
147    
148     TSQPBItem = class(TParamBlockItem,ISQPBItem)
149     public
150     function CopyFrom(source: TStream; count: integer): integer;
151 tony 56 {$IFDEF FPC}
152 tony 45 procedure ISQPBItem.SetAsInteger = SetAsInteger2;
153     procedure ISQPBItem.SetAsString = SetAsString2;
154 tony 56 {$ELSE}
155     procedure SetAsString(aValue: AnsiString) ;
156     procedure SetAsInteger(aValue: integer);
157     {$ENDIF}
158 tony 45 end;
159    
160     { TBPBItem }
161    
162     TBPBItem = class(TParamBlockItem,IBPBItem)
163     public
164 tony 56 {$IFDEF FPC}
165 tony 45 procedure IBPBItem.SetAsInteger = SetAsInteger1;
166 tony 56 {$ELSE}
167     procedure SetAsInteger(aValue: integer);
168     {$ENDIF}
169 tony 45 end;
170    
171 tony 143 { 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 tony 56 { 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 tony 263 constructor Create(api: TFBClientAPI);
201 tony 56 end;
202    
203     { TTPB }
204    
205     TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
206     public
207 tony 263 constructor Create(api: TFBClientAPI);
208 tony 56 end;
209    
210     { TSPB }
211    
212     TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
213     public
214 tony 263 constructor Create(api: TFBClientAPI);
215 tony 56 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 tony 45 { TBPB }
226    
227 tony 56 TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
228 tony 45 public
229 tony 263 constructor Create(api: TFBClientAPI);
230 tony 45 end;
231    
232 tony 143 TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);
233    
234 tony 45 implementation
235    
236 tony 56 uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
237 tony 45
238     const
239     MaxBufferSize = 65535;
240    
241 tony 143 { TDIRBItem }
242     {$IFNDEF FPC}
243     procedure TDIRBItem.SetAsInteger(aValue: integer);
244     begin
245     SetAsInteger2(aValue);
246     end;
247     {$ENDIF}
248    
249 tony 56 { TBPBItem }
250     {$IFNDEF FPC}
251     procedure TBPBItem.SetAsInteger(aValue: integer);
252 tony 45 begin
253 tony 56 SetAsInteger1(aValue);
254 tony 45 end;
255 tony 56 {$ENDIF}
256 tony 45
257 tony 56 { TSRBItem }
258    
259     {$IFNDEF FPC}
260     procedure TSRBItem.SetAsString(aValue: AnsiString);
261 tony 45 begin
262 tony 56 SetAsString2(aValue);
263 tony 45 end;
264    
265 tony 56 procedure TSRBItem.SetAsByte(aValue: byte);
266 tony 45 begin
267 tony 56 SetAsByte2(aValue);
268 tony 45 end;
269 tony 56 {$ENDIF}
270 tony 45
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 tony 263 with FFirebirdClientAPI do
282 tony 45 EncodeInteger(Result,2,FBufPtr+1);
283 tony 56 (FBufPtr+Result + 3)^ := isc_info_end;
284 tony 45 if Result <> count then
285     FOwner.UpdateRequestItemSize(self,Result + 4);
286     FDataType := dtString2;
287     end;
288     end;
289    
290 tony 56 {$IFNDEF FPC}
291     procedure TSQPBItem.SetAsString(aValue: AnsiString);
292     begin
293     SetAsString2(aValue);
294     end;
295 tony 45
296 tony 56 procedure TSQPBItem.SetAsInteger(aValue: integer);
297 tony 45 begin
298 tony 56 SetAsInteger2(aValue);
299 tony 45 end;
300 tony 56 {$ENDIF}
301 tony 45
302     { TParamBlockItem }
303    
304     constructor TParamBlockItem.Create(AOwner: TParamBlock;
305     Data: PParamBlockItemData);
306     begin
307     inherited Create;
308     FOwner := AOwner;
309 tony 263 FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
310 tony 45 FOwnerIntf := AOwner;
311     FParamData := Data;
312     end;
313    
314     function TParamBlockItem.getAsInteger: integer;
315     begin
316 tony 263 with FFirebirdClientAPI, FParamData^ do
317 tony 45 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 tony 56 function TParamBlockItem.getAsString: AnsiString;
339 tony 45 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 tony 56 len := (FBufPtr+1)^;
357     SetString(Result,PAnsiChar(FBufPtr+2),len);
358 tony 45 end;
359     dtString2:
360     begin
361 tony 263 with FFirebirdClientAPI do
362 tony 45 len := DecodeInteger(FBufPtr+1,2);
363 tony 56 SetString(Result,PAnsiChar(FBufPtr+3),len);
364 tony 45 end;
365     dtString0:
366 tony 56 Result := strpas(PAnsiChar(FBufPtr+1));
367 tony 45 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 tony 56 P: PByte;
387 tony 45 begin
388     with FParamData^ do
389     begin
390     P := FBufPtr + FBufLength;
391     len := FBufLength + 1;
392     FOwner.UpdateRequestItemSize(self,len);
393 tony 56 P^ := aValue;
394 tony 45 end;
395     end;
396    
397 tony 308 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 tony 45 procedure TParamBlockItem.addShortInteger(aValue: integer);
411     var len: integer;
412 tony 56 P: PByte;
413 tony 45 begin
414     with FParamData^ do
415     begin
416     P := FBufPtr + FBufLength;
417     len := FBufLength + 2;
418     FOwner.UpdateRequestItemSize(self,len);
419 tony 263 with FFirebirdClientAPI do
420 tony 45 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 tony 56 (FBufPtr+1)^ := $1;
432     (FBufPtr+2)^ := aValue;
433 tony 45 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 tony 56 (FBufPtr+1)^ := aValue;
444 tony 45 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 tony 263 with FFirebirdClientAPI do
456 tony 45 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 tony 56 (FBufPtr+1)^ := $4;
470 tony 263 with FFirebirdClientAPI do
471 tony 45 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 tony 263 with FFirebirdClientAPI do
485 tony 45 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 tony 263 with FFirebirdClientAPI do
500 tony 45 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 tony 263 with FFirebirdClientAPI do
512 tony 45 EncodeInteger(aValue,1,FBufPtr+1);
513     FDataType := dtTinyInteger;
514     end;
515     end;
516    
517     {Short string encoding}
518    
519 tony 56 procedure TParamBlockItem.SetAsString(aValue: AnsiString);
520 tony 45 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 tony 56 (FBufPtr+1)^ := len;
529 tony 45 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 tony 56 procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
538 tony 45 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 tony 263 with FFirebirdClientAPI do
547 tony 45 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 tony 56 procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
557 tony 45 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 tony 56 (FBufPtr+len+1)^ := 0;
566 tony 45 FDataType := dtString0;
567     end;
568     end;
569    
570     { TParamBlock }
571    
572     procedure TParamBlock.AdjustBuffer;
573 tony 56 var P: PByte;
574 tony 45 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 tony 56 var src, dest: PByte;
596 tony 45 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 tony 56 FBufPtr := FBufPtr + delta;
613 tony 45 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 tony 56 FDataLength := FDataLength + delta;
627 tony 45 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 tony 56 FDataLength := FDataLength + delta;
653 tony 45 end;
654     end;
655    
656 tony 263 constructor TParamBlock.Create(api: TFBClientAPI);
657 tony 45 begin
658     inherited Create;
659 tony 263 FFirebirdClientAPI := api;
660 tony 45 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 tony 56 function TParamBlock.getBuffer: PByte;
677 tony 45 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 tony 56 Result^.FBufPtr^ := ParamType;
700 tony 45 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 tony 56 if byte(FItems[i]^.FBufPtr^) = ParamType then
713 tony 45 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 tony 56 if byte(FItems[i]^.FBufPtr^) = ParamType then
739 tony 45 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 tony 56 FDataLength := FDataLength - P^.FBufLength;
747 tony 45 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 tony 56 { 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 tony 45 { TDPB }
824    
825 tony 263 constructor TDPB.Create(api: TFBClientAPI);
826 tony 45 begin
827 tony 263 inherited Create(api);
828 tony 45 FDataLength := 1;
829 tony 56 FBuffer^ := isc_dpb_version1;
830 tony 45 end;
831    
832     { TTPB }
833    
834 tony 263 constructor TTPB.Create(api: TFBClientAPI);
835 tony 45 begin
836 tony 263 inherited Create(api);
837 tony 45 FDataLength := 1;
838 tony 56 FBuffer^ := isc_tpb_version3;
839 tony 45 end;
840    
841     { TSPB }
842    
843 tony 263 constructor TSPB.Create(api: TFBClientAPI);
844 tony 45 begin
845 tony 263 inherited Create(api);
846 tony 45 FDataLength := 2;
847 tony 56 FBuffer^ := isc_spb_version;
848     (FBuffer+1)^ := isc_spb_current_version;
849 tony 45 end;
850    
851 tony 56 { TBPB }
852    
853 tony 263 constructor TBPB.Create(api: TFBClientAPI);
854 tony 56 begin
855 tony 263 inherited Create(api);
856 tony 56 FDataLength := 1;
857     FBuffer^ := isc_bpb_version1;
858     end;
859    
860 tony 45 end.
861