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

Comparing ibx/trunk/fbintf/client/FBParamBlock.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC

# Line 25 | Line 25
25   *
26   *)
27   unit FBParamBlock;
28 + {$IFDEF MSWINDOWS}
29 + {$DEFINE WINDOWS}
30 + {$ENDIF}
31  
32   {$IFDEF FPC}
33 < {$mode objfpc}{$H+}
33 > {$mode delphi}
34   {$interfaces COM}
35   {$ENDIF}
36  
# Line 47 | Line 50 | type
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: PChar;
53 >    FBufPtr: PByte;
54      FBuflength: integer;
55      FDataType: TParamDataType;
56    end;
# Line 64 | Line 67 | type
67      procedure MoveBy(Item: PParamBlockItemData; delta: integer);
68      procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
69    protected
70 <    FBuffer: PChar;
70 >    FBuffer: PByte;
71      FDataLength: integer;
72      function Add(ParamType: byte): PParamBlockItemData;
73      function Find(ParamType: byte): PParamBlockItemData;
# Line 72 | Line 75 | type
75    public
76      constructor Create;
77      destructor Destroy; override;
78 <    function getBuffer: PChar;
78 >    function getBuffer: PByte;
79      function getDataLength: integer;
80      function AvailableBufferSpace: integer;
81  
# Line 96 | Line 99 | type
99    public
100       function getAsInteger: integer;
101       function getParamType: byte;
102 <     function getAsString: string;
102 >     function getAsString: AnsiString;
103       function getAsByte: byte;
104       procedure addByte(aValue: byte);
105       procedure addShortInteger(aValue: integer);
# Line 107 | Line 110 | type
110       procedure SetAsInteger2(aValue: integer);
111       procedure SetAsShortInteger(aValue: integer);
112       procedure SetAsTinyInteger(aValue: integer);
113 <     procedure SetAsString(aValue: string);
114 <     procedure SetAsString2(aValue: string);
115 <     procedure SetAsString0(aValue: string);
113 <  end;
114 <
115 <  { TCustomParamBlock }
116 <
117 <  generic TCustomParamBlock<_TItem; _IItem> = class(TParamBlock)
118 <  public
119 <    function Add(ParamType: byte): _IItem;
120 <    function Find(ParamType: byte): _IItem;
121 <    function GetItems(index: integer): _IItem;
113 >     procedure SetAsString(aValue: AnsiString);
114 >     procedure SetAsString2(aValue: AnsiString);
115 >     procedure SetAsString0(aValue: AnsiString);
116    end;
117  
118    { TDPBItem }
119  
120    TDPBItem = class(TParamBlockItem,IDPBItem);
121  
128  { TDPB }
129
130  TDPB = class (specialize TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
131  public
132    constructor Create;
133  end;
134
122    { TTPBItem }
123  
124    TTPBItem = class(TParamBlockItem,ITPBItem);
125  
139  { TTPB }
140
141  TTPB = class (specialize TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
142  public
143    constructor Create;
144  end;
145
126    { TSPBItem }
127  
128    TSPBItem = class(TParamBlockItem,ISPBItem);
129  
150  { TSPB }
151
152  TSPB = class (specialize TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
153  public
154   constructor Create;
155  end;
156
130    { TSRBItem }
131  
132    TSRBItem = class(TParamBlockItem,ISRBItem)
133    public
134 <    function ISRBItem.SetAsString = SetAsString2;
135 <    function ISRBItem.SetAsByte = SetAsByte2;
134 >    {$IFDEF FPC}
135 >    procedure ISRBItem.SetAsString = SetAsString2;
136 >    procedure ISRBItem.SetAsByte = SetAsByte2;
137 >    {$ELSE}
138 >    procedure SetAsString(aValue: AnsiString) ;
139 >    procedure SetAsByte(aValue: byte);
140 >    {$ENDIF}
141    end;
142  
165  { TSRB }
166
167  TSRB = class (specialize TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
168
143    { TSQPBItem }
144  
145    TSQPBItem = class(TParamBlockItem,ISQPBItem)
146    public
147     function CopyFrom(source: TStream; count: integer): integer;
148 +   {$IFDEF FPC}
149     procedure ISQPBItem.SetAsInteger = SetAsInteger2;
150     procedure ISQPBItem.SetAsString = SetAsString2;
151 +   {$ELSE}
152 +   procedure SetAsString(aValue: AnsiString) ;
153 +   procedure SetAsInteger(aValue: integer);
154 +   {$ENDIF}
155    end;
156  
178  { TSQPB }
179
180  TSQPB = class (specialize TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
181
157    { TBPBItem }
158  
159    TBPBItem =  class(TParamBlockItem,IBPBItem)
160    public
161 +   {$IFDEF FPC}
162      procedure IBPBItem.SetAsInteger = SetAsInteger1;
163 +   {$ELSE}
164 +    procedure SetAsInteger(aValue: integer);
165 +   {$ENDIF}
166 +  end;
167 +
168 +  { TCustomParamBlock }
169 +
170 + {$IFDEF FPC}
171 +  TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
172 + {$ELSE}
173 +  TParamBlockItemClass = class of TParamBlockItem;
174 +  TCustomParamBlock<_TItem: TParamBlockItem;  _IItem: IParameterBlockItem> = class(TParamBlock)
175 + {$ENDIF}
176 +  public
177 +    function Add(ParamType: byte): _IItem;
178 +    function Find(ParamType: byte): _IItem;
179 +    function GetItems(index: integer): _IItem;
180 +  end;
181 +
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 +
203 +  { TSRB }
204 +
205 +  TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
206 +
207 +  { TSQPB }
208 +
209 +  TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
210 +
211    { TBPB }
212  
213 <  TBPB = class (specialize TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
213 >  TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
214    public
215     constructor Create;
216    end;
217  
218   implementation
219  
220 < uses FBMessages;
220 > uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
221  
222   const
223    MaxBufferSize = 65535;
224  
225 < { TCustomParamBlock }
226 <
227 < function TCustomParamBlock.Add(ParamType: byte): _IItem;
206 < var Item: PParamBlockItemData;
225 > { TBPBItem }
226 > {$IFNDEF FPC}
227 > procedure TBPBItem.SetAsInteger(aValue: integer);
228   begin
229 <  Item := inherited Add(ParamType);
209 <  Result := _TItem.Create(self,Item);
229 >  SetAsInteger1(aValue);
230   end;
231 + {$ENDIF}
232  
233 < function TCustomParamBlock.Find(ParamType: byte): _IItem;
234 < var Item: PParamBlockItemData;
233 > { TSRBItem }
234 >
235 > {$IFNDEF FPC}
236 > procedure TSRBItem.SetAsString(aValue: AnsiString);
237   begin
238 <  Result := nil;
216 <  Item := inherited Find(ParamType);
217 <  if Item <> nil then
218 <    Result := _TItem.Create(self,Item);
238 >  SetAsString2(aValue);
239   end;
240  
241 < function TCustomParamBlock.GetItems(index: integer): _IItem;
222 < var Item: PParamBlockItemData;
241 > procedure TSRBItem.SetAsByte(aValue: byte);
242   begin
243 <  Item := inherited getItems(index);
225 <  Result := _TItem.Create(self,Item);
243 >  SetAsByte2(aValue);
244   end;
245 + {$ENDIF}
246  
247   { TSQPBItem }
248  
# Line 237 | Line 256 | begin
256        Result := source.Read((FBufPtr+3)^,count);
257        with FirebirdClientAPI do
258          EncodeInteger(Result,2,FBufPtr+1);
259 <      (FBufPtr+Result + 3)^ := chr(isc_info_end);
259 >      (FBufPtr+Result + 3)^ := isc_info_end;
260        if Result <> count then
261          FOwner.UpdateRequestItemSize(self,Result + 4);
262        FDataType := dtString2;
263      end;
264   end;
265  
266 < { TBPB }
266 > {$IFNDEF FPC}
267 > procedure TSQPBItem.SetAsString(aValue: AnsiString);
268 > begin
269 >  SetAsString2(aValue);
270 > end;
271  
272 < constructor TBPB.Create;
272 > procedure TSQPBItem.SetAsInteger(aValue: integer);
273   begin
274 <  inherited Create;
252 <  FDataLength := 1;
253 <  FBuffer^ := char(isc_bpb_version1);
274 >  SetAsInteger2(aValue);
275   end;
276 + {$ENDIF}
277  
278   { TParamBlockItem }
279  
# Line 288 | Line 310 | begin
310    Result := byte(FParamData^.FBufPtr^);
311   end;
312  
313 < function TParamBlockItem.getAsString: string;
313 > function TParamBlockItem.getAsString: AnsiString;
314   var len: byte;
315   begin
316    Result := '';
# Line 306 | Line 328 | begin
328      Result := IntToStr(getAsByte);
329    dtString:
330      begin
331 <      len := byte((FBufPtr+1)^);
332 <      SetString(Result,FBufPtr+2,len);
331 >      len := (FBufPtr+1)^;
332 >      SetString(Result,PAnsiChar(FBufPtr+2),len);
333      end;
334    dtString2:
335      begin
336        with FirebirdClientAPI do
337          len := DecodeInteger(FBufPtr+1,2);
338 <      SetString(Result,FBufPtr+3,len);
338 >      SetString(Result,PAnsiChar(FBufPtr+3),len);
339      end;
340    dtString0:
341 <      Result := strpas(FBufPtr+1);
341 >      Result := strpas(PAnsiChar(FBufPtr+1));
342      else
343        IBError(ibxeOutputBlockTypeError,[nil]);
344    end;
# Line 336 | Line 358 | end;
358  
359   procedure TParamBlockItem.addByte(aValue: byte);
360   var len: integer;
361 <    P: PChar;
361 >    P: PByte;
362   begin
363    with FParamData^ do
364    begin
365      P := FBufPtr + FBufLength;
366      len := FBufLength + 1;
367      FOwner.UpdateRequestItemSize(self,len);
368 <    P^ := char(aValue)
368 >    P^ := aValue;
369    end;
370   end;
371  
372   procedure TParamBlockItem.addShortInteger(aValue: integer);
373   var len: integer;
374 <    P: PChar;
374 >    P: PByte;
375   begin
376    with FParamData^ do
377    begin
# Line 368 | Line 390 | begin
390      if FBufLength <> 3 then
391        FOwner.UpdateRequestItemSize(self,3);
392      FDataType := dtByte;
393 <    (FBufPtr+1)^ := #1;
394 <    (FBufPtr+2)^ := chr(aValue);
393 >    (FBufPtr+1)^ := $1;
394 >    (FBufPtr+2)^ := aValue;
395    end;
396   end;
397  
# Line 380 | Line 402 | begin
402      if FBufLength <> 2 then
403        FOwner.UpdateRequestItemSize(self,2);
404      FDataType := dtByte2;
405 <    (FBufPtr+1)^ := chr(aValue);
405 >    (FBufPtr+1)^ := aValue;
406    end;
407   end;
408  
# Line 406 | Line 428 | begin
428    begin
429      if FBufLength <> 6 then
430        FOwner.UpdateRequestItemSize(self,6);
431 <    (FBufPtr+1)^ := chr(4);
431 >    (FBufPtr+1)^ := $4;
432      with FirebirdClientAPI do
433        EncodeInteger(aValue,4,FBufPtr+2);
434      FDataType := dtInteger1;
# Line 456 | Line 478 | end;
478  
479   {Short string encoding}
480  
481 < procedure TParamBlockItem.SetAsString(aValue: string);
481 > procedure TParamBlockItem.SetAsString(aValue: AnsiString);
482   var len: integer;
483   begin
484    with FParamData^ do
# Line 465 | Line 487 | begin
487      if len > 255 then
488        IBError(ibxStringTooLong,[aValue,255]);
489      FOwner.UpdateRequestItemSize(self,len+2);
490 <    (FBufPtr+1)^ := char(len);
490 >    (FBufPtr+1)^ := len;
491      if len > 0 then
492        Move(aValue[1],(FBufPtr+2)^,len);
493      FDataType := dtString;
# Line 474 | Line 496 | end;
496  
497   {Long string up to 65535 encoding}
498  
499 < procedure TParamBlockItem.SetAsString2(aValue: string);
499 > procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
500   var len: integer;
501   begin
502    with FParamData^ do
# Line 493 | Line 515 | end;
515  
516   {Zero byte terminated string encoding}
517  
518 < procedure TParamBlockItem.SetAsString0(aValue: string);
518 > procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
519   var len: integer;
520   begin
521    with FParamData^ do
# Line 502 | Line 524 | begin
524      FOwner.UpdateRequestItemSize(self,len+2);
525      if len > 0 then
526        Move(aValue[1],(FBufPtr+1)^,len);
527 <    (FBufPtr+len+1)^ := #0;
527 >    (FBufPtr+len+1)^ := 0;
528      FDataType := dtString0;
529    end;
530   end;
# Line 510 | Line 532 | end;
532   { TParamBlock }
533  
534   procedure TParamBlock.AdjustBuffer;
535 < var P: PChar;
535 > var P: PByte;
536      i: integer;
537      headerLen: integer;
538   begin
# Line 532 | Line 554 | begin
554   end;
555  
556   procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
557 < var src, dest: PChar;
557 > var src, dest: PByte;
558    i: integer;
559   begin
560    with Item^ do
# Line 549 | Line 571 | begin
571        for i := 0 to FBufLength - 1 do
572        (dest +i)^ := (src+i)^;
573      end;
574 <    FBufPtr += delta;
574 >    FBufPtr := FBufPtr + delta;
575    end;
576   end;
577  
# Line 563 | Line 585 | begin
585    begin
586      if FDataLength + delta > MaxBufferSize then
587        IBError(ibxeParamBufferOverflow,[nil]);
588 <    FDataLength += delta;
588 >    FDataLength := FDataLength + delta;
589      AdjustBuffer;
590      i := Length(FItems) - 1;
591      while i >= 0  do
# Line 589 | Line 611 | begin
611        Moveby(FItems[i],delta);
612        Inc(i);
613      end;
614 <    FDataLength += delta;
614 >    FDataLength := FDataLength + delta;
615    end;
616   end;
617  
# Line 612 | Line 634 | begin
634    inherited Destroy;
635   end;
636  
637 < function TParamBlock.getBuffer: PChar;
637 > function TParamBlock.getBuffer: PByte;
638   begin
639    if FDataLength = 0 then
640      Result := nil
# Line 635 | Line 657 | begin
657    new(Result);
658    Result^.FBufPtr := FBuffer + FDataLength;
659    Result^.FBufLength := 1;
660 <  Result^.FBufPtr^ := char(ParamType);
660 >  Result^.FBufPtr^ := ParamType;
661    Result^.FDataType := dtnone; {default}
662    Inc(FDataLength,1);
663    AdjustBuffer;
# Line 648 | Line 670 | var i: integer;
670   begin
671    Result := nil;
672    for i := 0 to getCount - 1 do
673 <    if FItems[i]^.FBufPtr^ = char(ParamType) then
673 >    if byte(FItems[i]^.FBufPtr^) = ParamType then
674      begin
675        Result := FItems[i];
676        Exit;
# Line 674 | Line 696 | var P: PParamBlockItemData;
696   begin
697    P := nil;
698    for i := 0 to getCount - 1 do
699 <    if FItems[i]^.FBufPtr^ = char(ParamType) then
699 >    if byte(FItems[i]^.FBufPtr^) = ParamType then
700      begin
701        P := FItems[i];
702        for j := i + 1 to getCount - 1 do
# Line 682 | Line 704 | begin
704          MoveBy(FItems[j],-P^.FBufLength);
705          FItems[j - 1] := FItems[j];
706        end;
707 <      FDataLength -= P^.FBufLength;
707 >      FDataLength := FDataLength - P^.FBufLength;
708        dispose(P);
709        SetLength(FItems,Length(FItems)-1);
710        Exit;
# Line 698 | Line 720 | begin
720    writeln
721   end;
722  
723 + { TCustomParamBlock }
724 +
725 + {$IFDEF FPC}
726 + function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
727 + var Item: PParamBlockItemData;
728 + begin
729 +  Item := inherited Add(ParamType);
730 +  Result := _TItem.Create(self,Item);
731 + end;
732 +
733 + function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
734 + var Item: PParamBlockItemData;
735 + begin
736 +  Result := nil;
737 +  Item := inherited Find(ParamType);
738 +  if Item <> nil then
739 +    Result := _TItem.Create(self,Item);
740 + end;
741 +
742 + function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
743 + var Item: PParamBlockItemData;
744 + begin
745 +  Item := inherited getItems(index);
746 +  Result := _TItem.Create(self,Item);
747 + end;
748 + {$ELSE}
749 + function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
750 + var Item: PParamBlockItemData;
751 +    Obj: TParamBlockItem;
752 + begin
753 +  Item := inherited Add(ParamType);
754 +  Obj := TParamBlockItemClass(_TItem).Create(self,Item);
755 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
756 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
757 + end;
758 +
759 + function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
760 + var Item: PParamBlockItemData;
761 +    Obj: TParamBlockItem;
762 + begin
763 +  FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
764 +  Item := inherited Find(ParamType);
765 +  if Item <> nil then
766 +  begin
767 +    Obj := TParamBlockItemClass(_TItem).Create(self,Item);
768 +    if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
769 +      IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
770 +  end;
771 + end;
772 +
773 + function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
774 + var Item: PParamBlockItemData;
775 +    Obj: TParamBlockItem;
776 + begin
777 +  Item := inherited getItems(index);
778 +  Obj := TParamBlockItemClass(_TItem).Create(self,Item);
779 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
780 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
781 + end;
782 + {$ENDIF}
783 +
784   { TDPB }
785  
786   constructor TDPB.Create;
787   begin
788    inherited Create;
789    FDataLength := 1;
790 <  FBuffer^ := char(isc_dpb_version1);
790 >  FBuffer^ := isc_dpb_version1;
791   end;
792  
793   { TTPB }
# Line 713 | Line 796 | constructor TTPB.Create;
796   begin
797    inherited Create;
798    FDataLength := 1;
799 <  FBuffer^ := char(isc_tpb_version3);
799 >  FBuffer^ := isc_tpb_version3;
800   end;
801  
802   { TSPB }
# Line 722 | Line 805 | constructor TSPB.Create;
805   begin
806    inherited Create;
807    FDataLength := 2;
808 <  FBuffer^ := char(isc_spb_version);
809 <  (FBuffer+1)^ := char(isc_spb_current_version);
808 >  FBuffer^ := isc_spb_version;
809 >  (FBuffer+1)^ := isc_spb_current_version;
810 > end;
811 >
812 > { TBPB }
813 >
814 > constructor TBPB.Create;
815 > begin
816 >  inherited Create;
817 >  FDataLength := 1;
818 >  FBuffer^ := isc_bpb_version1;
819   end;
820  
821   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines