dxpascalscript.pas

Well known and usefull component for delphi 7

var
  Ws:String;

begin
   If Length(Parameters)>0 then Ws:=TDXPascalScript.ToString(Parameters[0])
   Else Ws:='';
   While Length(Ws)<50 do Ws:=Ws+#32;
   MessageDlg(Ws,mtWarning,[mbOK],0); // v1.2
// THIS LOSES CURSOR:
//   MessageBox(0,PChar(Ws),'DXJavaScript',MB_ICONWARNING or MB_OK or MB_SYSTEMMODAL or MB_TOPMOST);
end;

function __confirm(const Parameters: array of Variant): Variant;
var
  Ws:String;

begin
   If Length(Parameters)>0 then Ws:=TDXPascalScript.ToString(Parameters[0])
   Else Ws:='';
   While Length(Ws)<50 do Ws:=Ws+#32;
   Result:=MessageDlg(Ws,mtConfirmation,mbOKCancel,0)=idOK; // v1.2
// THIS LOSES CURSOR:
//   Result:=MessageBox(0,PChar(Ws),'DXJavaScript',MB_ICONQUESTION or MB_OKCANCEL or MB_SYSTEMMODAL or MB_TOPMOST)=idOK;
end;

function __prompt(const Parameters: array of Variant): Variant;
var
  Ws:String;
  Ts:String;

begin
   If Length(Parameters)>0 then Ws:=TDXPascalScript.ToString(Parameters[0])
   Else Ws:='';
   If Length(Parameters)>1 then Ts:=TDXPascalScript.ToString(Parameters[1])
   Else Ts:='';
   Result:=InputBox('DXJavaScript',Ws,TS); // v1.2
end;

constructor TDXPascalScript.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Initialize_Engine;
end;

destructor TDXPascalScript.Destroy;
begin
  Deinitialize_Engine;
  inherited Destroy;
end;

procedure TDXPascalScript.Initialize_Engine;
begin
  fIDCache := TStringList.Create;
  fCallStack := TStringList.Create;
  Compiled := false;
  JavaScript := TJScript.Create;
  JavaScript.AddRoutine('alert', @__alert);
  JavaScript.AddRoutine('confirm', @__confirm);
  JavaScript.AddRoutine('prompt', @__prompt);
end;

procedure TDXPascalScript.Deinitialize_Engine;
begin
  ClearCallStack;
  fCallStack.Free;
  fIDCache.Free;
  JavaScript.Free;
end;

function TDXPascalScript.GetSourceCode: String;
begin
  result := JavaScript.Modules.SourceCode;
end;

function ConvertToJavaScript(Original:String):String;
Begin
   Result:='';
End;

procedure TDXPascalScript.SetSourceCode(Value: String);
begin
  JavaScript.Modules.Clear;
  AddCode(Value);
end;

procedure TDXPascalScript.SetCompiled(Value: Boolean);
begin
  fIDCache.Clear;
  fCompiled := Value;
end;

function TDXPascalScript.GetZeroBasedStringIndex: boolean;
begin
  result := JavaScript.ZeroBasedStringIndex;
end;

procedure TDXPascalScript.SetZeroBasedStringIndex(Value: boolean);
begin
  JavaScript.ZeroBasedStringIndex := Value;
end;

function TDXPascalScript.GetID(const Name: String): Integer;
var
  Index: Integer;
begin
  Index := fIDCache.IndexOf(Name);
  if Index = - 1 then
  begin
    result := JavaScript.GetID(Name);
    If Result>0 then // OZZ
    fIDCache.AddObject(Name, Pointer(result));
  end
  else
    result := Integer(fIDCache.Objects[Index]);
end;

function TDXPascalScript.GetVariable(const Name: String): Variant;
var
  ID: Integer;
begin
  ID := GetID(Name);
  if ID > 0 then
    result := JavaScript.GetValue(ID);
end;

procedure TDXPascalScript.SetVariable(const Name: String; const Value: Variant);
var
  ID: Integer;
begin
  ID := GetID(Name);
  if ID > 0 then
    JavaScript.PutValue(ID, Value);
end;

procedure TDXPascalScript.SetShowError(Value: TScriptEvent);
begin
  JavaScript.fOnShowError := Value;
end;

procedure TDXPascalScript.AddCode(Code: String; const ModuleName: String = '');
Var
   TStrList:TStringList;
   Loop:Integer;
   Ws:String;
   Token:String;
   oToken:String;
   nStr:String;
   definingFunction:Boolean;
   functionNames:TStringList; // function names are case sensative - track them!
   functionName:String;
   tmpPos:Integer;
   stringFields:TStringList;

