dxjavascript.pas

Well known and usefull component for delphi 7

procedure RegisterRTTIType(pti: PTypeInfo);

implementation

uses
  DXJS_CONV, // ToStr
{$IFDEF LINUX}
   QForms,
   QDialogs,
   QControls,
{$ELSE}
  Forms, // 1-17-2003
  Dialogs,
  Windows,
{$ENDIF}
  SysUtils;

const
  ModuleMain = 'Main';

var
  _Count: Integer = 5;

procedure RegisterRTTIType(pti: PTypeInfo);
begin
  if RTTITypeList.IndexOf(pti^.Name) = -1 then
    RTTITypeList.AddObject(pti^.Name, TObject(pti));
end;

procedure AskToRegister;
begin
  Inc(_Count);
  if _Count mod 10 = 0 then
    ShowMessage('This is a trial version. Please register!');
end;

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

begin
   If Length(Parameters)>0 then Ws:=DXJS_CONV.ToStr(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:=DXJS_CONV.ToStr(Parameters[0])
   Else Ws:='';
   While Length(Ws)<50 do Ws:=Ws+#32;
{$IFDEF LINUX}
   Result:=MessageDlg(Ws,mtConfirmation,mbOKCancel,0)=mrOK; // v1.2
{$ELSE}
   Result:=MessageDlg(Ws,mtConfirmation,mbOKCancel,0)=idOK; // v1.2
{$ENDIF}
// 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:=DXJS_CONV.ToStr(Parameters[0])
   Else Ws:='';
   If Length(Parameters)>1 then Ts:=DXJS_CONV.ToStr(Parameters[1])
   Else Ts:='';
   Result:=InputBox('DXJavaScript',Ws,TS); // v1.2
end;

{$C+}
function __assert(const Parameters: array of Variant): Variant;
Begin
   If Length(Parameters)>0 then begin
      if DXJS_CONV.ToStr(Parameters[0])='undefined' then
         assert(false,'The first parameter you passed in, is UNDEFINED.')
      Else
      If Length(Parameters)=0 then assert(TDXJavaScript.ToBoolean(Parameters[0]))
      Else assert(TDXJavaScript.ToBoolean(Parameters[0]),DXJS_CONV.ToStr(Parameters[1]));
   End;
end;
{$C-}

constructor TDXJavaScript.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  fCallStack := TStringList.Create;
  fIDCache := TStringList.Create;
  Initialize_Engine;
end;

destructor TDXJavaScript.Destroy;
begin
  Deinitialize_Engine;
  fCallStack.Free;
  fIDCache.Free;
  inherited Destroy;
end;

procedure TDXJavaScript.Initialize_Engine;
begin
  Compiled := false;
  JavaScript := TJScript.Create(Self);
  JavaScript.AddRoutine('alert', @__alert);
  JavaScript.AddRoutine('confirm', @__confirm);
  JavaScript.AddRoutine('prompt', @__prompt);
  JavaScript.AddRoutine('assert', @__assert);
  JavaScript.AddRoutine('check', @__assert);
end;

procedure TDXJavaScript.Deinitialize_Engine;
begin
  ClearCallStack;
  If Assigned(JavaScript) then JavaScript.Free; // December 1st, 2003
  JavaScript:=nil; // December 1st, 2003
end;

procedure TDXJavaScript.Reset_Engine;
Begin
   JavaScript.ResetRun;
   JavaScript.Reset;
End;

function TDXJavaScript.GetGetExtraProperty: TGetExtraPropertyEvent;
begin
  result := JavaScript.fOnGetExtraProperty;
end;

function TDXJavaScript.GetPutExtraProperty: TPutExtraPropertyEvent;
begin
  result := JavaScript.fOnPutExtraProperty;
end;

function TDXJavaScript.GetUndefinedVariableEvent: TVariableEvent;
begin
  result := JavaScript.fOnUndefinedVariable;
end;

procedure TDXJavaScript.SetUndefinedVariableEvent(Value: TVariableEvent);
begin
  JavaScript.fOnUndefinedVariable := Value;
end;

function TDXJavaScript.GetChangedVariableEvent: TVariableEvent;
begin
  result := JavaScript.fOnChangedVariable;
end;

procedure TDXJavaScript.SetChangedVariableEvent(Value: TVariableEvent);
begin
  JavaScript.fOnChangedVariable := Value;
end;

procedure TDXJavaScript.SetGetExtraProperty(Value: TGetExtraPropertyEvent);
begin
  JavaScript.fOnGetExtraProperty := Value;
end;

procedure TDXJavaScript.SetPutExtraProperty(Value: TPutExtraPropertyEvent);
begin
  JavaScript.fOnPutExtraProperty := Value;
end;

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

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

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

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

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

function TDXJavaScript.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 begin
    result := Integer(fIDCache.Objects[Index]);
  end;
end;

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

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

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

procedure TDXJavaScript.AddCode(Code: String; const ModuleName: String = '');
begin
  Compiled := false;
  if ModuleName = '' then JavaScript.AddCode(ModuleMain, Code)
  else JavaScript.AddCode(ModuleName, Code);
end;

procedure TDXJavaScript.LoadFromFile(const FileName: String);
var
  FName: String;
begin
  Compiled := false;
  FName := FileName;
  if not FileExists(FName) then FName := Filename+'.js';
  if FileExists(FName) then begin
    JavaScript.Reset;
    JavaScript.AddCodeFromFile(ModuleMain, FName);
  end;
end;

procedure TDXJavaScript.LoadFromFileWithoutReset(const FileName: String);
var
  FName: String;
begin
  Compiled := false;
  FName := FileName;
  if not FileExists(FName) then FName := Filename+'.js';
  if FileExists(FName) then begin
    JavaScript.AddCodeFromFile(ModuleMain, FName);
  end;
end;

procedure TDXJavaScript.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, ModuleMain);
end;

procedure TDXJavaScript.LoadFromStreamWithoutReset(Stream: TStream);
var
  Ws: String;
begin
  Compiled := false;
  SetLength(Ws, Stream.Size-Stream.Position);
  Stream.Read(Ws[1], Length(Ws));
  AddCode(Ws, ModuleMain);
end;

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

procedure TDXJavaScript.SaveCompiledScriptFile(const Filename:String);
//Var
//   MemStream:TMemoryStream;
Var
   FStream:TFileStream;

begin
  if not Compiled then Compile;
  if Compiled then Begin
     FStream:=TFileStream.Create(FileName,fmCreate);
     JavaScript.SaveToStream(FStream);
     FStream.Free;
//     MemStream:=TMemoryStream.Create;
//     JavaScript.SaveToStream(MemStream);
//     MemStream.Seek(0,0);
//     MemStream.SaveToFile(FileName);
//     MemStream.Free;
  end;
end;

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