Улучшение импорта fs_iibxrtti.

awexawex
отредактировано 14:47 Раздел: FastScript
Для удобства работы на суд пользователям предлагаю следующую модификацию модуля.
Все пожилания и замеченные ошибки приветствуются.
Если авторы FS посчитают нужным то включайте в стандартную поставку.

Основное:

1. TIBDataBase.GenID - Ну куда же без этого.

2. TIBTransaction - > QueryValue, QueryExecute
Аналогично FIB, но логичней было сделать не у TIBDataBase
а в рамках TIBTransaction.

2. TIBQuery, TIBDataSet -> OpenWP
Избаление от строчек ParamByName :='' как в FIB
Пример Query.OpenWP([23,23])

3. TIBQuery.ExecSQLWP
{******************************************}
{             FastScript v1.8              }
{        IBX classes and functions         }
{  (c) 2003-2005 by Alexander Tzyganenko,  }
{             Fast Reports Inc             }
{******************************************}

{ Correction by Zheltkov Aleksei (zheltkov2000@mail.ru) }

unit fs_iibxrtti;

interface

{$I fs.inc}

uses
  SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti,
  DB, IBDatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc, IBSQL, IBScript;

type
  TfsIBXRTTI = class(TComponent); // fake component

implementation

type
  TFunctions = class(TObject)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: string; var Params: Variant): Variant;
    function GetProp(Instance: TObject; ClassType: TClass;
      const PropName: string): Variant;
    procedure SetProp(Instance: TObject; ClassType: TClass;
      const PropName: string; Value: Variant);
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  Functions: TFunctions;

function GenID(ADataBase: TIBDataBase; AGenerator: string; AIncrement: integer = 1): integer;
const
  SGENSQL = 'SELECT GEN_ID(%S, %D) FROM RDB$DATABASE'; {do not localize}
var
  sqlGen: TIBSQL;
begin
  sqlGen := TIBSQL.Create(ADataBase);
  sqlGen.Transaction := ADataBase.DefaultTransaction;
  try
    sqlGen.SQL.Text := Format(SGENSQL, [AGenerator, AIncrement]);
    sqlGen.ExecQuery;
    Result := sqlGen.Current.Vars[0].AsInt64;
    sqlGen.Close;
  finally
    sqlGen.Free;
  end;
end;

procedure OpenDatasetWP(ADataset: TIBDataset; AParam: array of Variant);
var
  i: integer;
begin
  if not ADataset.Prepared then
    ADataset.Prepare;
  for I := 0 to High(AParam) do
    ADataset.Params[i].Value := AParam[i];
  ADataset.Open;
end;

procedure _OpenDatasetWP(ADataset: TIBDataset; Args: Variant);
var
  TempArray: array of Variant;
  ar: TVarRecArray;
  i: integer;
begin
  VariantToVarRec(Args, ar);
  SetLength(TempArray, Length(ar));
  for i := 0 to Length(ar) - 1 do
    TempArray[i] := VarRecToVariant(ar[i]);
  ClearVarRec(ar);
  OpenDatasetWP(ADataset, TempArray);
end;

procedure OpenQueryWP(AQuery: TIBQuery; AParam: array of Variant; const AExec: Boolean);
var
  i: integer;
begin
  if not AQuery.Prepared then
    AQuery.Prepare;
  for I := 0 to High(AParam) do
    AQuery.Params[i].Value := AParam[i];
  if AExec then
    AQuery.ExecSQL
  else
    AQuery.Open;
end;

procedure _OpenQueryWP(AQuery: TIBQuery; Args: Variant; const AExec: Boolean);
var
  TempArray: array of Variant;
  ar: TVarRecArray;
  i: integer;
begin
  VariantToVarRec(Args, ar);
  SetLength(TempArray, Length(ar));
  for i := 0 to Length(ar) - 1 do
    TempArray[i] := VarRecToVariant(ar[i]);
  ClearVarRec(ar);
  OpenQueryWP(AQuery, TempArray, AExec);
end;

function QueryValue(ATransaction: TIBTransaction; ASQL: string; AParam: array of Variant): variant;
var
  Query: TIBQuery;
begin
  Query := TIBQuery.Create(nil);
  try
    Query.Transaction := ATransaction;
    Query.SQL.Text := ASQL;
    OpenQueryWP(Query, AParam, False);
    Result := Query.Fields[0].AsVariant;
  finally
    if Query.Active then
      Query.Close;
    Query.Free;
  end;
end;

function _QueryValue(ATransaction: TIBTransaction; ASQL: string; Args: Variant): variant;
var
  TempArray: array of Variant;
  ar: TVarRecArray;
  i: integer;
begin
  VariantToVarRec(Args, ar);
  SetLength(TempArray, Length(ar));
  for i := 0 to Length(ar) - 1 do
    TempArray[i] := VarRecToVariant(ar[i]);
  ClearVarRec(ar);
  Result := QueryValue(ATransaction, ASQL, TempArray);
