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.
ibx/branches/journaling/fbintf/client/FBOutputBlock.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 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 43 | Line 46 | uses
46  
47   const
48    DefaultBufferSize = 32000;
49 <  DBInfoDefaultBufferSize = 512;
49 >  DBInfoDefaultBufferSize = DefaultBufferSize; {allow for database page}
50  
51   type
52 <  TItemDataType = (dtString, dtString2, dtByte, dtBytes, dtInteger, dtIntegerFixed, dtnone,
53 <    dtList,dtSpecial);
52 >  TItemDataType = (dtString, dtString2, dtByte, dtBytes, dtInteger, dtIntegerFixed,
53 >    dtTinyInteger, dtShortIntFixed, dtnone, dtList, dtSpecial, dtDateTime, dtOctetString);
54  
55    POutputBlockItemData = ^TOutputBlockItemData;
56    TOutputBlockItemData = record
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 +    FFirebirdClientAPI: TFBClientAPI;
77      procedure ParseBuffer;
78      {$IFDEF DEBUGOUTPUTBLOCK}
79      procedure FormattedPrint(const aItems: array of POutputBlockItemData;
80 <      Indent: string);
80 >      Indent: AnsiString);
81      {$ENDIF}
78    procedure PrintBuf;
82    protected
83      FIntegerType: TItemDataType;
84      FError: boolean;
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; IntType: TItemDataType): POutputBlockItemData; overload;
90 >    function AddIntegerItem(BufPtr: PByte): POutputBlockItemData; overload;
91 >    function AddStringItem(BufPtr: PByte): POutputBlockItemData;
92 >    function AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
93 >    function AddByteItem(BufPtr: PByte): POutputBlockItemData;
94 >    function AddBytesItem(BufPtr: PByte): POutputBlockItemData;
95 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; virtual;
96 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; virtual;
97 >    function AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
98 >    function AddOctetString(BufPtr: PByte): POutputBlockItemData;
99    public
100 <    constructor Create(aSize: integer = DefaultBufferSize);
100 >    constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
101      destructor Destroy; override;
102 <    function Buffer: PChar;
102 >    function Buffer: PByte;
103      function getBufSize: integer;
104  
105    public
106      function GetCount: integer;
107      function GetItem(index: integer): POutputBlockItemData;
108      function Find(ItemType: byte): POutputBlockItemData;
109 +    procedure PrintBuf;
110      property Count: integer read GetCount;
111      property Items[index: integer]: POutputBlockItemData read getItem; default;
112    end;
# Line 112 | Line 119 | type
119      FOwnerIntf: IUnknown;
120      FItemData: POutputBlockItemData;
121    protected
122 +    FFirebirdClientAPI: TFBClientAPI;
123      function GetItem(index: integer): POutputBlockItemData;
124      function Find(ItemType: byte): POutputBlockItemData;
125 <    procedure SetString(out S: AnsiString; Buf: PAnsiChar; Len: SizeInt;
125 >    procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
126                                             CodePage: TSystemCodePage);
127      property ItemData: POutputBlockItemData read FItemData;
128      property Owner: TOutputBlock read FOwner;
# Line 125 | Line 133 | type
133      function getItemType: byte;
134      function getSize: integer;
135      procedure getRawBytes(var Buffer);
136 <    function getAsInteger: integer;
136 >    function getAsInteger: int64;
137      function getParamType: byte;
138 <    function getAsString: string;
138 >    function getAsString: AnsiString;
139      function getAsByte: byte;
140      function getAsBytes: TByteArray;
141 +    function getAsDateTime: TDateTime;
142      function CopyTo(stream: TStream; count: integer): integer;
143    end;
144  
145 +  TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
146 +
147    { TCustomOutputBlock }
148  
149 <  generic TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
149 > {$IFDEF FPC}
150 >  TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
151 > {$ELSE}
152 >  TOutputBlockItemClass = class of TOutputBlockItem;
153 >  TCustomOutputBlock<_TItem: TOutputBlockItem;_IItem: IUnknown> = class(TOutputBlock)
154 > {$ENDIF}
155    public
156      function getItem(index: integer): _IItem;
157      function find(ItemType: byte): _IItem;
# Line 144 | Line 160 | type
160  
161    { TOutputBlockItemGroup }
162  
163 <  generic TOutputBlockItemGroup<_TItem;_IItem> = class(TOutputBlockItem)
163 > {$IFDEF FPC}
164 >  TOutputBlockItemGroup<_TItem,_IItem> = class(TOutputBlockItem)
165 > {$ELSE}
166 >  TOutputBlockItemGroup<_TItem: TOutputBlockItem; _IItem: IUnknown> = class(TOutputBlockItem)
167 > {$ENDIF}
168    public
169      function GetItem(index: integer): _IItem;
170      function Find(ItemType: byte): _IItem;
171      property Items[index: integer]: _IItem read getItem; default;
172    end;
173  
154  TDBInfoItem = class;
155
174    { TDBInfoItem }
175  
176 <  TDBInfoItem = class(specialize TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
176 > {$IFDEF FPC}
177 >   TDBInfoItem = class;
178 >
179 >   TDBInfoItem = class(TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
180 > {$ELSE}
181 >  TDBInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IDBInfoItem>,IDBInfoItem)
182 > {$ENDIF}
183    public
184 <    procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: string);
185 <    procedure DecodeVersionString(var Version: byte; var VersionString: string);
184 >    procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
185 >    procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
186      procedure DecodeUserNames(UserNames: TStrings);
187      function getOperationCounts: TDBOperationCounts;
188 < end;
188 >  end;
189  
190    { TDBInformation }
191  
192 <  TDBInformation = class(specialize TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
192 >  TDBInformation = class(TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
193    protected
194 <    function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
194 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
195      procedure DoParseBuffer; override;
196    public
197 <    constructor Create(aSize: integer=DBInfoDefaultBufferSize);
197 >    constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
198 >  {$IFNDEF FPC}
199 >    function Find(ItemType: byte): IDBInfoItem;
200 >  {$ENDIF}
201    end;
202  
176  TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
177
203    { TServiceQueryResultItem }
204  
205 <  TServiceQueryResultItem = class(specialize TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
205 >  TServiceQueryResultItem = class(TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
206                        IServiceQueryResultItem);
207  
208    { TServiceQueryResults }
209  
210 <  TServiceQueryResults = class(specialize TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
210 >  TServiceQueryResults = class(TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
211    protected
212 <    function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
213 <    function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
212 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
213 >    function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
214      procedure DoParseBuffer; override;
215 +  {$IFNDEF FPC}
216 +  public
217 +    function Find(ItemType: byte): IServiceQueryResultItem;
218 +  {$ENDIF}
219    end;
220  
221 +
222    { ISQLInfoItem }
223  
224 <  ISQLInfoItem = interface
224 >  ISQLInfoSubItem = interface
225 >    ['{39852ee4-4851-44df-8dc0-26b991250098}']
226      function getItemType: byte;
227      function getSize: integer;
228 <    function getAsString: string;
229 <    function getAsInteger: integer;
228 >    function getAsString: AnsiString;
229 >    function getAsInteger: int64;
230 >  end;
231 >
232 >  ISQLInfoItem = interface(ISQLInfoSubItem)
233 >    ['{34e3c39d-fe4f-4211-a7e3-0266495a359d}']
234      function GetCount: integer;
235 <    function GetItem(index: integer): ISQLInfoItem;
236 <    function Find(ItemType: byte): ISQLInfoItem;
235 >    function GetItem(index: integer): ISQLInfoSubItem;
236 >    function Find(ItemType: byte): ISQLInfoSubItem;
237      property Count: integer read GetCount;
238 <    property Items[index: integer]: ISQLInfoItem read getItem; default;
238 >    property Items[index: integer]: ISQLInfoSubItem read getItem; default;
239    end;
240  
241    {ISQLInfoResults}
242  
243    ISQLInfoResults = interface
244 +    ['{0b3fbe20-6f80-44e7-85ef-e708bc1f2043}']
245      function GetCount: integer;
246      function GetItem(index: integer): ISQLInfoItem;
247      function Find(ItemType: byte): ISQLInfoItem;
# Line 213 | Line 249 | type
249      property Items[index: integer]: ISQLInfoItem read getItem; default;
250    end;
251  
252 <  TSQLInfoResultsItem = class;
252 >  TSQLInfoResultsSubItem = class(TOutputBlockItem,ISQLInfoSubItem);
253  
254    { TSQLInfoResultsItem }
255  
256 <  TSQLInfoResultsItem = class(specialize TOutputBlockItemGroup<TSQLInfoResultsItem,ISQLInfoItem>,ISQLInfoItem);
256 >  TSQLInfoResultsItem = class(TOutputBlockItemGroup<TSQLInfoResultsSubItem,ISQLInfoSubItem>,ISQLInfoItem);
257  
258    { TSQLInfoResultsBuffer }
259  
260 <  TSQLInfoResultsBuffer = class(specialize TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
260 >  TSQLInfoResultsBuffer = class(TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
261 >  protected
262 >    function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
263 >    procedure DoParseBuffer; override;
264 >  public
265 >    constructor Create(api: TFBClientAPI; aSize: integer= DefaultBufferSize);
266 >  end;
267 >
268 >  IBlobInfoItem = interface
269 >     ['{3a55e558-b97f-4cf3-af95-53b84f4d9a65}']
270 >     function getItemType: byte;
271 >     function getSize: integer;
272 >     function getAsString: AnsiString;
273 >     function getAsInteger: int64;
274 >   end;
275 >
276 >  IBlobInfo = interface
277 >    ['{8a340109-f600-4d26-ab1d-e0be2c759f1c}']
278 >    function GetCount: integer;
279 >    function GetItem(index: integer): IBlobInfoItem;
280 >    function Find(ItemType: byte): IBlobInfoItem;
281 >    property Count: integer read GetCount;
282 >    property Items[index: integer]: IBlobInfoItem read getItem; default;
283 >  end;
284 >
285 > {$IFDEF FPC}
286 >  TBlobInfoItem = class;
287 >
288 >  TBlobInfoItem = class(TOutputBlockItemGroup<TBlobInfoItem,IBlobInfoItem>,IBlobInfoItem)
289 > {$ELSE}
290 >  TBlobInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IBlobInfoItem>,IBlobInfoItem)
291 > {$ENDIF}
292 >
293 >  end;
294 >
295 >  { TBlobInfo }
296 >
297 >  TBlobInfo = class(TCustomOutputBlock<TBlobInfoItem,IBlobInfoItem>, IBlobInfo)
298    protected
226    function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
299      procedure DoParseBuffer; override;
300    public
301 <    constructor Create(aSize: integer = 1024);
301 >    constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
302    end;
303  
304   implementation
305  
306 < uses FBMessages;
306 > uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
307  
308 + function BufToStr(P: PByte; Len: integer):AnsiString;
309 + begin
310 +  SetLength(Result,Len);
311 +  Move(P^,Result[1],Len);
312 + end;
313 +
314 + {$IFDEF FPC}
315   { TOutputBlockItemGroup }
316  
317 < function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
317 > function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
318   var P: POutputBlockItemData;
319   begin
320    P := inherited getItem(index);
321    Result := _TItem.Create(self.Owner,P);
322   end;
323  
324 < function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
324 > function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
325   var P: POutputBlockItemData;
326   begin
327    P := inherited Find(ItemType);
# Line 251 | Line 330 | end;
330  
331   { TCustomOutputBlock }
332  
333 < function TCustomOutputBlock.getItem(index: integer): _IItem;
333 > function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
334   var P: POutputBlockItemData;
335   begin
336    P := inherited getItem(index);
337    Result := _TItem.Create(self,P)
338   end;
339  
340 < function TCustomOutputBlock.find(ItemType: byte): _IItem;
340 > function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
341   var P: POutputBlockItemData;
342   begin
343    P := inherited Find(ItemType);
344 <  Result := _TItem.Create(self,P)
344 >  if P = nil then
345 >    Result := nil
346 >  else
347 >    Result := _TItem.Create(self,P)
348   end;
349  
350 + {$ELSE}
351 +
352   { TOutputBlockItemGroup }
353  
354 + function TOutputBlockItemGroup<_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.Owner,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 TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
365 + var P: POutputBlockItemData;
366 +    Obj: TOutputBlockItem;
367 + begin
368 +  P := inherited Find(ItemType);
369 +  if P = nil then
370 +    Result := Default(_IITEM)
371 +  else
372 +  begin
373 +    Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
374 +    if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
375 +      IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
376 +  end;
377 + end;
378 +
379 + { TCustomOutputBlock }
380 +
381 + function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
382 + var P: POutputBlockItemData;
383 +    Obj: TOutputBlockItem;
384 + begin
385 +  P := inherited getItem(index);
386 +  Obj := TOutputBlockItemClass(_TItem).Create(self,P);
387 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
388 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
389 + end;
390 +
391 + function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
392 + var P: POutputBlockItemData;
393 +    Obj: TOutputBlockItem;
394 + begin
395 +  P := inherited Find(ItemType);
396 +  Obj := TOutputBlockItemClass(_TItem).Create(self,P);
397 +  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
398 +    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
399 + end;
400 +
401 + {$ENDIF}
402 +
403 + { TOutputBlockItem }
404 +
405   function TOutputBlockItem.GetCount: integer;
406   begin
407    Result := Length(FItemData^.FSubItems);
# Line 277 | Line 412 | begin
412    if (index >= 0) and (index < Length(FItemData^.FSubItems)) then
413      Result := FItemData^.FSubItems[index]
414    else
415 <  with FirebirdClientAPI do
415 >  with FFirebirdClientAPI do
416      IBError(ibxeOutputBlockIndexError,[index]);
417   end;
418  
# Line 286 | Line 421 | var i: integer;
421   begin
422    Result := nil;
423    for i := 0 to GetCount - 1 do
424 <    if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
424 >    if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
425      begin
426        Result := FItemData^.FSubItems[i];
427        Exit;
# Line 295 | Line 430 | end;
430  
431   { TOutputBlockItem }
432  
433 < procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
434 <  Len: SizeInt; CodePage: TSystemCodePage);
433 > procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
434 >  Len: integer; CodePage: TSystemCodePage);
435   var rs: RawByteString;
436 +    i: integer;
437   begin
438 <  system.SetString(rs,Buf,len);
438 >  {There seems to be a memory manager problem with SetString that can cause
439 >   an unhandled exception at the end of a program if it is used to set the
440 >   string. Safer to copy characters one by one. Note that Setlength does
441 >   not work around the bug either.}
442 >  rs := '';
443 >  for i := 0 to len-1 do
444 >    rs := rs + PAnsiChar(buf+i)^;
445 > //  system.SetString(rs,PAnsiChar(Buf),len);
446    SetCodePage(rs,CodePage,false);
447    S := rs;
448   end;
# Line 310 | Line 453 | begin
453    inherited Create;
454    FOwner := AOwner;
455    FOwnerIntf := AOwner;
456 +  FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
457    FItemData := Data;
458   end;
459  
# Line 320 | Line 464 | end;
464  
465   function TOutputBlockItem.getSize: integer;
466   begin
467 <  Result := FItemData^.FDataLength;
467 >  if FItemData = nil then
468 >    Result := 0
469 >  else
470 >    Result := FItemData^.FDataLength;
471   end;
472  
473   procedure TOutputBlockItem.getRawBytes(var Buffer);
# Line 329 | Line 476 | begin
476      Move(FBufPtr^,Buffer,FDatalength);
477   end;
478  
479 < function TOutputBlockItem.getAsInteger: integer;
479 > function TOutputBlockItem.getAsInteger: int64;
480   var len: integer;
481   begin
482    with FItemData^ do
483    case FDataType of
484    dtIntegerFixed:
485 <    with FirebirdClientAPI do
485 >    with FFirebirdClientAPI do
486        Result := DecodeInteger(FBufPtr+1,4);
487  
488 +  dtShortIntFixed:
489 +    with FFirebirdClientAPI do
490 +      Result := DecodeInteger(FBufPtr+1,2);
491 +
492 +  dtTinyInteger:
493 +    with FFirebirdClientAPI do
494 +    begin
495 +      len := DecodeInteger(FBufPtr+1,1);
496 +      Result := DecodeInteger(FBufPtr+2,len);
497 +    end;
498 +
499    dtByte,
500    dtInteger:
501 <    with FirebirdClientAPI do
501 >    with FFirebirdClientAPI do
502      begin
503        len := DecodeInteger(FBufPtr+1,2);
504        Result := DecodeInteger(FBufPtr+3,len);
# Line 355 | Line 513 | begin
513     Result := byte(FItemData^.FBufPtr^)
514   end;
515  
516 < function TOutputBlockItem.getAsString: string;
516 > function TOutputBlockItem.getAsString: AnsiString;
517   var len: integer;
518   begin
519    Result := '';
520    with FItemData^ do
521    case FDataType of
522 +  dtIntegerFixed,
523    dtInteger:
524      Result := IntToStr(getAsInteger);
525    dtByte:
# Line 372 | Line 531 | begin
531      end;
532    dtString2:
533      begin
534 <      with FirebirdClientAPI do
534 >      with FFirebirdClientAPI do
535          len := DecodeInteger(FBufPtr+1,2);
536        SetString(Result,FBufPtr+3,len,CP_ACP);
537      end;
538 +  dtOctetString:
539 +    begin
540 +      with FFirebirdClientAPI do
541 +        len := DecodeInteger(FBufPtr+1,2);
542 +      SetString(Result,FBufPtr+3,len,CP_NONE);
543 +    end;
544    else
545      IBError(ibxeOutputBlockTypeError,[nil]);
546    end;
# Line 392 | Line 557 | end;
557  
558   function TOutputBlockItem.getAsBytes: TByteArray;
559   var i: integer;
560 <    P: PChar;
560 >    P: PByte;
561   begin
562    with FItemData^ do
563    if FDataType = dtBytes then
# Line 409 | Line 574 | begin
574      IBError(ibxeOutputBlockTypeError,[nil]);
575   end;
576  
577 + function TOutputBlockItem.getAsDateTime: TDateTime;
578 + var aDate: integer;
579 +    aTime: integer;
580 + begin
581 +  with FItemData^, FFirebirdClientAPI do
582 +  if FDataType = dtDateTime then
583 +  begin
584 +    aDate := DecodeInteger(FBufPtr+3,4);
585 +    aTime := DecodeInteger(FBufPtr+7,4);
586 +    Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
587 +  end
588 +  else
589 +    IBError(ibxeOutputBlockTypeError,[nil]);
590 + end;
591 +
592 +
593   function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
594   var len: integer;
595   begin
# Line 424 | Line 605 | begin
605        end;
606      dtString2:
607        begin
608 <        with FirebirdClientAPI do
608 >        with FFirebirdClientAPI do
609            len := DecodeInteger(FBufPtr+1,2);
610          if (count > 0) and (count < len) then len := count;
611          Result := stream.Write((FBufPtr+3)^,len);
# Line 454 | Line 635 | begin
635    FBufferParsed := true;
636   end;
637  
638 < function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
638 > function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
639   begin
640    new(Result);
641    with Result^ do
# Line 467 | Line 648 | begin
648    end;
649   end;
650  
651 < function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
651 > function TOutputBlock.AddIntegerItem(BufPtr: PByte; IntType: TItemDataType
652 >  ): POutputBlockItemData;
653   begin
654    new(Result);
655    with Result^ do
656    begin
657 <    FDataType := FIntegerType;
657 >    FDataType := IntType;
658      FBufPtr := BufPtr;
659 <    if FDataType = dtIntegerFixed then
660 <    begin
661 <      FDataLength := 4;
662 <      FSize := 5;
663 <    end
664 <    else
665 <    begin
666 <      with FirebirdClientAPI do
667 <        FDataLength := DecodeInteger(FBufPtr+1, 2);
668 <      FSize := FDataLength + 3;
659 >    case FDataType of
660 >      dtIntegerFixed:
661 >      begin
662 >        FDataLength := 4;
663 >        FSize := 5;
664 >      end;
665 >
666 >      dtShortIntFixed:
667 >      begin
668 >        FDataLength := 2;
669 >        FSize := 3;
670 >      end;
671 >
672 >      dtTinyInteger:
673 >      begin
674 >        with FFirebirdClientAPI do
675 >          FDataLength := DecodeInteger(FBufPtr+1, 1);
676 >        FSize := FDataLength + 2;
677 >      end;
678 >
679 >      else
680 >      begin
681 >        with FFirebirdClientAPI do
682 >          FDataLength := DecodeInteger(FBufPtr+1, 2);
683 >        FSize := FDataLength + 3;
684 >      end;
685      end;
686      SetLength(FSubItems,0);
687    end;
688   end;
689  
690 < function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
690 > function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
691 > begin
692 >  Result := AddIntegerItem(BufPtr,FIntegerType);
693 > end;
694 >
695 > function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
696   begin
697    new(Result);
698    with Result^ do
699    begin
700      FDataType := dtString2;
701      FBufPtr := BufPtr;
702 <    with FirebirdClientAPI do
702 >    with FFirebirdClientAPI do
703        FDataLength := DecodeInteger(FBufPtr+1, 2);
704      FSize := FDataLength + 3;
705      SetLength(FSubItems,0);
706    end;
707   end;
708  
709 < function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
709 > function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
710   begin
711    new(Result);
712    with Result^ do
# Line 516 | Line 719 | begin
719    end;
720   end;
721  
722 < function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
722 > function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
723   begin
724    new(Result);
725    with Result^ do
# Line 529 | Line 732 | begin
732    end;
733   end;
734  
735 < function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
735 > function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
736   begin
737    new(Result);
738    with Result^ do
739    begin
740      FDataType := dtBytes;
741      FBufPtr := BufPtr;
742 <    with FirebirdClientAPI do
742 >    with FFirebirdClientAPI do
743        FDataLength := DecodeInteger(FBufPtr+1, 2);
744      FSize := FDataLength + 3;
745      SetLength(FSubItems,0);
746    end;
747   end;
748  
749 < function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
749 > function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
750   begin
751    new(Result);
752    with Result^ do
# Line 556 | Line 759 | begin
759    end;
760   end;
761  
762 < function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
762 > function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
763   begin
764    new(Result);
765    with Result^ do
# Line 569 | Line 772 | begin
772    end;
773   end;
774  
775 < constructor TOutputBlock.Create(aSize: integer);
775 > function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
776 > begin
777 >  new(Result);
778 >  with Result^ do
779 >  begin
780 >    FDataType := dtDateTime;
781 >    FBufPtr := BufPtr;
782 >    with FFirebirdClientAPI do
783 >      FDataLength := DecodeInteger(FBufPtr+1, 2);
784 >    FSize := FDataLength + 3;
785 >    SetLength(FSubItems,0);
786 >  end;
787 > end;
788 >
789 > function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
790 > begin
791 >  new(Result);
792 >  with Result^ do
793 >  begin
794 >    FDataType := dtOctetString;
795 >    FBufPtr := BufPtr;
796 >    with FFirebirdClientAPI do
797 >      FDataLength := DecodeInteger(FBufPtr+1, 2);
798 >    FSize := FDataLength + 3;
799 >    SetLength(FSubItems,0);
800 >  end;
801 > end;
802 >
803 > constructor TOutputBlock.Create(api: TFBClientAPI; aSize: integer);
804   begin
805    inherited Create;
806 +  FFirebirdClientAPI := api;
807    FBufSize := aSize;
808    GetMem(FBuffer,aSize);
809    if FBuffer = nil then
# Line 586 | Line 818 | var i, j: integer;
818   begin
819    for i := 0 to length(FItems) - 1 do
820    begin
821 <    for j := 0 to Length(FItems[i]^.FSubItems) -1 do
822 <      dispose(FItems[i]^.FSubItems[j]);
823 <    dispose(FItems[i]);
821 >    if FItems[i] <> nil then
822 >    begin
823 >      for j := 0 to Length(FItems[i]^.FSubItems) -1 do
824 >        if FItems[i]^.FSubItems[j] <> nil then
825 >          dispose(FItems[i]^.FSubItems[j]);
826 >      dispose(FItems[i]);
827 >    end;
828    end;
829    FreeMem(FBuffer);
830    inherited Destroy;
831   end;
832  
833 < function TOutputBlock.Buffer: PChar;
833 > function TOutputBlock.Buffer: PByte;
834   begin
835    Result := FBuffer;
836   end;
# Line 624 | Line 860 | var i: integer;
860   begin
861    Result := nil;
862    for i := 0 to getCount - 1 do
863 <    if FItems[i]^.FBufPtr^ = char(ItemType) then
863 >    if byte(FItems[i]^.FBufPtr^) = ItemType then
864      begin
865        Result := FItems[i];
866        Exit;
# Line 633 | Line 869 | end;
869  
870   {$IFDEF DEBUGOUTPUTBLOCK}
871   procedure TOutputBlock.FormattedPrint(
872 <  const aItems: array of POutputBlockItemData; Indent: string);
872 >  const aItems: array of POutputBlockItemData; Indent: AnsiString);
873  
874   var i: integer;
875      item: TOutputBlockItem;
# Line 664 | Line 900 | begin
900      else
901        begin
902          item := TOutputBlockItem.Create(self,(aItems[i]));
903 <        writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
903 >        try
904 >          writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
905 >        except
906 >          writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
907 >        end;
908        end;
909      end;
910    end;
# Line 677 | Line 917 | begin
917    write(classname,': ');
918    for i := 0 to getBufSize - 1 do
919    begin
920 +    if byte(FBuffer[i]) = $FF then break;
921      write(Format('%x ',[byte(Buffer[i])]));
922 <    if byte(FBuffer[i]) = isc_info_end then break;
922 > //    if byte(FBuffer[i]) = isc_info_end then break;
923 >  end;
924 >  writeln;
925 >  for i := 0 to getBufSize - 1 do
926 >  begin
927 >    if byte(FBuffer[i]) = $FF then break;
928 >    if chr(FBuffer[i]) in [' '..'~'] then
929 >      write(chr(Buffer[i]))
930 >    else
931 >      write('.');
932 > //    if byte(FBuffer[i]) = isc_info_end then break;
933    end;
934    writeln;
935   end;
# Line 686 | Line 937 | end;
937   { TDBInfoItem }
938  
939   procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
940 <  var DBFileName, DBSiteName: string);
941 < var  P: PChar;
940 >  var DBFileName, DBSiteName: AnsiString);
941 > var  P: PByte;
942   begin
943    with ItemData^ do
944 <  if FBufPtr^ = char(isc_info_db_id) then
944 >  if FBufPtr^ = isc_info_db_id then
945    begin
946      P := FBufPtr + 3;
947      if FDataLength > 0 then
948        ConnectionType := integer(P^);
949      Inc(P);
950      SetString(DBFileName,P+1,byte(P^),CP_ACP);
951 <    P += Length(DBFileName) + 1;
951 >    P := P + Length(DBFileName) + 1;
952      SetString(DBSiteName,P+1,byte(P^),CP_ACP);
953    end
954    else
# Line 705 | Line 956 | begin
956   end;
957  
958   procedure TDBInfoItem.DecodeVersionString(var Version: byte;
959 <  var VersionString: string);
960 < var  P: PChar;
959 >  var VersionString: AnsiString);
960 > var  P: PByte;
961   begin
962    with ItemData^ do
963 <  if FBufPtr^ = char(isc_info_version) then
963 >  if FBufPtr^ = isc_info_version then
964    begin
965     P := FBufPtr+3;
966     VersionString := '';
# Line 722 | Line 973 | begin
973   end;
974  
975   procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
976 < var P: PChar;
977 <    s: string;
976 > var P: PByte;
977 >    s: AnsiString;
978   begin
979    with ItemData^ do
980 <  if FBufPtr^ = char(isc_info_user_names) then
980 >  if FBufPtr^ = isc_info_user_names then
981    begin
982      P := FBufPtr+3;
983      while (P < FBufPtr + FSize) do
984      begin
985        SetString(s,P+1,byte(P^),CP_ACP);
986        UserNames.Add(s);
987 <      P += Length(s) + 1;
987 >      P := P + Length(s) + 1;
988      end;
989    end
990    else
# Line 742 | Line 993 | end;
993  
994   function TDBInfoItem.getOperationCounts: TDBOperationCounts;
995   var tableCounts: integer;
996 <    P: PChar;
996 >    P: PByte;
997      i: integer;
998   begin
999    with ItemData^ do
# Line 754 | Line 1005 | begin
1005      SetLength(Result,TableCounts);
1006      P := FBufPtr + 3;
1007      for i := 0 to TableCounts -1 do
1008 <    with FirebirdClientAPI do
1008 >    with FFirebirdClientAPI do
1009      begin
1010        Result[i].TableID := DecodeInteger(P,2);
1011        Inc(P,2);
# Line 768 | Line 1019 | end;
1019  
1020   { TDBInformation }
1021  
1022 < function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
1022 > function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
1023   begin
1024    Result := inherited AddSpecialItem(BufPtr);
1025    with Result^ do
1026    begin
1027 <    with FirebirdClientAPI do
1027 >    with FFirebirdClientAPI do
1028        FDataLength := DecodeInteger(FBufPtr+1,2);
1029      FSize := FDataLength + 3;
1030    end;
1031   end;
1032  
1033   procedure TDBInformation.DoParseBuffer;
1034 < var P: PChar;
1034 > var P: PByte;
1035      index: integer;
1036   begin
1037    P := Buffer;
1038    index := 0;
1039    SetLength(FItems,0);
1040 <  while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1040 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1041    begin
1042      SetLength(FItems,index+1);
1043      case byte(P^) of
1044 +    isc_info_db_read_only,
1045      isc_info_no_reserve,
1046      isc_info_allocation,
1047      isc_info_ods_minor_version,
# Line 804 | Line 1056 | begin
1056      isc_info_fetches,
1057      isc_info_marks,
1058      isc_info_reads,
1059 <    isc_info_writes:
1059 >    isc_info_writes,
1060 >    isc_info_active_tran_count,
1061 >    fb_info_pages_used,
1062 >    fb_info_pages_free,
1063 >    fb_info_conn_flags:
1064        FItems[index] := AddIntegerItem(P);
1065  
1066      isc_info_implementation,
1067      isc_info_base_level:
1068        FItems[index] := AddBytesItem(P);
1069  
1070 +    isc_info_creation_date:
1071 +      FItems[index] := AddDateTimeItem(P);
1072 +
1073 +    fb_info_page_contents:
1074 +      FItems[index] := AddOctetString(P);
1075 +
1076 +    fb_info_crypt_key:
1077 +      FItems[index] := AddStringItem(P);
1078 +
1079      isc_info_db_id,
1080      isc_info_version,
1081      isc_info_backout_count,
# Line 827 | Line 1092 | begin
1092      else
1093        FItems[index] := AddSpecialItem(P);
1094       end;
1095 <    P += FItems[index]^.FSize;
1095 >    P := P + FItems[index]^.FSize;
1096      Inc(index);
1097    end;
1098   end;
1099  
1100 < constructor TDBInformation.Create(aSize: integer);
1100 > {$IFNDEF FPC}
1101 > function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1102   begin
1103 <  inherited Create(aSize);
1103 >  Result := inherited Find(ItemType);
1104 >  if Result.GetSize = 0 then
1105 >    Result := nil;
1106 > end;
1107 > {$ENDIF}
1108 >
1109 > constructor TDBInformation.Create(api: TFBClientAPI; aSize: integer);
1110 > begin
1111 >  inherited Create(api,aSize);
1112    FIntegerType := dtInteger;
1113   end;
1114  
1115   { TServiceQueryResults }
1116  
1117 < function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
1118 < var P: PChar;
1117 > function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
1118 > var P: PByte;
1119      i: integer;
1120      group: byte;
1121   begin
# Line 851 | Line 1125 | begin
1125    group := byte(BufPtr^);
1126    if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1127    begin
1128 <    with FirebirdClientAPI do
1128 >    with FFirebirdClientAPI do
1129         Result^.FSize := DecodeInteger(P,2) + 3;
1130      Inc(P,2);
1131    end;
1132    with Result^ do
1133    begin
1134 <    while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
1134 >    while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1135      begin
1136        SetLength(FSubItems,i+1);
1137 +      FSubItems[i] := nil;
1138        case group of
1139        isc_info_svc_svr_db_info:
1140          case integer(P^) of
# Line 871 | Line 1146 | begin
1146              FSubItems[i] := AddStringItem(P);
1147  
1148            else
1149 <            IBError(ibxeOutputParsingError, [integer(P^)]);
1149 >            IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1150            end;
1151  
1152        isc_info_svc_get_license:
# Line 880 | Line 1155 | begin
1155          isc_spb_lic_key:
1156            FSubItems[i] := AddIntegerItem(P);
1157          else
1158 <          IBError(ibxeOutputParsingError, [integer(P^)]);
1158 >          IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1159          end;
1160  
1161        isc_info_svc_limbo_trans:
# Line 899 | Line 1174 | begin
1174         isc_spb_tra_state:
1175           FSubItems[i] := AddByteItem(P);
1176         else
1177 <         IBError(ibxeOutputParsingError, [integer(P^)]);
1177 >         IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1178         end;
1179  
1180        isc_info_svc_get_users:
1181          case integer(P^) of
1182 +        isc_spb_sec_admin,
1183          isc_spb_sec_userid,
1184          isc_spb_sec_groupid:
1185            FSubItems[i] := AddIntegerItem(P);
# Line 916 | Line 1192 | begin
1192            FSubItems[i] := AddStringItem(P);
1193  
1194          else
1195 <          IBError(ibxeOutputParsingError, [integer(P^)]);
1195 >          IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1196          end;
1197  
1198        end;
1199 <      P +=  FSubItems[i]^.FSize;
1199 >      P := P + FSubItems[i]^.FSize;
1200        Inc(i);
1201      end;
1202      FDataLength := 0;
1203      for i := 0 to Length(FSubItems) - 1 do
1204 <      FDataLength += FSubItems[i]^.FSize;
1204 >      FDataLength := FDataLength + FSubItems[i]^.FSize;
1205      if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1206        Exit;
1207  
1208 <    if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1208 >    if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1209        FSize := FDataLength + 2 {include start and end flag}
1210      else
1211        FSize := FDataLength + 1; {start flag only}
1212    end;
1213   end;
1214  
1215 < function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1215 > function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1216    ): POutputBlockItemData;
1217 < var P: PChar;
1217 > var P: PByte;
1218      i: integer;
1219   begin
1220    Result := inherited AddSpecialItem(BufPtr);
1221    with Result^ do
1222    begin
1223 <    with FirebirdClientAPI do
1223 >    with FFirebirdClientAPI do
1224        FDataLength := DecodeInteger(FBufPtr+1, 2);
1225  
1226      P := FBufPtr + 3; {skip length bytes}
# Line 952 | Line 1228 | begin
1228      while P < FBufPtr + FDataLength do
1229      begin
1230        FSubItems[i] := AddIntegerItem(P);
1231 <      P +=  FSubItems[i]^.FSize;
1231 >      P := P + FSubItems[i]^.FSize;
1232        Inc(i);
1233      end;
1234    end;
1235   end;
1236  
1237   procedure TServiceQueryResults.DoParseBuffer;
1238 < var P: PChar;
1238 > var P: PByte;
1239      i: integer;
1240   begin
1241    P := Buffer;
1242    i := 0;
1243 <  while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1243 >  while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1244    begin
1245      SetLength(FItems,i+1);
1246 +    FItems[i] := nil;
1247      case integer(P^) of
1248      isc_info_svc_line,
1249      isc_info_svc_get_env,
# Line 1001 | Line 1278 | begin
1278  
1279  
1280      else
1281 <       IBError(ibxeOutputParsingError, [integer(P^)]);
1281 >       IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1282      end;
1283 <    P += FItems[i]^.FSize;
1283 >    P := P + FItems[i]^.FSize;
1284      Inc(i);
1285    end;
1286   end;
1287  
1288 + {$IFNDEF FPC}
1289 + function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1290 + begin
1291 +  Result := inherited Find(ItemType);
1292 +  if Result.GetSize = 0 then
1293 +    Result := nil;
1294 + end;
1295 + {$ENDIF}
1296 +
1297   { TSQLInfoResultsBuffer }
1298  
1299 < function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1300 < var P: PChar;
1299 > function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1300 > var P: PByte;
1301      i: integer;
1302   begin
1303    Result := inherited AddListItem(BufPtr);
# Line 1020 | Line 1306 | begin
1306  
1307    if byte(BufPtr^) = isc_info_sql_records then
1308    begin
1309 <    with FirebirdClientAPI do
1309 >    with FFirebirdClientAPI do
1310        Result^.FSize := DecodeInteger(P,2) + 3;
1311      Inc(P,2);
1312      with Result^ do
# Line 1049 | Line 1335 | begin
1335          else
1336            FSubItems[i] := AddSpecialItem(P);
1337          end;
1338 <        P +=  FSubItems[i]^.FSize;
1338 >        P := P + FSubItems[i]^.FSize;
1339          Inc(i);
1340        end;
1341      end;
# Line 1057 | Line 1343 | begin
1343   end;
1344  
1345   procedure TSQLInfoResultsBuffer.DoParseBuffer;
1346 < var P: PChar;
1346 > var P: PByte;
1347      index: integer;
1348   begin
1349    P := Buffer;
1350    index := 0;
1351    SetLength(FItems,0);
1352 <  while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1352 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1353    begin
1354      SetLength(FItems,index+1);
1355      case byte(P^) of
# Line 1091 | Line 1377 | begin
1377      else
1378        FItems[index] := AddSpecialItem(P);
1379      end;
1380 <    P += FItems[index]^.FSize;
1380 >    P := P + FItems[index]^.FSize;
1381 >    Inc(index);
1382 >  end;
1383 > end;
1384 >
1385 > constructor TSQLInfoResultsBuffer.Create(api: TFBClientAPI; aSize: integer);
1386 > begin
1387 >  inherited Create(api,aSize);
1388 >  FIntegerType := dtInteger;
1389 > end;
1390 >
1391 > { TBlobInfo }
1392 >
1393 > procedure TBlobInfo.DoParseBuffer;
1394 > var P: PByte;
1395 >    index: integer;
1396 > begin
1397 >  P := Buffer;
1398 >  index := 0;
1399 >  SetLength(FItems,0);
1400 >  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1401 >  begin
1402 >    SetLength(FItems,index+1);
1403 >    case byte(P^) of
1404 >    isc_info_blob_num_segments,
1405 >    isc_info_blob_max_segment,
1406 >    isc_info_blob_total_length,
1407 >    isc_info_blob_type:
1408 >      FItems[index] := AddIntegerItem(P);
1409 >    else
1410 >      FItems[index] := AddSpecialItem(P);
1411 >    end;
1412 >    P := P + FItems[index]^.FSize;
1413      Inc(index);
1414    end;
1415   end;
1416  
1417 < constructor TSQLInfoResultsBuffer.Create(aSize: integer);
1417 > constructor TBlobInfo.Create(api: TFBClientAPI; aSize: integer);
1418   begin
1419 <  inherited Create(aSize);
1419 >  inherited Create(api,aSize);
1420    FIntegerType := dtInteger;
1421   end;
1422  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines