runtime/nongui/IBDataOutput.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2017 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit IBDataOutput;

{$mode objfpc}{$H+}
{$codepage UTF8}

(*
     These are helper components, primarily for use with TIBXScript, but which are
     also used by TIBExtact (for formatting data as SQL Insert statements). Their
     purpose is to execute SQL SELECT statements and to format the results of the
     query. Data Output Formatters are currently available for:

     Block Format Output        (TIBBlockFormatOut)
     CSV Format                 (TIBCSVDataOut)
     SQL Insert Statements      (TIBInsertStmtsOut).
  *)
interface

uses
  Classes, SysUtils, IBSQL, IBDatabase, IB;

const
  MaxBlobText = 80;

  sTimeStampFormat = 'yyyy.mm.dd hh:nn:ss.zzz';
  sDateFormat      = 'yyyy.mm.dd';
  sTimeFormat      =  'hh:nn:ss.zzz';

type
  TPlanOptions = (poNoPlan,poIncludePlan, poPlanOnly);

  TAdd2Log = procedure(const Msg: string; IsError: boolean=true) of object;
  TOnFormatTextString = procedure(sender: TObject; var TextString: string) of object;

  { TIBCustomDataOutput }

  TIBCustomDataOutput = class(TComponent)
  private
    FDateFormat: string;
    FIBSQL: TIBSQL;
    FIncludeHeader: Boolean;
    FOnFormatTextString: TOnFormatTextString;
    FPlanOptions: TPlanOptions;
    FRowCount: integer;
    FShowPerformanceStats: boolean;
    FTimeFormat: string;
    FTimestampFormat: string;
    function GetDatabase: TIBDatabase;
    function GetTransaction: TIBTransaction;
    procedure SetDatabase(AValue: TIBDatabase);
    procedure SetTransaction(AValue: TIBTransaction);
  protected
    procedure HeaderOut(Add2Log: TAdd2Log); virtual;
    procedure FormattedDataOut(Add2Log: TAdd2Log); virtual; abstract;
    procedure TrailerOut(Add2Log: TAdd2Log); virtual;
    function FormatTimestamp(aValue: ISQLData): string;
    function FormatDate(aValue: ISQLData): string;
    function FormatTime(aValue: ISQLData): string;
    function FormatTextString(aValue: string): string;
    property IncludeHeader: Boolean read FIncludeHeader write FIncludeHeader default true;
    property OnFormatTextString: TOnFormatTextString read FOnFormatTextString write FOnFormatTextString;
  public
    constructor Create(aOwner: TComponent); override;
    procedure Assign(Source: TPersistent); override;
    function DataOut(SelectQuery: string; Add2Log: TAdd2Log): boolean;
    procedure SetCommand(command, aValue, stmt: string; var Done: boolean); virtual;
    class procedure ShowPerfStats(Statement: IStatement; Add2Log: TAdd2Log);
  published
    property Database: TIBDatabase read GetDatabase write SetDatabase;
    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
    property PlanOptions: TPlanOptions read FPlanOptions write FPlanOptions;
    property RowCount: integer read FRowCount write FRowCount;
    property ShowPerformanceStats: boolean read FShowPerformanceStats write FShowPerformanceStats;
    property TimestampFormat: string read FTimestampFormat write FTimestampFormat;
    property DateFormat: string read FDateFormat write FDateFormat;
    property TimeFormat: string read FTimeFormat write FTimeFormat;
 end;

  TDataOutputFormatter = class of TIBCustomDataOutput;

  { TIBCSVDataOut }

  TIBCSVDataOut = class(TIBCustomDataOutput)
  private
    FFieldSeparator: string;
    FHeaderSeparator: string;
    FQuoteChar: char;
    FQuoteStrings: boolean;
  protected
    procedure HeaderOut(Add2Log: TAdd2Log); override;
    procedure FormattedDataOut(Add2Log: TAdd2Log); override;
  public
    constructor Create(aOwner: TComponent); override;
  published
    property IncludeHeader;
    property FieldSeparator: string read FFieldSeparator write FFieldSeparator;
    property HeaderSeparator: string read FHeaderSeparator write FHeaderSeparator;
    property QuoteStrings: boolean read FQuoteStrings write FQuoteStrings default true;
    property QuoteChar: char read FQuoteChar write FQuoteChar default '''';
    property OnFormatTextString;
  end;

  { TIBInsertStmtsOut }

  TIBInsertStmtsOut = class(TIBCustomDataOutput)
  private
    FIncludeBlobsAndArrays: boolean;
    FInsertHeader: string;
  protected
    procedure HeaderOut(Add2Log: TAdd2Log); override;
    procedure FormattedDataOut(Add2Log: TAdd2Log); override;
  public
    constructor Create(aOwner: TComponent); override;
  published
    property IncludeBlobsAndArrays: boolean read FIncludeBlobsAndArrays
                                    write FIncludeBlobsAndArrays default true;
  end;

  TAlignments = (taLeft, taCentre, taRight);

  { TIBBlockFormatOut }

  TIBBlockFormatOut = class(TIBCustomDataOutput)
  private
    FColWidths: array of integer;
    FRowWidth: integer;
    function DashedLine: string;
    function TextAlign(s: string; ColWidth: integer; alignment: TAlignments
      ): string;
  protected
    procedure HeaderOut(Add2Log: TAdd2Log); override;
    procedure FormattedDataOut(Add2Log: TAdd2Log); override;
    procedure TrailerOut(Add2Log: TAdd2Log); override;
  published
    property IncludeHeader;
    property OnFormatTextString;
  end;

implementation

uses IBUtils, IBMessages, Math, IBXScript;

{ TIBBlockFormatOut }

function TIBBlockFormatOut.DashedLine: string;
var i: integer;
begin
  Setlength(Result,FRowWidth);
  for i := 1 to FRowWidth do
    Result[i] := '-';
end;

function TIBBlockFormatOut.TextAlign(s: string; ColWidth: integer;
  alignment: TAlignments): string;
begin
  SetLength(Result,ColWidth);
  FillChar(Result[1],ColWidth,' ');
  if Length(s) > ColWidth then
    s := LeftStr(s,ColWidth);
  case alignment of
  taLeft:
    Move(s[1],Result[1],Length(s));
  taCentre:
    Move(s[1],Result[(ColWidth - Length(s)) div 2 + 1],Length(s));
  taRight:
    Move(s[1],Result[ColWidth - Length(s) + 1],Length(s));
  end;
end;

procedure TIBBlockFormatOut.HeaderOut(Add2Log: TAdd2Log);
var i: integer;
    s: string;
begin
  with FIBSQL do
  begin
    {Calculate column Widths}
    SetLength(FColWidths,MetaData.Count);
    FRowWidth := 1; {assume leading '|'}
    for i := 0 to MetaData.Count - 1 do
    with MetaData[i] do
    begin
      case SQLType of
      SQL_VARYING, SQL_TEXT:
        FColWidths[i] := GetSize;

      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        FColWidths[i] := 18; {see http://www.freepascal.org/docs-html/rtl/sysutils/formatfloat.html}

      SQL_LONG:
        if Scale = 0 then
          FColWidths[i] := 12 {allow for minus sign}
        else
          FColWidths[i] := 13; {leave room for the decimal point}

      SQL_SHORT:
        if Scale = 0 then
          FColWidths[i] := 6 {allow for minus sign}
        else
          FColWidths[i] := 7; {leave room for the decimal point}

      SQL_INT64:
        if Scale = 0 then
          FColWidths[i] := 20 {allow for minus sign}
        else
          FColWidths[i] := 21; {leave room for the decimal point}

      SQL_TIMESTAMP:
        if TimestampFormat = '' then  {Default format}
          FColWidths[i] := GetDateTimeStrLength(dfTimestamp)
        else
          FColWidths[i] := Length(TimestampFormat);

      SQL_TYPE_DATE:
        if DateFormat = '' then {Default format}
          FColWidths[i] := GetDateTimeStrLength(dfDateTime)
        else
          FColWidths[i] := Length(DateFormat);

      SQL_TYPE_TIME:
        if TimeFormat = '' then {Default format}
          FColWidths[i] := GetDateTimeStrLength(dfTime)
        else
          FColWidths[i] := Length(TimeFormat);

      SQL_BLOB:
        if SQLSubType = 1 then
          FColWidths[i] := MaxBlobText
        else
          FColWidths[i] := length(SBlob);

      SQL_ARRAY:
        FColWidths[i] := length(SArray);

      SQL_BOOLEAN:
        FColWidths[i] := Max(Length(STrue),Length(SFalse));
      end;
      if FColWidths[i] < Length(Name) then
        FColWidths[i] := Length(Name);
      FRowWidth += FColWidths[i] + 1;
    end;

    {Now output the header}

    Add2Log(DashedLine,false);
    s := '|';
    for i := 0 to MetaData.Count - 1 do
      s += TextAlign(MetaData[i].Name,FColWidths[i],taCentre) + '|';
    Add2Log(s,false);
    Add2Log(DashedLine,false);
  end;
end;

procedure TIBBlockFormatOut.FormattedDataOut(Add2Log: TAdd2Log);

  function TruncateTextBlob(textStr: string): string;
  begin
    if Length(textStr) > MaxBlobText then
      Result := LeftStr(textStr,MaxBlobText-3) + '...'
    else
      Result := textStr;
  end;

var i: integer;
    s: string;
begin
  s := '|';
  for i := 0 to FIBSQL.Current.Count - 1 do
  with FIBSQL do
  begin
    if Current[i].IsNull then
      s += TextAlign('NULL',FColWidths[i],taCentre)
    else
    case Current[i].SQLType of
    SQL_VARYING, SQL_TEXT:
      s += TextAlign(FormatTextString(Current[i].AsString),FColWidths[i],taLeft);

    SQL_TIMESTAMP:
      s += TextAlign(FormatTimeStamp(Current[i]),FColWidths[i],taLeft);

    SQL_TYPE_DATE:
      s += TextAlign(FormatDate(Current[i]),FColWidths[i],taLeft);

    SQL_TYPE_TIME:
      s += TextAlign(FormatTime(Current[i]),FColWidths[i],taLeft);

    SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
    SQL_LONG, SQL_SHORT, SQL_INT64:
      s += TextAlign(Current[i].AsString,FColWidths[i],taRight);

    SQL_BOOLEAN, SQL_ARRAY:
      s += TextAlign(Current[i].AsString,FColWidths[i],taCentre);

    SQL_BLOB:
      if Current[i].SQLSubType = 1 then
        s += TextAlign(TruncateTextBlob(Current[i].AsString),FColWidths[i],taLeft)
      else
        s += TextAlign(sBlob,FColWidths[i],taCentre);
    end;
    s += '|';
  end;
  Add2Log(s,false);
  Add2Log(DashedLine,false);
end;

procedure TIBBlockFormatOut.TrailerOut(Add2Log: TAdd2Log);
begin
  Add2Log(DashedLine,false);
end;

{ TIBInsertStmtsOut }

procedure TIBInsertStmtsOut.HeaderOut(Add2Log: TAdd2Log);
var TableName: string;
    i,j: integer;
begin
  TableName := trim(FIBSQL.GetUniqueRelationName);
  if TableName = '' then
    IBError(ibxeUniqueRelationReqd,[nil]);

  Add2Log('',false);
  Add2Log('/* Inserting data into Table: ' + TableName + ' */',false);
  Add2Log('',false);

  FInsertHeader := 'INSERT INTO ' + QuoteIdentifierIfNeeded(Database.SQLDialect, TableName) + ' (';
  with FIBSQL do
  begin
    j := 0;
    for i := 0 to MetaData.Count - 1 do
    if IncludeBlobsAndArrays or
       ((MetaData[i].SQLTYPE <> SQL_BLOB) and (MetaData[i].SQLType <> SQL_ARRAY)) then
    begin
      if j <> 0 then FInsertHeader += ',';
      FInsertHeader += QuoteIdentifierIfNeeded(Database.SQLDialect,Trim(MetaData[i].getAliasName));
      Inc(j);
    end;
  end;
  FInsertHeader += ') VALUES(';
end;

procedure TIBInsertStmtsOut.FormattedDataOut(Add2Log: TAdd2Log);
const
  QuoteChar = '''';