end;

procedure QueryExecute(ATransaction: TIBTransaction; ASQL: string; AParam: array of Variant);
var
  Query: TIBQuery;
begin
  Query := TIBQuery.Create(nil);
  try
    Query.Transaction := ATransaction;
    Query.SQL.Text := ASQL;
    OpenQueryWP(Query, AParam, True);
  finally
    if Query.Active then
      Query.Close;
    Query.Free;
  end;
end;

procedure _QueryExecute(ATransaction: TIBTransaction; ASQL: string; Args: Variant);
var
  TempArray: array of Variant;
  ar: TVarRecArray;
  i: integer;
begin
  VariantToVarRec(Args, ar);
  SetLength(TempArray, Length(ar));
  for i := 0 to Length(ar) - 1 do
    TempArray[i] := VarRecToVariant(ar[i]);
  ClearVarRec(ar);
  QueryExecute(ATransaction, ASQL, TempArray);
end;

{ TFunctions }

constructor TFunctions.Create;
begin
  with fsGlobalUnit do
  begin
    AddedBy := Self;
    with AddClass(TIBXSQLVAR, 'TObject') do
    begin
      AddMethod('procedure Clear', CallMethod);
      AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
      AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
      AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
      AddProperty('AsFloat', 'Double', GetProp, SetProp);
      AddProperty('AsInteger', 'Integer', GetProp, SetProp);
      AddProperty('AsDate', 'TDate', GetProp, SetProp);
      AddProperty('AsTime', 'TTime', GetProp, SetProp);
      AddProperty('AsString', 'String', GetProp, SetProp);
      AddProperty('IsNull', 'Boolean', GetProp, nil);
    end;
    with AddClass(TIBDataBase, 'TComponent') do
    begin
      AddMethod('procedure Close', CallMethod);
      AddMethod('procedure Open', CallMethod);
      AddMethod('function GenID(AGenerator: String; AIncrement: integer = 1)', CallMethod);
      AddMethod('procedure GetTableNames(List: TStrings; SystemTables: Boolean = False)', CallMethod);
      AddMethod('procedure GetFieldNames(const TableName: string; List: TStrings)', CallMethod);
    end;
    with AddClass(TIBTransaction, 'TComponent') do
    begin
      AddMethod('procedure Rollback', CallMethod);
      AddMethod('procedure RollbackRetaining', CallMethod);
      AddMethod('procedure Commit', CallMethod);
      AddMethod('procedure CommitRetaining', CallMethod);
      AddMethod('procedure StartTransaction', CallMethod);
      AddMethod('function QueryValue(ASQL: string; AParams: array): Variant', CallMethod);
      AddMethod('procedure QueryExecute(ASQL: string; AParams: array)', CallMethod);
    end;
    AddClass(TIBCustomDataSet, 'TDataSet');
    AddClass(TIBTable, 'TIBCustomDataSet');
    with AddClass(TIBDataSet, 'TIBCustomDataSet') do
    begin
      AddMethod('procedure OpenWP(AParams: array)', CallMethod);
      AddMethod('function ParamByName(Value : String) : TIBXSQLVAR', CallMethod);
    end;
    with AddClass(TIBQuery, 'TIBCustomDataSet') do
    begin
      AddMethod('procedure ExecSQL', CallMethod);
      AddMethod('procedure ExecSQLWP(AParams: array)', CallMethod);
      AddMethod('procedure OpenWP(AParams: array)', CallMethod);
      AddMethod('function ParamByName(Value: string): TParam', CallMethod);
    end;
    with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
      AddMethod('procedure ExecProc', CallMethod);
    AddClass(TIBStringField, 'TStringField');
    AddClass(TIBBCDField, 'TBCDField');
    with AddClass(TIBSQL, 'TComponent') do
    begin
      AddMethod('procedure ExecQuery', CallMethod);
      AddMethod('function ParamByName(Value : String) : TIBXSQLVAR', CallMethod);
    end;
    with AddClass(TIBScript, 'TComponent') do
    begin
      AddMethod('procedure ExecuteScript', CallMethod);
    end;
    AddedBy := nil;
  end;
end;

destructor TFunctions.Destroy;
begin
  if fsGlobalUnit <> nil then
    fsGlobalUnit.RemoveItems(Self);
  inherited;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: string; var Params: Variant): Variant;