begin
  Compiled := false;
  TStrList:=TStringList.Create;
  Code:=StringReplace(Code,'{','/* ',[rfReplaceAll]);
  Code:=StringReplace(Code,'{',' */',[rfReplaceAll]);
  Code:=StringReplace(Code,'(*','/* ',[rfReplaceAll]);
  Code:=StringReplace(Code,'*)',' */',[rfReplaceAll]);
  TStrList.Text:=Code;
  functionNames:=TStringList.Create;
  stringFields:=TStringList.Create;
  Loop:=0;
  While Loop<TStrList.Count do Begin
     definingFunction:=False;
     // Working String
     Ws:=TStrList[Loop];
     nStr:='';
     // Store Leading Indentation
     While (Copy(Ws,1,1)=#32) or (Copy(Ws,1,1)=#9) do Begin
        nStr:=nStr+Copy(Ws,1,1);
        Delete(Ws,1,1);
     End;
     // Replace Pascal Strings with Tokens
     tmpPos:=charPos(#39,Ws);
     while tmpPos>0 do Begin
        oToken:=copy(Ws,1,tmpPos-1);
        delete(ws,1,tmpPos);
        stringFields.Add(Copy(Ws,1,charPos(#39,ws)-1));
        delete(ws,1,charPos(#39,ws));
        ws:=oToken+char(stringFields.Count)+Ws;
        tmpPos:=charPos(#39,Ws);
     End;
     // replace pascal operators with Tokens
     tmpPos:=charPos('=',Ws);
     while tmpPos>0 do Begin
        if Copy(Ws,tmpPos-1,1)=':' then Ws:=StringReplace(Ws,':=',#254,[])
        else if Copy(Ws,tmpPos-1,1)='<' then Ws:=StringReplace(Ws,'<=',#253,[])
        else if Copy(Ws,tmpPos+1,1)='>' then Ws:=StringReplace(Ws,'=>',#252,[])
        else if Copy(Ws,tmpPos+1,1)='=' then Ws:=StringReplace(Ws,'==',#251,[])
        else Ws:=StringReplace(Ws,'=',#255,[]);
        tmpPos:=charPos('=',Ws);
     End;
     // Tokenize the Keywords
     While Length(Ws)>0 do Begin
        oToken:=DXString.FetchByChar(Ws,#32,False);
        Token:=DXString.Uppercase(oToken);
        If TOKEN='THEN' then Begin
           {absorb it!}
        End
        Else If TOKEN='BEGIN' then Begin
           nStr:=nStr+' { ';
        End
        Else If (TOKEN='END;') or (TOKEN='END.') or (TOKEN='END') then Begin
           nStr:=nStr+' } ';
        End
        Else If (TOKEN='PROCEDURE') or (TOKEN='FUNCTION') then Begin
           nStr:='function ';
           definingFunction:=True;
           functionName:='';
           If charPos('(',Ws)>0 then begin
              functionName:=DXString.lowercase(trim(Copy(Ws,1,charPos('(',Ws)-1)));
              delete(ws,1,charPos('(',Ws));
           end;
           If charPos(';',Ws)>0 then begin
              functionName:=DXString.lowercase(trim(Copy(Ws,1,charPos(';',Ws)-1)));
              delete(ws,1,charPos(';',Ws));
           end;
           if functionName='' then Begin // bruteforce find the function name!
           end;
           // now we have the function name, look for parameters and clean up
        End
        Else Begin
           // parse operators
           if Copy(oToken,1,1)<>#32 then nStr:=nStr+#32+oTOKEN
           else nStr:=nStr+oTOKEN;
        End;
     End;
     // restore string tokens back to pascal strings
     tmpPos:=0;
     while tmpPos<stringFields.Count do begin
        nStr:=StringReplace(nStr,char(tmpPos+1),#39+stringFields[tmpPos]+#39,[]);
        inc(tmpPos);
     end;
     // restore operator tokens to javascript operators
     nStr:=StringReplace(nStr,#255,' == ',[rfReplaceAll]);
     nStr:=StringReplace(nStr,#254,' = ',[rfReplaceAll]);
     nStr:=StringReplace(nStr,#253,' <= ',[rfReplaceAll]);
     nStr:=StringReplace(nStr,#252,' => ',[rfReplaceAll]);
     nStr:=StringReplace(nStr,#251,' == ',[rfReplaceAll]);
     // store javascript version of the line back into the source
     TStrList[Loop]:=nStr;
     Inc(Loop);
     stringFields.Clear;
  End;
  stringFields.Free;
  functionNames.Free;
  if ModuleName = '' then JavaScript.AddCode(ModuleMain, TStrList.Text)
  else JavaScript.AddCode(ModuleName, TStrList.Text);
  TStrList.Free;
end;

procedure TDXPascalScript.LoadFromFile(const FileName: String);
var
  FName: String;
  L: TStringList;
  I: Integer;
  Module: TModule;

begin
  Compiled := false;
  FName := FileName;
  if not FileExists(FName) then FName := Filename+'.js';
  if FileExists(FName) then begin
    JavaScript.Reset;
    L := TStringList.Create;
    try
       L.LoadFromFile(FileName);
       AddCode(L.Text);
       I := JavaScript.Modules.IndexOf(ModuleMain);
       Module := TModule(JavaScript.Modules.Items[I]);
       Module.FileName := FName;
    finally
       L.Free;
    end;
  end;
end;

procedure TDXPascalScript.LoadFromStream(Stream: TStream);
var
  Ws: String;
begin
  Compiled := false;
  SetLength(Ws, Stream.Size-Stream.Position);
  Stream.Read(Ws[1], Length(Ws));
  JavaScript.Reset;
  AddCode(Ws);
end;

procedure TDXPascalScript.SaveCompiledScript(Stream: TStream);
begin
  if not Compiled then Compile;
  JavaScript.SaveToStream(Stream)
end;

procedure TDXPascalScript.LoadCompiledScript(Stream: TStream);
begin
  JavaScript.Reset;
  JavaScript.LoadFromStream(Stream);
  Compiled := true;
end;

procedure TDXPascalScript.AddRoutine(const Name:String; Address:Pointer);
begin
  JavaScript.AddRoutine(Name,Address);
end;

procedure TDXPascalScript.AddMethod(AClass:TClass;const Name:String; Address:Pointer);
begin
  JavaScript.AddMethod(AClass, Name, Address);
end;