unit DOM;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Winapi.ActiveX, System.Win.ComObj, MSHTML, TypInfo,
  JSEventObject;
type

  THTMLElement = class;
  THTMLElementCollection = class;

  TDocument = class(TObject)
  private
    FDocument: IDispatch;

    function GetActiveElement: THTMLElement;
    function GetAnchors: THTMLElementCollection;
    function GetBody: THTMLElement;
    function GetCookie: string;
    procedure SetCookie(val: string);
    function GetCharset: string;
    procedure SetCharset(val: string);
    function GetDomain: string;
    function GetForms: THTMLElementCollection;
    function GetHead: THTMLElement;
    function GetImages: THTMLElementCollection;
    function GetScripts: THTMLElementCollection;
    function GetAll: THTMLElementCollection;
  public
    property Document: IDispatch read FDocument write FDocument;
    property ActiveElement: THTMLElement read GetActiveElement;
    property Anchors: THTMLElementCollection read GetAnchors;
    property Body: THTMLElement read GetBody;
    property Head: THTMLElement read GetHead;
    property Cookie: string read GetCookie write SetCookie;
    property Charset: string read GetCharset write SetCharset;
    property Domain: string read GetDomain;
    property Forms: THTMLElementCollection read GetForms;
    property Images: THTMLElementCollection read GetImages;
    property Scripts: THTMLElementCollection read GetScripts;
    property All: THTMLElementCollection read GetAll;


    function GetElementById(v: string): THTMLElement;
    function GetElementsByClassName(classname: string): THTMLElementCollection;
    function GetElementsByName(name: string): THTMLElementCollection;
    function GetElementsByTagName(tagName: string): THTMLElementCollection;
    function CreateElement(eTag: string): THTMLElement;
    function QuerySelector(Query: string): THTMLElementCollection;
    procedure Write(val: string);
    procedure WriteLn(val: string);
  end;

  THTMLElementCollection = class(TList)
  private
    function Get(Index: Integer): THTMLElement;
    procedure Put(Index: Integer; Item: THTMLElement);
  public
    property Item[Index: Integer]: THTMLElement read Get write Put; default;
  end;

  THTMLElement = class(TObject)
  private
    FElement: IDispatch;
    function GetId: string;
    procedure SetId(Value: string);
    function GetTagName: string;
    function GetClassValues: string;
    procedure SetClassValues(Value: string);
    function GetParentElement: THTMLElement;
    function GetOffsetLeft: integer;
    function GetOffsetTop: integer;
    function GetOffsetWidth: integer;
    function GetOffsetHeight: integer;
    function GetInnerHtml: string;
    procedure SetInnerHtml(Value: string);
    function GetInnerText: string;
    procedure SetInnerText(Value: string);
    function GetOuterHTML: string;
    function GetOuterText: string;
    function GetChildren: THTMLElementCollection;
  public
    property Element: IDispatch read FElement write FElement;
    property ParentElement: THTMLElement read GetParentElement;
    property Id: string read GetId write SetId;
    property ClassValues: string read GetClassValues write SetClassValues;
    property TagName: string read GetTagName;
    property OffsetLeft: integer read GetOffsetLeft;
    property OffsetTop: integer read GetOffsetTop;
    property OffsetWidth: integer read GetOffsetWidth;
    property OffsetHeight: integer read GetOffsetHeight;
    property InnerHtml: string read GetInnerHtml write SetInnerHtml;
    property InnerText: string read GetInnerText write SetInnerText;
    property OuterHTML: string read GetOuterHTML;
    property OuterText: string read GetOuterText;
    property Children: THTMLElementCollection read GetChildren;

    procedure SetAttribute(Name, Value: string);
    function GetAttribute(Name: string): string;
    procedure RemoveAttribute(Name: string);
    procedure SetActive();
    procedure AppendElement(El: THTMLElement);
    procedure Focus();
    procedure AttachEvent(event: string; method: Pointer);
  end;

  THTMLLocation = class(TObject)
  private
    FElement: IDispatch;
    function GetHref: string;
    function GetProtocol: string;
    function GetHost: string;
    function GetHash: string;
    function GetPort: integer;
  public
    property Element: IDispatch read FElement write FElement;
    property Href: string read GetHref;
    property Protocol: string read GetProtocol;
    property Host: string read GetHost;
    property Port: integer read GetPort;
    property Hash: string read GetHash;

    procedure Reload();
  end;

  THTMLScreen = class(TObject)
  private
    FElement: IDispatch;
    function GetWidth: integer;
    function GetHeight: integer;
  public
    property Element: IDispatch read FElement write FElement;
    property Width: integer read GetWidth;
    property Height: integer read GetHeight;

  end;

  THTMLWindowElement = class(TObject)
  private
    FElement: IDispatch;
    function GetFrames: THTMLElementCollection;
    function GetParentWindow: THTMLWindowElement;
    function GetTop: THTMLWindowElement;
    function GetLocation: THTMLLocation;
    function GetDocument: TDocument;
    function GetScreen: THTMLScreen;
  public
    property Element: IDispatch read FElement write FElement;
    property Frames: THTMLElementCollection read GetFrames;
    property Parent: THTMLWindowElement read GetParentWindow;
    property Top: THTMLWindowElement read GetTop;
    property Location: THTMLLocation read GetLocation;
    property Document: TDocument read GetDocument;
    property Screen: THTMLScreen read GetScreen;

    function Call(ScriptName: string; ScriptParams: array of Variant): Variant;
    procedure Eval(ScriptName: string);
    procedure Navigate(Url: string);
    procedure ScrollBy(X,Y: integer);
    procedure ScrollTo(X,Y: integer);


  end;





