dws2ibxmodule.pas

script language

    with DBLookUp do
    begin
      if TIBQuery(IBXStatement).Locate(KeyFieldName, KeyFieldValue,
        [loCaseInsensitive]) then
      begin
        Info['Result'] :=
          Info.Vars['TDBField'].GetConstructor('Create', LUCol).Call.Value;
      end
      else
      begin // datarow not found by locate
        Info['Result'] :=
          Info.Vars['TLUField'].GetConstructor('Create', DBLookUp).Call.Value;
      end;
    end
  else
    Info['Result'] := 'no lookup field';
end;

procedure Tdws2IBXLib.customIBXUnitClassesTQueryMethodsPriorEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIBQuery(TdwsIBxStatementObj(ExtObject).IBXStatement) do
  begin
    prior;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTQueryMethodsSetFilteredEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIBQuery(TdwsIBXStatementObj(ExtObject).IBXStatement) do
  begin
    Filtered := Info['Filtered'];
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTQueryMethodsSetFilterEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIBQuery(TdwsIBXStatementObj(ExtObject).IBXStatement) do
  begin
    Filter := Info['FilterStr'];
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTQueryMethodsSetLookUpFieldsEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIBXStatementObj(ExtObject) do
  try
    if not (IBXStatement as TIBQuery).Prepared then
      (IBXStatement as TIBQuery).Prepare;
    KeyFieldName := Info['KeyFieldName'];
    LUFieldName := Info['LUFieldName'];
    //    ParamCol := IBOStatement.ParamByName(KeyFieldName);
    LUCol := IBXStatement.FieldByName(LUFieldName);
  except
    raise;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTQueryMethodsSetSortOrderEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  raise Exception.Create('Not supported by IBX');
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TdwsIBXStatementObj.Create;
  TdwsIBXStatementObj(ExtObject).IBXStatement := TIBQuery.Create(self);
  TdwsIBXStatementObj(ExtObject).IBXStatement.Database := FIBXConnection;
  TdwsIBXStatementObj(ExtObject).IBXStatement.Transaction := FIBXTransaction;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementConstructorsCreateFromDBAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
var
  ScriptObj: IScriptObj;
  DBObj: TdwsIbxDataBaseObj;
begin
  ScriptObj := IScriptObj(IUnknown(Info['Database']));
  if ScriptObj = nil then
    DBObj := nil
  else
    DBObj := TdwsIbxDataBaseObj(ScriptObj.ExternalObject);

  ExtObject := TdwsIBXStatementObj.Create;
  TdwsIBXStatementObj(ExtObject).IBXStatement := TIBQuery.Create(self);
  TdwsIBXStatementObj(ExtObject).IBXStatement.Database := DBObj.IBXConnection;
  TdwsIBXStatementObj(ExtObject).IBXStatement.Transaction := FIBXTransaction;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsExecuteEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  (TdwsIBXStatementObj(ExtObject).IBXStatement as TIBQuery).ExecSQL;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsFieldByNameEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    Info.Vars['TDBField'].GetConstructor('Create',
    TdwsIBXStatementObj(ExtObject).IBXStatement.FieldByName(Info['FieldName'])
    ).Call.Value;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsFieldEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  MyStatement: TIBCustomDataSet;
  IboCol: TField;
  sFieldName: string;
begin
  MyStatement := TdwsIBXStatementObj(ExtObject).IBXStatement;
  sFieldName := Info['FieldName'];
  IboCol := MyStatement.FindField(sFieldName);
  with MyStatement do
    if IboCol = nil then
      Info['Result'] := '!!dbfield(' + sFieldName + ')??'
    else
    begin
      if (MyStatement is TIBDataset) and (IboCol.IsNull or
        TIBDataset(MyStatement).eof
        or TIBDataset(MyStatement).bof) then
      begin
        { TODO : .IsNumeric not available in IBX! }
        //if IboCol.IsNumeric then
        //begin
        //   Info['Result'] := 0.0
        //end
        //else
        Info['Result'] := '';
      end
      else
        Info['Result'] := IboCol.AsVariant;
    end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsFieldIsNullEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with (TdwsIBXStatementObj(ExtObject).IBXStatement) do
  begin
    Info['Result'] := FieldByName(Info['FieldName']).IsNull;
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsGetSQLEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := (TdwsIBXStatementObj(ExtObject).IBXStatement as
    TIBQuery).SQL.Text;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsParamByNameEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    Info.Vars['TDBField'].GetConstructor('Create',
    (TdwsIBXStatementObj(ExtObject).IBXStatement as
    TIBQuery).ParamByName(Info['ParamName'])
    ).Call.Value;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsSetParamEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  (TdwsIBXStatementObj(ExtObject).IBXStatement as
    TIBQuery).parambyname(Info['ParamName']).Value
    := Info['Value'];
