ui_less.pas

sql inject HDSI3--delphi.rar

unit UI_Less;

interface

uses
   MsHtml,Urlmon, ActiveX, Windows, Messages, Classes;

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

  DLCTL_DLIMAGES = $00000010;
  DLCTL_VIDEOS = $00000020;
  DLCTL_BGSOUNDS = $00000040;
  DLCTL_NO_SCRIPTS = $00000080;
  DLCTL_NO_JAVA = $00000100;
  DLCTL_NO_RUNACTIVEXCTLS = $00000200;
  DLCTL_NO_DLACTIVEXCTLS = $00000400;
  DLCTL_DOWNLOADONLY = $00000800;
  DLCTL_NO_FRAMEDOWNLOAD = $00001000;
  DLCTL_RESYNCHRONIZE = $00002000;
  DLCTL_PRAGMA_NO_CACHE = $00004000;
  DLCTL_NO_BEHAVIORS = $00008000;
  DLCTL_NO_METACHARSET = $00010000;
  DLCTL_URL_ENCODING_DISABLE_UTF8 = $00020000;
  DLCTL_URL_ENCODING_ENABLE_UTF8 = $00040000;
  DLCTL_FORCEOFFLINE = $10000000;
  DLCTL_NO_CLIENTPULL = $20000000;
  DLCTL_SILENT = $40000000;
  DLCTL_OFFLINEIFNOTCONNECTED = $80000000;
  DLCTL_OFFLINE = DLCTL_OFFLINEIFNOTCONNECTED;


type


  TUILess = class(TComponent, IUnknown,IDispatch, IPropertyNotifySink, IOleClientSite)
  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;
///
    function LoadUrlFromMoniker: HResult;
    function LoadUrlFromFile: HResult;
// * We only use LoadUrlFromMoniker, but we could use LoadUrlFromFile instead.

  public
    function Get(URL: PWidechar): IHTMLELEMENTCollection;
  end;


/// Utils
procedure GetAnchorList(IC: IHTMLElementCollection; Anchorlist: TStrings);
procedure GetImageList(IC: IHTMLElementCollection; ImageList: TStrings);



implementation
uses
main_unit;

var
  Doc: IhtmlDocument2;
   _URL: PwideChar;


/// CORE ---->>>>>>>>>

function TUILess.Get(Url: Pwidechar): IHtmlElementCollection;
var
  Cookie: Integer;
  CP: IConnectionPoint;
  OleObject: IOleObject;
  OleControl: IOleControl;
  CPC : IConnectionPointContainer;
  Msg: TMsg;
  hr: HRESULT;
begin
  _Url:=Url;
  CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER, IID_IHTMLDocument2, Doc);
  OleObject:=Doc as IOleObject;
  OleObject.SetClientSite(self);
  OleControl:=Doc as IOleControl;
  OleControl.OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
  CPC:=Doc 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);
        result := Doc.Get_all;
     end else DispatchMessage(msg);
end;




function TUILess.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  I: Integer;
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;
  end else
    Result := DISP_E_MEMBERNOTFOUND;
end;



function TUILess.OnChanged(dispid: TDispID): HResult;
var
  dp: TDispParams;
  vResult: OleVariant;
begin
  if (DISPID_READYSTATE = Dispid) then
    if SUCCEEDED((Doc 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;

function TUILess.LoadUrlFromMoniker: HResult;
var
  Moniker: IMoniker;
  BindCtx: IBindCTX;
  PM: IPersistMoniker;
begin
createURLMoniker( nil, _Url, Moniker);
CreateBindCtx(0, BindCtx);
PM:=Doc as IPersistMoniker;
Result := PM.Load(LongBool(0), Moniker, BindCtx, STGM_READ)
end;

function TUILess.LoadUrlFromFile: HResult;
var
  PF: IPersistfile;
begin
PF:=Doc as IPersistfile;
Result := PF.Load(_URL, 0);
end;


///  UTILILIES ---------- >>>>>>>>>>>>>>>>>>>>>



procedure GetImageList(IC: IHtmlElementCollection; ImageList: TStrings);
var
  Image: IHTMLImgElement;
  Disp: IDispatch;
  x: Integer;
begin
  if IC <> nil then begin
    for x := 0 to IC.length - 1 do begin
      Disp := IC.item(x, 0);
      if SUCCEEDED(Disp.QueryInterface(IHTMLImgElement, Image))
        then ImageList.add(Image.src);
    end;
  end;
end;


procedure GetAnchorList(Ic: IHTMLElementCollection; Anchorlist: TStrings);
var
  Anchor: IHTMLAnchorElement;
  Disp: IDispatch;
  x: Integer;
begin
  if IC <> nil then begin
    for x := 0 to IC.length - 1 do begin
    if form_main.stop_clin=true then exit;
      Disp := IC.item(x, 0);
      Form_main.ProgressBar.Position:=30;
      Form_main.ProgressBar.Position:=60;
      Form_main.ProgressBar.Position:=100;
      if SUCCEEDED(Disp.QueryInterface(IHTMLAnchorElement, Anchor))
        and (anchor.href <> '')
        then Anchorlist.add(Anchor.href);
    end;
  end;
end;



/// Don't Care ------>>>>>>>>>>>


function TUILess.OnRequestEdit(dispid: TDispID): HResult;
begin
  RESULT := E_NOTIMPL;
end;

function TUILess.SaveObject: HResult;
begin
  result := E_NOTIMPL;
end;

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

function TUILess.GetContainer(out container: IOleContainer): HResult;
begin
  result := E_NOTIMPL;
end;

function TUILess.ShowObject: HResult;
begin
  result := E_NOTIMPL;
end;

function TUILess.OnShowWindow(fShow: BOOL): HResult;
begin
  result := E_NOTIMPL;
end;

function TUILess.RequestNewObjectLayout: HResult;
begin
  result := E_NOTIMPL;
end;

end.