implementation

uses Main, JavascriptObject;

function CreateHtmlElement(IElement: IHTMLElement): THTMLElement;
var
  el: THTMLElement;
begin
  el:= THTMLElement.Create;
  el.Element := IElement;
  Result := el;
end;

function CreateHtmlWindowElement(IElement: IHTMLWindow2): THTMLWindowElement;
var
  el: THTMLWindowElement;
begin
  el:= THTMLWindowElement.Create;
  el.Element := IElement;
  Result := el;
end;

function TDocument.CreateElement(eTag: string): THTMLElement;
var
  IElement: IHTMLElement;
begin
  IElement := (Self.Document as IHTMLDocument2).createElement(eTag);
  Result := CreateHtmlElement(IElement);
end;

function TDocument.GetActiveElement: THTMLElement;
begin
  Result := CreateHtmlElement((Self.Document as IHTMLDocument2).activeElement);
end;

function TDocument.GetAll: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin
  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument2).all;
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetAnchors: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IAnchors: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IAnchors := (Document as IHTMLDocument3).getElementsByTagName('A');
  for I := 0 to IAnchors.length -1 do
  begin
    IElement := IAnchors.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;
end;

function TDocument.GetBody: THTMLElement;
begin
  Result := CreateHtmlElement((Document as IHTMLDocument2).body);

end;

function TDocument.GetElementById(v: string): THTMLElement;
begin
  Result := CreateHtmlElement((Self.Document as IHTMLDocument3).getElementById(v));
end;

function TDocument.GetElementsByClassName(
  classname: string): THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument7).getElementsByClassName(classname);
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetElementsByName(name: string): THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument3).getElementsByName(name);
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;
end;

function TDocument.GetElementsByTagName(
  tagName: string): THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument3).getElementsByTagName(tagName);
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetForms: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IForms: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IForms := (Document as IHTMLDocument2).forms;
  for I := 0 to IForms.length -1 do
  begin
    IElement := IForms.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetHead: THTMLElement;
begin
  Result := CreateHtmlElement((Self.Document as IHTMLDocument7).head);
end;

function TDocument.GetImages: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin

  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument3).getElementsByTagName('img');
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetScripts: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
begin
  Collection:= THTMLElementCollection.Create;
  IElements := (Document as IHTMLDocument3).getElementsByTagName('script');
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.QuerySelector(Query: string): THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
  V: Variant;
begin
  Collection:= THTMLElementCollection.Create;
  //IElements := (Document as IHTMLDocument2).
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function TDocument.GetCharset: string;
begin
  Result := (Document as IHTMLDocument2).charset;
end;

procedure TDocument.SetCharset(val: string);
begin
  (Document as IHTMLDocument2).charset := val;
end;

function TDocument.GetCookie: string;
begin
  Result := (Document as IHTMLDocument2).cookie;
end;

function TDocument.GetDomain: string;
begin
  Result :=(Document as IHTMLDocument2).domain;
end;

procedure TDocument.SetCookie(val: string);
begin
  (Document as IHTMLDocument2).cookie := val;
end;

procedure TDocument.Write(val: string);
var
  v: Variant;
