dxjs_extern.pas

Well known and usefull component for delphi 7

         for I:=0 to L-1 do
            SO.PutProperty (IntegerToString (I) ,Parameters[I]) ;
   end;
   result:=ScriptObjectToVariant (SO) ;
   This:=result;
end;

function __Function (var This:Variant;const Parameters:array of Variant) :Variant;
const
   FuncName='___';
var
   FuncDecl,FormalParameters,Body:string;
   Loop,L:Integer;

begin
   FormalParameters:='';
   Body:='';
   L:=Length (Parameters) ;
   for Loop:=0 to L-2 do begin
      FormalParameters:=FormalParameters+ToString (Parameters[Loop]) ;
      if Loop<L-2 then FormalParameters:=FormalParameters+',';
   end;
   if L>0 then Body:=ToString (Parameters[L-1]) +';';
   FuncDecl:='function '+FuncName+'('+FormalParameters+')'+'{'+Body+'}';
   TJScript (VariantToScriptObject (This).PScript) .Eval (FuncDecl) ;
   Loop:=TJScript (VariantToScriptObject (This).PScript) .SymbolTable.LookUpID (FuncName,0) ;
   result:=TJScript (VariantToScriptObject (This).PScript) .SymbolTable.GetVariant (Loop) ;
   TJScript (VariantToScriptObject (This).PScript) .SymbolTable.SetName (Loop,'') ;
   This:=result;
end;

