dxjs_extern.pas

Well known and usefull component for delphi 7

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
   else begin
      S:=ToString (This) ;
      P:=ToString (Parameters[0]) ;
      if L>1 then J:=ToInt32 (Parameters[1])
      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:=I-1; {ozz added -1 july 25}
            If Not TJScript(SO.PScript).ZeroBasedStringIndex then inc(result);
            Exit;
         end;
   end;
   If Not TJScript(SO.PScript).ZeroBasedStringIndex then inc(result);
end;

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

function __link (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 HREF="'+Name+'">'+ToString (This) +'</A>';
end;

function __match (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   if Length (Parameters) >0 then result:=TStringObject (VariantToScriptObject (This) ).Match (Parameters[0])
   else result:=Null;
end;

function __replace (var This:Variant;const Parameters:array of Variant) :Variant;
var
   searchValue:TVariant;
   S,replaceValue:string;
begin
   S:=ToString (This) ;
   if Length (Parameters) <2 then begin
      result:=S;
      Exit;
   end;
   searchValue:=Parameters[0];
   replaceValue:=ToString (Parameters[1]) ;
   if VarType (searchValue) =varScriptObject then begin
      if VariantToScriptObject (searchValue).ClassProp='RegExp' then begin
         result:=TStringObject (VariantToScriptObject (This)) .Replace (searchValue,replaceValue) ;
         Exit;
      end;
   end;
   result:=SysUtils.StringReplace (S,ToString (searchValue) ,replaceValue, [rfReplaceAll]) ;
end;

function __search (var This:Variant;const Parameters:array of Variant) :Variant;
var
   R:TVariant;
begin
   R:=__match (This,Parameters) ;
   if VarType (R) =varNull then begin
      result:=-1;
   end
   Else Begin
      result:=VariantToScriptObject (R).GetProperty ('index') ;
   End;
end;

function __slice (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
   StartPos,EndPos,L:Integer;
begin
   result:='';
   S:=ToString (This) ;
   L:=Length (Parameters) ;
   EndPos:=Length (S) ;
   if L>0 then begin
      StartPos:=ToInt32 (Parameters[0]) ;
      if L>1 then
         EndPos:=ToInt32 (Parameters[1]) ;
      L:=Length (S) ;
      if StartPos<0 then
         StartPos:=L+StartPos;
      if EndPos<0 then
         EndPos:=L+EndPos;
      result:=Copy (S,StartPos,EndPos-1) ;
   end;
end;

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

function __split (var This:Variant;const Parameters:array of Variant) :Variant; // Sept 2003
var
  S:String;
  splitter:string;
  SO: TScriptObject;
  I, L, M: Integer;
begin
  SO := TArrayObject.Create(VariantToScriptObject(This).PScript);
  S := ToString(This);
  If Length(Parameters) >= 1 then Begin
     if Length(Parameters) = 2 then M := ToInt32(Parameters[1])
     else M := Length(S);
     splitter:=ToString(Parameters[0]);
     L:=0;
     While Length(S)>0 do Begin
        Inc(L);
        Fetch(S,splitter,false);
     End;
     S := ToString(This);
     if L > 0 then begin
        for I:=0 to L - 1 do begin
          SO.PutProperty(IntegerToString(I), Fetch(S,splitter,false));
          Dec(M);
          if M <= 0 then Break;
        end;
     end;
  End
  else SO.PutProperty('0', S);
  Result := ScriptObjectToVariant(SO);
end;



function __substr (var This:Variant;const Parameters:array of Variant) :Variant;
var
   L,StartPos,LenS:Integer;
   S:string;
begin
   S:=ToString (This) ;
   L:=Length (Parameters) ;
   StartPos:=1;
   LenS:=Length (S) ;
   if L>0 then begin
      StartPos:=ToInt32 (Parameters[0]) ;
      if TJScript(VariantToScriptObject(This).PScript).ZeroBasedStringIndex then Inc(StartPos);  // Sept 2003
      if L>1 then
         LenS:=ToInt32 (Parameters[1]) ;
   end;
   result:=ToString(Copy (S,StartPos,LenS)) ;
end;

function __substring(var This: Variant; const Parameters: array of Variant): Variant;
var
  L, StartPos, EndPos: Integer;
  S: String;
  
begin
   { substring extracts characters from indexA up to but not including indexB. }
   S:=ToString(This);
   L:=Length(Parameters);
   StartPos:=1;
   EndPos:=Length(S);
   if L>0 then begin
      StartPos:=ToInt32(Parameters[0]);
      if TJScript(VariantToScriptObject(This).PScript).ZeroBasedStringIndex then Inc(StartPos);
      if L>1 then EndPos:=ToInt32(Parameters[1]);
   end;
   if TJScript(VariantToScriptObject(This).PScript).ZeroBasedStringIndex then Inc(EndPos);
   Result:=Copy(S,StartPos,EndPos-StartPos);
end;

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

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

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

function __toLowerCase (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:=DXString.LowerCase (ToString (This) ) ;
end;

function __toUpperCase (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:=DXString.UpperCase (ToString (This) ) ;
end;

function __toString (var This:Variant;const Parameters:array of Variant) :
   Variant;
var
   S:string;

begin
   S:=ToString (This) ;
//715   if DXString.isNumericString (S) then begin
      if Length (Parameters) >0 then begin
         if ToString (Parameters[0]) ='16' then
            S:=IntToHex (StrToInt (S) ,2)
         else if ToString (Parameters[0]) ='2' then
            S:=DXString.BinaryToString (StrToInt (S) )
         else if ToString (Parameters[0]) ='36' then
            S:=DXString.StringToBase36 (S)
         else if ToString (Parameters[0]) ='64' then
            S:=DXString.StringToBase64 (S) ;
      end;
//715   end
//715   else begin
//715      if Length (Parameters) >0 then
//715         if ToString (Parameters[0]) ='64' then
//715            S:=DXString.StringToBase64 (S) ;
//715   end;
   Result:=S;
end;

function __valueOfString (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;

begin
   S:=ToString (This) ;
   if DXString.isNumericString (S) then begin
      result:=StrToInt(S);
   end
   Else result:=ToString (This) ;
end;

function __trim (var This:Variant;const Parameters:array of Variant) :Variant;
var
   S:string;
begin
   S:=ToString (This) ;
   result:=Trim (S) ;
end;

function __valueOfDate (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;
begin
   Date:=ToNumber (This) ;
   {$IFNDEF VARIANTS}
   Result:=Integer(DateTimeToUnix(Date));
   {$ELSE}
   Result:=DateTimeToUnix(Date);
   {$ENDIF}
end;

function __getTime (var This:Variant;const Parameters:array of Variant) :Variant;
var
   D:TDateTime;
begin
   D:=VariantToScriptObject (This) .DefaultValue;
   {$IFNDEF VARIANTS}
   Result:=Integer(DateTimeToUnix(D));
   {$ELSE}
   Result:=DateTimeToUnix(D);
   {$ENDIF}
//720
   Result:=Result*1000;
end;

function __getFullYear (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Date:TDateTime;
   Year,Month,Day:Word;
begin
   Date:=ToNumber (This) ;
   SysUtils.DecodeDate (Date,Year,Month,Day) ;
   result:=Year;
end;

function __getUTC (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;
   I:Integer;

begin
   Date:=ToNumber (This) ;
   if length(parameters)=6 then begin
      Date:=SysUtils.EncodeDate(Parameters[0],Parameters[1],Parameters[2])+
      SysUtils.EncodeTime(Parameters[3],Parameters[4],Parameters[5],0)
   end;
   i:=DXString.DateTimeToUnix(Date); // delphi5 did not support result:=int64!
   Result:=i;
end;

function __toStringDate (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('ddd mmm d hh:nn:ss @ yyyy',Date);
   Result:=StringReplace(Result,'@',DXString.ShortTimeZone,[]);
end;

function __toUTCString (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('ddd, d mmm yyyy hh:nn:ss',DateTimeToGMT(Date));
   Result:=Result+' UTC';
end;

function __toDateString (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('ddd mmm d yyyy',Date);
end;

function __toTimeString (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('hh:nn:ss @',Date);
   Result:=StringReplace(Result,'@',DXString.ShortTimeZone,[]);
end;

function __toLocaleStringDate (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('dddd, mmmm dd, yyyy H:nn:ss AM/PM',Date);
end;

function __toLocaleDateString (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('dddd, mmmm dd, yyyy',Date);
end;

function __toLocaleTimeString (var This:Variant;const Parameters:array of Variant) :Variant;
Var
   Date:TDateTime;

begin
   Date:=ToNumber(This);
   Result:=FormatDateTime('H:nn:ss AM/PM',Date);
end;

function __getTimezoneOffset (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   Result:=DXString.TimeZoneBias
end;

function __getMonth (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Date:TDateTime;
   Year,Month,Day:Word;

begin
   Date:=ToNumber (This) ;
   SysUtils.DecodeDate (Date,Year,Month,Day) ;
   If Not TJScript(VariantToScriptObject (This).PScript).ZeroBasedStringIndex then result:=Month
   Else result:=Month-1;
end;

function __getDate (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Date:TDateTime;
   Year,Month,Day:Word;

begin
   Date:=ToNumber (This) ;
   SysUtils.DecodeDate (Date,Year,Month,Day) ;
   result:=Day;
end;

function __toGMTString (var This:Variant;const Parameters:array of Variant) :Variant;
begin
   result:=DXString.DateTimeToGMTRFC822(Now);
end;

function __getDay (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Date:TDateTime;
begin
   Date:=ToNumber (This) ;
   If Not TJScript(VariantToScriptObject (This).PScript).ZeroBasedStringIndex then result:=SysUtils.DayOfWeek (Date)
   Else result:=SysUtils.DayOfWeek (Date)-1;
end;

function __getHours (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Time:TDateTime;
   Hour,Min,Sec,MSec:Word;
begin
   Time:=ToNumber (This) ;
   SysUtils.DecodeTime (Time,Hour,Min,Sec,MSec) ;
   result:=Hour;
end;

function __getMinutes (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Time:TDateTime;
   Hour,Min,Sec,MSec:Word;
begin
   Time:=ToNumber (This) ;
   SysUtils.DecodeTime (Time,Hour,Min,Sec,MSec) ;
   result:=Min;
end;

function __getSeconds (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Time:TDateTime;
   Hour,Min,Sec,MSec:Word;
begin
   Time:=ToNumber (This) ;
   SysUtils.DecodeTime (Time,Hour,Min,Sec,MSec) ;
   result:=Sec;
end;

function __getMilliseconds (var This:Variant;const Parameters:array of Variant) :Variant;
var
   Time:TDateTime;
   Hour,Min,Sec,MSec:Word;
begin
   Time:=ToNumber (This) ;
   SysUtils.DecodeTime (Time,Hour,Min,Sec,MSec) ;
   result:=MSec;
end;