begin
  v := VarArrayCreate([0, 0], varVariant);
  V[0] := val;
  (Document as IHTMLDocument2).write(PSafeArray(System.TVarData(v).VArray));
end;

procedure TDocument.WriteLn(val: string);
var
  v: Variant;
begin
  v := VarArrayCreate([0, 0], varVariant);
  V[0] := val;
  (Document as IHTMLDocument2).writeln(PSafeArray(System.TVarData(v).VArray));

end;

{ THTMLElementCollection }

function THTMLElementCollection.Get(Index: Integer): THTMLElement;
begin
  Result := THTMLElement(Items[Index]) ;
end;

procedure THTMLElementCollection.Put(Index: Integer; Item: THTMLElement);
begin
  Insert(Index, Item);
end;

{ THTMLElement }

procedure THTMLElement.AppendElement(El: THTMLElement);
begin
  (Element as IHtmlDomNode).appendChild(IHTMLDOMNode(El.Element));
end;

procedure THTMLElement.AttachEvent(event: string; method: Pointer);
var
  IElement: IHTMLElement2;
begin
  IElement.attachEvent(event, (TEventObject.Create(TProcedure(PProcedure(method)^)) as IDispatch));
end;

procedure THTMLElement.Focus;
begin
  (Element as IHTMLElement2).focus();
end;

function THTMLElement.GetAttribute(Name: string): string;
begin
   Result := (Element as IHTMLElement).getAttribute(Name, 0);
end;

function THTMLElement.GetChildren: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLElement;
  I: Integer;
  V: Variant;
begin
  Collection:= THTMLElementCollection.Create;
  IElements := (Element as IHTMLElement).children as IHTMLElementCollection;
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLElement;
    Collection.Add(CreateHtmlElement(IElement));
  end;
  Result := Collection;

end;

function THTMLElement.GetClassValues: string;
begin
  Result := (Element as IHTMLElement)._className;
end;

procedure THTMLElement.SetClassValues(Value: string);
begin
  (Element as IHTMLElement)._className := Value;
end;

function THTMLElement.GetId: string;
begin
  Result := (Element as IHTMLElement).id;
end;

function THTMLElement.GetInnerHtml: string;
begin
  Result := (Element as IHTMLElement).innerHTML;
end;

function THTMLElement.GetInnerText: string;
begin
  (Element as IHTMLElement).innerText;
end;

function THTMLElement.GetOffsetHeight: integer;
begin
  Result := (Element as IHTMLElement).offsetHeight;
end;

function THTMLElement.GetOffsetLeft: integer;
begin
  Result := (Element as IHTMLElement).offsetLeft;
end;

function THTMLElement.GetOffsetTop: integer;
begin
    Result := (Element as IHTMLElement).offsetTop;
end;

function THTMLElement.GetOffsetWidth: integer;
begin
    Result := (Element as IHTMLElement).offsetWidth;
end;

function THTMLElement.GetOuterHTML: string;
begin
  Result := (Element as IHTMLElement).outerHTML;
end;

function THTMLElement.GetOuterText: string;
begin
  Result := (Element as IHTMLElement).outerText;
end;

function THTMLElement.GetParentElement: THTMLElement;
begin
  Result := CreateHtmlElement((Element as IHTMLElement).parentElement);
end;

function THTMLElement.GetTagName: string;
begin
  Result := (Element as IHTMLElement).tagName;
end;

procedure THTMLElement.SetId(Value: string);
begin
  (Element as IHTMLElement).id := Value;
end;

procedure THTMLElement.SetInnerHtml(Value: string);
begin
  (Element as IHTMLElement).innerHTML := Value;
end;

procedure THTMLElement.SetInnerText(Value: string);
begin
  (Element as IHTMLElement).innerText := Value;
end;

procedure THTMLElement.RemoveAttribute(Name: string);
begin
  (Element as IHTMLElement).removeAttribute(Name, 0);
end;

procedure THTMLElement.SetActive;
begin
  (Element as IHTMLElement3).setActive();
end;

procedure THTMLElement.SetAttribute(Name, Value: string);
begin
  (Element as IHTMLElement).setAttribute(Name, Value, 0);
end;





{ THTMLWindowElement }

function THTMLWindowElement.Call(ScriptName: string; ScriptParams: array of Variant): Variant;
var
  doc2: IHTMLDocument2;
  disp: IDispatch;
  ScriptID: SYSINT;
  hr: HRESULT;
  DispParams: TDispParams;
  i: Integer;
  ScriptValue: OleVariant;
  Temp: TExcepInfo;