begin
  Result := 0;
  if ClassType = TIBXSQLVAR then
  begin
    if MethodName = 'CLEAR' then
      TIBXSQLVAR(Instance).Clear
  end
  else if ClassType = TIBDataBase then
  begin
    if MethodName = 'OPEN' then
      TIBDataBase(Instance).Open
    else if MethodName = 'CLOSE' then
      TIBDataBase(Instance).Close
    else if MethodName = 'GENID' then
      Result := GenID(TIBDataBase(Instance), Params[0], Params[1])
    else if MethodName = 'GETTABLENAMES' then
      TIBDataBase(Instance).GetTableNames(TStrings(integer(Params[0])), Params[1])
    else if MethodName = 'GETFIELDNAMES' then
      TIBDataBase(Instance).GetFieldNames(Params[0], TStrings(integer(Params[1])));
  end
  else if ClassType = TIBTransaction then
  begin
    if MethodName = 'STARTTRANSACTION' then
      TIBTransaction(Instance).StartTransaction
    else if MethodName = 'ROLLBACK' then
      TIBTransaction(Instance).Rollback
    else if MethodName = 'ROLLBACKRETAINING' then
      TIBTransaction(Instance).RollbackRetaining
    else if MethodName = 'COMMIT' then
      TIBTransaction(Instance).Commit
    else if MethodName = 'COMMITRETAINING' then
      TIBTransaction(Instance).CommitRetaining
    else if MethodName = 'QUERYVALUE' then
      Result := _QueryValue(TIBTransaction(Instance), string(Params[0]), Params[1])
    else if MethodName = 'QUERYEXECUTE' then
      _QueryExecute(TIBTransaction(Instance), string(Params[0]), Params[1]);
  end
  else if ClassType = TIBDataSet then
  begin
    if MethodName = 'OPENWP' then
      _OpenDatasetWP(TIBDataSet(Instance), Params[0])
    else if MethodName = 'PARAMBYNAME' then
      Result := Integer(TIBDataSet(Instance).ParamByName(Params[0]))
  end
  else if ClassType = TIBQuery then
  begin
    if MethodName = 'EXECSQL' then
      TIBQuery(Instance).ExecSQL
    else if MethodName = 'PARAMBYNAME' then
      Result := integer(TIBQuery(Instance).ParamByName(Params[0]))
    else if MethodName = 'EXECSQLWP' then
      _OpenQueryWP(TIBQuery(Instance), Params[0], True)
    else if MethodName = 'OPENWP' then
      _OpenQueryWP(TIBQuery(Instance), Params[0], False);
  end
  else if ClassType = TIBStoredProc then
  begin
    if MethodName = 'EXECPROC' then
      TIBStoredProc(Instance).ExecProc
  end
  else if ClassType = TIBSQL then
  begin
    if MethodName = 'EXECQUERY' then
      TIBSQL(Instance).ExecQuery
    else if MethodName = 'PARAMBYNAME' then
      Result := Integer(TIBSQL(Instance).ParamByName(Params[0]))
  end
  else if ClassType = TIBScript then
  begin
    if MethodName = 'EXECUTESCRIPT' then
      TIBScript(Instance).ExecuteScript;
  end;
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: string): Variant;
var
  _TIBXSQLVAR: TIBXSQLVAR;
begin
  Result := 0;
  if ClassType = TIBXSQLVAR then
  begin
    _TIBXSQLVAR := TIBXSQLVAR(Instance);
    if PropName = 'ISNULL' then
      Result := _TIBXSQLVAR.IsNull
    else if PropName = 'ASBOOLEAN' then
      Result := _TIBXSQLVAR.AsBoolean
    else if PropName = 'ASCURRENCY' then
      Result := _TIBXSQLVAR.AsCurrency
    else if PropName = 'ASDATETIME' then
      Result := _TIBXSQLVAR.AsDateTime
    else if PropName = 'ASFLOAT' then
      Result := _TIBXSQLVAR.AsFloat
    else if PropName = 'ASINTEGER' then
      Result := _TIBXSQLVAR.AsInteger
    else if PropName = 'ASDATE' then
      Result := _TIBXSQLVAR.AsDate
    else if PropName = 'ASTIME' then
      Result := _TIBXSQLVAR.AsTime
    else if PropName = 'ASSTRING' then
      Result := _TIBXSQLVAR.AsString
  end;
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; const PropName: string; Value: Variant);
var
  _TIBXSQLVAR: TIBXSQLVAR;
begin
  if ClassType = TIBXSQLVAR then
  begin
    _TIBXSQLVAR := TIBXSQLVAR(Instance);
    if PropName = 'ASBOOLEAN' then
      _TIBXSQLVAR.AsBoolean := Value
    else if PropName = 'ASCURRENCY' then
      _TIBXSQLVAR.AsCurrency := Value
    else if PropName = 'ASDATETIME' then
      _TIBXSQLVAR.AsDateTime := Value
    else if PropName = 'ASFLOAT' then
      _TIBXSQLVAR.AsFloat := Value
    else if PropName = 'ASINTEGER' then
      _TIBXSQLVAR.AsInteger := Value
    else if PropName = 'ASDATE' then
      _TIBXSQLVAR.AsDate := Value
    else if PropName = 'ASTIME' then
      _TIBXSQLVAR.AsTime := Value
    else if PropName = 'ASSTRING' then
      _TIBXSQLVAR.AsString := Value;
  end
end;

initialization
  Functions := TFunctions.Create;

finalization
  Functions.Free;
end.

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.

Начало • FastScriptКомментировать как ...

© Vanilla Keystone Theme 2024