function __RegExp (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SO:TScriptObject;
   ARegExpr,Flags:string;
   PScript:Pointer;
begin
   SO:=VariantToScriptObject (This) ;
   PScript:=SO.PScript;

   ARegExpr:='';
   Flags:='';

   if Length (Parameters) >0 then ARegExpr:=Parameters[0];
   if Length (Parameters) >1 then Flags:=Parameters[1];

   SO:=TRegExpObject.Create (ARegExpr,Flags,PScript) ;

   result:=ScriptObjectToVariant (SO) ;
   This:=result;
end;

function __Error (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SO:TErrorObject;
   L:Integer;
   PScript:Pointer;
begin
   PScript:=VariantToScriptObject (This) .PScript;

   SO:=TErrorObject.Create (PScript) ;
   L:=Length (Parameters) ;
   if L>0 then SO.PutProperty ('number',ToInteger (Parameters[0]) ) ;
   if L>1 then SO.PutProperty ('description',ToInteger (Parameters[1]) ) ;
   result:=ScriptObjectToVariant (SO) ;
   This:=result;
end;

function __DelphiObject (var This:Variant;const Parameters:array of Variant) :Variant;
var
   ClassName:string;
   Address:Pointer;
   SO:TScriptObject;
   I,L,Index:Integer;
   AnObject:TObject;
   P:array of Variant;
begin
   SO:=VariantToScriptObject (This) ;
   AnObject:=nil;
   L:=Length (Parameters) ;
   if L>0 then begin
      ClassName:=ToString (Parameters[0]) ;
      Index:=TJScript (SO.PScript) .HostConstructorList.IndexOf (DXString.UpperCase (ClassName) ) ;
      if Index<>-1 then begin
         SetLength (P,L-1) ;
         for I:=1 to L-1 do P[I-1]:=Parameters[I];
         Address:=TJScript (SO.PScript) .HostConstructorList.Objects[Index];
         AnObject:=TDelphiConstructor (Address) (P) ;// calls constructor
try
         if AnObject.InheritsFrom (TForm) then
            TJScript (SO.PScript) .OpenWindows.Add (AnObject) ;
except
end;
      end;
   end;
   result:=ScriptObjectToVariant (TDelphiObject.Create (AnObject,SO.PScript) ) ;
   This:=result;
end;

function __ActiveXObject (var This:Variant;const Parameters:array of Variant) :Variant;
{$IFDEF LINUX}
begin
end;
{$ENDIF}
{$IFDEF WIN32}
var
   ClassName:string;
   OleObject:TVariant;
begin
   if not IsCOM then begin
      IsCOM:=true;
      CoInitialize (nil) ;
   end;
   ClassName:=ToString (Parameters[0]) ;
   OleObject:=CreateOleObject (ClassName) ;
   result:=ScriptObjectToVariant (TActiveXObject.Create (OleObject,VariantToScriptObject (This).PScript) ) ;
   This:=result;
end;
{$ENDIF}

function __DetectActiveXControl (var This:Variant;const Parameters:array of Variant) :Variant;
{$IFDEF LINUX}
begin
end;
{$ENDIF}
{$IFDEF WIN32}
var
   ClassName:string;
   _GUID:TGUID;

begin
   if not IsCOM then begin
      IsCOM:=true;
      CoInitialize (nil) ;
   end;
   ClassName:=ToString (Parameters[0]) ;
   Result:=CLSIDFromProgID(PWideChar(WideString(ClassName)), _GUID) and $80000000 = 0;;
end;
{$ENDIF}


function __EnumeratorObject (var This:Variant;const Parameters:array of Variant) :Variant;
begin
{
  result := ScriptObjectToVariant (TEnumeratorObject.Create(
     ToObject(Parameters[0], VariantToScriptObject(This).PScript),
     VariantToScriptObject (This).PScript) ) ;
}
  result := ScriptObjectToVariant (TEnumeratorObject.Create(
     Parameters[0],
     VariantToScriptObject (This).PScript) ) ;
  This:=result;
end;

function __EnumeratorMoveFirst(var This:Variant;const Parameters:array of Variant) :Variant;
begin
  TEnumeratorObject(VariantToScriptObject(This)).MoveFirst;
end;

function __EnumeratorMoveNext(var This:Variant;const Parameters:array of Variant) :Variant;
begin
  TEnumeratorObject(VariantToScriptObject(This)).MoveNext;
end;

function __EnumeratorItem(var This:Variant;const Parameters:array of Variant) :Variant;
begin
  Result:=TEnumeratorObject(VariantToScriptObject(This)).Item;
end;

function __EnumeratorAtEnd(var This:Variant;const Parameters:array of Variant) :Variant;
begin
  Result:=TEnumeratorObject(VariantToScriptObject(This)).AtEnd;
end;

function __execRegExp (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
   SO:TRegExpObject;
begin
   if Length (Parameters) >0 then begin
      S:=ToString (Parameters[0]) ;
      SO:=TRegExpObject (VariantToScriptObject (This) ) ;
      result:=SO.Exec (S) ;
   end;
end;

function __testRegExp (var This:Variant;const Parameters:array of Variant) :Variant;
var
   V:Variant;
begin
   V:=__execRegExp (This,Parameters) ;
   result:= (VarType (V) <>varNull) and (VarType (V) <>varUndefined) ;
end;

function __toStringRegExp (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:=ToString (This) ;
end;

function _eval (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Code:string;
   SO:TGlobalObject;
begin
   if Length (Parameters) <1 then begin
      result:=Undefined;
   end
   Else Begin
      Code:=ToString (Parameters[0]) ;
      SO:=TGlobalObject (VariantToScriptObject (This) ) ;
      result:=TJScript (SO.PScript) .Eval (Code) ;
   End;
end;

function _escape (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:String;
begin
   S:=ToString(this);
   Result:=DXString.EscapeEncode(S);
end;

function _unescape (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:String;
begin
   S:=ToString(this);
   Result:=DXString.EscapeDecode(S);
end;

function _parseInt (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
   D:Double;
   Ws:string; // July 22
   A:Variant;

begin
   if Length (Parameters) >0 then begin //715
      If Length (Parameters)=2 then Begin // 715 contains RADIX
         A:=Parameters[0];
         Result:=__toString(A,Parameters[1]);
      End
      Else begin
         S:=ToString (Parameters[0]) ;
         if S='NaN' then result:=NaN
         else begin
            Ws:='';
            while (S<>'') and (S[1]in ['0'..'9']) do begin
               Ws:=Ws+S[1];
               Delete (S,1,1) ;
            end;
            if Ws='' then result:=NaN
            else begin
               D:=SysUtils.StrToInt (Ws) ;
               result:=D;
            end;
         end;
      End;
   end
end;

function _parseFloat (var This:Variant;const Parameters:array of Variant) :
   Variant;
var
   S:string;
   D:Double;
   Ws:string;// July 22
begin
   if Length (Parameters) =1 then begin //715
      S:=ToString (Parameters[0]) ;
      if S='NaN' then result:=NaN
      else begin
         Ws:='';
         while (S<>'') and (S[1]in ['0'..'9','.']) do begin
            Ws:=Ws+S[1];
            Delete (S,1,1) ;
         end;
         if Ws='' then result:=NaN
         else begin
            D:=SysUtils.StrToFloat (Ws) ;
            result:=D;
         end;
      end;
   end;
end;

function _isNaN (var This:Variant;const Parameters:array of Variant) :Variant;
var
   D:Double;
begin
   result:=false;
   if Length (Parameters) >0 then begin
      D:=ToNumber (Parameters[0]) ;
      if D=NaN then
         result:=true;
   end;
end;

function _isFinite (var This:Variant;const Parameters:array of Variant) :Variant;
var
   D:Double;
begin
   result:=true;
   if Length (Parameters) >0 then begin
      D:=ToNumber (Parameters[0]) ;
      if (D=NaN) or (D=POSITIVE_INFINITY) or (D=NEGATIVE_INFINITY) then
         result:=false;
   end;
end;

function __anchor (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Name:string;
begin
   if Length (Parameters) >0 then
      Name:=ToString (Parameters[0])
   else
      Name:='undefined';
   result:='<A NAME="'+Name+'">'+ToString (This) +'</A>';
end;

function __big (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:='<BIG>'+ToString (This) +'</BIG>';
end;

function __blink (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:='<BLINK>'+ToString (This) +'</BLINK>';
end;

function __bold (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:='<B>'+ToString (This) +'</B>';
end;

function __charAt (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
   I:Integer;
begin
   S:=ToString (This) ;
   I:=ToInt32 (Parameters[0]) ;
   if (I>=0) and (I<=Length (S) -1) then
      result:=S[I+1]
   else
      result:='';
end;

function __charCodeAt (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
   I:Integer;
begin
   S:=ToString (This) ;
   I:=ToInt32 (Parameters[0]) ;
   if (I>=0) and (I<=Length (S) -1) then
      result:=ord (S[I+1])
   else
      result:=-1;
end;

function __concat (var This:Variant;const Parameters:array of Variant) :Variant;
var
   I:Integer;
begin
   result:=ToString (This) ;
   for I:=0 to Length (Parameters) -1 do
      result:=result+ToString (Parameters[I]) ;
end;

function __fixed (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:='<TT>'+ToString (This) +'</TT>';
end;

function __fontcolor (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Name:string;
begin
   if Length (Parameters) >0 then
      Name:=ToString (Parameters[0])
   else
      Name:='undefined';
   result:='<FONT COLOR="'+Name+'">'+ToString (This) +'</FONT>';
end;

function __fontsize (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Name:string;
begin
   if Length (Parameters) >0 then
      Name:=ToString (Parameters[0])
   else
      Name:='undefined';
   result:='<FONT SIZE="'+Name+'">'+ToString (This) +'</FONT>';
end;

function __fromCharCode (var This:Variant;const Parameters:array of Variant) :Variant;
var
   I:Integer;
   B:Byte;
begin
   result:='';
   for I:=0 to Length (Parameters) -1 do begin
      B:=ToInt32 (Parameters[I]) ;
      result:=result+Chr (B) ;
   end;
end;

function __indexOf (var This:Variant;const Parameters:array of Variant) :
   Variant;
var
   S,P:string;
   J,L:Integer;
   SO:TScriptObject;

begin
   SO:=VariantToScriptObject (This) ;
   result:=-1;
   L:=Length (Parameters) ;
   if L=0 then Begin
      If Not TJScript(SO.PScript).ZeroBasedStringIndex then inc(result);
      Exit;
   end;
   S:=ToString (This) ;
   P:=ToString (Parameters[0]) ;
   if L>1 then J:=ToInt32 (Parameters[1])
   else J:=0;
   if J<=0 then J:=0;
   L:=Length (P) ;
   if (L=0) then begin{ empty search string }
      if (J>Length (S) ) then Result:=Length (S) { no more than length of string }
      else Result:=J;{ use whatever was supplied }
   end
   else begin
      Result:=Pos (P,Copy (S,J+1,Length (S) ) ) -1;
      if Result>=0 then Inc (Result,J) ;
   end;
   If Not TJScript(SO.PScript).ZeroBasedStringIndex then inc(result);
end;

function __LastIndexOf (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S,P:string;
   I,J,L:Integer;
   SO:TScriptObject;