end;

procedure Tdws2IBXLib.customIBXUnitClassesTStatementMethodsSetSQLEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  (TdwsIBXStatementObj(ExtObject).IBXStatement as TIBQuery).SQL.Text :=
    Info['sSQL'];
end;

procedure Tdws2IBXLib.LUFieldSetValue(FieldValue: variant;
  ExtObject: TObject);
var
  sFieldValue: string;
begin
  with TdwsIBXStatementObj(ExtObject) do
  begin
    if IBxStatement.FieldByName(KeyFieldName).AsString = KeyFieldValue then
    begin
      LUCol.AsVariant := FieldValue;
    end
    else
    begin
      sFieldValue := FieldValue;
      AddLUFieldRow(sFieldValue);
    end;
  end;
end;

procedure Tdws2IBXLib.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FScript) then
    SetScript(nil);
  if (Operation = opRemove) and (AComponent = FIBXConnection) then
    SetIBXConnection(nil);
  if (Operation = opRemove) and (AComponent = FIBXTransaction) then
    SetIBXTransaction(nil);
end;

procedure Tdws2IBXLib.SetIBXConnection(const Value: TIBDatabase);
begin
  FIBXConnection := Value;
end;

procedure Tdws2IBXLib.SetIBXTransaction(const Value: TIBTransaction);
begin
  FIBXTransaction := Value;
end;

procedure Tdws2IBXLib.SetScript(const Value: TDelphiWebScriptII);
var
  x: Integer;
begin
  if Assigned(FScript) then
    FScript.RemoveFreeNotification(Self);
  if Assigned(Value) then
    Value.FreeNotification(Self);
  FScript := Value;
  for x := 0 to ComponentCount - 1 do
    if Components[x] is Tdws2Unit then
      Tdws2Unit(Components[x]).Script := Value;
end;
{begin
  FScript := Value;
  customIBXUnit.Script := Value;
end;
}
{ TdwsIBXStatementObj }

procedure TdwsIBXStatementObj.AddLUFieldRow(sFieldValue: string);
begin
  TIBQuery(IBXStatement).Insert;
  IBXStatement.FieldByName(KeyFieldName).asstring := KeyFieldValue;
  LUCol.AsString := sFieldValue;
  TIBQuery(IBXStatement).Post;
end;

destructor TdwsIBXStatementObj.destroy;
begin
  if assigned(IBXStatement) then
    IBXStatement.Close;
  inherited destroy;
end;

{ TdwsIboDataBaseObj }

destructor TdwsIbxDataBaseObj.destroy;
begin
  if assigned(IBXConnection) then
    IBXConnection.Close;
  inherited destroy;
end;

{ TdwsDBGroupObj }

{ATTENTION: IBX fields max. .AsFloat!!!}

procedure TdwsDBGroupObj.AddFieldValue(IboCol: TField);
var
  rSum: extended;
  sH: string;
begin
  rSum := IboCol.AsFloat;
  if GroupValues.IndexOfName(IboCol.FieldName) < 0 then
  begin
    sH := IboCol.FieldName + '=' + Format('%g', [rSum]);
    GroupValues.Add(sH);
  end
  else
  begin
    try
      sH := GroupValues.Values[IboCol.FieldName];
      rSum := rSum + StrToFloat(sH);
    except
      rSum := 0;
    end;
    GroupValues.Values[IboCol.FieldName] := Format('%g', [rSum]);
  end;
end;

procedure TdwsDBGroupObj.AddGroupRow;
var
  rSum: extended;
  sH: string;
  ii: Integer;
begin
  for ii := 0 to GroupValues.Count - 1 do
  begin
    sH := GroupValues.Names[ii];
    rSum := StrToFloat(GroupValues.Values[sH])
      + IBXDataset.FieldByName(sH).AsFloat;
    GroupValues.Values[sH] := Format('%g', [rSum]);
  end;
end;

function TdwsDBGroupObj.GetGroupSum(sFieldName: string): extended;
var
  sH: string;
begin
  try
    sH := GroupValues.Values[sFieldName];
    result := StrToFloat(sH);
  except
    result := 0;
  end;
end;

procedure TdwsDBGroupObj.ResetGroup;
var
  ii: Integer;
begin
  for ii := 0 to GroupValues.Count - 1 do
  begin
    GroupValues.Values[GroupValues.Names[ii]] := '0';
  end;
end;

procedure Tdws2IBXLib.customIBXUnitClassesTDatasetMethodsExecSQLEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIBDataset(TdwsIBXStatementObj(ExtObject).IBXStatement) do
  begin
    Prepare;
    ExecSQL;
  end;
end;

end.