dws2stringfunctions.pas

script language

procedure TInsertFunc.Execute;
var
  s: string;
begin
  s := Info['S'];
  Insert(Info['src'], s, Integer(Info['Index']));
  Info['S'] := s;
end;

{ TLowerCaseFunc }

procedure TLowerCaseFunc.Execute;
begin
  Info.Result := LowerCase(Info['str']);
end;

function TLowerCaseFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        LowerCase(Args[0].Eval))
    else
      result := TLowerCaseFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TLowerCaseFuncExpr.Eval: Variant;
begin
  result := LowerCase(Expr.Eval);
end;

{ TAnsiLowerCaseFunc }

procedure TAnsiLowerCaseFunc.Execute;
begin
  Info.Result := AnsiLowerCase(Info['str']);
end;

function TAnsiLowerCaseFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        AnsiLowerCase(Args[0].Eval))
    else
      result := TAnsiLowerCaseFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TAnsiLowerCaseFuncExpr.Eval: Variant;
begin
  result := AnsiLowerCase(Expr.Eval);
end;

{ TUpperCaseFunc }

procedure TUpperCaseFunc.Execute;
begin
  Info.Result := UpperCase(Info['str']);
end;

function TUpperCaseFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        UpperCase(Args[0].Eval))
    else
      result := TUpperCaseFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TUpperCaseFuncExpr.Eval: Variant;
begin
  result := UpperCase(Expr.Eval);
end;

{ TAnsiUpperCaseFunc }

procedure TAnsiUpperCaseFunc.Execute;
begin
  Info.Result := AnsiUpperCase(Info['str']);
end;

function TAnsiUpperCaseFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        AnsiUpperCase(Args[0].Eval))
    else
      result := TAnsiUpperCaseFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TAnsiUpperCaseFuncExpr.Eval: Variant;
begin
  result := AnsiUpperCase(Expr.Eval);
end;

{ TPosFunc }

procedure TPosFunc.Execute;
begin
  Info.Result := Pos(Info['subStr'], Info['str']);
end;

{ TLengthFunc }

procedure TLengthFunc.Execute;
begin
  Info.Result := Length(Info['str']);
end;

function TLengthFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypInteger,
        Length(Args[0].Eval))
    else
      result := TLengthFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TLengthFuncExpr.Eval: Variant;
begin
  result := Length(Expr.Eval);
end;

{ TTrimLeftFunc }

procedure TTrimLeftFunc.Execute;
begin
  Info.Result := TrimLeft(Info['str']);
end;

function TTrimLeftFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        TrimLeft(Args[0].Eval))
    else
      result := TTrimLeftFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TTrimLeftFuncExpr.Eval: Variant;
begin
  result := TrimLeft(Expr.Eval);
end;

{ TTrimRightFunc }

procedure TTrimRightFunc.Execute;
begin
  Info.Result := TrimRight(Info['str']);
end;

function TTrimRightFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        TrimRight(Args[0].Eval))
    else
      result := TTrimRightFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TTrimRightFuncExpr.Eval: Variant;
begin
  result := TrimRight(Expr.Eval);
end;

{ TTrimFunc }

procedure TTrimFunc.Execute;
begin
  Info.Result := Trim(Info['str']);
end;

function TTrimFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString, Trim(Args[0].Eval))
    else
      result := TTrimFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TTrimFuncExpr.Eval: Variant;
begin
  result := Trim(Expr.Eval);
end;

{ TCompareTextFunc }

procedure TCompareTextFunc.Execute;
begin
  Info.Result := CompareText(Info['str1'], Info['str2']);
end;

{ TAnsiCompareTextFunc }

procedure TAnsiCompareTextFunc.Execute;
begin
  Info.Result := AnsiCompareText(Info['str1'], Info['str2']);
end;

{ TCompareStrFunc }

procedure TCompareStrFunc.Execute;
begin
  Info.Result := CompareStr(Info['str1'], Info['str2']);
end;

{ TAnsiCompareStrFunc }

procedure TAnsiCompareStrFunc.Execute;
begin
  Info.Result := AnsiCompareStr(Info['str1'], Info['str2']);
end;

{ TIsDelimiterFunc }

procedure TIsDelimiterFunc.Execute;
begin
  Info.Result := IsDelimiter(Info['delims'], Info['s'],
    Integer(Info['index']));
end;

{ TLastDelimiterFunc }

procedure TLastDelimiterFunc.Execute;
begin
  Info.Result := LastDelimiter(Info['delims'], Info['s']);
end;

{ TQuotedStrFunc }

procedure TQuotedStrFunc.Execute;
begin
  Info.Result := QuotedStr(Info['str']);
end;

function TQuotedStrFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        QuotedStr(Args[0].Eval))
    else
      result := TQuotedStrFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TQuotedStrFuncExpr.Eval: Variant;
begin
  result := QuotedStr(Expr.Eval);
end;

{ TChrFunc }

procedure TChrFunc.Execute;
begin
  Info.Result := Chr(Integer(Info['x']));
end;

{ TOrdFunc }

procedure TOrdFunc.Execute;
begin
  Info.Result := Ord(String(Info['s'])[1]);