var s: string;
    i, j: integer;
    ar: IArray;
begin
  s := FInsertHeader;
  with FIBSQL do
  begin
    j := 0;
    for i := 0 to Current.Count - 1 do
    if IncludeBlobsAndArrays or
       ((Current[i].SQLTYPE <> SQL_BLOB) and (Current[i].SQLType <> SQL_ARRAY)) then
    begin
      if j <> 0 then s += ',';
      if Current[i].IsNull then
        s += 'NULL'
      else
      case Current[i].SQLType of
      SQL_BLOB:
        if Current[i].SQLSubType = 1 then
        begin
          if Current[i].getCharSetID = 1 {octets} then
            s += Format('x''%s''',[StringToHex(Current[i].AsString)])
          else
            s += QuoteChar + SQLSafeString(Current[i].AsString) + QuoteChar
        end
        else
          s += TSQLXMLReader.FormatBlob(Current[i]);

      SQL_ARRAY:
        begin
          ar := Current[i].AsArray;
          if ar = nil then
            s += 'NULL'
          else
            s += TSQLXMLReader.FormatArray(Database,ar);
        end;

      SQL_TEXT, SQL_VARYING:
        if Current[i].getCharSetID = 1 {octets} then
          s += Format('x''%s''',[StringToHex(Current[i].AsString)])
        else
          s += QuoteChar + SQLSafeString(Current[i].AsString) + QuoteChar;

      SQL_TIMESTAMP:
        s += QuoteChar + FormatTimeStamp(Current[i]) + QuoteChar;

      SQL_TYPE_DATE:
        s += QuoteChar + FormatDate(Current[i]) + QuoteChar;

      SQL_TYPE_TIME:
        s += QuoteChar + FormatTime(Current[i]) + QuoteChar;

      else
        s += Current[i].AsString;
      end;
      Inc(j);
    end;
  end;
  s += ');';
  Add2Log(s,false);
