dxjs_conv.pas

Well known and usefull component for delphi 7

////////////////////////////////////////////////////////////////////////////
//    Component: DXJS_CONV
//       Author: Alexander Baranovsky ([e-mail])
//               G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 2002, 2004
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
// Code Version: (3rd Generation)
// ========================================================================
//  Description: Type Conversion Routines
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit DXJS_CONV;
interface
{$I DXJavaScript.def}

uses
{$IFDEF VARIANTS}
  Variants,
{$ENDIF}
  DXJS_SHARE,
  DXJS_OBJECT;

function ScriptObjectToVariant(Value: TScriptObject): TVariant;
function VariantToScriptObject(Value: TVariant): TScriptObject;
function ToDelphiObject(Value: TVariant): TObject;
function DelphiObjectToVariant(Instance: TObject): Variant;
function ToString(const Value: TVariant): String;
function ToStr(const Value: TVariant): String;
function ToObject(const Value: TVariant; AScript: Pointer): TVariant;
function ToPrimitive(const V: TVariant): TVariant;
function ToBoolean(const V: TVariant): TVariant;
function ToNumber(const V: TVariant): TVariant;
function ToInt32(const V: TVariant): TVariant;
function ToInteger(const V: TVariant): TVariant;
// new AUGUST 6 2003
function VariantArrayToJavaScriptArray(const V: TVariant; Scripter: Pointer): TVariant;

implementation

Uses
   DXString,
   SysUtils; // StrToFloat

function VariantArrayToJavaScriptArray(const V: TVariant; Scripter: Pointer): TVariant;
var
  SO: TScriptObject;
  I, L, H: Integer;
  VI: TVariant;
begin
  SO := TArrayObject.Create(Scripter);
  L := VarArrayLowBound(V, 1);
  H := VarArrayHighBound(V, 1);
  for I:=L to H do
  begin
    VI := V[I];
    if VarType(VI) > varArray then
      SO.PutProperty(IntegerToString(I), VariantArrayToJavaScriptArray(VI, Scripter))
    else
      SO.PutProperty(IntegerToString(I), VI);
  end;
  SO.PutProperty('length', H + 1);
  result := ScriptObjectToVariant(SO);
end;

function ScriptObjectToVariant(Value: TScriptObject): TVariant;
begin
  result := Integer(Value);
  TVarData(result).VType := varScriptObject;
end;

function DelphiObjectToVariant(Instance: TObject): Variant;
begin
  result := Integer(Instance);
  TVarData(result).VType := varDelphiObject;
end;

function VariantToScriptObject(Value: TVariant): TScriptObject;
begin
  if VarType(Value) <> varScriptObject then begin
    if VarType(Value) <> varUndefined then
       raise TScriptFailure.Create(reIncompatibleTypes)
    else
       raise TScriptFailure.Create(reFunctionNotFound);
  end;
  TVarData(Value).VType := varInteger;
  result := TScriptObject(Integer(Value));
end;

function ToDelphiObject(Value: TVariant): TObject;
begin
  Result:=TDelphiObject(VariantToScriptObject(Value)).Instance;
end;

function ToString(const Value: TVariant): String;
var
  N: Integer;
  D: Double;
  S,L,R: String;

