{******************************************************************}
{ IEParser.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 03.01.2007                                           }
{                                                                  }
{ Based on UI_Less.pas (Per Lindsų Larsen)                         }
{ http://www.euromind.com/ieDelphi                                 }
{ lindsoe@po.ia.dk                                                 }
{                                                                  }
{ Sizden iki žey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit IEParser;

interface

uses
  MsHtml_EWB, Urlmon, ActiveX, Windows, Messages, Classes, SysUtils, Variants;

const
  WM_USER_STARTWALKING      = WM_USER + 1;
  DISPID_AMBIENT_DLCONTROL  = (-5512);
  READYSTATE_COMPLETE       = $00000004;

type
  TInvokeEvent = function(DispID: Integer; const IID: TGUID; LocaleID: Integer;
    Flags: Word; var Params: TagDispParams; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT of object;

  TIEParser = class(TComponent, IUnknown, IDispatch, IPropertyNotifySink, IOleClientSite)
  private
    FOnInvoke: TInvokeEvent;
    FEnabled: Boolean;
  protected
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
    { IPropertyNotifySink }
    function OnChanged(dispid: TDispID): HResult; stdcall;
    function OnRequestEdit(dispid: TDispID): HResult; stdcall;
    { IOleClientSite }
    function SaveObject: HResult; stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
       out mk: IMoniker): HResult; stdcall;
    function GetContainer(out container: IOleContainer): HResult; stdcall;
    function ShowObject: HResult; stdcall;
    function OnShowWindow(fShow: BOOL): HResult; stdcall;
    function RequestNewObjectLayout: HResult; stdcall;
    { Other Methods }
    function LoadUrlFromMoniker: HResult;
    function LoadUrlFromFile: HResult;
  // * We only use LoadUrlFromMoniker, but we could use LoadUrlFromFile instead.
  public
    HTMLElementCollection: IHTMLElementCollection;
    Document: IHTMLDocument; // Changed by Shenturk
    _URL: WideString; // Changed by Shenturk
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Go(URL: WideString): IHTMLElementCollection;
    function LoadFromFile(URL: WideString): IDispatch;//IHTMLElementCollection;//
    function LoadFromStream(AStream: TStream): IDispatch; // By Shenturk
    function LoadFromString(AString: WideString): IDispatch; // By Shenturk
  published
    property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
    property Enabled: Boolean read FEnabled write FEnabled default True;
  end;
{
var
  Document: IHTMLDocument2;
  _URL: WideString;
}
implementation

constructor TIEParser.Create(AOwner: TComponent);
begin
  FEnabled := True;
  inherited Create(AOwner);
end;

destructor TIEParser.Destroy;
begin

  HTMLElementCollection := nil;
  Document := nil;
  
  inherited Destroy;
end;

function TIEParser.Go(URL: WideString): IHtmlElementCollection;
var
  Cookie: Integer;
  CP: IConnectionPoint;
  OleObject: IOleObject;
  OleControl: IOleControl;
  CPC: IConnectionPointContainer;
  Msg: TMsg;
  hr: HRESULT;
begin
  if FEnabled then
  begin
    _URL := Url;
    CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER,
      IID_IHTMLDocument2, Document);
    OleObject := Document as IOleObject;
    OleObject.SetClientSite(Self);
    OleControl := Document as IOleControl;
    OleControl.OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
    CPC := Document as IConnectionPointContainer;
    CPC.FindConnectionPoint(IpropertyNotifySink, CP);
    CP.Advise(Self, Cookie);
    HR := LoadUrlFromMoniker; // alternative: Hr:= LoadUrlFromFile;

    if ((SUCCEEDED(HR)) or (HR = E_PENDING)) then
      while (GetMessage(msg, 0, 0, 0)) do
        if ((msg.message = WM_USER_STARTWALKING) and (msg.hwnd = 0)) then
        begin
          PostQuitMessage(0);
          HtmlElementCollection := nil;//HTMLDocument.Get_all();
          Result := HtmlElementCollection;
        end
        else DispatchMessage(msg);
  end;
end;

function TIEParser.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
const
  DLCTL_NO_SCRIPTS        = $00000080;
  DLCTL_NO_JAVA           = $00000100;
  DLCTL_NO_RUNACTIVEXCTLS = $00000200;
  DLCTL_NO_DLACTIVEXCTLS  = $00000400;
  DLCTL_DOWNLOADONLY      = $00000800;

var
  I: Integer;
begin
  Result := E_FAIL;
  if FEnabled then
  begin
    if DISPID_AMBIENT_DLCONTROL = DispID then
    begin
      I := DLCTL_DOWNLOADONLY + DLCTL_NO_SCRIPTS +
           DLCTL_NO_JAVA + DLCTL_NO_DLACTIVEXCTLS +
           DLCTL_NO_RUNACTIVEXCTLS;
      PVariant(VarResult)^ := I;
      Result := S_OK;
      if Assigned(FOnInvoke) then
        FOnInvoke(DispID, IID, LocaleID, Flags, TagDispParams(Params),
          VarResult, ExcepInfo, ArgErr)
    end
    else Result := DISP_E_MEMBERNOTFOUND;
  end;
end;

function TIEParser.OnChanged(dispid: TDispID): HResult;
var
  dp: TDispParams;
  vResult: OleVariant;
begin
  Result := E_FAIL;
  if FEnabled then
  begin
    if (DISPID_READYSTATE = Dispid) then
    begin
      if SUCCEEDED((Document as IHTMLdocument2).Invoke(DISPID_READYSTATE, GUID_NULL,
        LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET, dp, @vResult, nil, nil)) then
        if Integer(vResult) = READYSTATE_COMPLETE then
          PostThreadMessage(GetCurrentThreadId(), WM_USER_STARTWALKING, 0, 0);
    end;
  end;
end;

function TIEParser.LoadUrlFromMoniker: HResult;
var
  Moniker: IMoniker;
  BindCtx: IBindCTX;
  PM: IPersistMoniker;
begin
  Result := E_FAIL;
  if FEnabled then
  begin
    CreateURLMoniker(nil, PWideChar(_URL), Moniker);
    CreateBindCtx(0, BindCtx);
    PM := Document as IPersistMoniker;
    Result := PM.Load(LongBool(0), Moniker, BindCtx, STGM_READ);
  end;
end;

function TIEParser.LoadUrlFromFile: HResult;
var
  PF: IPersistFile;
begin
  Result := E_FAIL;
  if FEnabled then
  begin
    PF := Document as IPersistFile;
    Result := PF.Load(PWideChar(_URL), 0);
  end;
end;

function TIEParser.OnRequestEdit(dispid: TDispID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.SaveObject: HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  out mk: IMoniker): HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.GetContainer(out container: IOleContainer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.ShowObject: HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.OnShowWindow(fShow: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.RequestNewObjectLayout: HResult;
begin
  Result := E_NOTIMPL;
end;

function TIEParser.LoadFromFile(URL: WideString): IDispatch;//IHTMLELEMENTCollection;//
var
  Cookie: Integer;
  CP: IConnectionPoint;
  OleObject: IOleObject;
  OleControl: IOleControl;
  CPC: IConnectionPointContainer;
  Msg: TMsg;
  HR: HRESULT;
begin
  if FEnabled then
  begin
    _URL := Url;
    CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER,
      IID_IHTMLDocument2, Document);
    OleObject := Document as IOleObject;
    OleObject.SetClientSite(Self);
    OleControl := Document as IOleControl;
    OleControl.OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
    CPC := Document as IConnectionPointContainer;
    CPC.FindConnectionPoint(IpropertyNotifySink, CP);
    CP.Advise(Self, Cookie);

    HR:= LoadUrlFromFile;

    if ((SUCCEEDED(HR)) or (HR = E_PENDING)) then
      while (GetMessage(msg, 0, 0, 0)) do
        if ((msg.message = WM_USER_STARTWALKING) and (msg.hwnd = 0)) then
        begin
          PostQuitMessage(0);
          HtmlElementCollection := nil;//HTMLDocument.Get_all();
          Result := Document;//HtmlElementCollection;//
        end
        else DispatchMessage(msg);
  end;
end;

function TIEParser.LoadFromStream(AStream: TStream): IDispatch;
var
  Cookie: Integer;
  CP: IConnectionPoint;
  OleObject: IOleObject;
  OleControl: IOleControl;
  CPC: IConnectionPointContainer;
  Msg: TMsg;
  HR: HRESULT;
begin

  if FEnabled then
  begin
    _URL := '';
    CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER,
      IID_IHTMLDocument2, Document);
    OleObject := Document as IOleObject;
    OleObject.SetClientSite(Self);
    OleControl := Document as IOleControl;
    OleControl.OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
    CPC := Document as IConnectionPointContainer;
    CPC.FindConnectionPoint(IpropertyNotifySink, CP);
    CP.Advise(Self, Cookie);

    AStream.Seek(0, 0);
    HR := (Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));

    if ((SUCCEEDED(HR)) or (HR = E_PENDING)) then
      while (GetMessage(msg, 0, 0, 0)) do
        if ((msg.message = WM_USER_STARTWALKING) and (msg.hwnd = 0)) then
        begin
          PostQuitMessage(0);
          HtmlElementCollection := nil;//HTMLDocument.Get_all();
          Result := Document;//HtmlElementCollection;//
        end
        else DispatchMessage(msg);
  end;
end;

function TIEParser.LoadFromString(AString: WideString): IDispatch;
var
  M: TStringStream;
begin
  M := TStringStream.Create(AString);
  try
    Result := LoadFromStream(M);
  finally
    M.Free;
  end;
end;

initialization

finalization

end.