end;

constructor TIBInsertStmtsOut.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FIncludeBlobsAndArrays := true;
end;

{ TIBCSVDataOut }

procedure TIBCSVDataOut.HeaderOut(Add2Log: TAdd2Log);
var i: integer;
    s: string;
begin
  s := '';
  for i := 0 to FIBSQL.MetaData.Count - 1 do
  begin
    if i <> 0 then s += HeaderSeparator;
    s += FIBSQL.MetaData[i].getAliasName;
  end;
  Add2Log(s,false);
end;

procedure TIBCSVDataOut.FormattedDataOut(Add2Log: TAdd2Log);

  function GetQuoteChar: string;
  begin
    if QuoteStrings then
      Result := QuoteChar
    else
      Result := '';
  end;

var i: integer;
    s: string;
begin
  s := '';
  with FIBSQL do
  begin
    for i := 0 to Current.Count - 1 do
    with Current[i] do
    begin
      if i <> 0 then s += FieldSeparator;
      case SQLType of
      SQL_BLOB:
        if SQLSubType <> 1 then
          s += sBlob
        else
          s += GetQuoteChar + Current[i].AsString + GetQuoteChar;

      SQL_VARYING,SQL_TEXT:
        s += GetQuoteChar + FormatTextString(Current[i].AsString) + GetQuoteChar;

      SQL_TIMESTAMP:
        s += GetQuoteChar + FormatTimeStamp(Current[i]) + GetQuoteChar;

      SQL_TYPE_DATE:
        s += GetQuoteChar + FormatDate(Current[i]) + GetQuoteChar;

      SQL_TYPE_TIME:
        s += GetQuoteChar + FormatTime(Current[i]) + GetQuoteChar;

      else
        s += Current[i].AsString;
      end;
    end;
  end;
  Add2Log(s,false);
end;