begin
  if VarType(Value) = varScriptObject then begin
    Result:=VariantToScriptObject(Value).ToString;
  end
  else begin
    if VarType(Value) = varDouble then begin
      D := Value;
      if D = NaN then begin
        result := 'NaN';
        Exit;
      end
      else if D = Infinity then begin
        result := 'infinity';
        Exit;
      end
      else if D = - Infinity then begin
        result := '-infinity';
        Exit;
      end;
    end;
    result := VariantToString(Value);
    if VarType(Value) = varDouble then begin
      N := DXString.CharPos(',', result);
      if N > 0 then result[N] := '.';
    end;
   end;
   // march 2004 (was in DXJS_MAIN.ToString()):
   S:=Result;
  If CharPos('\',S)>0 then Begin // OZZ
     S := StringReplace(S, '\\', #255, [rfReplaceAll]); // mask out \\ for now
     S := StringReplace(S, '\b', #$08, [rfReplaceAll]);
     S := StringReplace(S, '\t', #$09, [rfReplaceAll]);
     S := StringReplace(S, '\n', #$0A, [rfReplaceAll]);
     S := StringReplace(S, '\v', #$0B, [rfReplaceAll]);
     S := StringReplace(S, '\f', #$0C, [rfReplaceAll]);
     S := StringReplace(S, '\r', #$0D, [rfReplaceAll]);
     S := StringReplace(S, '\"', #$22, [rfReplaceAll]);
     S := StringReplace(S, '\''',#$27, [rfReplaceAll]);
     //715
     N:=QuickPos('\u',S);
     While N>0 do Begin
        L:=Copy(S,1,N-1);
        R:=Copy(S,N+6,Length(S));
        S:=Copy(S,N+2,4);
        If (S[1]='0') and (S[1]=S[2]) then Begin
           Delete(S,1,2);
           S:=Char(StrToInt('$'+S));
        End
        Else S:=WideCharToString(PWidechar(S));
        S:=L+S+R;
        N:=QuickPos('\u',S);
     End;
     N:=QuickPos('\x',S);
     While N>0 do Begin
        L:=Copy(S,1,N-1);
        R:=Copy(S,N+6,Length(S));
        S:=Copy(S,N+2,2);
        S:=Char(StrToInt('$'+S));
        S:=L+S+R;
        N:=QuickPos('\x',S);
     End;
     S := StringReplace(S, #255, #$5C, [rfReplaceAll]); // unmask \\ now...
  End;
  result := S;
end;

function ToStr(const Value: TVariant): String;
Var
   Ws:String;

begin
   if VarType(Value) = varScriptObject then begin
      If VariantToScriptObject(Value).ClassProp='Date' then Begin // Sept 24
(*
{$IFDEF VER130}
         Ws:=FormatDateTime ('ddd mmm d h:nn:ss @ yyyy',SysUtils.StrToDateTime(VariantToScriptObject(Value).DefaultValue)) ;
{$ELSE}
         Ws:=FormatDateTime ('ddd mmm d h:nn:ss @ yyyy',SysUtils.StrToDateTimeDef(VariantToScriptObject(Value).DefaultValue,SysUtils.Now)) ;
{$ENDIF}
         Ws:=StringReplace (Ws,'@',DXString.ShortTimeZone, []) ;
         Result:=Ws;
*)
         Ws:=VariantToScriptObject(Value).DefaultValue; // 720
      End
      Else Result:=ToString(value); // March 2004
      //VariantToScriptObject(Value).DefaultValue;
   end
   else result := ToString(Value);
end;

function ToObject(const Value: TVariant; AScript: Pointer): TVariant;
var
  SO: TScriptObject;
begin
  case VarType(Value) of
    varScriptObject:
    begin
      result := Value;
      Exit;
    end;
    varBoolean:
      SO := TBooleanObject.Create(Value, AScript);
//    varInteger, varDouble, varDate:
   varDouble,varInteger, {original 2 types}
   {varSmallInt,}varSingle,varCurrency,{varShortInt}$0010,{varWord}$0012,{varLongWord}$0013,{varInt64}$0014,varDate:
      SO := TNumberObject.Create(Value, AScript);
    varString:
      SO := TStringObject.Create(Value, AScript);
    else
      raise TScriptFailure.Create(reIncompatibleTypes);
   end;
  result := ScriptObjectToVariant(SO);
end;

function ToPrimitive(const V: TVariant): TVariant;
begin
  if VarType(V) = varScriptObject then begin
     TVarData(Result).VType := varInteger;
//     result := TScriptObject(Integer(Result)).DefaultValue;
     result := TScriptObject(Integer(V)).DefaultValue;
  end
  Else Result:=V;
end;

function ToBoolean(const V: TVariant): TVariant;
begin
  result := true;
  case VarType(V) of
    varEmpty, varNull: result := false;
    varBoolean: result := V;
   varDouble,varInteger, {original 2 types}
   {varSmallInt,}varSingle,varCurrency,{varShortInt}$0010,{varWord}$0012,{varLongWord}$0013,{varInt64}$0014,varDate:
       Result:=V<>0;
    varString: result := V <> '';
    varScriptObject: result := ToBoolean(VariantToScriptObject(V).DefaultValue);
  end;
end;

function ToNumber(const V: TVariant): TVariant;
begin
  case VarType(V) of
    varEmpty: result := NaN;
    varNull: result := 0;
   varDouble,varInteger, {original 2 types}
   {varSmallInt,}varSingle,varCurrency,{varShortInt}$0010,{varWord}$0012,{varLongWord}$0013,{varInt64}$0014,varDate:
      Result:=V;
//    varInteger, varDouble, varDate: result := V;
    varBoolean:
      if V then result := 1
      else result := 0;
    varString:
       if (V<>'') and (DXString.isNumericString(V)) then begin
          result := SysUtils.StrToFloat(V);
       end
       Else result:=NaN;
    varScriptObject: result := ToNumber(VariantToScriptObject(V).DefaultValue);
  end;
end;

function ToInt32(const V: TVariant): TVariant;
var
  N: Variant;
  D: Double;
begin
  N := ToNumber(V);
  D := N;
  if (D = NaN) or
     (D = NEGATIVE_INFINITY) or
     (D = POSITIVE_INFINITY) then result := 0
  else result := V;
end;

function ToInteger(const V: TVariant): TVariant;
var
  N: Variant;
  D: Double;
begin
  N := ToNumber(V);
  D := N;
  if D = NaN then result := 0
  else result := N;
end;

end.