const
  IID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
begin
  doc2 := (Element as IHTMLWindow2).document;
//  hr := WebBrowser1.Document.QueryInterface(IHTMLDocument2,doc2);
  disp := doc2.Script;
//  hr := doc2.Script.QueryInterface(IDispatch, disp);
  hr := disp.GetIDsOfNames(IID_NULL, @ScriptName, 1, LOCALE_USER_DEFAULT, @ScriptID );
  with DispParams do
  begin
    cArgs := Length(ScriptParams);
    GetMem(rgvarg, cArgs*SizeOf(Variant));
    for i := 0 to cArgs - 1 do
    begin
      VariantInit(OleVariant(rgvarg^[i]));
      OleVariant(rgvarg^[i]) := ScriptParams[i];
      sleep(0);
    end;
    rgdispidNamedArgs := NIL;
    cNamedArgs := 0;
  end;
  hr := disp.Invoke(ScriptID,
    IID_NULL,
    LOCALE_USER_DEFAULT,
    DISPATCH_METHOD,
    DispParams,
    @ScriptValue, @Temp, nil);
  Result := ScriptValue;
  FreeMem(DispParams.rgvarg);
end;

procedure THTMLWindowElement.Eval(ScriptName: string);
begin
  (Element as IHTMLWindow2).execScript(ScriptName, 'javascript');
end;

function THTMLWindowElement.GetDocument: TDocument;
var
  doc: TDocument;
begin
  doc := TDocument.Create;
  doc.Document := (Element as IHTMLWindow2).document;
  Result := doc;
end;

function THTMLWindowElement.GetFrames: THTMLElementCollection;
var
  Collection: THTMLElementCollection;
  IElements: IHTMLElementCollection;
  IElement: IHTMLWindow2;
  I: Integer;
  V: Variant;
begin
  Collection:= THTMLElementCollection.Create;
  IElements := ((Element as IHTMLWindow2).document as IHTMLDocument3).getElementsByTagName('iframe');
  for I := 0 to IElements.length -1 do
  begin
    IElement := IElements.item(I, EmptyParam) as IHTMLWindow2;
    Collection.Add(CreateHtmlWindowElement(IElement));
  end;
  Result := Collection;

end;

function THTMLWindowElement.GetLocation: THTMLLocation;
var
  L: THTMLLocation;
begin
  L := THTMLLocation.Create;
  L.Element := (Element as IHTMLWindow2).location;
  Result := L;
end;

function THTMLWindowElement.GetParentWindow: THTMLWindowElement;
begin
  Result := CreateHtmlWindowElement((Element as IHTMLWindow2).parent);
end;

function THTMLWindowElement.GetScreen: THTMLScreen;
var
  S: THTMLScreen;
begin
  S := THTMLScreen.Create;
  S.Element := (Element as IHTMLWindow2).screen;
  Result := S;

end;

function THTMLWindowElement.GetTop: THTMLWindowElement;
begin
  Result := CreateHtmlWindowElement((Element as IHTMLWindow2).top);
end;

procedure THTMLWindowElement.Navigate(Url: string);
begin
  (Element as IHTMLWindow2).navigate(Url);
end;

procedure THTMLWindowElement.ScrollBy(X, Y: integer);
begin
  (Element as IHTMLWindow2).scrollBy(X,Y);
end;

procedure THTMLWindowElement.ScrollTo(X, Y: integer);
begin
  (Element as IHTMLWindow2).scrollTo(X,Y);
end;

{ THTMLLocation }

function THTMLLocation.GetHash: string;
begin
  Result := (Element as IHTMLLocation).hash;
end;

function THTMLLocation.GetHost: string;
begin
  Result := (Element as IHTMLLocation).host;
end;

function THTMLLocation.GetHref: string;
begin
  Result := (Element as IHTMLLocation).href;
end;

function THTMLLocation.GetPort: integer;
begin
  Result := StrToInt((Element as IHTMLLocation).port);
end;

function THTMLLocation.GetProtocol: string;
begin
  Result := (Element as IHTMLLocation).protocol;
end;

procedure THTMLLocation.Reload;
begin
  (Element as IHTMLLocation).reload(true);
end;

{ THTMLScreen }

function THTMLScreen.GetHeight: integer;
begin
  Result := (Element as IHTMLScreen).height;
end;

function THTMLScreen.GetWidth: integer;
begin
  Result := (Element as IHTMLScreen).width;
end;


end.