end;

{ TCharAtFunc }

procedure TCharAtFunc.Execute;
begin
  Info.Result := String(Info['s'])[Integer(Info['x'])];
end;

{ TSetCharAtFunc }

procedure TSetCharAtFunc.Execute;
var
  s: string;
begin
  s := Info['s'];
  s[Integer(Info['x'])] := String(Info['c'])[1];
  Info['s'] := s;
end;

{ TSetLengthFunc }

procedure TSetLengthFunc.Execute;
var
  S: string;
begin
  //procedure SetLength(var S : String; NewLength : Integer);
  S := Info['S'];
  SetLength(S, Integer(Info['NewLength']));
  Info['S'] := S;              // re-assign 'var' value
end;

{ TStringOfCharFunc }

procedure TStringOfCharFunc.Execute;
var
  Ch: string;
begin
  //function StringOfChar(Ch : String; Count : Integer) : String;
  Ch := Info['Ch'];
  if Length(Ch) < 1 then
    Ch := ' ';   // default to blank if an empty string
  Info.Result := StringOfChar(Ch[1], Integer(Info['Count']));
end;

initialization
  RegisterInternalFunction(TIntToStrFunc, 'IntToStr', ['i', cInteger], cString);
  RegisterInternalFunction(TStrToIntFunc, 'StrToInt', ['str', cString], cInteger);
  RegisterInternalFunction(TStrToIntDefFunc, 'StrToIntDef', ['str', cString, 'def', cInteger], cInteger);
  RegisterInternalFunction(TIntToHexFunc, 'IntToHex', ['v', cInteger, 'digits', cInteger], cString);
  RegisterInternalFunction(TFloatToStrFunc, 'FloatToStr', ['f', cFloat], cString);
  RegisterInternalFunction(TStrToFloatFunc, 'StrToFloat', ['str', cString], cFloat);
  RegisterInternalFunction(TStrToFloatDefFunc, 'StrToFloatDef', ['str', cString, 'def', cFloat], cFloat);
  RegisterInternalFunction(TChrFunc, 'Chr', ['x', cInteger], cString);
  RegisterInternalFunction(TOrdFunc, 'Ord', ['s', cString], cInteger);
  RegisterInternalFunction(TCharAtFunc, 'CharAt', ['s', cString, 'x', cInteger], cString);
  RegisterInternalFunction(TSetCharAtFunc, 'SetCharAt', ['@s', cString, 'x', cInteger, 'c', cString], '');
  RegisterInternalFunction(TDeleteFunc, 'Delete', ['@S', cString, 'Index', cInteger, 'Len', cInteger], '');
  RegisterInternalFunction(TInsertFunc, 'Insert', ['src', cString, '@S', cString, 'Index', cInteger], '');
  RegisterInternalFunction(TLowerCaseFunc, 'LowerCase', ['str', cString], cString);
  RegisterInternalFunction(TAnsiLowerCaseFunc, 'AnsiLowerCase', ['str', cString], cString);
  RegisterInternalFunction(TUpperCaseFunc, 'UpperCase', ['str', cString], cString);
  RegisterInternalFunction(TAnsiUpperCaseFunc, 'AnsiUpperCase', ['str', cString], cString);
  RegisterInternalFunction(TPosFunc, 'Pos', ['subStr', cString, 'str', cString], cInteger);
  RegisterInternalFunction(TLengthFunc, 'Length', ['str', cString], cInteger);
  RegisterInternalFunction(TSetLengthFunc, 'SetLength', ['@S', cString, 'NewLength', cInteger], '');
  RegisterInternalFunction(TTrimLeftFunc, 'TrimLeft', ['str', cString], cString);
  RegisterInternalFunction(TTrimRightFunc, 'TrimRight', ['str', cString], cString);
  RegisterInternalFunction(TTrimFunc, 'Trim', ['str', cString], cString);
  RegisterInternalFunction(TCompareTextFunc, 'CompareText', ['str1', cString, 'str2', cString], cInteger);
  RegisterInternalFunction(TAnsiCompareTextFunc, 'AnsiCompareText', ['str1', cString, 'str2', cString], cInteger);
  RegisterInternalFunction(TCompareStrFunc, 'CompareStr', ['str1', cString, 'str2', cString], cInteger);
  RegisterInternalFunction(TAnsiCompareStrFunc, 'AnsiCompareStr', ['str1', cString, 'str2', cString], cInteger);
  RegisterInternalFunction(TIsDelimiterFunc, 'IsDelimiter', ['delims', cString, 's', cString, 'index', cInteger], cBoolean);
  RegisterInternalFunction(TLastDelimiterFunc, 'LastDelimiter', ['delims', cString, 's', cString], cBoolean);
  RegisterInternalFunction(TQuotedStrFunc, 'QuotedStr', ['str', cString], cString);
  RegisterInternalFunction(TCopyFunc, 'Copy', ['str', cString, 'Index', cInteger, 'Len', cInteger], cString);
  RegisterInternalFunction(TStringOfCharFunc, 'StringOfChar', ['Ch', cString, 'Count', cInteger], cString);
end.