ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/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 61 by tony, Sun Apr 2 11:40:29 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
901 +    isc_info_db_read_only,
902      isc_info_no_reserve,
903      isc_info_allocation,
904      isc_info_ods_minor_version,
# Line 827 | Line 936 | begin
936      else
937        FItems[index] := AddSpecialItem(P);
938       end;
939 <    P += FItems[index]^.FSize;
939 >    P := P + FItems[index]^.FSize;
940      Inc(index);
941    end;
942   end;
# Line 840 | Line 949 | end;
949  
950   { TServiceQueryResults }
951  
952 < function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
953 < var P: PChar;
952 > function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
953 > var P: PByte;
954      i: integer;
955      group: byte;
956   begin
# Line 857 | Line 966 | begin
966    end;
967    with Result^ do
968    begin
969 <    while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
969 >    while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
970      begin
971        SetLength(FSubItems,i+1);
972        case group of
# Line 920 | Line 1029 | begin
1029          end;
1030  
1031        end;
1032 <      P +=  FSubItems[i]^.FSize;
1032 >      P := P + FSubItems[i]^.FSize;
1033        Inc(i);
1034      end;
1035      FDataLength := 0;
1036      for i := 0 to Length(FSubItems) - 1 do
1037 <      FDataLength += FSubItems[i]^.FSize;
1037 >      FDataLength := FDataLength + FSubItems[i]^.FSize;
1038      if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1039        Exit;
1040  
1041 <    if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1041 >    if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1042        FSize := FDataLength + 2 {include start and end flag}
1043      else
1044        FSize := FDataLength + 1; {start flag only}
1045    end;
1046   end;
1047  
1048 < function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1048 > function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1049    ): POutputBlockItemData;
1050 < var P: PChar;
1050 > var P: PByte;
1051      i: integer;
1052   begin
1053    Result := inherited AddSpecialItem(BufPtr);
# Line 952 | Line 1061 | begin
1061      while P < FBufPtr + FDataLength do
1062      begin
1063        FSubItems[i] := AddIntegerItem(P);
1064 <      P +=  FSubItems[i]^.FSize;
1064 >      P := P + FSubItems[i]^.FSize;
1065        Inc(i);
1066      end;
1067    end;
1068   end;
1069  
1070   procedure TServiceQueryResults.DoParseBuffer;
1071 < var P: PChar;
1071 > var P: PByte;
1072      i: integer;
1073   begin
1074    P := Buffer;
1075    i := 0;
1076 <  while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1076 >  while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1077    begin
1078      SetLength(FItems,i+1);
1079      case integer(P^) of
# Line 1003 | Line 1112 | begin
1112      else
1113         IBError(ibxeOutputParsingError, [integer(P^)]);
1114      end;
1115 <    P += FItems[i]^.FSize;
1115 >    P := P + FItems[i]^.FSize;
1116      Inc(i);
1117    end;
1118   end;
1119  
1120   { TSQLInfoResultsBuffer }
1121  
1122 < function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1123 < var P: PChar;
1122 > function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1123 > var P: PByte;
1124      i: integer;
1125   begin
1126    Result := inherited AddListItem(BufPtr);
# Line 1049 | Line 1158 | begin
1158          else
1159            FSubItems[i] := AddSpecialItem(P);
1160          end;
1161 <        P +=  FSubItems[i]^.FSize;
1161 >        P := P + FSubItems[i]^.FSize;
1162          Inc(i);
1163        end;
1164      end;
# Line 1057 | Line 1166 | begin
1166   end;
1167  
1168   procedure TSQLInfoResultsBuffer.DoParseBuffer;
1169 < var P: PChar;
1169 > var P: PByte;
1170      index: integer;
1171   begin
1172    P := Buffer;
1173    index := 0;
1174    SetLength(FItems,0);
1175 <  while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1175 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1176    begin
1177      SetLength(FItems,index+1);
1178      case byte(P^) of
# Line 1091 | Line 1200 | begin
1200      else
1201        FItems[index] := AddSpecialItem(P);
1202      end;
1203 <    P += FItems[index]^.FSize;
1203 >    P := P + FItems[index]^.FSize;
1204      Inc(index);
1205    end;
1206   end;
# Line 1100 | Line 1209 | constructor TSQLInfoResultsBuffer.Create
1209   begin
1210    inherited Create(aSize);
1211    FIntegerType := dtInteger;
1212 + end;
1213 +
1214 + { TBlobInfo }
1215 +
1216 + procedure TBlobInfo.DoParseBuffer;
1217 + var P: PByte;
1218 +    index: integer;
1219 + begin
1220 +  P := Buffer;
1221 +  index := 0;
1222 +  SetLength(FItems,0);
1223 +  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1224 +  begin
1225 +    SetLength(FItems,index+1);
1226 +    case byte(P^) of
1227 +    isc_info_blob_num_segments,
1228 +    isc_info_blob_max_segment,
1229 +    isc_info_blob_total_length,
1230 +    isc_info_blob_type:
1231 +      FItems[index] := AddIntegerItem(P);
1232 +    else
1233 +      FItems[index] := AddSpecialItem(P);
1234 +    end;
1235 +    P := P + FItems[index]^.FSize;
1236 +    Inc(index);
1237 +  end;
1238 + end;
1239 +
1240 + constructor TBlobInfo.Create(aSize: integer);
1241 + begin
1242 +  inherited Create(aSize);
1243 +  FIntegerType := dtInteger;
1244   end;
1245  
1246   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines