dws2ibomodule.pas

script language

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsGetFilteredEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIB_Query(TdwsIBOStatementObj(ExtObject).IBOStatement) do
  begin
    Info['Result'] :=  Filtered;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsSetFilteredEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIB_Query(TdwsIBOStatementObj(ExtObject).IBOStatement) do
  begin
    Filtered := Info['Filtered'];
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsGetSortOrderEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIB_Query(TdwsIBOStatementObj(ExtObject).IBOStatement) do
  begin
    Info['Result'] :=  OrderingItemNo;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsSetSortOrderEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TIB_Query(TdwsIBOStatementObj(ExtObject).IBOStatement) do
  begin
    OrderingItemNo := Info['SortOrder'];
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDataSetGrpConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
var
  IBGroup: TdwsDBGroupObj;
  ScriptObj: IScriptObj;
  DBObj: TdwsIBOStatementObj;
begin
  ScriptObj := IScriptObj(IUnknown(Info['DataSet']));
  if ScriptObj = nil then
    DBObj := nil
  else
    DBObj := TdwsIBOStatementObj(ScriptObj.ExternalObject);
  IBGroup := TdwsDBGroupObj.Create;
  try
    IBGroup.IBODataset := TIB_Dataset(DBObj.IBOStatement);
    IBGroup.GroupFieldName := Info['GroupFieldName'];
    IBGroup.GroupCol := IBGroup.IBODataset.Fieldbyname(IBGroup.GroupFieldName);
    IBGroup.GroupFieldValue := IBGroup.GroupCol.AsString;
    IBGroup.GroupValues := TStringList.Create;
    ExtObject := IBGroup;
  except
    raise;
  end;
end;

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

procedure Tdws2IboLib.customIBOUnitClassesTDataSetGrpMethodsGroupEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  IBGroup: TdwsDBGroupObj;
  boOK : boolean;
begin
  IBGroup := TdwsDBGroupObj(ExtObject);
  if not (IBGroup.IBODataset.eof or IBGroup.IBODataset.bof) then
  begin
    boOK := IBGroup.GroupFieldValue = IBGroup.GroupCol.AsString;
    if boOK then
      inc(IBGroup.iGroupCnt);
    Info['result'] := not boOK;
  end
  else
    Info['result'] := true;
end;

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

