dws2ibomodule.pas

script language

{**********************************************************************}
{                                                                      }
{    "The contents of this file are subject to the Mozilla Public      }
{    License Version 1.1 (the "License"); you may not use this         }
{    file except in compliance with the License. You may obtain        }
{    a copy of the License at                                          }
{                                                                      }
{    http://www.mozilla.org/MPL/                                       }
{                                                                      }
{    Software distributed under the License is distributed on an       }
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
{    or implied. See the License for the specific language             }
{    governing rights and limitations under the License.               }
{                                                                      }
{    The Original Code is DelphiWebScriptII source code, released      }
{    January 1, 2001                                                   }
{                                                                      }
{    http://www.dwscript.com                                           }
{                                                                      }
{    The Initial Developers of the Original Code are Matthias          }
{    Ackermann and hannes hernler.                                     }
{    Portions created by Matthias Ackermann are Copyright (C) 2001     }
{    Matthias Ackermann, Switzerland. All Rights Reserved.             }
{    Portions created by hannes hernler are Copyright (C) 2001         }
{    hannes hernler, Austria. All Rights Reserved.                     }
{                                                                      }
{    Contributor(s): ______________________________________.           }
{                                                                      }
{**********************************************************************}

unit dws2IboModule;

interface

uses
  Windows,  SysUtils, Controls, Classes, Forms,
  dws2Comp, dws2Exprs, IB_Session, IB_Components;

type
  TdwsIBOStatementObj = class(TObject)
    IBOStatement: TIB_Statement;
    LUCol, ParamCol: TIB_Column;
    KeyFieldName, KeyFieldValue, LUFieldName: string;
    procedure AddLUFieldRow(sFieldValue: string);
  public
   destructor destroy; override;
  end;

  TdwsIboDataBaseObj = class(TObject)
    IBOConnection: TIB_Connection;
  public
   destructor destroy; override;
  end;

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

  TiboLookUpObj = class(TdwsIBOStatementObj)
  end;


  Tdws2IboLib = class(TDataModule)
    customIBOUnit: Tdws2Unit;
    procedure AFreeExtObject(Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsGetSQLEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsSetSQLEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsExecuteEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsFieldByNameEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsFieldEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsParamByNameEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsSetParamEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsCreateFromDBEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsOpenEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsFirstEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsNextEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsEditEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsInsertEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsPostEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsDeleteEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsCloseEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsPriorEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTFieldMethodsSetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTFieldMethodsGetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTFieldMethodsSetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTFieldMethodsGetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsEofEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTStatementMethodsFieldIsNullEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetMethodsCancelEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsGetFilterEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsSetFilterEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsGetFilteredEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsSetFilteredEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsGetSortOrderEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsSetSortOrderEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsAddSumFieldEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsCountEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsAddGroupRowEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsRestartGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsResetGroupEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpMethodsSumOfFieldEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsCreateFromDBEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodsconnectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodsdisconnectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodssetdialectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodsgetdialectEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodssetcharsetEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseMethodsgetcharsetEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsLookUpEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTQueryMethodsSetLookUpFieldsEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTLUFieldMethodsGetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTLUFieldMethodsGetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTLUFieldMethodsSetValueEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTLUFieldMethodsSetValueStrEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsSetIntegerEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsSetFloatEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsSetDateTimeEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsGetIntegerEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsGetFloatEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDBFieldMethodsGetDateTimeEval(
      Info: TProgramInfo; ExtObject: TObject);
    procedure customIBOUnitClassesTDatabaseConstructorscreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBOUnitClassesTStatementConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBOUnitClassesTStatementConstructorsCreateFromDBAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBOUnitClassesTDatasetConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBOUnitClassesTQueryConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
    procedure customIBOUnitClassesTDataSetGrpConstructorsCreateAssignExternalObject(
      Info: TProgramInfo; var ExtObject: TObject);
  private
    FScript: TDelphiWebScriptII;
    FIBOConnection: TIB_Connection;
    FIBOTransaction: TIB_Transaction;
//    FConstantSrc: Tdws2Constants;
    procedure SetScript(const Value: TDelphiWebScriptII);
    procedure SetIBOConnection(const Value: TIB_Connection);
    procedure SetIBOTransaction(const Value: TIB_Transaction);
    procedure LUFieldSetValue(FieldValue: variant; ExtObject: TObject);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property Script: TDelphiWebScriptII read FScript write SetScript;
    property IBOConnection: TIB_Connection read FIBOConnection write SetIBOConnection;
    property IBOTransaction: TIB_Transaction read FIBOTransaction write SetIBOTransaction;
//    property ConstantSrc: Tdws2Constants read FConstantSrc write FConstantSrc;
  end;

procedure Register;

var
  dws2IboLib: Tdws2IboLib;

implementation

{$R *.DFM}

uses
  dws2Symbols;

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

// ****************************************************************************
// ********************* internal library classes  *****************************
// ****************************************************************************

destructor TdwsIBOStatementObj.destroy;
begin
  if assigned(IBOStatement) then
    IBOStatement.Unprepare;
  inherited destroy;
end;

procedure TdwsIBOStatementObj.AddLUFieldRow(sFieldValue: string);
begin
  TIB_Query(IBOStatement).Insert;
  IBOStatement.FieldByName(KeyFieldName).asstring := KeyFieldValue;
  LUCol.AsString := sFieldValue;
  TIB_Query(IBOStatement).Post;
end;

destructor TdwsIboDataBaseObj.destroy;
begin
  if assigned(IBOConnection) then
    IBOConnection.Close;
  inherited destroy;
end;

// ****************************************************************************
// ********************* DBGroupObj object ***********************************
// ****************************************************************************
procedure TdwsDBGroupObj.AddFieldValue(IboCol: TIB_Column);
var
  rSum: extended;
  sH: string;
begin
  rSum := IboCol.AsExtended;
  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;

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 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])
      + IBODataset.FieldByName(sH).asextended;
    GroupValues.Values[sH] := Format('%g', [rSum]);
  end;
end;



// ****************************************************************************
// ********************* IBO Library object ***********************************
// ****************************************************************************

procedure Tdws2IboLib.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FScript) then
    SetScript(nil);
  if (Operation = opRemove) and (AComponent = FIBOConnection) then
    SetIBOConnection (nil);
  if (Operation = opRemove) and (AComponent = FIBOTransaction) then
    SetIBOTransaction (nil);
end;