ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBParamBlock.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBParamBlock.pas (file contents):
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 63 | Line 63 | type
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);
# Line 72 | Line 73 | type
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;
78 >    constructor Create(api: TFBClientAPI);
79      destructor Destroy; override;
80      function getBuffer: PByte;
81      function getDataLength: integer;
# Line 92 | Line 94 | type
94       FOwner: TParamBlock;
95       FOwnerIntf: IUnknown;
96       FParamData: PParamBlockItemData;
97 +     FFirebirdClientAPI: TFBClientAPI;
98    protected
99      property ParamData: PParamBlockItemData read FParamData;
100    public
# Line 99 | Line 102 | type
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);
# Line 115 | Line 120 | type
120       procedure SetAsString0(aValue: AnsiString);
121    end;
122  
118  { TDPBItem }
119
120  TDPBItem = class(TParamBlockItem,IDPBItem);
121
122  { TTPBItem }
123
124  TTPBItem = class(TParamBlockItem,ITPBItem);
125
126  { TSPBItem }
127
128  TSPBItem = class(TParamBlockItem,ISPBItem);
129
123    { TSRBItem }
124  
125    TSRBItem = class(TParamBlockItem,ISRBItem)
# Line 165 | Line 158 | type
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}
# Line 175 | Line 179 | type
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  
182  { TDPB }
183
184  TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
185  public
186    constructor Create;
187  end;
188
189  { TTPB }
190
191  TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
192  public
193    constructor Create;
194  end;
195
196  { TSPB }
197
198  TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
199  public
200   constructor Create;
201  end;
202
187    { TSRB }
188  
189    TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
# Line 212 | Line 196 | type
196  
197    TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
198    public
199 <   constructor Create;
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};
# Line 222 | Line 208 | uses FBMessages {$IFNDEF FPC} , TypInfo
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);
# Line 254 | Line 248 | begin
248      begin
249        FOwner.UpdateRequestItemSize(self,count + 4);
250        Result := source.Read((FBufPtr+3)^,count);
251 <      with FirebirdClientAPI do
251 >      with FFirebirdClientAPI do
252          EncodeInteger(Result,2,FBufPtr+1);
253        (FBufPtr+Result + 3)^ := isc_info_end;
254        if Result <> count then
# Line 282 | Line 276 | constructor TParamBlockItem.Create(AOwne
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 FirebirdClientAPI, FParamData^ do
286 >  with FFirebirdClientAPI, FParamData^ do
287    case FDataType of
288    dtInteger:
289      Result := DecodeInteger(FBufPtr+1,4);
# Line 310 | Line 305 | 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
# Line 333 | Line 333 | begin
333      end;
334    dtString2:
335      begin
336 <      with FirebirdClientAPI do
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 <    else
343 <      IBError(ibxeOutputBlockTypeError,[nil]);
342 >  dtNone:
343 >      Result := '';
344 >  else
345 >    IBError(ibxeOutputBlockTypeError,[nil]);
346    end;
347   end;
348  
# Line 369 | Line 371 | begin
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;
# Line 378 | Line 393 | begin
393      P := FBufPtr + FBufLength;
394      len := FBufLength + 2;
395      FOwner.UpdateRequestItemSize(self,len);
396 <    with FirebirdClientAPI do
396 >    with FFirebirdClientAPI do
397        EncodeInteger(aValue,2,P);
398    end;
399   end;
# Line 414 | Line 429 | begin
429    begin
430      if FBufLength <> 5 then
431        FOwner.UpdateRequestItemSize(self,5);
432 <    with FirebirdClientAPI do
432 >    with FFirebirdClientAPI do
433        EncodeInteger(aValue,4,FBufPtr+1);
434      FDataType := dtInteger;
435    end;
# Line 429 | Line 444 | begin
444      if FBufLength <> 6 then
445        FOwner.UpdateRequestItemSize(self,6);
446      (FBufPtr+1)^ := $4;
447 <    with FirebirdClientAPI do
447 >    with FFirebirdClientAPI do
448        EncodeInteger(aValue,4,FBufPtr+2);
449      FDataType := dtInteger1;
450    end;
# Line 443 | Line 458 | begin
458    begin
459      if FBufLength <> 7 then
460        FOwner.UpdateRequestItemSize(self,7);
461 <    with FirebirdClientAPI do
461 >    with FFirebirdClientAPI do
462      begin
463        EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
464        EncodeInteger(aValue,4,FBufPtr+3);
# Line 458 | Line 473 | begin
473    begin
474      if FBufLength <> 3 then
475        FOwner.UpdateRequestItemSize(self,3);
476 <    with FirebirdClientAPI do
476 >    with FFirebirdClientAPI do
477        EncodeInteger(aValue,2,FBufPtr+1);
478      FDataType := dtShortInteger;
479    end;
# Line 470 | Line 485 | begin
485    begin
486      if FBufLength <> 2 then
487        FOwner.UpdateRequestItemSize(self,2);
488 <    with FirebirdClientAPI do
488 >    with FFirebirdClientAPI do
489        EncodeInteger(aValue,1,FBufPtr+1);
490      FDataType := dtTinyInteger;
491    end;
# Line 505 | Line 520 | begin
520      if len > 65535 then
521        IBError(ibxStringTooLong,[aValue,65535]);
522      FOwner.UpdateRequestItemSize(self,len + 3);
523 <    with FirebirdClientAPI do
523 >    with FFirebirdClientAPI do
524        EncodeInteger(len,2,FBufPtr+1);
525      if len > 0 then
526        Move(aValue[1],(FBufPtr+3)^,len);
# Line 615 | Line 630 | begin
630    end;
631   end;
632  
633 < constructor TParamBlock.Create;
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;
# Line 644 | Line 660 | end;
660  
661   function TParamBlock.getDataLength: integer;
662   begin
663 <  Result :=  FDataLength
663 >  Result :=  FDataLength;
664   end;
665  
666   function TParamBlock.AvailableBufferSpace: integer;
# Line 685 | Line 701 | begin
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);
# Line 714 | Line 735 | end;
735   procedure TParamBlock.PrintBuf;
736   var i: integer;
737   begin
738 <  write(ClassName,': ');
738 >  write(ClassName,': (',getDataLength,') ');
739    for i := 0 to getDataLength - 1 do
740      write(Format('%x ',[byte(FBuffer[i])]));
741    writeln
# Line 722 | Line 743 | 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;
# Line 745 | Line 776 | 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;
# Line 781 | Line 813 | begin
813   end;
814   {$ENDIF}
815  
784 { TDPB }
785
786 constructor TDPB.Create;
787 begin
788  inherited Create;
789  FDataLength := 1;
790  FBuffer^ := isc_dpb_version1;
791 end;
792
793 { TTPB }
794
795 constructor TTPB.Create;
796 begin
797  inherited Create;
798  FDataLength := 1;
799  FBuffer^ := isc_tpb_version3;
800 end;
801
802 { TSPB }
803
804 constructor TSPB.Create;
805 begin
806  inherited Create;
807  FDataLength := 2;
808  FBuffer^ := isc_spb_version;
809  (FBuffer+1)^ := isc_spb_current_version;
810 end;
811
816   { TBPB }
817  
818 < constructor TBPB.Create;
818 > constructor TBPB.Create(api: TFBClientAPI);
819   begin
820 <  inherited Create;
820 >  inherited Create(api);
821    FDataLength := 1;
822    FBuffer^ := isc_bpb_version1;
823   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines