PureBasic Forums - English

Code: Select all

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ActiveX,SHDOCVW,MSHTML, WinSkinData, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    StatusBar1: TStatusBar;
    SkinData1: TSkinData;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
     RSPSIMPLESERVICE = 1;
     RSPUNREGISTERSERVICE = 0;

type
     TObjectFromLResult = function(LRESULT: lResult; const IID: TIID; WPARAM: wParam; out pObject): HRESULT; stdcall;


implementation

{$R *.dfm}
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
     hInst: HWND;
     lRes: Cardinal;
     MSG: Integer;
     pDoc: IHTMLDocument2;
     ObjectFromLresult: TObjectFromLresult;
begin
     hInst := LoadLibrary('Oleacc.dll');
     @ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult');
     if @ObjectFromLresult <> nil then
     begin
       try
         MSG := RegisterWindowMessage('WM_HTML_GETOBJECT');
         SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
         Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
         if Result = S_OK then
           (pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
       finally
         FreeLibrary(hInst);
       end;
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
     All: IHtmlElementCollection;
     HtmlElement: IHtmlElement;
     Range: IHTMLTxtRange;
     Document: IHtmlDocument2;
     IE: IWebBrowser2;
     Wnd: HWND;
     WndChild: HWND;
begin
     Wnd := FindWindow('IEFrame', nil);
     if Wnd = 0 then Exit;
     WndChild := FindWindowEX(Wnd, 0, 'Shell DocObject View', nil);
     if WndChild <> 0 then
     begin
       WndChild := FindWindowEX(WndChild, 0, 'Internet Explorer_Server', nil);
       if WndChild <> 0 then
       begin
         GetIEFromHWnd(WndChild, IE); 
         Document := IE.Document as IHtmlDocument2;
         if Assigned(Document) then
         begin
          Range := (Document.body as IHTMLBodyElement).createTextRange;
          Range.pasteHTML('<a href=' + Edit1.Text + ' target=_self></a>');
          (Document.links.item(0,0) as IHTMLElement).click;
         end;
       end;
     end;

end;

Code: Select all

Declare   COM(hwnd.l)

WndChild.l = FindWindow_("IEFrame",#Null)
WndChild.l = FindWindowEx_(WndChild,#Null,"Shell DocObject View",#Null)
WndChild.l = FindWindowEx_(WndChild,#Null,"Internet Explorer_Server",#Null)

COM(WndChild)

Procedure COM(hwnd.l)
CoInitialize_(#Null)
pDoc.IHTMLDocument2  = #Null
ISP.IServiceprovider = #Null
IE.IWebBrowser2      = #Null
lib.l = OpenLibrary(#PB_Any, "Oleacc.dll")
If lib
   MSG.l = RegisterWindowMessage_("WM_HTML_GETOBJECT")
   SendMessageTimeout_(hwnd,MSG,#Null,#Null,#SMTO_ABORTIFHUNG,1000,@lRes.l)
   If CallFunction(lib,"ObjectFromLresult",lRes,?IID_IHTMLDocument2,#Null,@pDoc) = #S_OK
    If pDoc\get_parentWindow(@ISP)  = #S_OK
      Debug ISP\QueryService(?IID_IWebbrowserApp,?IID_IWebBrowser2,@IE.IWebBrowser2)
     ISP\Release()
    EndIf
    pDoc\Release()
   EndIf
   CloseLibrary(lib)
EndIf
CoUninitialize_()
EndProcedure

DataSection 
  IID_IWebBrowser2: 
   Data.l $D30C1661 
   Data.w $CDAF, $11d0 
   Data.b $8A, $3E, $00, $C0, $4F, $C9, $E2, $6E
  IID_IWebbrowserApp: 
   Data.l $0002DF05
   Data.w $0000, $0000
   Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  IID_IHTMLDocument2:
    Data.l $332C4425 
    Data.w $26CB, $11D0 
    Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  IID_IHTMLElement2:
    Data.l $3050F434 
    Data.w $98B5, $11CF 
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
  IID_IHTMLElement:
    Data.l $3050F1FF 
    Data.w $98B5, $11CF 
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection