Pascal (Lazarus/Delphi)

Prevent JavaScript Infinite Loops

See more JavaScript Examples

Demonstrates how prevent infinite loops or prevent the JavaScript from running for a longer amount of time than allowed. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Js,
  Chilkat.StringBuilder,
  Chilkat.JsonObject;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  sbScript: TStringBuilder;
  js: TJs;
  result: TJsonObject;

begin
  success := False;

  //  This is the JavaScript we'll run:

  //  console.log('Starting infinite loop...'); while(true) {};

  sbScript := TStringBuilder.Create;
  sbScript.Append('console.log(''Starting infinite loop...''); while(true) {};');

  js := TJs.Create;

  //  Set a limit on the amount of time (in seconds) the script is allowed to run.
  //  If the JavaScript takes longer than this amount of time, then Chilkat kills the script without crashing the host program.
  //  The default value of TimeoutSeconds is 0, which indicates no limit.
  //  For this example, set a limit of 2 seconds.
  js.TimeoutSeconds := 2;

  result := TJsonObject.Create;
  result.EmitCompact := False;

  //  Run the script..
  success := js.Eval(sbScript,result);
  if (success = False) then
    begin
      //  Examine the result for an exception.
      WriteLn(result.Emit());

      //  The result contains this:

      //  	{
      //  	  "exception": {
      //  	    "message": "interrupted - JavaScript exceeded the Chilkat.Js.TimeoutSeconds",
      //  	    "stack": [
      //  	      {
      //  	        "func": "<eval>",
      //  	        "file": "<input>",
      //  	        "line": 1,
      //  	        "col": 8
      //  	      }
      //  	    ]
      //  	  }
      //  	}

      //  Also examine the LastErrorText.
      WriteLn(js.LastErrorText);
      Exit;
    end;

  //  We should never get here..
  WriteLn('Succeeded.');
  WriteLn(result.Emit());


  sbScript.Free;
  js.Free;
  result.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.