constructor TIBCSVDataOut.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FQuoteStrings := true;
  FQuoteChar := '''';
  FTimestampFormat := '';
  FDateFormat := '';
  FTimestampFormat := '';
  FFieldSeparator := ',';
  FHeaderSeparator := ',';
end;

{ TIBCustomDataOutput }

function TIBCustomDataOutput.GetDatabase: TIBDatabase;
begin
  Result := FIBSQL.Database;
end;

function TIBCustomDataOutput.GetTransaction: TIBTransaction;
begin
  Result := FIBSQL.Transaction;
end;

procedure TIBCustomDataOutput.SetDatabase(AValue: TIBDatabase);
begin
  FIBSQL.Database := AValue;
end;

procedure TIBCustomDataOutput.SetTransaction(AValue: TIBTransaction);
begin
  FIBSQL.Transaction := AValue;
end;

procedure TIBCustomDataOutput.HeaderOut(Add2Log: TAdd2Log);
begin
  //stub
end;

procedure TIBCustomDataOutput.TrailerOut(Add2Log: TAdd2Log);
begin
  //stub
end;

function TIBCustomDataOutput.FormatTimestamp(aValue: ISQLData): string;
begin
  if TimeStampFormat <> '' then
    Result := FormatDateTime(TimeStampFormat,aValue.AsDateTime)
  else
    Result := aValue.AsString;
end;

function TIBCustomDataOutput.FormatDate(aValue: ISQLData): string;
begin
  if DateFormat <> '' then
    Result := FormatDateTime(DateFormat,aValue.AsDateTime)
  else
    Result := aValue.AsString;
end;

function TIBCustomDataOutput.FormatTime(aValue: ISQLData): string;
begin
  if TimeFormat <> '' then
    Result := FormatDateTime(TimeFormat,aValue.AsDateTime)
  else
    Result := aValue.AsString;
end;

function TIBCustomDataOutput.FormatTextString(aValue: string): string;
begin
  Result := aValue;
  if assigned(FOnFormatTextString) then
    OnFormatTextString(self,Result);
end;

constructor TIBCustomDataOutput.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FIBSQL := TIBSQL.Create(self);
  FIncludeHeader := true;
  FTimestampFormat := sTimestampFormat;
  FDateFormat := sDateFormat;
  FTimeFormat := sTimeFormat;
end;

procedure TIBCustomDataOutput.Assign(Source: TPersistent);
begin
  if Source is TIBCustomDataOutput then
  begin
    IncludeHeader := TIBCustomDataOutput(Source).IncludeHeader;
    RowCount := TIBCustomDataOutput(Source).RowCount;
    ShowPerformanceStats := TIBCustomDataOutput(Source).ShowPerformanceStats;
    PlanOptions := TIBCustomDataOutput(Source).PlanOptions;
  end;
end;

function TIBCustomDataOutput.DataOut(SelectQuery: string; Add2Log: TAdd2Log
  ): boolean;
var Count: integer;
begin
  FIBSQL.SQL.Text := SelectQuery;
  FIBSQL.Prepare;
  FIBSQL.Statement.EnableStatistics(ShowPerformanceStats);
  if PlanOptions <> poNoPlan then
    Add2Log(FIBSQL.Plan,false);
  if PlanOptions = poPlanOnly then
    Exit;

  Count := 0;
  FIBSQL.ExecQuery;
  try
    if IncludeHeader and not FIBSQL.EOF then
      HeaderOut(Add2Log);
    while (not FIBSQL.EOF) and ((FRowCount = 0) or (Count < FRowCount)) do
    begin
      FormattedDataOut(Add2Log);
      FIBSQL.Next;
      Inc(Count);
    end;
    ShowPerfStats(FIBSQL.Statement,Add2Log);
  finally
    FIBSQL.Close;
  end;
  Result := Count > 0;
end;

procedure TIBCustomDataOutput.SetCommand(command, aValue, stmt: string;
  var Done: boolean);

  function Toggle(aValue: string): boolean;
  begin
    aValue := AnsiUpperCase(aValue);
    if aValue = 'ON' then
      Result := true
    else
    if aValue = 'OFF' then
      Result := false
    else
      raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
  end;

begin
  done := true;
  if command = 'HEADING' then
    FIncludeHeader := ((aValue = '') and not FIncludeHeader) or
                      ((aValue <> '') and Toggle(aValue))
  else
  if command = 'ROWCOUNT' then
    FRowCount := StrToInt(aValue)
  else
  if command = 'PLAN' then
  begin
    if aValue = '' then
    begin
      if FPlanOptions <>  poIncludePlan then
        FPlanOptions := poIncludePlan
      else
        FPlanOptions := poNoPlan;
    end
    else
    if Toggle(aValue) then
      FPlanOptions := poIncludePlan
    else
      FPlanOptions := poNoPlan;
  end
  else
  if command = 'PLANONLY' then
  begin
    if aValue = '' then
    begin
      if FPlanOptions <>  poPlanOnly then
        FPlanOptions := poPlanOnly
      else
        FPlanOptions := poNoPlan;
    end
    else
    if Toggle(aValue) then
      FPlanOptions := poPlanOnly
    else
    if FPlanOptions <> poIncludePlan then
      FPlanOptions := poNoPlan;
  end
  else
    done := false;
end;

class procedure TIBCustomDataOutput.ShowPerfStats(Statement: IStatement;
  Add2Log: TAdd2Log);
var stats: TPerfCounters;
    LargeCompFormat: string;
    ThreeSigPlacesFormat: string;
begin
  LargeCompFormat := '#' + DefaultFormatSettings.ThousandSeparator + '##0';
  ThreeSigPlacesFormat := '#0' + DefaultFormatSettings.DecimalSeparator + '000';
  if Statement.GetPerfStatistics(stats) then
  begin
    Add2Log('Current memory = ' + FormatFloat(LargeCompFormat,stats[psCurrentMemory]));
    Add2Log('Delta memory = ' + FormatFloat(LargeCompFormat,stats[psDeltaMemory]));
    Add2Log('Max memory = ' + FormatFloat(LargeCompFormat,stats[psMaxMemory]));
    Add2Log('Elapsed time= ' + FormatFloat(ThreeSigPlacesFormat,stats[psRealTime]/1000) +' sec');
    Add2Log('Cpu = ' + FormatFloat(ThreeSigPlacesFormat,stats[psUserTime]/1000) + ' sec');
    Add2Log('Buffers = ' + FormatFloat('#0',stats[psBuffers]));
    Add2Log('Reads = ' + FormatFloat('#0',stats[psReads]));
    Add2Log('Writes = ' + FormatFloat('#0',stats[psWrites]));
    Add2Log('Fetches = ' + FormatFloat('#0',stats[psFetches]));
 end;
end;

end.

Revision:	291
Committed:	Fri Apr 17 10:26:08 2020 UTC (4 years ago) by tony
Content type:	text/x-pascal
File size:	19878 byte(s)
Log Message:	Changed for 2.3.4 merged into public release
#	User	Rev	Content
1	tony	209	(*
2			* IBX For Lazarus (Firebird Express)
3			*
4			* The contents of this file are subject to the Initial Developer's
5			* Public License Version 1.0 (the "License"); you may not use this
6			* file except in compliance with the License. You may obtain a copy
7			* of the License here:
8			*
9			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10			*
11			* Software distributed under the License is distributed on an "AS
12			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13			* implied. See the License for the specific language governing rights
14			* and limitations under the License.
15			*
16			* The Initial Developer of the Original Code is Tony Whyman.
17			*
18			* The Original Code is (C) 2017 Tony Whyman, MWA Software
19			* (http://www.mwasoftware.co.uk).
20			*
21			* All Rights Reserved.
22			*
23			* Contributor(s): ______________________________________.
24			*
25			*)
26			unit IBDataOutput;
27
28			{$mode objfpc}{$H+}
29			{$codepage UTF8}
30
31			(*
32			These are helper components, primarily for use with TIBXScript, but which are
33			also used by TIBExtact (for formatting data as SQL Insert statements). Their
34			purpose is to execute SQL SELECT statements and to format the results of the
35			query. Data Output Formatters are currently available for:
36
37			Block Format Output (TIBBlockFormatOut)
38			CSV Format (TIBCSVDataOut)
39			SQL Insert Statements (TIBInsertStmtsOut).
40			*)
41			interface
42
43			uses
44			Classes, SysUtils, IBSQL, IBDatabase, IB;
45
46			const
47			MaxBlobText = 80;
48
49			sTimeStampFormat = 'yyyy.mm.dd hh:nn:ss.zzz';
50			sDateFormat = 'yyyy.mm.dd';
51			sTimeFormat = 'hh:nn:ss.zzz';
52
53			type
54			TPlanOptions = (poNoPlan,poIncludePlan, poPlanOnly);
55
56			TAdd2Log = procedure(const Msg: string; IsError: boolean=true) of object;
57	tony	270	TOnFormatTextString = procedure(sender: TObject; var TextString: string) of object;
58	tony	209
59			{ TIBCustomDataOutput }
60
61			TIBCustomDataOutput = class(TComponent)
62			private
63	tony	270	FDateFormat: string;
64	tony	209	FIBSQL: TIBSQL;
65			FIncludeHeader: Boolean;
66	tony	270	FOnFormatTextString: TOnFormatTextString;
67	tony	209	FPlanOptions: TPlanOptions;
68			FRowCount: integer;
69			FShowPerformanceStats: boolean;
70	tony	270	FTimeFormat: string;
71			FTimestampFormat: string;
72	tony	209	function GetDatabase: TIBDatabase;
73			function GetTransaction: TIBTransaction;
74			procedure SetDatabase(AValue: TIBDatabase);
75			procedure SetTransaction(AValue: TIBTransaction);
76			protected
77			procedure HeaderOut(Add2Log: TAdd2Log); virtual;
78			procedure FormattedDataOut(Add2Log: TAdd2Log); virtual; abstract;
79			procedure TrailerOut(Add2Log: TAdd2Log); virtual;
80	tony	270	function FormatTimestamp(aValue: ISQLData): string;
81			function FormatDate(aValue: ISQLData): string;
82			function FormatTime(aValue: ISQLData): string;
83			function FormatTextString(aValue: string): string;
84	tony	209	property IncludeHeader: Boolean read FIncludeHeader write FIncludeHeader default true;
85	tony	270	property OnFormatTextString: TOnFormatTextString read FOnFormatTextString write FOnFormatTextString;
86	tony	209	public
87			constructor Create(aOwner: TComponent); override;
88			procedure Assign(Source: TPersistent); override;
89			function DataOut(SelectQuery: string; Add2Log: TAdd2Log): boolean;
90			procedure SetCommand(command, aValue, stmt: string; var Done: boolean); virtual;
91			class procedure ShowPerfStats(Statement: IStatement; Add2Log: TAdd2Log);
92			published
93			property Database: TIBDatabase read GetDatabase write SetDatabase;
94			property Transaction: TIBTransaction read GetTransaction write SetTransaction;
95			property PlanOptions: TPlanOptions read FPlanOptions write FPlanOptions;
96			property RowCount: integer read FRowCount write FRowCount;
97			property ShowPerformanceStats: boolean read FShowPerformanceStats write FShowPerformanceStats;
98	tony	270	property TimestampFormat: string read FTimestampFormat write FTimestampFormat;
99			property DateFormat: string read FDateFormat write FDateFormat;
100			property TimeFormat: string read FTimeFormat write FTimeFormat;
101	tony	209	end;
102
103			TDataOutputFormatter = class of TIBCustomDataOutput;
104
105			{ TIBCSVDataOut }
106
107			TIBCSVDataOut = class(TIBCustomDataOutput)
108			private
109	tony	270	FFieldSeparator: string;
110			FHeaderSeparator: string;
111	tony	209	FQuoteChar: char;
112	tony	270	FQuoteStrings: boolean;
113	tony	209	protected
114			procedure HeaderOut(Add2Log: TAdd2Log); override;
115			procedure FormattedDataOut(Add2Log: TAdd2Log); override;
116			public
117			constructor Create(aOwner: TComponent); override;
118			published
119			property IncludeHeader;
120	tony	270	property FieldSeparator: string read FFieldSeparator write FFieldSeparator;
121			property HeaderSeparator: string read FHeaderSeparator write FHeaderSeparator;
122			property QuoteStrings: boolean read FQuoteStrings write FQuoteStrings default true;
123	tony	209	property QuoteChar: char read FQuoteChar write FQuoteChar default '''';
124	tony	270	property OnFormatTextString;
125	tony	209	end;
126
127			{ TIBInsertStmtsOut }
128
129			TIBInsertStmtsOut = class(TIBCustomDataOutput)
130			private
131			FIncludeBlobsAndArrays: boolean;
132			FInsertHeader: string;
133			protected
134			procedure HeaderOut(Add2Log: TAdd2Log); override;
135			procedure FormattedDataOut(Add2Log: TAdd2Log); override;
136			public
137			constructor Create(aOwner: TComponent); override;
138			published
139			property IncludeBlobsAndArrays: boolean read FIncludeBlobsAndArrays
140			write FIncludeBlobsAndArrays default true;
141			end;
142
143			TAlignments = (taLeft, taCentre, taRight);
144
145			{ TIBBlockFormatOut }
146
147			TIBBlockFormatOut = class(TIBCustomDataOutput)
148			private
149			FColWidths: array of integer;
150			FRowWidth: integer;
151			function DashedLine: string;
152			function TextAlign(s: string; ColWidth: integer; alignment: TAlignments
153			): string;
154			protected
155			procedure HeaderOut(Add2Log: TAdd2Log); override;
156			procedure FormattedDataOut(Add2Log: TAdd2Log); override;
157			procedure TrailerOut(Add2Log: TAdd2Log); override;
158			published
159			property IncludeHeader;
160	tony	270	property OnFormatTextString;
161	tony	209	end;
162
163			implementation
164
165	tony	291	uses IBUtils, IBMessages, Math, IBXScript;
166	tony	209
167			{ TIBBlockFormatOut }
168
169			function TIBBlockFormatOut.DashedLine: string;
170			var i: integer;
171			begin
172			Setlength(Result,FRowWidth);
173			for i := 1 to FRowWidth do
174			Result[i] := '-';
175			end;
176
177			function TIBBlockFormatOut.TextAlign(s: string; ColWidth: integer;
178			alignment: TAlignments): string;
179			begin
180			SetLength(Result,ColWidth);
181			FillChar(Result[1],ColWidth,' ');
182			if Length(s) > ColWidth then
183			s := LeftStr(s,ColWidth);
184			case alignment of
185			taLeft:
186			Move(s[1],Result[1],Length(s));
187			taCentre:
188			Move(s[1],Result[(ColWidth - Length(s)) div 2 + 1],Length(s));
189			taRight:
190			Move(s[1],Result[ColWidth - Length(s) + 1],Length(s));
191			end;
192			end;
193
194			procedure TIBBlockFormatOut.HeaderOut(Add2Log: TAdd2Log);
195			var i: integer;
196			s: string;
197			begin
198			with FIBSQL do
199			begin
200			{Calculate column Widths}
201			SetLength(FColWidths,MetaData.Count);
202			FRowWidth := 1; {assume leading '\|'}
203			for i := 0 to MetaData.Count - 1 do
204			with MetaData[i] do
205			begin
206			case SQLType of
207			SQL_VARYING, SQL_TEXT:
208			FColWidths[i] := GetSize;
209
210			SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
211			FColWidths[i] := 18; {see http://www.freepascal.org/docs-html/rtl/sysutils/formatfloat.html}
212
213			SQL_LONG:
214			if Scale = 0 then
215			FColWidths[i] := 12 {allow for minus sign}
216			else
217			FColWidths[i] := 13; {leave room for the decimal point}
218
219			SQL_SHORT:
220			if Scale = 0 then
221			FColWidths[i] := 6 {allow for minus sign}
222			else
223			FColWidths[i] := 7; {leave room for the decimal point}
224
225			SQL_INT64:
226			if Scale = 0 then
227			FColWidths[i] := 20 {allow for minus sign}
228			else
229			FColWidths[i] := 21; {leave room for the decimal point}
230
231			SQL_TIMESTAMP:
232	tony	270	if TimestampFormat = '' then {Default format}
233			FColWidths[i] := GetDateTimeStrLength(dfTimestamp)
234			else
235			FColWidths[i] := Length(TimestampFormat);
236	tony	209
237			SQL_TYPE_DATE:
238	tony	270	if DateFormat = '' then {Default format}
239			FColWidths[i] := GetDateTimeStrLength(dfDateTime)
240			else
241			FColWidths[i] := Length(DateFormat);
242	tony	209
243			SQL_TYPE_TIME:
244	tony	270	if TimeFormat = '' then {Default format}
245			FColWidths[i] := GetDateTimeStrLength(dfTime)
246			else
247			FColWidths[i] := Length(TimeFormat);
248	tony	209
249			SQL_BLOB:
250			if SQLSubType = 1 then
251			FColWidths[i] := MaxBlobText
252			else
253			FColWidths[i] := length(SBlob);
254
255			SQL_ARRAY:
256			FColWidths[i] := length(SArray);
257
258			SQL_BOOLEAN:
259			FColWidths[i] := Max(Length(STrue),Length(SFalse));
260			end;
261			if FColWidths[i] < Length(Name) then
262			FColWidths[i] := Length(Name);
263			FRowWidth += FColWidths[i] + 1;
264			end;
265
266			{Now output the header}
267
268			Add2Log(DashedLine,false);
269			s := '\|';
270			for i := 0 to MetaData.Count - 1 do
271			s += TextAlign(MetaData[i].Name,FColWidths[i],taCentre) + '\|';
272			Add2Log(s,false);
273			Add2Log(DashedLine,false);
274			end;
275			end;
276
277			procedure TIBBlockFormatOut.FormattedDataOut(Add2Log: TAdd2Log);
278
279			function TruncateTextBlob(textStr: string): string;
280			begin
281			if Length(textStr) > MaxBlobText then
282			Result := LeftStr(textStr,MaxBlobText-3) + '...'
283			else
284			Result := textStr;
285			end;
286
287			var i: integer;
288			s: string;
289			begin
290			s := '\|';
291			for i := 0 to FIBSQL.Current.Count - 1 do
292	tony	270	with FIBSQL do
293	tony	209	begin
294	tony	270	if Current[i].IsNull then
295	tony	209	s += TextAlign('NULL',FColWidths[i],taCentre)
296			else
297	tony	270	case Current[i].SQLType of
298	tony	209	SQL_VARYING, SQL_TEXT:
299	tony	270	s += TextAlign(FormatTextString(Current[i].AsString),FColWidths[i],taLeft);
300	tony	209
301			SQL_TIMESTAMP:
302	tony	270	s += TextAlign(FormatTimeStamp(Current[i]),FColWidths[i],taLeft);
303	tony	209
304			SQL_TYPE_DATE:
305	tony	270	s += TextAlign(FormatDate(Current[i]),FColWidths[i],taLeft);
306	tony	209
307			SQL_TYPE_TIME:
308	tony	270	s += TextAlign(FormatTime(Current[i]),FColWidths[i],taLeft);
309	tony	209
310			SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
311			SQL_LONG, SQL_SHORT, SQL_INT64:
312	tony	270	s += TextAlign(Current[i].AsString,FColWidths[i],taRight);
313	tony	209
314			SQL_BOOLEAN, SQL_ARRAY:
315	tony	270	s += TextAlign(Current[i].AsString,FColWidths[i],taCentre);
316	tony	209
317			SQL_BLOB:
318	tony	270	if Current[i].SQLSubType = 1 then
319			s += TextAlign(TruncateTextBlob(Current[i].AsString),FColWidths[i],taLeft)
320	tony	209	else
321			s += TextAlign(sBlob,FColWidths[i],taCentre);
322			end;
323			s += '\|';
324			end;
325			Add2Log(s,false);
326			Add2Log(DashedLine,false);
327			end;
328
329			procedure TIBBlockFormatOut.TrailerOut(Add2Log: TAdd2Log);
330			begin
331			Add2Log(DashedLine,false);
332			end;
333
334			{ TIBInsertStmtsOut }
335
336			procedure TIBInsertStmtsOut.HeaderOut(Add2Log: TAdd2Log);
337			var TableName: string;
338			i,j: integer;
339			begin
340			TableName := trim(FIBSQL.GetUniqueRelationName);
341			if TableName = '' then
342			IBError(ibxeUniqueRelationReqd,[nil]);
343
344			Add2Log('',false);
345			Add2Log('/* Inserting data into Table: ' + TableName + ' */',false);
346			Add2Log('',false);
347
348			FInsertHeader := 'INSERT INTO ' + QuoteIdentifierIfNeeded(Database.SQLDialect, TableName) + ' (';
349			with FIBSQL do
350			begin
351			j := 0;
352			for i := 0 to MetaData.Count - 1 do
353			if IncludeBlobsAndArrays or
354			((MetaData[i].SQLTYPE <> SQL_BLOB) and (MetaData[i].SQLType <> SQL_ARRAY)) then
355			begin
356			if j <> 0 then FInsertHeader += ',';
357			FInsertHeader += QuoteIdentifierIfNeeded(Database.SQLDialect,Trim(MetaData[i].getAliasName));
358			Inc(j);
359			end;
360			end;
361			FInsertHeader += ') VALUES(';
362			end;
363
364			procedure TIBInsertStmtsOut.FormattedDataOut(Add2Log: TAdd2Log);
365			const
366			QuoteChar = '''';
367
368			var s: string;
369			i, j: integer;
370			ar: IArray;
371			begin
372			s := FInsertHeader;
373			with FIBSQL do
374			begin
375			j := 0;
376			for i := 0 to Current.Count - 1 do
377			if IncludeBlobsAndArrays or
378			((Current[i].SQLTYPE <> SQL_BLOB) and (Current[i].SQLType <> SQL_ARRAY)) then
379			begin
380			if j <> 0 then s += ',';
381			if Current[i].IsNull then
382			s += 'NULL'
383			else
384			case Current[i].SQLType of
385			SQL_BLOB:
386			if Current[i].SQLSubType = 1 then
387			begin
388			if Current[i].getCharSetID = 1 {octets} then
389			s += Format('x''%s''',[StringToHex(Current[i].AsString)])
390			else
391			s += QuoteChar + SQLSafeString(Current[i].AsString) + QuoteChar
392			end
393			else
394	tony	263	s += TSQLXMLReader.FormatBlob(Current[i]);
395	tony	209
396			SQL_ARRAY:
397			begin
398			ar := Current[i].AsArray;
399			if ar = nil then
400			s += 'NULL'
401			else
402	tony	263	s += TSQLXMLReader.FormatArray(Database,ar);
403	tony	209	end;
404
405			SQL_TEXT, SQL_VARYING:
406			if Current[i].getCharSetID = 1 {octets} then
407			s += Format('x''%s''',[StringToHex(Current[i].AsString)])
408			else
409			s += QuoteChar + SQLSafeString(Current[i].AsString) + QuoteChar;
410
411			SQL_TIMESTAMP:
412	tony	270	s += QuoteChar + FormatTimeStamp(Current[i]) + QuoteChar;
413	tony	209
414			SQL_TYPE_DATE:
415	tony	270	s += QuoteChar + FormatDate(Current[i]) + QuoteChar;
416	tony	209
417			SQL_TYPE_TIME:
418	tony	270	s += QuoteChar + FormatTime(Current[i]) + QuoteChar;
419	tony	209
420			else
421			s += Current[i].AsString;
422			end;
423			Inc(j);
424			end;
425			end;
426			s += ');';
427			Add2Log(s,false);
428			end;
429
430			constructor TIBInsertStmtsOut.Create(aOwner: TComponent);
431			begin
432			inherited Create(aOwner);
433			FIncludeBlobsAndArrays := true;
434			end;
435
436			{ TIBCSVDataOut }
437
438			procedure TIBCSVDataOut.HeaderOut(Add2Log: TAdd2Log);
439			var i: integer;
440			s: string;
441			begin
442			s := '';
443			for i := 0 to FIBSQL.MetaData.Count - 1 do
444			begin
445	tony	270	if i <> 0 then s += HeaderSeparator;
446	tony	209	s += FIBSQL.MetaData[i].getAliasName;
447			end;
448			Add2Log(s,false);
449			end;
450
451			procedure TIBCSVDataOut.FormattedDataOut(Add2Log: TAdd2Log);
452	tony	270
453			function GetQuoteChar: string;
454			begin
455			if QuoteStrings then
456			Result := QuoteChar
457			else
458			Result := '';
459			end;
460
461	tony	209	var i: integer;
462			s: string;
463			begin
464			s := '';
465			with FIBSQL do
466			begin
467			for i := 0 to Current.Count - 1 do
468			with Current[i] do
469			begin
470	tony	270	if i <> 0 then s += FieldSeparator;
471	tony	209	case SQLType of
472			SQL_BLOB:
473			if SQLSubType <> 1 then
474			s += sBlob
475			else
476	tony	270	s += GetQuoteChar + Current[i].AsString + GetQuoteChar;
477	tony	209
478	tony	270	SQL_VARYING,SQL_TEXT:
479			s += GetQuoteChar + FormatTextString(Current[i].AsString) + GetQuoteChar;
480	tony	209
481	tony	270	SQL_TIMESTAMP:
482			s += GetQuoteChar + FormatTimeStamp(Current[i]) + GetQuoteChar;
483
484			SQL_TYPE_DATE:
485			s += GetQuoteChar + FormatDate(Current[i]) + GetQuoteChar;
486
487			SQL_TYPE_TIME:
488			s += GetQuoteChar + FormatTime(Current[i]) + GetQuoteChar;
489
490	tony	209	else
491			s += Current[i].AsString;
492			end;
493			end;
494			end;
495			Add2Log(s,false);
496			end;
497
498			constructor TIBCSVDataOut.Create(aOwner: TComponent);
499			begin
500			inherited Create(aOwner);
501	tony	270	FQuoteStrings := true;
502	tony	209	FQuoteChar := '''';
503	tony	270	FTimestampFormat := '';
504			FDateFormat := '';
505			FTimestampFormat := '';
506			FFieldSeparator := ',';
507			FHeaderSeparator := ',';
508	tony	209	end;
509
510			{ TIBCustomDataOutput }
511
512			function TIBCustomDataOutput.GetDatabase: TIBDatabase;
513			begin
514			Result := FIBSQL.Database;
515			end;
516
517			function TIBCustomDataOutput.GetTransaction: TIBTransaction;
518			begin
519			Result := FIBSQL.Transaction;
520			end;
521
522			procedure TIBCustomDataOutput.SetDatabase(AValue: TIBDatabase);
523			begin
524			FIBSQL.Database := AValue;
525			end;
526
527			procedure TIBCustomDataOutput.SetTransaction(AValue: TIBTransaction);
528			begin
529			FIBSQL.Transaction := AValue;
530			end;
531
532			procedure TIBCustomDataOutput.HeaderOut(Add2Log: TAdd2Log);
533			begin
534			//stub
535			end;
536
537			procedure TIBCustomDataOutput.TrailerOut(Add2Log: TAdd2Log);
538			begin
539			//stub
540			end;
541
542	tony	270	function TIBCustomDataOutput.FormatTimestamp(aValue: ISQLData): string;
543			begin
544			if TimeStampFormat <> '' then
545			Result := FormatDateTime(TimeStampFormat,aValue.AsDateTime)
546			else
547			Result := aValue.AsString;
548			end;
549
550			function TIBCustomDataOutput.FormatDate(aValue: ISQLData): string;
551			begin
552			if DateFormat <> '' then
553			Result := FormatDateTime(DateFormat,aValue.AsDateTime)
554			else
555			Result := aValue.AsString;
556			end;
557
558			function TIBCustomDataOutput.FormatTime(aValue: ISQLData): string;
559			begin
560			if TimeFormat <> '' then
561			Result := FormatDateTime(TimeFormat,aValue.AsDateTime)
562			else
563			Result := aValue.AsString;
564			end;
565
566			function TIBCustomDataOutput.FormatTextString(aValue: string): string;
567			begin
568			Result := aValue;
569			if assigned(FOnFormatTextString) then
570			OnFormatTextString(self,Result);
571			end;
572
573	tony	209	constructor TIBCustomDataOutput.Create(aOwner: TComponent);
574			begin
575			inherited Create(aOwner);
576			FIBSQL := TIBSQL.Create(self);
577			FIncludeHeader := true;
578	tony	270	FTimestampFormat := sTimestampFormat;
579			FDateFormat := sDateFormat;
580			FTimeFormat := sTimeFormat;
581	tony	209	end;
582
583			procedure TIBCustomDataOutput.Assign(Source: TPersistent);
584			begin
585			if Source is TIBCustomDataOutput then
586			begin
587			IncludeHeader := TIBCustomDataOutput(Source).IncludeHeader;
588			RowCount := TIBCustomDataOutput(Source).RowCount;
589			ShowPerformanceStats := TIBCustomDataOutput(Source).ShowPerformanceStats;
590			PlanOptions := TIBCustomDataOutput(Source).PlanOptions;
591			end;
592			end;
593
594			function TIBCustomDataOutput.DataOut(SelectQuery: string; Add2Log: TAdd2Log
595			): boolean;
596			var Count: integer;
597			begin
598			FIBSQL.SQL.Text := SelectQuery;
599			FIBSQL.Prepare;
600			FIBSQL.Statement.EnableStatistics(ShowPerformanceStats);
601			if PlanOptions <> poNoPlan then
602			Add2Log(FIBSQL.Plan,false);
603			if PlanOptions = poPlanOnly then
604			Exit;
605
606			Count := 0;
607			FIBSQL.ExecQuery;
608			try
609			if IncludeHeader and not FIBSQL.EOF then
610			HeaderOut(Add2Log);
611			while (not FIBSQL.EOF) and ((FRowCount = 0) or (Count < FRowCount)) do
612			begin
613			FormattedDataOut(Add2Log);
614			FIBSQL.Next;
615			Inc(Count);
616			end;
617			ShowPerfStats(FIBSQL.Statement,Add2Log);
618			finally
619			FIBSQL.Close;
620			end;
621			Result := Count > 0;
622			end;
623
624			procedure TIBCustomDataOutput.SetCommand(command, aValue, stmt: string;
625			var Done: boolean);
626
627			function Toggle(aValue: string): boolean;
628			begin
629			aValue := AnsiUpperCase(aValue);
630			if aValue = 'ON' then
631			Result := true
632			else
633			if aValue = 'OFF' then
634			Result := false
635			else
636			raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
637			end;
638
639			begin
640			done := true;
641			if command = 'HEADING' then
642			FIncludeHeader := ((aValue = '') and not FIncludeHeader) or
643			((aValue <> '') and Toggle(aValue))
644			else
645			if command = 'ROWCOUNT' then
646			FRowCount := StrToInt(aValue)
647			else
648			if command = 'PLAN' then
649			begin
650			if aValue = '' then
651			begin
652			if FPlanOptions <> poIncludePlan then
653			FPlanOptions := poIncludePlan
654			else
655			FPlanOptions := poNoPlan;
656			end
657			else
658			if Toggle(aValue) then
659			FPlanOptions := poIncludePlan
660			else
661			FPlanOptions := poNoPlan;
662			end
663			else
664			if command = 'PLANONLY' then
665			begin
666			if aValue = '' then
667			begin
668			if FPlanOptions <> poPlanOnly then
669			FPlanOptions := poPlanOnly
670			else
671			FPlanOptions := poNoPlan;
672			end
673			else
674			if Toggle(aValue) then
675			FPlanOptions := poPlanOnly
676			else
677			if FPlanOptions <> poIncludePlan then
678			FPlanOptions := poNoPlan;
679			end
680			else
681			done := false;
682			end;
683
684			class procedure TIBCustomDataOutput.ShowPerfStats(Statement: IStatement;
685			Add2Log: TAdd2Log);
686			var stats: TPerfCounters;
687			LargeCompFormat: string;
688			ThreeSigPlacesFormat: string;
689			begin
690			LargeCompFormat := '#' + DefaultFormatSettings.ThousandSeparator + '##0';
691			ThreeSigPlacesFormat := '#0' + DefaultFormatSettings.DecimalSeparator + '000';
692			if Statement.GetPerfStatistics(stats) then
693			begin
694			Add2Log('Current memory = ' + FormatFloat(LargeCompFormat,stats[psCurrentMemory]));
695			Add2Log('Delta memory = ' + FormatFloat(LargeCompFormat,stats[psDeltaMemory]));
696			Add2Log('Max memory = ' + FormatFloat(LargeCompFormat,stats[psMaxMemory]));
697			Add2Log('Elapsed time= ' + FormatFloat(ThreeSigPlacesFormat,stats[psRealTime]/1000) +' sec');
698			Add2Log('Cpu = ' + FormatFloat(ThreeSigPlacesFormat,stats[psUserTime]/1000) + ' sec');
699			Add2Log('Buffers = ' + FormatFloat('#0',stats[psBuffers]));
700			Add2Log('Reads = ' + FormatFloat('#0',stats[psReads]));
701			Add2Log('Writes = ' + FormatFloat('#0',stats[psWrites]));
702			Add2Log('Fetches = ' + FormatFloat('#0',stats[psFetches]));
703			end;
704			end;
705
706			end.
707