dws2ibxmodule.pas

script language

unit dws2IbxModule;

interface

uses
  SysUtils, Classes, dws2Comp, dws2Exprs, IBDatabase, DB, IBCustomDataSet,
  IBQuery;

type
  TdwsIBXStatementObj = class(TObject)
    IBXStatement: TIBCustomDataSet;
    LUCol, ParamCol: TField;
    KeyFieldName, KeyFieldValue, LUFieldName: string;
    procedure AddLUFieldRow(sFieldValue: string);
  public

    destructor destroy; override;
  end;

  TdwsIbxDataBaseObj = class(TObject)
    IBXConnection: TIBDatabase;
  public
    destructor destroy; override;
  end;

  TdwsDBGroupObj = class(TObject)
    IBXDataset: TIBDataset;
    GroupCol: TField;
    GroupFieldName, GroupFieldValue: string;
    iGroupCnt: Integer;
    boNewGrp: boolean;
    GroupValues: TStringList;
    procedure AddFieldValue(IboCol: TField);
    procedure ResetGroup;
    procedure AddGroupRow;
    function GetGroupSum(sFieldName: string): extended;
  end;

  TiboLookUpObj = class(TdwsIBXStatementObj)
  end;

  Tdws2IBXLib = class(TDataModule)
    customIBXUnit: Tdws2Unit;
    procedure customIBXUnitClassesTStatementMethodsGetSQLEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsSetSQLEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsExecuteEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsFieldByNameEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsFieldEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsParamByNameEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTStatementMethodsSetParamEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsOpenEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsFirstEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsNextEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsEditEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsInsertEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsPostEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsDeleteEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsCloseEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsEofEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsCancelEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTQueryMethodsPriorEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTFieldMethodsSetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTFieldMethodsGetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTFieldMethodsSetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTFieldMethodsGetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTStatementMethodsFieldIsNullEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTQueryMethodsGetFilterEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsSetFilterEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsGetFilteredEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsSetFilteredEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsGetSortOrderEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsSetSortOrderEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsAddSumFieldEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsCountEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsAddGroupRowEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsRestartGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsResetGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpMethodsSumOfFieldEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTDatabaseMethodsconnectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseMethodsdisconnectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseMethodssetdialectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseMethodsgetdialectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseMethodssetcharsetEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseMethodsgetcharsetEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTQueryMethodsLookUpEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTQueryMethodsSetLookUpFieldsEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTLUFieldMethodsGetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTLUFieldMethodsGetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTLUFieldMethodsSetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTLUFieldMethodsSetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);

    procedure customIBXUnitClassesTDBFieldMethodsSetIntegerEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDBFieldMethodsSetFloatEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDBFieldMethodsSetDateTimeEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDBFieldMethodsGetIntegerEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDBFieldMethodsGetFloatEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDBFieldMethodsGetDateTimeEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetMethodsExecSQLEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBXUnitClassesTDatabaseConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTStatementConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTStatementConstructorsCreateFromDBAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTDatasetConstructorsCreateFromDBAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTQueryConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTQueryConstructorsCreateFromDBAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBXUnitClassesTDataSetGrpConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);

  private
    FScript: TDelphiWebScriptII;
    FIBXConnection: TIBDatabase;
    FIBXTransaction: TIBTransaction;
    procedure SetScript(const Value: TDelphiWebScriptII);
    procedure LUFieldSetValue(FieldValue: variant; ExtObject: TObject);
    procedure SetIBXConnection(const Value: TIBDatabase);
    procedure SetIBXTransaction(const Value: TIBTransaction);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  published
    property Script: TDelphiWebScriptII read FScript write SetScript;
    property IBXDatabase: TIBDatabase read FIBXConnection write
      SetIBXConnection;
    property IBXTransaction: TIBTransaction read FIBXTransaction write
      SetIBXTransaction;
  end;

procedure Register;

var
  dws2IBXLib: Tdws2IBXLib;

implementation

{$R *.dfm}

uses
  dws2Symbols;

procedure Register;
begin
  RegisterComponents('DWS2', [Tdws2IbxLib]);
end;

{ Tdws2IBXLibrary }

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodsconnectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIbxDataBaseObj(ExtObject) do
  begin
    IBXConnection.Connected := true;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
var
  dbh: TdwsIbxDataBaseObj;
begin
  dbh := TdwsIbxdataBaseObj.Create;
  dbh.IBXConnection := TIBDatabase.Create(self);
  dbh.IBXConnection.DatabaseName := Info['Database'];
  dbh.IBXConnection.Params.Add('user_name=' + Info['user']);
  dbh.IBXConnection.Params.Add('password=' + Info['pwd']);
  { TODO : Important: Connection type specified by db-filename string!!! }
  // dbh.IBXConnection.Protocol := cpTCP_IP;
  dbh.IBXConnection.Connected := true;
  ExtObject := dbh;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodsdisconnectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIbxDataBaseObj(ExtObject) do
  begin
    IBXConnection.Connected := false;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodsgetcharsetEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  raise Exception.Create('Not yet supported ..');
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodsgetdialectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TdwsIbxDataBaseObj(ExtObject).IBXConnection.SQLDialect;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodssetcharsetEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  con: boolean;
begin
  with TdwsIbxDataBaseObj(ExtObject).IBXConnection do
  begin
    con := Connected;
    Connected := false;
    Params.Add('lc_ctype=' + Info['sCharSet']);
    Connected := con;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatabaseMethodssetdialectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TdwsIbxDataBaseObj(ExtObject).IBXConnection.SQLDialect := Info['iDialect'];
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDataSetGrpMethodsAddGroupRowEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsDBGroupObj(ExtObject) do
  begin
    AddGroupRow;
    if boNewGrp then
    begin
      GroupFieldValue := GroupCol.AsString;
      boNewGrp := false;
      iGroupCnt := 0;
    end
    else
      boNewGrp := not (GroupFieldValue = GroupCol.AsString)
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDataSetGrpMethodsAddSumFieldEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsDBGroupObj(ExtObject) do
  begin
    GroupValues.Add(Info['FieldName'] + '=0');
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDataSetGrpMethodsCountEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['result'] := TdwsDBGroupObj(ExtObject).iGroupCnt;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDataSetGrpConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
var
  IBGroup: TdwsDBGroupObj;
  ScriptObj: IScriptObj;
  DBObj: TdwsIBXStatementObj;
begin
  ScriptObj := IScriptObj(IUnknown(Info['DataSet']));
  if ScriptObj = nil then
    DBObj := nil
  else
    DBObj := TdwsIBXStatementObj(ScriptObj.ExternalObject);
  IBGroup := TdwsDBGroupObj.Create;
  try
    IBGroup.IBXDataset := DBObj.IBxStatement as TIBDataset;
    IBGroup.GroupFieldName := Info['GroupFieldName'];
    IBGroup.GroupCol := IBGroup.IBXDataset.FieldByName(IBGroup.GroupFieldName);
    IBGroup.GroupFieldValue := IBGroup.GroupCol.AsString;
    IBGroup.GroupValues := TStringList.Create;
    ExtObject := IBGroup;
  except
    raise;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDataSetGrpMethodsGroupEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  IBGroup: TdwsDBGroupObj;
  boOK: boolean;
begin
  IBGroup := TdwsDBGroupObj(ExtObject);