imp_javascript.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,672 行 · 第 1/5 页
PAS
2,672 行
       if Copy(S, I, L) = P then
       begin
         result.AsVariant := I;

         if TPAXBaseScripter(Scripter).Code.SignZERO_BASED_STRINGS then
           result.AsVariant := result.AsVariant - 1;

         Exit;
       end;
  end;
end;

procedure _String_lastIndexOf(MethodBody: TPAXMethodBody);
var
  S, P: String;
  I, J, L: Integer;
begin
  with MethodBody do
  begin
    result.AsVariant := -1;
    L := ParamCount;
    if L = 0 then
      Exit;
     S := ToString(DefaultValue);
     P := ToString(Params[0].AsVariant);

     if L > 1 then
       J := ToInt32(Params[1].AsVariant)
     else
       J := 1;

     if J <= 0 then
       J := 1;

     L := Length(P);
     for I:=Length(S) - L downto J do
       if Copy(S, I, L) = P then
       begin
         result.AsVariant := I;

         if TPAXBaseScripter(Scripter).Code.SignZERO_BASED_STRINGS then
           result.AsVariant := result.AsVariant - 1;

         Exit;
       end;
  end;
end;

procedure _String_italics(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<I>' + ToString(DefaultValue) + '</I>';
end;

procedure _String_link(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    if ParamCount > 0 then
      Name := ToString(Params[0].AsVariant)
    else
      Name := 'undefined';
    result.AsVariant := '<A HREF="' + Name + '">' + ToString(DefaultValue) + '</A>';
  end;
end;

procedure _String_slice(M: TPAXMethodBody);
var
  IStart, IEnd, L: Integer;
  S: String;
begin
  with M do
  begin
    S := ToString(DefaultValue);
    L := Length(S);

    if ParamCount = 0 then
    begin
      IStart := 0;
      IEnd := L - 1;
    end
    else if ParamCount = 1 then
    begin
      IStart := ToInt32(Params[0].AsVariant);
      if IStart < 0 then
        IStart := IStart + L;
      IEnd := L - 1;
    end
    else
    begin
      IStart := ToInt32(Params[0].AsVariant);
      IEnd := ToInt32(Params[1].AsVariant);
      if IStart < 0 then
        IStart := IStart + L;
      if IEnd < 0 then
        IEnd := IEnd + L;
    end;

    L := IEnd - IStart + 1;

    if L > 0 then
      result.AsVariant := Copy(S, IStart, L);
  end;
end;

procedure _String_small(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<SMALL>' + ToString(DefaultValue) + '</SMALL>';
end;

procedure _String_substr(MethodBody: TPAXMethodBody);
var
  I, L: Integer;
  S: String;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);
    I := 1;
    L := Length(S);
    if ParamCount > 0 then
      I := ToInt32(Params[0].AsVariant);
    if ParamCount > 1 then
      L := ToInt32(Params[1].AsVariant);

    if TPAXBaseScripter(Scripter).Code.SignZERO_BASED_STRINGS then
       Inc(I);

    result.AsVariant := Copy(S, I, L);
  end;
end;

procedure _String_substring(MethodBody: TPAXMethodBody);
var
  I, L: Integer;
  S: String;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);
    I := 1;
    L := Length(S);
    if ParamCount > 0 then
      I := ToInt32(Params[0].AsVariant);
    if ParamCount > 1 then
      L := ToInt32(Params[1].AsVariant);

    if TPAXBaseScripter(Scripter).Code.SignZERO_BASED_STRINGS then
       Inc(I);

    result.AsVariant := Copy(S, I, L);
  end;
end;

procedure _String_strike(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<STRIKE>' + ToString(DefaultValue) + '</STRIKE>';
end;

procedure _String_sub(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<SUB>' + ToString(DefaultValue) + '</SUB>';
end;

procedure _String_sup(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<SUP>' + ToString(DefaultValue) + '</SUP>';
end;

procedure _String_Split(MethodBody: TPAXMethodBody);
var
  P, S, Q: String;
  L: TStringList;
  Dest: TPAXJavaScriptArrayObject;
  r: TRegExpr;
  I, I1, I2, K: Integer;
  SO: TPaxScriptObject;
  V: Variant;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);

    V := Params[0].AsVariant;
    if IsObject(V) then
    begin
      SO := VariantToScriptObject(V);
      if SO.ClassRec.Name = 'RegExp' then
        P := RegExp(SO.Instance).Source
      else
        P := ToString(Params[0].AsString);
    end
    else
      P := ToString(Params[0].AsString);

    L := TStringList.Create;

  	r := TRegExpr.Create;
  	try
{  		r.Expression := P;
      if r.Exec(S) then
			repeat
         I2 := r.MatchPos[0];
         K := r.MatchLen[0];
         Q := Copy(S, I1, I2 - I1);
         L.Add(Q);
         I1 := I2 + K;
			until not r.ExecNext;}

      if Length(P) = 1 then
      begin
        I1 := PosCh(P[1], S);
        while I1 > 0 do
        begin
          Q := Copy(S, 1, I1 - 1);
          L.Add(Q);
          Delete(S, 1, I1);

          I1 := PosCh(P[1], S);
        end;
        L.Add(S);
      end
      else
      begin
        r.Expression := P;
        I1 := 1;
        if r.Exec(S) then
        repeat
          I2 := r.MatchPos[0];
          K := r.MatchLen[0];
          Q := Copy(S, I1, I2 - I1);
          L.Add(Q);
          I1 := I2 + K;
        until not r.ExecNext;
        Q := Copy(S, I1, (Length(S) - I1) + 1);
        L.Add(Q);
      end;


		finally
      Dest := TPAXJavaScriptArrayObject.Create(TPaxBaseScripter(Scripter).ClassList.ArrayClassRec);
      Dest.Length := L.Count;
      for I:=0 to L.Count - 1 do
      begin
        Dest[I] := L[I];
      end;
      r.Free;
      L.Free;
    end;
    result.AsVariant := ScriptObjectToVariant(Dest);
    PSelf := nil;
  end;
end;

procedure _String_toLowerCase(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := LowerCase(ToString(DefaultValue));
end;

procedure _String_toUpperCase(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := UpperCase(ToString(DefaultValue));
end;

procedure _String_valueOf(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := ToString(DefaultValue);
end;

procedure _String_match(MethodBody: TPAXMethodBody);

function StrIsGlobal(const S: String): Boolean;
var
  I, J: Integer;
begin
  result := false;
  for I:=Length(S) downto 1 do
    if S[I] = '\' then
    begin
      for J:=I + 1 to Length(S) do
        if S[I] in ['g','G'] then
        begin
          result := true;
          Exit;
        end;
      Exit;
    end;
end;

var
  P, S, Q: String;
  L: TStringList;
  Dest: TPAXJavaScriptArrayObject;
  r: TRegExpr;
  SO: TPaxScriptObject;
  V: Variant;
  I: Integer;
  IsGlobal: Boolean;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);

    V := Params[0].AsVariant;
    if IsObject(V) then
    begin
      SO := VariantToScriptObject(V);
      if SO.ClassRec.Name = 'RegExp' then
      begin
        P := RegExp(SO.Instance).Source;
        IsGlobal := RegExp(SO.Instance).Global;
      end
      else
      begin
        P := ToString(Params[0].AsString);
        IsGlobal := StrIsGlobal(S);
      end;
    end
    else
    begin
      P := ToString(Params[0].AsString);
      IsGlobal := StrIsGlobal(S);
    end;

    L := TStringList.Create;

  	r := TRegExpr.Create;
  	try
  		r.Expression := P;
      if r.Exec(S) then
			repeat
         Q := r.Match[0];
         L.Add(Q);

         if not IsGlobal then
           Break;

			until not r.ExecNext;
		finally
      Dest := TPAXJavaScriptArrayObject.Create(TPaxBaseScripter(Scripter).ClassList.ArrayClassRec);
      Dest.Length := L.Count;
      for I:=0 to L.Count - 1 do
        Dest[I] := L[I];

      Dest.SetProperty(CreateNameIndex('index', Scripter), r.MatchPos[0]);
      Dest.SetProperty(CreateNameIndex('lastIndex', Scripter), r.MatchPos[0] + r.MatchLen[0]);
      Dest.SetProperty(CreateNameIndex('input', Scripter), S);

      r.Free;
      L.Free;
    end;
    result.AsVariant := ScriptObjectToVariant(Dest);
    PSelf := nil;
  end;
end;

procedure _String_replace(MethodBody: TPAXMethodBody);
var
  ReplaceStr: String;
  R: RegExp;
  SO: TPAXJavaScriptStringObject;
  V: Variant;
begin
  with MethodBody do
  begin
    SO := TPAXJavaScriptStringObject(Self);
    ReplaceStr := ToString(Params[1].AsVariant);

    V := Params[0].AsVariant;
    if IsObject(V) then
    begin
      R := RegExp(VariantToScriptObject(V).Instance);
      result.AsVariant := SO.Replace(R, ReplaceStr);
    end
    else
    begin
      R := RegExp.Create;
      R.Source := ToStr(Scripter, V);
      result.AsVariant := SO.Replace(R, ReplaceStr);
      R.Free;
    end;
  end;
end;

procedure _String_search(MethodBody: TPAXMethodBody);
var
  R: RegExp;
  SO: TPAXJavaScriptStringObject;
  V: Variant;
  A: TPAXJavaScriptArrayObject;
begin
  with MethodBody do
  begin
    SO := TPAXJavaScriptStringObject(Self);

    V := Params[0].AsVariant;
    if IsObject(V) then
    begin
      R := RegExp(VariantToScriptObject(V).Instance);
      A := SO.Match(R);
      result.AsVariant := A.GetProperty(CreateNameIndex('index', Scripter));
    end
    else
    begin
      R := RegExp.Create;
      R.Source := ToStr(Scripter, V);
      A := SO.Match(R);
      result.AsVariant := A.GetProperty(CreateNameIndex('index', Scripter));
      R.Free;
    end;
  end;
end;

/////////////// NUMBER ////////////////////////////////////

procedure _Number_New(MethodBody: TPAXMethodBody);
var
  SO: TPAXJavaScriptNumberObject;
  ClassRec: TPAXClassRec;
  R: Variant;
begin
  with MethodBody do
  begin
    ClassRec := TPAXBaseScripter(Scripter).ClassList.NumberClassRec;
    SO := TPAXJavaScriptNumberObject.Create(ClassRec);

    case ParamCount of
      1: R := ToNumber(Params[0].AsVariant);
      else
        R := '';
    end;
    SO.fDefaultValue := R;
    Self := SO;
    Result.AsVariant := R;
  end;
end;

/////////////// ARRAY ////////////////////////////////////

function IsJavaScriptArrayObject(const V: Variant): Boolean;
var
  SO: TPAXScriptObject;
begin
  result := IsObject(V);
  if result then
  begin
    SO := VariantToScriptObject(V);
    result := SO.ClassRec.Name = 'Array';
  end;
end;

constructor TPAXJavaScriptArrayObject.Create(ClassRec: TPAXClassRec);
begin
  inherited Create(ClassRec);
  PaxArray := TPaxArray.Create([0]);
  Instance := Self;
end;

function TPAXJavaScriptArrayObject.ExtraInstance: TObject;
begin
  result := PaxArray;
end;

function TPAXJavaScriptArrayObject.GetLength: Integer;
begin
  result := PaxArray.HighBound(1);
end;

procedure TPAXJavaScriptArrayObject.SetLength(Value: Integer);
begin
  PaxArray.ReDim([Value - 1]);
end;

procedure TPAXJavaScriptArrayObject.PutItem(I: Integer; const Value: Variant);
begin
  PaxArray.PutEx([I], Value);
end;

function TPAXJavaScriptArrayObject.GetItem(I: Integer): Variant;
begin
  result := PaxArray.GetEx([I]);
end;

function TPAXJavaScriptArrayObject.ToString: String;
var
  V: Variant;
  I: Integer;
  S: String;
begin
  result := '';
  for I:=0 to Length - 1 do
  begin
    V := Items[I];
    if IsUndefined(V) then
      S := ''
    else
      S := ToStr(Scripter, V);
    if I > 0 then
     result := result + ',';
    result := result + S;
  end;
end;

function TPAXJavaScriptArrayObject.DefaultValue: Variant;
begin
  result := ToString;
end;

destructor TPAXJavaScriptArrayObject.Destroy;
begin
  if Assigned(PaxArray) then
    PaxArray.Free;
  inherited;
end;

procedure _Array_New(MethodBody: TPAXMethodBody);
var
  SO: TPAXJavaScriptArrayObject;
  I, L: Integer;
  ClassRec: TPaxClassRec;
  V: Variant;
begin
  with MethodBody do
  begin
    if ParamCount = 0 then
      L := 0
    else if ParamCount = 1 then
    begin
imp_javascript.pas - 源码说明

本页面展示了「Delphi脚本控件」中的 imp_javascript.pas 源码文件，采用 PAS 编程语言编写，共 2,672 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫下载站收录了大量与Delphi相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?