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

Comparing ibx/trunk/fbintf/client/FBOutputBlock.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 FBOutputBlock;
28 + {$IFDEF MSWINDOWS}
29 + {$DEFINE WINDOWS}
30 + {$ENDIF}
31  
32   {$IFDEF FPC}
33 < {$mode objfpc}{$H+}
33 > {$mode delphi}
34   {$codepage UTF8}
35   {$interfaces COM}
36   {$ENDIF}
# Line 54 | Line 57 | type
57       {Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
58       the rest of the clumplet up to the FSize is data. The data format is
59       given by FDataType, and the data length is given by FDataLength}
60 <    FBufPtr: PChar;
60 >    FBufPtr: PByte;
61      FDataLength: integer;
62      FSize: integer;
63      FDataType: TItemDataType;
# Line 67 | Line 70 | type
70  
71    TOutputBlock = class(TFBInterfacedObject)
72    private
73 <    FBuffer: PChar;
73 >    FBuffer: PByte;
74      FBufSize: integer;
75      FBufferParsed: boolean;
76      procedure ParseBuffer;
77      {$IFDEF DEBUGOUTPUTBLOCK}
78      procedure FormattedPrint(const aItems: array of POutputBlockItemData;
79 <      Indent: string);
79 >      Indent: AnsiString);
80      {$ENDIF}
81      procedure PrintBuf;
82    protected
# Line 82 | Line 85 | type
85      FTruncated: boolean;
86      FItems: array of POutputBlockItemData;
87      procedure DoParseBuffer; virtual; abstract;
88 <    function AddItem(BufPtr: PChar): POutputBlockItemData;
89 <    function AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
90 <    function AddStringItem(BufPtr: PChar): POutputBlockItemData;
91 <    function AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
92 <    function AddByteItem(BufPtr: PChar): POutputBlockItemData;
93 <    function AddBytesItem(BufPtr: PChar): POutputBlockItemData;
94 <    function AddListItem(BufPtr: PChar): POutputBlockItemData; virtual;
95 <    function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; virtual;
88 >    function AddItem(BufPtr: PByte): POutputBlockItemData;
89 >    function AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
90 >    function AddStringItem(BufPtr: PByte): POutputBlockItemData;
91 >    function AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
92 >    function AddByteItem(BufPtr: PByte): POutputBlockItemData;
93 >    function AddBytesItem(BufPtr: PByte): POutputBlockItemData;
94 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; virtual;
95 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; virtual;
96    public
97      constructor Create(aSize: integer = DefaultBufferSize);
98      destructor Destroy; override;
99 <    function Buffer: PChar;
99 >    function Buffer: PByte;
100      function getBufSize: integer;
101  
102    public
# Line 114 | Line 117 | type
117    protected
118      function GetItem(index: integer): POutputBlockItemData;
119      function Find(ItemType: byte): POutputBlockItemData;
120 <    procedure SetString(out S: AnsiString; Buf: PAnsiChar; Len: SizeInt;
120 >    procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
121                                             CodePage: TSystemCodePage);
122      property ItemData: POutputBlockItemData read FItemData;
123      property Owner: TOutputBlock read FOwner;
# Line 127 | Line 130 | type
130      procedure getRawBytes(var Buffer);
131      function getAsInteger: integer;
132      function getParamType: byte;
133 <    function getAsString: string;
133 >    function getAsString: AnsiString;
134      function getAsByte: byte;
135      function getAsBytes: TByteArray;
136      function CopyTo(stream: TStream; count: integer): integer;
137    end;
138  
139 +  TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
140 +
141    { TCustomOutputBlock }
142  
143 <  generic TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
143 > {$IFDEF FPC}
144 >  TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
145 > {$ELSE}
146 >  TOutputBlockItemClass = class of TOutputBlockItem;
147 >  TCustomOutputBlock<_TItem: TOutputBlockItem;_IItem: IUnknown> = class(TOutputBlock)
148 > {$ENDIF}
149    public
150      function getItem(index: integer): _IItem;
151      function find(ItemType: byte): _IItem;
# Line 144 | Line 154 | type
154  
155    { TOutputBlockItemGroup }
156  
157 <  generic TOutputBlockItemGroup<_TItem;_IItem> = class(TOutputBlockItem)
157 > {$IFDEF FPC}
158 >  TOutputBlockItemGroup<_TItem,_IItem> = class(TOutputBlockItem)
159 > {$ELSE}
160 >  TOutputBlockItemGroup<_TItem: TOutputBlockItem; _IItem: IUnknown> = class(TOutputBlockItem)
161 > {$ENDIF}
162    public
163      function GetItem(index: integer): _IItem;
164      function Find(ItemType: byte): _IItem;
165      property Items[index: integer]: _IItem read getItem; default;
166    end;
167  
154  TDBInfoItem = class;
155
168    { TDBInfoItem }
169  
170 <  TDBInfoItem = class(specialize TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
170 > {$IFDEF FPC}
171 >   TDBInfoItem = class;
172 >
173 >   TDBInfoItem = class(TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
174 > {$ELSE}
175 >  TDBInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IDBInfoItem>,IDBInfoItem)
176 > {$ENDIF}
177    public
178 <    procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: string);
179 <    procedure DecodeVersionString(var Version: byte; var VersionString: string);
178 >    procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
179 >    procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
180      procedure DecodeUserNames(UserNames: TStrings);
181      function getOperationCounts: TDBOperationCounts;
182   end;
183  
184    { TDBInformation }
185  
186 <  TDBInformation = class(specialize TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
186 >  TDBInformation = class(TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
187    protected
188 <    function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
188 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
189      procedure DoParseBuffer; override;
190    public
191      constructor Create(aSize: integer=DBInfoDefaultBufferSize);
192    end;
193  
176  TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
177
194    { TServiceQueryResultItem }
195  
196 <  TServiceQueryResultItem = class(specialize TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
196 >  TServiceQueryResultItem = class(TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
197                        IServiceQueryResultItem);
198  
199    { TServiceQueryResults }
200  
201 <  TServiceQueryResults = class(specialize TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
201 >  TServiceQueryResults = class(TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
202    protected
203 <    function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
204 <    function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
203 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
204 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
205      procedure DoParseBuffer; override;
206    end;
207  
208 +
209    { ISQLInfoItem }
210  
211 <  ISQLInfoItem = interface
211 >  ISQLInfoSubItem = interface
212 >    ['{39852ee4-4851-44df-8dc0-26b991250098}']
213      function getItemType: byte;
214      function getSize: integer;
215 <    function getAsString: string;
215 >    function getAsString: AnsiString;
216      function getAsInteger: integer;
217 +  end;
218 +
219 +  ISQLInfoItem = interface(ISQLInfoSubItem)
220 +    ['{34e3c39d-fe4f-4211-a7e3-0266495a359d}']
221      function GetCount: integer;
222 <    function GetItem(index: integer): ISQLInfoItem;
223 <    function Find(ItemType: byte): ISQLInfoItem;
222 >    function GetItem(index: integer): ISQLInfoSubItem;
223 >    function Find(ItemType: byte): ISQLInfoSubItem;
224      property Count: integer read GetCount;
225 <    property Items[index: integer]: ISQLInfoItem read getItem; default;
225 >    property Items[index: integer]: ISQLInfoSubItem read getItem; default;
226    end;
227  
228    {ISQLInfoResults}
229  
230    ISQLInfoResults = interface
231 +    ['{0b3fbe20-6f80-44e7-85ef-e708bc1f2043}']
232      function GetCount: integer;
233      function GetItem(index: integer): ISQLInfoItem;
234      function Find(ItemType: byte): ISQLInfoItem;
# Line 213 | Line 236 | type
236      property Items[index: integer]: ISQLInfoItem read getItem; default;
237    end;
238  
239 <  TSQLInfoResultsItem = class;
239 >  TSQLInfoResultsSubItem = class(TOutputBlockItem,ISQLInfoSubItem);
240  
241    { TSQLInfoResultsItem }
242  
243 <  TSQLInfoResultsItem = class(specialize TOutputBlockItemGroup<TSQLInfoResultsItem,ISQLInfoItem>,ISQLInfoItem);
243 >  TSQLInfoResultsItem = class(TOutputBlockItemGroup<TSQLInfoResultsSubItem,ISQLInfoSubItem>,ISQLInfoItem);
244  
245    { TSQLInfoResultsBuffer }
246  
247 <  TSQLInfoResultsBuffer = class(specialize TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
247 >  TSQLInfoResultsBuffer = class(TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
248    protected
249 <    function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
249 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
250      procedure DoParseBuffer; override;
251    public
252      constructor Create(aSize: integer = 1024);
253    end;
254  
255 +  IBlobInfoItem = interface
256 +     ['{3a55e558-b97f-4cf3-af95-53b84f4d9a65}']
257 +     function getItemType: byte;
258 +     function getSize: integer;
259 +     function getAsString: AnsiString;
260 +     function getAsInteger: integer;
261 +   end;
262 +
263 +  IBlobInfo = interface
264 +    ['{8a340109-f600-4d26-ab1d-e0be2c759f1c}']
265 +    function GetCount: integer;
266 +    function GetItem(index: integer): IBlobInfoItem;
267 +    function Find(ItemType: byte): IBlobInfoItem;
268 +    property Count: integer read GetCount;
269 +    property Items[index: integer]: IBlobInfoItem read getItem; default;
270 +  end;
271 +
272 + {$IFDEF FPC}
273 +  TBlobInfoItem = class;
274 +
275 +  TBlobInfoItem = class(TOutputBlockItemGroup<TBlobInfoItem,IBlobInfoItem>,IBlobInfoItem)
276 + {$ELSE}
277 +  TBlobInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IBlobInfoItem>,IBlobInfoItem)
278 + {$ENDIF}
279 +
280 +  end;
281 +
282 +  { TBlobInfo }
283 +
284 +  TBlobInfo = class(TCustomOutputBlock<TBlobInfoItem,IBlobInfoItem>, IBlobInfo)
285 +  protected
286 +    procedure DoParseBuffer; override;
287 +  public
288 +    constructor Create(aSize: integer=DBInfoDefaultBufferSize);
289 +  end;
290 +
291   implementation
292  
293 < uses FBMessages;
293 > uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
294  
295 + {$IFDEF FPC}
296   { TOutputBlockItemGroup }
297  
298 < function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
298 > function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
299   var P: POutputBlockItemData;
300   begin
301    P := inherited getItem(index);
302    Result := _TItem.Create(self.Owner,P);
303   end;
304  
305 < function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
305 > function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
306   var P: POutputBlockItemData;
307   begin
308    P := inherited Find(ItemType);
# Line 251 | Line 311 | end;
311  
312   { TCustomOutputBlock }
313  
314 < function TCustomOutputBlock.getItem(index: integer): _IItem;
314 > function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
315   var P: POutputBlockItemData;
316   begin
317    P := inherited getItem(index);
318    Result := _TItem.Create(self,P)
319   end;
320  
321 < function TCustomOutputBlock.find(ItemType: byte): _IItem;
321 > function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
322   var P: POutputBlockItemData;
323   begin
324    P := inherited Find(ItemType);
325    Result := _TItem.Create(self,P)
326   end;
327  
328 + {$ELSE}
329 +
330   { TOutputBlockItemGroup }
331  
332 + function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
333 + var P: POutputBlockItemData;
334 +    Obj: TOutputBlockItem;
335 + begin
336 +  P := inherited getItem(index);
337 +  Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
338 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
339 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
340 + end;
341 +
342 + function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
343 + var P: POutputBlockItemData;
344 +    Obj: TOutputBlockItem;
345 + begin
346 +  P := inherited Find(ItemType);
347 +  Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
348 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
349 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
350 + end;
351 +
352 + { TCustomOutputBlock }
353 +
354 + function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
355 + var P: POutputBlockItemData;
356 +    Obj: TOutputBlockItem;
357 + begin
358 +  P := inherited getItem(index);
359 +  Obj := TOutputBlockItemClass(_TItem).Create(self,P);
360 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
361 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
362 + end;
363 +
364 + function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
365 + var P: POutputBlockItemData;
366 +    Obj: TOutputBlockItem;
367 + begin
368 +  P := inherited Find(ItemType);
369 +  Obj := TOutputBlockItemClass(_TItem).Create(self,P);
370 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
371 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
372 + end;
373 +
374 + {$ENDIF}
375 +
376 + { TOutputBlockItem }
377 +
378   function TOutputBlockItem.GetCount: integer;
379   begin
380    Result := Length(FItemData^.FSubItems);
# Line 286 | Line 394 | var i: integer;
394   begin
395    Result := nil;
396    for i := 0 to GetCount - 1 do
397 <    if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
397 >    if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
398      begin
399        Result := FItemData^.FSubItems[i];
400        Exit;
# Line 295 | Line 403 | end;
403  
404   { TOutputBlockItem }
405  
406 < procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
407 <  Len: SizeInt; CodePage: TSystemCodePage);
406 > procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
407 >  Len: integer; CodePage: TSystemCodePage);
408   var rs: RawByteString;
409   begin
410 <  system.SetString(rs,Buf,len);
410 >  system.SetString(rs,PAnsiChar(Buf),len);
411    SetCodePage(rs,CodePage,false);
412    S := rs;
413   end;
# Line 355 | Line 463 | begin
463     Result := byte(FItemData^.FBufPtr^)
464   end;
465  
466 < function TOutputBlockItem.getAsString: string;
466 > function TOutputBlockItem.getAsString: AnsiString;
467   var len: integer;
468   begin
469    Result := '';
# Line 392 | Line 500 | end;
500  
501   function TOutputBlockItem.getAsBytes: TByteArray;
502   var i: integer;
503 <    P: PChar;
503 >    P: PByte;
504   begin
505    with FItemData^ do
506    if FDataType = dtBytes then
# Line 454 | Line 562 | begin
562    FBufferParsed := true;
563   end;
564  
565 < function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
565 > function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
566   begin
567    new(Result);
568    with Result^ do
# Line 467 | Line 575 | begin
575    end;
576   end;
577  
578 < function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
578 > function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
579   begin
580    new(Result);
581    with Result^ do
# Line 489 | Line 597 | begin
597    end;
598   end;
599  
600 < function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
600 > function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
601   begin
602    new(Result);
603    with Result^ do
# Line 503 | Line 611 | begin
611    end;
612   end;
613  
614 < function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
614 > function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
615   begin
616    new(Result);
617    with Result^ do
# Line 516 | Line 624 | begin
624    end;
625   end;
626  
627 < function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
627 > function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
628   begin
629    new(Result);
630    with Result^ do
# Line 529 | Line 637 | begin
637    end;
638   end;
639  
640 < function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
640 > function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
641   begin
642    new(Result);
643    with Result^ do
# Line 543 | Line 651 | begin
651    end;
652   end;
653  
654 < function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
654 > function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
655   begin
656    new(Result);
657    with Result^ do
# Line 556 | Line 664 | begin
664    end;
665   end;
666  
667 < function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
667 > function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
668   begin
669    new(Result);
670    with Result^ do
# Line 594 | Line 702 | begin
702    inherited Destroy;
703   end;
704  
705 < function TOutputBlock.Buffer: PChar;
705 > function TOutputBlock.Buffer: PByte;
706   begin
707    Result := FBuffer;
708   end;
# Line 624 | Line 732 | var i: integer;
732   begin
733    Result := nil;
734    for i := 0 to getCount - 1 do
735 <    if FItems[i]^.FBufPtr^ = char(ItemType) then
735 >    if byte(FItems[i]^.FBufPtr^) = ItemType then
736      begin
737        Result := FItems[i];
738        Exit;
# Line 633 | Line 741 | end;
741  
742   {$IFDEF DEBUGOUTPUTBLOCK}
743   procedure TOutputBlock.FormattedPrint(
744 <  const aItems: array of POutputBlockItemData; Indent: string);
744 >  const aItems: array of POutputBlockItemData; Indent: AnsiString);
745  
746   var i: integer;
747      item: TOutputBlockItem;
# Line 686 | Line 794 | end;
794   { TDBInfoItem }
795  
796   procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
797 <  var DBFileName, DBSiteName: string);
798 < var  P: PChar;
797 >  var DBFileName, DBSiteName: AnsiString);
798 > var  P: PByte;
799   begin
800    with ItemData^ do
801 <  if FBufPtr^ = char(isc_info_db_id) then
801 >  if FBufPtr^ = isc_info_db_id then
802    begin
803      P := FBufPtr + 3;
804      if FDataLength > 0 then
805        ConnectionType := integer(P^);
806      Inc(P);
807      SetString(DBFileName,P+1,byte(P^),CP_ACP);
808 <    P += Length(DBFileName) + 1;
808 >    P := P + Length(DBFileName) + 1;
809      SetString(DBSiteName,P+1,byte(P^),CP_ACP);
810    end
811    else
# Line 705 | Line 813 | begin
813   end;
814  
815   procedure TDBInfoItem.DecodeVersionString(var Version: byte;
816 <  var VersionString: string);
817 < var  P: PChar;
816 >  var VersionString: AnsiString);
817 > var  P: PByte;
818   begin
819    with ItemData^ do
820 <  if FBufPtr^ = char(isc_info_version) then
820 >  if FBufPtr^ = isc_info_version then
821    begin
822     P := FBufPtr+3;
823     VersionString := '';
# Line 722 | Line 830 | begin
830   end;
831  
832   procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
833 < var P: PChar;
834 <    s: string;
833 > var P: PByte;
834 >    s: AnsiString;
835   begin
836    with ItemData^ do
837 <  if FBufPtr^ = char(isc_info_user_names) then
837 >  if FBufPtr^ = isc_info_user_names then
838    begin
839      P := FBufPtr+3;
840      while (P < FBufPtr + FSize) do
841      begin
842        SetString(s,P+1,byte(P^),CP_ACP);
843        UserNames.Add(s);
844 <      P += Length(s) + 1;
844 >      P := P + Length(s) + 1;
845      end;
846    end
847    else
# Line 742 | Line 850 | end;
850  
851   function TDBInfoItem.getOperationCounts: TDBOperationCounts;
852   var tableCounts: integer;
853 <    P: PChar;
853 >    P: PByte;
854      i: integer;
855   begin
856    with ItemData^ do
# Line 768 | Line 876 | end;
876  
877   { TDBInformation }
878  
879 < function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
879 > function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
880   begin
881    Result := inherited AddSpecialItem(BufPtr);
882    with Result^ do
# Line 780 | Line 888 | begin
888   end;
889  
890   procedure TDBInformation.DoParseBuffer;
891 < var P: PChar;
891 > var P: PByte;
892      index: integer;
893   begin
894    P := Buffer;
895    index := 0;
896    SetLength(FItems,0);
897 <  while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
897 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
898    begin
899      SetLength(FItems,index+1);
900      case byte(P^) of
# Line 827 | Line 935 | begin
935      else
936        FItems[index] := AddSpecialItem(P);
937       end;
938 <    P += FItems[index]^.FSize;
938 >    P := P + FItems[index]^.FSize;
939      Inc(index);
940    end;
941   end;
# Line 840 | Line 948 | end;
948  
949   { TServiceQueryResults }
950  
951 < function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
952 < var P: PChar;
951 > function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
952 > var P: PByte;
953      i: integer;
954      group: byte;
955   begin
# Line 857 | Line 965 | begin
965    end;
966    with Result^ do
967    begin
968 <    while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
968 >    while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
969      begin
970        SetLength(FSubItems,i+1);
971        case group of
# Line 920 | Line 1028 | begin
1028          end;
1029  
1030        end;
1031 <      P +=  FSubItems[i]^.FSize;
1031 >      P := P + FSubItems[i]^.FSize;
1032        Inc(i);
1033      end;
1034      FDataLength := 0;
1035      for i := 0 to Length(FSubItems) - 1 do
1036 <      FDataLength += FSubItems[i]^.FSize;
1036 >      FDataLength := FDataLength + FSubItems[i]^.FSize;
1037      if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1038        Exit;
1039  
1040 <    if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1040 >    if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1041        FSize := FDataLength + 2 {include start and end flag}
1042      else
1043        FSize := FDataLength + 1; {start flag only}
1044    end;
1045   end;
1046  
1047 < function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1047 > function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1048    ): POutputBlockItemData;
1049 < var P: PChar;
1049 > var P: PByte;
1050      i: integer;
1051   begin
1052    Result := inherited AddSpecialItem(BufPtr);
# Line 952 | Line 1060 | begin
1060      while P < FBufPtr + FDataLength do
1061      begin
1062        FSubItems[i] := AddIntegerItem(P);
1063 <      P +=  FSubItems[i]^.FSize;
1063 >      P := P + FSubItems[i]^.FSize;
1064        Inc(i);
1065      end;
1066    end;
1067   end;
1068  
1069   procedure TServiceQueryResults.DoParseBuffer;
1070 < var P: PChar;
1070 > var P: PByte;
1071      i: integer;
1072   begin
1073    P := Buffer;
1074    i := 0;
1075 <  while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1075 >  while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1076    begin
1077      SetLength(FItems,i+1);
1078      case integer(P^) of
# Line 1003 | Line 1111 | begin
1111      else
1112         IBError(ibxeOutputParsingError, [integer(P^)]);
1113      end;
1114 <    P += FItems[i]^.FSize;
1114 >    P := P + FItems[i]^.FSize;
1115      Inc(i);
1116    end;
1117   end;
1118  
1119   { TSQLInfoResultsBuffer }
1120  
1121 < function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1122 < var P: PChar;
1121 > function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1122 > var P: PByte;
1123      i: integer;
1124   begin
1125    Result := inherited AddListItem(BufPtr);
# Line 1049 | Line 1157 | begin
1157          else
1158            FSubItems[i] := AddSpecialItem(P);
1159          end;
1160 <        P +=  FSubItems[i]^.FSize;
1160 >        P := P + FSubItems[i]^.FSize;
1161          Inc(i);
1162        end;
1163      end;
# Line 1057 | Line 1165 | begin
1165   end;
1166  
1167   procedure TSQLInfoResultsBuffer.DoParseBuffer;
1168 < var P: PChar;
1168 > var P: PByte;
1169      index: integer;
1170   begin
1171    P := Buffer;
1172    index := 0;
1173    SetLength(FItems,0);
1174 <  while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1174 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1175    begin
1176      SetLength(FItems,index+1);
1177      case byte(P^) of
# Line 1091 | Line 1199 | begin
1199      else
1200        FItems[index] := AddSpecialItem(P);
1201      end;
1202 <    P += FItems[index]^.FSize;
1202 >    P := P + FItems[index]^.FSize;
1203      Inc(index);
1204    end;
1205   end;
# Line 1100 | Line 1208 | constructor TSQLInfoResultsBuffer.Create
1208   begin
1209    inherited Create(aSize);
1210    FIntegerType := dtInteger;
1211 + end;
1212 +
1213 + { TBlobInfo }
1214 +
1215 + procedure TBlobInfo.DoParseBuffer;
1216 + var P: PByte;
1217 +    index: integer;
1218 + begin
1219 +  P := Buffer;
1220 +  index := 0;
1221 +  SetLength(FItems,0);
1222 +  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1223 +  begin
1224 +    SetLength(FItems,index+1);
1225 +    case byte(P^) of
1226 +    isc_info_blob_num_segments,
1227 +    isc_info_blob_max_segment,
1228 +    isc_info_blob_total_length,
1229 +    isc_info_blob_type:
1230 +      FItems[index] := AddIntegerItem(P);
1231 +    else
1232 +      FItems[index] := AddSpecialItem(P);
1233 +    end;
1234 +    P := P + FItems[index]^.FSize;
1235 +    Inc(index);
1236 +  end;
1237 + end;
1238 +
1239 + constructor TBlobInfo.Create(aSize: integer);
1240 + begin
1241 +  inherited Create(aSize);
1242 +  FIntegerType := dtInteger;
1243   end;
1244  
1245   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines