{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{           DBC Layer Proxy Connectivity Classes          }
{                                                         }
{        Originally written by Jan Baumgarten             }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2020 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{  http://zeoslib.sourceforge.net  (FORUM)                }
{  http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER) }
{  http://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN)    }
{                                                         }
{  http://www.sourceforge.net/projects/zeoslib.           }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZDbcProxyStatement;

interface

{$I ZDbc.inc}

{$IFNDEF ZEOS_DISABLE_PROXY} //if set we have an empty unit
uses
  Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils,
  {$IF defined(UNICODE) and not defined(WITH_UNICODEFROMLOCALECHARS)}Windows,{$IFEND}
  ZDbcIntfs, ZDbcStatement, ZDbcLogging,
  ZCompatibility, ZVariant, ZDbcGenericResolver, ZDbcCachedResultSet,
  ZDbcUtils;

type
  { TZProxyPreparedStatement }

  {** Dbc Layer Web Proxy Prepared SQL statement interface. }
  IZProxyPreparedStatement = interface(IZPreparedStatement)
    ['{16818F5D-9A5B-4402-A71A-40839E414D2D}']
  end;

  TZDbcProxyPreparedStatement = class({$IFNDEF ZEOS73UP}TZAbstractPreparedStatement{$ELSE}TZAbstractPreparedStatement2{$ENDIF},
    IZProxyPreparedStatement)
  private
  protected
    function CreateResultSet(const ResultStr: String): IZResultSet;
    /// <summary>
    ///   Encodes the parameters into an xml string that can be sent to the server.
    /// </summary>
    /// <returns>
    ///   a string that contains the parameters.
    /// </returns>
    function EncodeParams: String;
  public
    constructor Create(const Connection: IZConnection; const SQL: string; Info: TStrings);

    /// <summary>
    ///   Executes the SQL query in this PreparedStatement object
    ///   and returns the result set generated by the query.
    /// </summary>
    /// <returns>
    ///   a ResultSet object that contains the data produced by the
    ///   query; never null
    /// </returns>
    function ExecuteQueryPrepared: IZResultSet; override;
    /// <summary>
    ///   Executes the SQL INSERT, UPDATE or DELETE statement
    ///   in this <code>PreparedStatement</code> object.
    ///   In addition,
    ///   SQL statements that return nothing, such as SQL DDL statements,
    ///   can be executed.
    /// </summary>
    /// <returns>
    ///   either the row count for INSERT, UPDATE or DELETE statements;
    ///   or 0 for SQL statements that return nothing
    /// </returns>
    function ExecuteUpdatePrepared: Integer; override;
    /// <summary>
    ///  Executes any kind of SQL statement.
    ///  Some prepared statements return multiple results; the <code>execute</code>
    ///  method handles these complex statements as well as the simpler
    ///  form of statements handled by the methods <code>executeQuery</code>
    ///  and <code>executeUpdate</code>.
    /// </summary>
    /// <returns>
    ///   True if there is an IZResultSet. False Otherwise.
    /// </returns>
    /// <see>
    ///   IZStatement.Execute
    /// </see>
    /// <remarks>
    ///   The result definition has been taken from the JDBC docs on PreparedStatement.execute()
    /// </remarks>
    function ExecutePrepared: Boolean; override;
  end;

{$ENDIF ZEOS_DISABLE_PROXY} //if set we have an empty unit
implementation
{$IFNDEF ZEOS_DISABLE_PROXY} //if set we have an empty unit

uses
  {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings, {$ENDIF}
  ZSysUtils, ZFastCode, ZMessages, ZDbcProxy, ZDbcProxyResultSet, ZDbcProxyUtils,
  ZEncoding, ZTokenizer, ZClasses,
  {$IFDEF ZEOS73UP}FMTBCD, {$ENDIF}
  // Resolvers that did not move between Zeos versions:
  ZDbcASA,ZDbcDbLibResultSet, ZDbcOracle,
  {$IFNDEF ZEOS73UP}
  // Zeos 7.2 resolvers
  ZDbcInterbase6, ZdbcPostgreSqlStatement,
  {$ELSE}
  // Zeos 7.3 resolvers
  ZDbcInterbase6Resultset, ZDbcPostgresqlResultSet,
  {$ENDIF}
  TypInfo, Variants, NetEncoding
  {$IF defined(NO_INLINE_SIZE_CHECK) and not defined(UNICODE) and defined(MSWINDOWS)},Windows{$IFEND}
  {$IFDEF NO_INLINE_SIZE_CHECK}, Math{$ENDIF};

var
  ProxyFormatSettings: TFormatSettings;

{ TZDbcProxyPreparedStatement }

constructor TZDbcProxyPreparedStatement.Create(const Connection: IZConnection; const SQL: string; Info: TStrings);
begin
  inherited;
  ResultSetType := rtScrollInsensitive;
end;

function TZDbcProxyPreparedStatement.CreateResultSet(Const ResultStr: String): IZResultSet;
var
  NativeResultSet: TZDbcProxyResultSet;
  CachedResultSet: TZCachedResultSet;
  CachedResolver: IZCachedResolver;
begin
  NativeResultSet := TZDbcProxyResultSet.Create(Connection, SQL, ResultStr);
  NativeResultSet.SetConcurrency(rcReadOnly);
  LastUpdateCount := NativeResultSet.GetUpdateCount;

  if GetResultSetConcurrency = rcUpdatable then
  begin
    case GetConnection.GetServerProvider of
      // The following cached resolvers cannot be used, because they need handles
      // from their databases: ADO, MySQL, SQLite
      spASA: CachedResolver := TZASACachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
      spMSSQL, spASE: CachedResolver := TZDBLibCachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
      spIB_FB: CachedResolver := TZInterbase6CachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
      spOracle: CachedResolver := TZOracleCachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
      spPostgreSQL: CachedResolver := TZPostgreSQLCachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
      else CachedResolver := TZGenericCachedResolver.Create(self as IZStatement, NativeResultSet.GetMetaData) as IZCachedResolver;
    end;

    CachedResultSet := TZCachedResultSet.Create(NativeResultSet, SQL, CachedResolver, ConSettings);
    CachedResultSet.SetConcurrency(rcUpdatable);
    LastResultSet := CachedResultSet;
    Result := CachedResultSet;
  end else begin
    LastResultSet := NativeResultSet;
    Result := NativeResultSet;
  end;
  if Result <> nil then
    FOpenResultSet := Pointer(Result);
end;

function BoolParamToStr(const Value: Boolean): String;
begin
  Result := BoolToStr(Value, true);
end;

function DoubleParamToStr(const Value: Double): String;
begin
  Result := FloatToStr(Value, ProxyFormatSettings);
end;

{$IFDEF ZEOS73UP}
function BcdParamToStr(const Value: TBCD): String;
begin
  Result := BCDToStr(Value, ProxyFormatSettings);
end;
{$ELSE}
function ExtendedParamToStr(const Value: Extended): String;
begin
  Result := FloatToStr(Value, ProxyFormatSettings);
end;
{$ENDIF}

function StrParamToStr(const Value: String): String;
begin
  Result := XMLEncode(Value);
end;

function DateParamToStr(const Value: TDate): String;
begin
  Result := DateToStr(Value, ProxyFormatSettings);
end;

function TimeParamToStr(const Value: TTime): String;
begin
  Result := TimeToStr(Value, ProxyFormatSettings);
end;

function DateTimeParamToStr(const Value: TDateTime): String;
begin
  Result := DateTimeToStr(Value, ProxyFormatSettings);
end;

function TZDbcProxyPreparedStatement.EncodeParams: String;
var
  ParamList: TStringList;
  TypeName: String;
  Line: String;
  x: Integer;
  TempBlob: IZBlob;
  TempBCD: TBCd;
begin
  if InParamCount = 0 then
    exit;

  ParamList := TStringList.Create;
  try
    for x := 0 to InParamCount - 1 do begin
      TypeName := GetEnumName(TypeInfo(TZSQLType), Ord(InParamTypes[x]));
      if ClientVarManager.IsNull(InParamValues[x]) then begin
        Line := 'isnull="' + BoolToStr(True, True) + '"';
      end else begin
        case InParamTypes[x] of
          stBoolean:
            Line := BoolParamToStr(ClientVarManager.GetAsBoolean(InParamValues[x]));
          stByte, stShort, stWord, stSmall, stLongWord, stInteger:
            Line := ClientVarManager.GetAsString(InParamValues[x]);
          stULong, stLong:
            Line := ClientVarManager.GetAsString(InParamValues[x]);
          stFloat, stDouble, stCurrency:
            {$IFDEF ZEOS73UP}
            Line := DoubleParamToStr(ClientVarManager.GetAsDouble(InParamValues[x]));
            {$ELSE}
            Line := DoubleParamToStr(ClientVarManager.GetAsFloat(InParamValues[x]));
            {$ENDIF}
          stBigDecimal:
            {$IFDEF ZEOS73UP}
            begin
              ClientVarManager.GetAsBigDecimal(InParamValues[x], TempBCD);
              Line := BcdParamToStr(TempBCD);
            end;
            {$ELSE}
            Line := ExtendedParamToStr(ClientVarManager.GetAsFloat(InParamValues[x]));
            {$ENDIF}
          stString, stUnicodeString:
            Line := StrParamToStr(ClientVarManager.GetAsString(InParamValues[x]));
          stDate:
            Line := DateParamToStr(ClientVarManager.GetAsDateTime(InParamValues[x]));
          stTime:
            Line := TimeParamToStr(ClientVarManager.GetAsDateTime(InParamValues[x]));
          stTimestamp:
            Line := DateTimeParamToStr(ClientVarManager.GetAsDateTime(InParamValues[x]));
          stAsciiStream, stUnicodeStream:
            if (InParamValues[x].VType = vtInterface) and Supports(InParamValues[x].VInterface, IZBlob, TempBlob) then begin
              Line := StrParamToStr(TempBlob.GetUnicodeString);
            end else begin
              Line := StrParamToStr(ClientVarManager.GetAsString(InParamValues[x]));
            end;
          stBinaryStream:
            if (InParamValues[x].VType = vtInterface) and Supports(InParamValues[x].VInterface, IZBlob, TempBlob) then begin
              Line := StrParamToStr(TNetEncoding.Base64.EncodeBytesToString(TempBlob.GetBytes));
            end else begin
              raise Exception.Create('Conversion of parameter of type ' + TypeName + ' to stBinaryStream is not supported (yet).');
            end;
          else raise Exception.Create('Conversion of parameter of type ' + TypeName + ' is not supported (yet).');
        end;
        Line := 'value="' + Line + '"';
      end;
      ParamList.Add('<param ' + 'type="' + TypeName + '" ' + Line + ' />');
    end;
    Result := '<params>' + ParamList.Text + '</params>';
  finally
    FreeAndNil(ParamList);
  end;
end;

function TZDbcProxyPreparedStatement.ExecuteQueryPrepared: IZResultSet;
begin
  ExecutePrepared;
  Result := LastResultSet;
end;

function TZDbcProxyPreparedStatement.ExecuteUpdatePrepared: Integer;
begin
  ExecutePrepared;
  Result := LastUpdateCount;
end;

function TZDbcProxyPreparedStatement.ExecutePrepared: Boolean;
var
  Params: String;
  ResultStr: String;
const
  ResultSetStart = '<resultset ';
begin
  Params := EncodeParams;
  ResultStr := (Connection as IZDbcProxyConnection).GetConnectionInterface.ExecuteStatement(SQL, Params, GetMaxRows);

  if copy(ResultStr, 1, length(ResultSetStart)) = ResultSetStart  then begin
    Result := True;
    CreateResultSet(ResultStr);
  end else begin
    Result := False;
    LastResultSet := nil;
    LastUpdateCount := StrToInt(ResultStr);
  end;

  inherited ExecutePrepared;
end;

initialization
  ProxyFormatSettings.DateSeparator := '-';
  ProxyFormatSettings.LongDateFormat := 'YYYY/MM/DD';
  ProxyFormatSettings.ShortDateFormat := 'YYYY/MM/DD';
  ProxyFormatSettings.LongTimeFormat := 'HH:NN:SS.ZZZ';
  ProxyFormatSettings.ShortTimeFormat := 'HH:NN:SS.ZZZ';
  ProxyFormatSettings.DecimalSeparator := '.';
  ProxyFormatSettings.TimeSeparator := ':';
  ProxyFormatSettings.ThousandSeparator := ',';

{$ENDIF ZEOS_DISABLE_PROXY} //if set we have an empty unit
end.