procedure Tdws2IboLib.customIBOUnitClassesTDataSetGrpMethodsAddGroupRowEval(
  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 Tdws2IboLib.customIBOUnitClassesTDataSetGrpMethodsRestartGroupEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsDBGroupObj(ExtObject) do
  begin
    // ResetGroup;
      GroupFieldValue := GroupCol.AsString;
      boNewGrp :=  false;
      iGroupCnt := 0;
  end;

end;

procedure Tdws2IboLib.customIBOUnitClassesTDataSetGrpMethodsResetGroupEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsDBGroupObj(ExtObject)  do
  begin
    ResetGroup;
      GroupFieldValue := GroupCol.AsString;
      boNewGrp :=  false;
      iGroupCnt := 0;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDataSetGrpMethodsSumOfFieldEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['result'] := TdwsDBGroupObj(ExtObject).GetGroupSum(Info['FieldName']);
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TdwsIBOStatementObj.Create;
  TdwsIBOStatementObj(ExtObject).IBOStatement := TIB_Query.Create(self);
  TdwsIBOStatementObj(ExtObject).IBOStatement.IB_Connection := FIBOConnection;
  TdwsIBOStatementObj(ExtObject).IBOStatement.IB_Transaction := FIBOTransaction;
end;

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

  ExtObject := TdwsIBOStatementObj.Create;
  TdwsIBOStatementObj(ExtObject).IBOStatement := TIB_Query.Create(self);
  TdwsIBOStatementObj(ExtObject).IBOStatement.IB_Connection := DBObj.IBOConnection;
  TdwsIBOStatementObj(ExtObject).IBOStatement.IB_Transaction := FIBOTransaction;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseConstructorscreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
var
  dbh: TdwsIboDataBaseObj;
begin
  dbh := TdwsIboDataBaseObj.Create;
  dbh.IBOConnection := TIB_Connection.Create(self);
  dbh.IBOConnection.DatabaseName := Info['Database'];
  dbh.IBOConnection.Username := Info['user'];
  dbh.IBOConnection.Password := Info['pwd'];
  dbh.IBOConnection.Protocol := cpTCP_IP;
  dbh.IBOConnection.Connect;
  ExtObject :=  dbh;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodsconnectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIboDataBaseObj(ExtObject)  do
  begin
    IBOConnection.Connect;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodsdisconnectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIboDataBaseObj(ExtObject)  do
  begin
    IBOConnection.Disconnect;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodssetdialectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TdwsIboDataBaseObj(ExtObject).IBOConnection.SQLDialect  := Info['iDialect'];
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodsgetdialectEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['result'] := TdwsIboDataBaseObj(ExtObject).IBOConnection.SQLDialect;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodssetcharsetEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TdwsIboDataBaseObj(ExtObject).IBOConnection.CharSet  := Info['sCharSet'];
end;

procedure Tdws2IboLib.customIBOUnitClassesTDatabaseMethodsgetcharsetEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['result'] := TdwsIboDataBaseObj(ExtObject).IBOConnection.CharSet;
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsSetLookUpFieldsEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  with TdwsIBOStatementObj(ExtObject) do
  try
    if not IBOStatement.Prepared then
      IBOStatement.Prepare;
    KeyFieldName := Info['KeyFieldName'];
    LUFieldName := Info['LUFieldName'];
//    ParamCol := IBOStatement.ParamByName(KeyFieldName);
    LUCol := IBOStatement.FieldByName(LUFieldName);
  except
    raise;
  end;
end;

procedure Tdws2IboLib.customIBOUnitClassesTQueryMethodsLookUpEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  DBLookUp: TdwsIBOStatementObj;
begin
  DBLookUp := TdwsIBOStatementObj(ExtObject);
  DBlookUp.KeyFieldValue :=  Info['KeyFieldValue'];
  if Assigned(DBLookUp.LUCol) then
  with DBLookUp do
  begin
    if TIB_Query(IBOStatement).Locate(KeyFieldName, KeyFieldValue, [lopCaseInsensitive]) 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 Tdws2IboLib.customIBOUnitClassesTLUFieldMethodsGetValueEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if TdwsIBOStatementObj(ExtObject).LUCol.IsNumeric then
    Info['Result'] := 0.0
  else
    Info['Result'] := '';
end;

procedure Tdws2IboLib.customIBOUnitClassesTLUFieldMethodsGetValueStrEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if TdwsIBOStatementObj(ExtObject).LUCol.IsNumeric then
    Info['Result'] := '0'
  else
    Info['Result'] := '';
end;


procedure Tdws2IboLib.customIBOUnitClassesTLUFieldMethodsSetValueEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  LUFieldSetValue(Info['Value'], ExtObject);
end;

procedure Tdws2IboLib.customIBOUnitClassesTLUFieldMethodsSetValueStrEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  vFieldValue : variant;
begin
  vFieldValue := Info['Value'];
  LUFieldSetValue(vFieldValue, ExtObject);
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsSetIntegerEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TIB_Column(ExtObject).AsInteger := Info['Value'];
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsSetFloatEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TIB_Column(ExtObject).AsExtended := Info['Value'];
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsSetDateTimeEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TIB_Column(ExtObject).AsDateTime := Info['Value'];
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsGetIntegerEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TIB_Column(ExtObject).AsInteger;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsGetFloatEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TIB_Column(ExtObject).AsExtended;
end;

procedure Tdws2IboLib.customIBOUnitClassesTDBFieldMethodsGetDateTimeEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TIB_Column(ExtObject).AsDateTime;
end;

end.