unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, SynEdit, SynMemo, Vcl.OleCtrls, SHDocVw,
  Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls, ActiveX, SynHighlighterJScript,
  SynHighlighterMulti, SynEditCodeFolding, SynHighlighterPas,
  SynEditHighlighter, SynHighlighterHtml, mshtml, uPSComponent,
  uPSComponent_COM, uPSComponent_StdCtrls, uPSComponent_Forms,
  uPSComponent_Default, uPSComponent_Controls, uPSRuntime, uPSPreProcessor,
  System.SyncObjs, System.Math,Vcl.AppEvnts,
  System.Generics.Collections, SynHighlighterCSS, uPSComponent_DB, System.Win.ComObj,
  JavascriptObject, Utils, DOM, Registry;

const
  CEF_SHOWKEYBOARD     = WM_APP + $B01;
  CEF_HIDEKEYBOARD     = WM_APP + $B02;
  MINIBROWSER_VISITDOM_FULL = WM_APP + $102;

type
  TMainForm = class(TForm)
    PnlCenter: TPanel;
    PnlBottom: TPanel;
    BtnOpen: TButton;
    OpenDialog: TOpenDialog;
    PageControl1: TPageControl;
    TabSheetBrowser: TTabSheet;
    TabSheetCode: TTabSheet;
    MemoCode: TSynMemo;
    SynHTMLSyn1: TSynHTMLSyn;
    SynPasSyn1: TSynPasSyn;
    SynMultiSyn1: TSynMultiSyn;
    SynJScriptSyn1: TSynJScriptSyn;
    IFPS3CE_Controls1: TPSImport_Controls;
    IFPS3CE_DateUtils1: TPSImport_DateUtils;
    IFPS3CE_Std1: TPSImport_Classes;
    IFPS3CE_ComObj1: TPSImport_ComObj;
    IFPS3DllPlugin1: TPSDllPlugin;
    BtnSave: TButton;
    ApplicationEvents: TApplicationEvents;
    Button1: TButton;
    Browser: TWebBrowser;
    ce: TPSScriptDebugger;
    SynCssSyn1: TSynCssSyn;
    PSImport_Classes1: TPSImport_Classes;
    PSImport_Forms1: TPSImport_Forms;
    PSImport_StdCtrls1: TPSImport_StdCtrls;
    MemoDebug: TMemo;
    SaveDialog: TSaveDialog;
    procedure TabSheetBrowserShow(Sender: TObject);
    procedure BtnOpenClick(Sender: TObject);
    procedure ceCompile(Sender: TPSScript);
    procedure ceExecute(Sender: TPSScript);
    procedure ceIdle(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure BrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch;
      const URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure BrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
      const [Ref] URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
    procedure FormDestroy(Sender: TObject);
    procedure BrowserNewWindow2(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
  private
    RunTimeConstants: TStringList;
    RunTimeVariables: TDictionary<string, string>;
    StrListRecordInterfaceClasses, StrListFunctionProcedure: TStringList;
    BrowserDocument: TDocument;
    BrowserWindow: THTMLWindowElement;

    function Compile: Boolean;
    function Execute: Boolean;
    procedure WB_LoadHTML(HTMLCode: string);
    function GetPascalScripts(doc : IHTMLDocument3): string;
    function GetJavascriptVariable(variable: string; out JSObject: TJSObject): Variant;
    function ParseIncludeJSVariables(line: string; ReturnList: TStringList): string;
    function VarTypeSetValues(V: Pointer; name: string; value: string ): string;
    function ParseLocalVariables(line: string; ReturnList: TDictionary<string, string>): string;

  protected
    __sPascalCodes: string;
  public
    { Public declarations }
  end;

  TRecordInterfaceClasses = class
    class var bStartParse: boolean;
    class function ParseRecordInterfaceClasses(sLine: string; List: TStringList): string;
  end;

  TFunctionProcedure = class
    class var bStartParse: boolean;
    class var iBeginCalculator: integer;
    class function ParseFunctionProcedure(sLine: string; DataList: TStringList): string;
  end;

var
  MainForm: TMainForm;


implementation


{$R *.dfm}

uses Lib, TypInfo, uPSI_JavascriptObject, uPSI_DOM, Lists, uPSI_Lists,
PluginBase, DialogList, uPSI_DialogList, uPSI_TypeDefines;


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

var
  Doc: IHTMLDocument2;
  TempFile: string;
  xBody   : IHTMLElement;
  xLoaded : Boolean;
  onlyOnce: Boolean;

{ TFunctionProcedure }

class function TFunctionProcedure.ParseFunctionProcedure(sLine: string; DataList: TStringList): string;
var
  sIdentifier, sEndIdentifier, sBegin: string;
  sList,sList2: TStringList;
  I: Integer;
  A: Integer;
begin


  sIdentifier := Copy(Trim(sLine), 0, Pos(' ', Trim(sLine)) -1);

  if (LowerCase(Trim(sIdentifier)) = 'procedure') or (LowerCase(Trim(sIdentifier)) = 'function')
     or (LowerCase(Trim(sIdentifier)) = 'class') then
    TFunctionProcedure.bStartParse := true;

  if TFunctionProcedure.bStartParse then
  begin
    DataList.Add(sLine);
    Result := '';
    sList:= Explode(sLine, ' ');
    for I := 0 to sList.Count -1 do
    begin
      sList2 := Explode(sList[I], ';');
      for A := 0 to sList2.Count -1 do
      begin
        if LowerCase(Trim(sList2[A])) = 'begin' then
          Inc(TFunctionProcedure.iBeginCalculator);

        if LowerCase(Trim(sList2[A])) = 'end' then
        begin
          Dec(TFunctionProcedure.iBeginCalculator);
          if TFunctionProcedure.iBeginCalculator = 0 then
            TFunctionProcedure.bStartParse := false;
        end;
      end;
      sList2.Free;

    end;
    sList.Free;

  end else
    Result := sLine;


end;

{ TRecordInterfaceClasses }

class function TRecordInterfaceClasses.ParseRecordInterfaceClasses(sLine: string; List: TStringList): string;
var
  strLine,sPiece, sType: string;
  I: Integer;
  sList: TStringList;
  bEndFound, bTypeFound: boolean;
begin
  sList := Explode(sLine, ' ');
  bEndFound := false;
  bTypeFound := false;
  for I := 0 to sList.Count -1 do
  begin
    sPiece := sList[I];

    if Pos('(', sPiece) > 0 then
      sType := Trim(Copy(sPiece, 0, Pos('(', sPiece) -1))
    else if Pos(';', sPiece) > 0 then
      sType := Trim(Copy(sPiece, 0, Pos(';', sPiece) -1))
    else
      sType := Trim(sPiece);

    if LowerCase(sType) = 'type' then
      bTypeFound := true;


    if ('record' = LowerCase(sType)) or ('class' = LowerCase(sType)) or
        ('interface' = LowerCase(sType)) then
          TRecordInterfaceClasses.bStartParse := true;

    if (TRecordInterfaceClasses.bStartParse) and ('end' = LowerCase(sType)) then
    begin
      bEndFound:= true;
      TRecordInterfaceClasses.bStartParse := false;
    end;

  end;

  if (TRecordInterfaceClasses.bStartParse) or (bEndFound) then
  begin
    List.Add(sLine);
    Result := '';
  end else if bTypeFound then
    Result := ''
  else
    Result := sLine;

end;

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

procedure TMainForm.WB_LoadHTML(HTMLCode: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin
  xLoaded := False;
  Browser.Navigate('about:blank');
  while Browser.ReadyState < READYSTATE_INTERACTIVE do
   Application.ProcessMessages;

  if Assigned(Browser.Document) then
  begin
    sl := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        sl.Text := HTMLCode;
        sl.SaveToStream(ms);
        ms.Seek(0, 0);
        (Browser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      finally
        ms.Free;
      end;
    finally
      sl.Free;
      Doc :=  Browser.Document as IHTMLDocument2;
    end;
  end;
end;

function TMainForm.Compile: Boolean;
begin
  ce.Script.Text := __sPascalCodes;
  Result := ce.Compile;
end;

function TMainForm.Execute: Boolean;
begin
  if CE.Execute then
  begin
    Result := True;
  end else
  begin
    Result := False;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  JSObject: TPSImport_JavascriptObject;
  DOMImport: TPSImport_DOM;
  Lists: TPSImport_Lists;
  DialogsObjects: TPSImport_DialogList;
  Reg: TRegistry;
  Import_TypeDefines: TPSImport_TypeDefines;
begin
  JSObject:= TPSImport_JavascriptObject.Create(nil);
  (ce.Plugins.Add as TPSPluginItem).Plugin := JSObject;

  DOMImport:= TPSImport_DOM.Create(nil);
  (ce.Plugins.Add as TPSPluginItem).Plugin := DOMImport;

  Lists:= TPSImport_Lists.Create(nil);
  (ce.Plugins.Add as TPSPluginItem).Plugin := Lists;

  DialogsObjects:= TPSImport_DialogList.Create(nil);
  (ce.Plugins.Add as TPSPluginItem).Plugin := DialogsObjects;

  Import_TypeDefines:= TPSImport_TypeDefines.Create(nil);
  (ce.Plugins.Add as TPSPluginItem).Plugin := Import_TypeDefines;

  TPlugins.DLLPlugins();

  Browser.Silent := True;

  //Get IE 11 (Edge) instance
  Reg:= TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION', true);
  Reg.WriteInteger(ExtractFileName(Application.ExeName), 11001);
  Reg.CloseKey;
  Reg.Free;

end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  if Assigned(BrowserDocument) then
  begin
    BrowserDocument.Free;
    BrowserDocument := nil;
  end;

  if Assigned(BrowserWindow) then
  begin
    BrowserWindow.Free;
    BrowserWindow := nil;
  end;
end;

function TMainForm.GetJavascriptVariable(variable: string; out JSObject: TJSObject): Variant;
var
  Window: IHTMLWindow2;
  DispatchIdOfProperty: Integer;
  MyPropertyValue: OleVariant;
  Temp: TExcepInfo;
  Res: Integer;
  Params:TDispParams;

  typeString : Variant;
  basicType  : Integer;
  ValueEx: IDispatchEx;
begin
  // get window interface
  Window:= (Browser.ControlInterface.Document as IHTMLDocument2).parentWindow;
  Assert(Assigned(Window));
  // get dispatch ID of our variable
  if (Window as IDispatchEx).GetDispID(PWideChar(variable), fdexNameCaseSensitive, DispatchIdOfProperty) = S_OK then
  begin
    // no parameters
    ZeroMemory(@Params, SizeOf(Params));
    // get value of our variable
    Res:=(Window as IDispatchEx).InvokeEx(DispatchIdOfProperty, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, @Params, MyPropertyValue, Temp, nil);
    if Res=S_OK then
    begin
     // JSObject:= TJSObject.Create;

      basicType := VarType(MyPropertyValue) and VarTypeMask;

      // Set a string to match the type
      case basicType of
        varDispatch : begin
          //Supports( IDispatch(MyPropertyValue), IDispatchEx, ValueEx );
          //JSObject := PJSObject(@ValueEx)^;
          JSObject := TJSObject.Create;
          JSObject.Name := variable;
          JSObject.ActualJSPoint := MyPropertyValue;
         // ShowMessage(JSObject.GetString('aaa'));
          Result := '[object]';
        end;
        else begin
          result := MyPropertyValue;
          JSObject := nil;
        end;
      end;
    end else
      JSObject := nil;
  end
  else
    JSObject := nil;
end;

function TMainForm.ParseIncludeJSVariables(line: string; ReturnList: TStringList): string;
var
  strLine, varStr, name, types: string;
  sNames: TStringList;
  I: Integer;
  JSValue: Variant;
  JSObject: TJSObject;
begin
  strLine := trim(line);
  while (Pos('import ', LowerCase(strLine)) > 0) do
  begin
    varStr := copy(strLine, Pos('import ', LowerCase(strLine)), Pos(';', strLine)- 1);
    Delete(varStr, 1,Pos('import ', LowerCase(varStr)) + 6);
    name := varStr;
    name := trim(name);

    sNames:= TStringList.Create;
    sNames.Text := StringReplace(name, ',',#13,[rfReplaceAll]);
    for I := 0 to sNames.Count -1 do
    begin
      JSValue := GetJavascriptVariable(Trim(sNames[I]), JSObject);

      if JSObject <> nil then
      begin
        ReturnList.AddObject(Trim(sNames[I]), JSObject);
      end
      else
        ReturnList.Values[Trim(sNames[I])] := JSValue;
    end;
    sNames.Free;
    Delete(strLine, Pos('import ', LowerCase(strLine)), Pos(';', strLine) + 1);
  end;
  Result := strLine;
end;


function TMainForm.ParseLocalVariables(line: string; ReturnList: TDictionary<string, string>): string;
var
  strLine, varStr, name, types: string;
  sNames: TStringList;
  I: Integer;
begin
  strLine := line;
  while (Pos('var ', LowerCase(strLine)) > 0) do
  begin
    varStr := copy(strLine, Pos('var ', LowerCase(strLine)), Pos(';', strLine)+ 1);
    Delete(varStr, 1,Pos('var ', LowerCase(varStr)) + 3);
    name := copy(varStr, 0, Pos(':', varStr) -1);
    name := trim(name);
    Delete(varStr, 1, Pos(':', varStr));
    types := copy(varStr, 0, Pos(';', varStr) - 1);
    types := trim(types);

    sNames:= TStringList.Create;
    sNames.Text := StringReplace(name, ',',#13,[rfReplaceAll]);
    for I := 0 to sNames.Count -1 do
      ReturnList.Add(Trim(sNames[I]), types);
    sNames.Free;
    Delete(strLine, Pos('var ', LowerCase(strLine)), Pos(';', strLine) + 1);
  end;
  Result := strLine;
end;




function TMainForm.GetPascalScripts(doc : IHTMLDocument3): string;
var
  scripts: IHTMLElementCollection;
  I: Integer;
  Code: string;
  sList: TStringList;

begin

  sList:= TStringList.Create;
  try
    scripts := doc.getElementsByTagName('script');
    for I := 0 to scripts.length -1 do
    begin
      if (scripts.item(I, EmptyParam) as IHTMLScriptElement).type_ = 'text/pascal' then
      begin
        Code := Code + (scripts.item(I, EmptyParam) as IHTMLScriptElement).text + chr(13);
      end;
    end;


    sList.Text := Code;

    I := 0;

    while I < sList.Count do
    begin
      sList[I] := TRecordInterfaceClasses.ParseRecordInterfaceClasses(sList[I], StrListRecordInterfaceClasses);
      sList[I] := TFunctionProcedure.ParseFunctionProcedure(sList[I], StrListFunctionProcedure);
      sList[I] := ParseIncludeJSVariables(sList[I], RunTimeConstants );
      sList[I] := ParseLocalVariables(sList[I], RunTimeVariables);

      if Trim(sList[I]) = '' then
      begin
        sList.Delete(I);
        Dec(I);
      end;

      Inc(I);
    end;

    Result := sList.Text;

  finally
    sList.Free;
  end;
end;

function VarTypeValue(V: pointer; name: string; value: string ): string;
var
  typeString : string;
  basicType  : Integer;
  isObject: boolean;
  VValue: Variant;
  ValueEx: IDispatchEx;

begin
  // Get the Variant basic type :
  // this means excluding array or indirection modifiers


  if V <> nil then
  begin
    isObject:= true;
  end else begin
    isObject := false;
    VValue := value;
  end;

  if not isObject then
  begin

    basicType := VarType(VValue) and VarTypeMask;

    // Set a string to match the type
    case basicType of
      vtInteger   : typeString := 'var ' + name +': integer;';
      vtExtended    : typeString := 'var ' + name +': double;';
      vtBoolean   : typeString := 'var ' + name +': boolean;';
      vtString    : typeString := 'var ' + name +': string;';
      vtClass      : typeString := 'var ' + name +': string;';
      varUString  : typeString := 'var ' + name +': string;';
      varString  : typeString := 'var ' + name +': string;';
      vtPointer  : typeString := 'var ' + name +': pointer;';
    end;


  end;

  Result := typeString;

end;

function TMainForm.VarTypeSetValues(V: pointer; name: string; value: string ): string;
var
  typeString : string;
  basicType  : Integer;
  isObject: boolean;
  VValue: Variant;
  ValueEx: IDispatchEx;

begin

  if V <> nil then
  begin
    isObject:= true;
  end else begin
    isObject := false;
    VValue := value;
  end;

  if not isObject then
  begin

    basicType := VarType(VValue) and VarTypeMask;

    // Set a string to match the type
    case basicType of
      vtInteger   : typeString := name +':=' + VValue + ';';
      vtExtended    : typeString := name +':=' + VValue + ';';
      vtBoolean   : typeString := name +':=' + VValue + ';';
      vtString    : typeString := name +':=' + #39+ VValue + #39 + ';';
      vtClass      : typeString := name +':=' + #39+ VValue + #39 + ';';
      varUString  : typeString := name +':=' + #39+ VValue + #39 + ';';
      varString  : typeString := name +':=' + #39+ VValue + #39 + ';';
    end;


  end;

  Result := typeString;


end;



procedure TMainForm.BrowserBeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; const [Ref] URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if Assigned(BrowserDocument) then
  begin
    BrowserDocument.Free;
    BrowserDocument := nil;
  end;

  if Assigned(BrowserWindow) then
  begin
    BrowserWindow.Free;
    BrowserWindow := nil;
  end;

end;

procedure TMainForm.BrowserDocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
var
  pascalCodes, sVariables, sConstants,
  VName, sConstantSetter, sTypeSection, sFunctionProcedures: string;
  RTVariableKeys: TArray<string>;
  I, a: Integer;
begin
  if Assigned((Browser.Document as IHTMLDocument2).body) then
  begin
    BrowserWindow:= THTMLWindowElement.Create;
    BrowserWindow.Element := (Browser.Document as IHTMLDocument2).parentWindow;

    BrowserDocument:= TDocument.Create;
    BrowserDocument.Document := Browser.Document;

    RunTimeConstants := TStringList.Create();
    StrListRecordInterfaceClasses := TStringList.Create();
    StrListFunctionProcedure := TStringList.Create();
    RunTimeVariables := TDictionary<string, string>.Create();
    try
      pascalCodes := GetPascalScripts(Browser.Document as IHTMLDocument3);
      if (trim(pascalCodes) <> '') or (RunTimeVariables.Count > 0)
         or (RunTimeConstants.Count > 0) or (StrListRecordInterfaceClasses.Count > 0)
         or (StrListFunctionProcedure.Count > 0) then
      begin
        RTVariableKeys := RunTimeVariables.Keys.ToArray();
        for VName in RTVariableKeys do
        begin
          sVariables := sVariables + ' var ' + VName + ':' +  RunTimeVariables[VName] +'; '+ chr(13);
        end;

        for I := 0 to RunTimeConstants.Count -1 do
        begin
          VName := RunTimeConstants[I];
          if Pos('=', VName) > 0 then
            VName := Copy(VName, 0, Pos('=', VName) - 1);
          sVariables := sVariables + VarTypeValue(RunTimeConstants.Objects[I], VName, RunTimeConstants.Values[VName]) + Chr(13);
          sConstantSetter := sConstantSetter + VarTypeSetValues(RunTimeConstants.Objects[I], VName, RunTimeConstants.Values[VName]) + Chr(13);
        end;

        if StrListRecordInterfaceClasses.Count > 0 then
        begin
          sTypeSection := 'type' + chr(13) + StrListRecordInterfaceClasses.Text;
        end;

        if StrListFunctionProcedure.Count > 0 then
        begin
          sFunctionProcedures := StrListFunctionProcedure.Text;
        end;

        __sPascalCodes := 'program pascaldhtml; '+ chr(13) +
                          sTypeSection + chr(13) +
                          sFunctionProcedures + chr(13) +
                          sVariables + chr(13) +
                          ' begin ' +chr(13)+ sConstantSetter + Chr(13)+ pascalCodes + ' end.';


        if Compile then
          Execute
        else begin
          for a := 0 to ce.CompilerMessageCount -1 do
            MemoDebug.Lines.Add(ce.CompilerMessages[a].MessageToString)
        end;
      end;
    finally
      RunTimeConstants.Free;
      RunTimeVariables.Free;
      StrListRecordInterfaceClasses.Free;
      StrListFunctionProcedure.Free;
    end;
  end;

end;

procedure TMainForm.BrowserNewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
 //ppDisp := Browser.DefaultInterface;
 //Cancel := true;

end;

procedure TMainForm.BtnOpenClick(Sender: TObject);
begin
  if OpenDialog.Execute() then
  begin
    MemoCode.Lines.LoadFromFile(OpenDialog.FileName);
  end;
end;

procedure TMainForm.BtnSaveClick(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    MemoCode.Lines.SaveToFile(SaveDialog.FileName);
  end;
end;



procedure TMainForm.ceCompile(Sender: TPSScript);
var
  I: integer;
  VName: string;
begin
  Sender.AddMethod(Self, @TLib.ShowMessage, 'procedure ShowMessage(const s: string);');
  Sender.AddMethod(Self, @TLib.JSDecode, 'function JSDecode(Value: Variant): TJSObject;');
  Sender.AddMethod(Self, @TLib.SoapCall, 'function SoapCall(Intf: string; Addr: string): ISoapInvokable;');


  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Application', 'TApplication');
  Sender.AddRegisteredVariable('Document', 'TDocument');
  Sender.AddRegisteredVariable('Window', 'THTMLWindowElement');
  //Sender.AddRegisteredVariable('document', 'Variant');

  for I := 0 to RunTimeConstants.Count -1 do
  begin
    VName := RunTimeConstants[I];
    if Pos('=', VName) > 0 then
      VName := Copy(VName, 0, Pos('=', VName) - 1);
    if RunTimeConstants.Objects[I] <> nil then
      Sender.AddRegisteredVariable(VName, 'TJSObject');
  end;

end;

procedure TMainForm.ceExecute(Sender: TPSScript);
var
  I: integer;
  VName: string;
  JSObject: TJSObject;
  vObj: TObject;

begin
  //document := (Browser.Document as IHTMLDocument2);

  ce.SetVarToInstance('SELF', Self);
  ce.SetVarToInstance('APPLICATION', Application);
  ce.SetVarToInstance('DOCUMENT', BrowserDocument);
  ce.SetVarToInstance('WINDOW', BrowserWindow);


  for I := 0 to RunTimeConstants.Count -1 do
  begin
    VName := RunTimeConstants[I];
    if Pos('=', VName) > 0 then
      VName := Copy(VName, 0, Pos('=', VName) - 1);
    if RunTimeConstants.Objects[I] <> nil then
    begin
      vObj := RunTimeConstants.Objects[I];
      JSObject := TJSObject(vObj);
      //ShowMessage(JSObject.GetString('aaa'));
      ce.SetVarToInstance(VName, RunTimeConstants.Objects[I] );
    end;
  end;

  //ce.SetVarToInstance('DOCUMENT', @document);
  //ce.SetVarToInstance('DOCUMENT', Browser.OleObject);

end;

procedure TMainForm.ceIdle(Sender: TObject);
begin
  Application.ProcessMessages;
end;

procedure TMainForm.TabSheetBrowserShow(Sender: TObject);
begin
  WB_LoadHTML(MemoCode.Lines.Text);
end;

end.
