IE 현재 열려있는 주소값 읽어오기

IE 현재 열려있는 주소값 읽어오기

 

 

IE 현재 열려있는 주소값 읽어오기

{ Code 1 **************************************}

 

uses

  ddeman;

 

function GetURL(Service: string): string;

var

  ClDDE: TDDEClientConv;

  temp: PChar;

begin

  Result := '';

  //create a new DDE Client object

  ClDDE := TDDEClientConv.Create(nil);

  with ClDDE do

  begin

    SetLink(Service, 'WWW_GetWindowInfo');

    temp := RequestData('0xFFFFFFFF');

    Result := StrPas(temp);

    StrDispose(temp);

    CloseLink;

  end;

  ClDDE.Free;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  // the result should be something like:

  ShowMessage(GetURL('IExplore'));

  { ShowMessage(GetURL('Netscape')); }

end;

 

{ Code 2 **************************************}

uses

  ddeman;

 

procedure GetCurrentURL(out URL, Title: string);

var

   DDEClient : TDDEClientConv;

   p, q: PChar;

   i: Integer;

begin

   DDEClient := TDDEClientConv.Create(nil);

   try

     with DDEClient do if SetLink('IExplore', 'WWW_GetWindowInfo') or

       SetLink('Netscape', 'WWW_GetWindowInfo') or

       SetLink('Mosaic', 'WWW_GetWindowInfo') or

       SetLink('Netscp6', 'WWW_GetWindowInfo') or

       SetLink('Mozilla', 'WWW_GetWindowInfo') or

       SetLink('Firefox', 'WWW_GetWindowInfo') then

       p := RequestData('0xFFFFFFFF')

     else raise Exception.Create('Could not establish browser DDE link');

     if Assigned(p) then try

       q := p;

       Assert(q^ = '"');

       SetLength(URL, StrLen(q));

       Inc(q);

       i := 0;

       while q^ <> '"' do begin

         if (q^ = '\') and (q[1] = '"') then Inc(q);

         Inc(i);

         URL[i] := q^;

         Inc(q);

       end;

       SetLength(URL, i);

       SetLength(Title, StrLen(q));

       i := 0;

       Inc(q, 3);

       while q^ <> '"' do begin

         if (q^ = '\') and (q[1] = '"') then Inc(q);
         Inc(i);

         Title[i] := q^;

         Inc(q);

       end;

       SetLength(Title, i);

     finally

       StrDispose(p);

     end else raise Exception.Create('Could not fetch browser data');

   finally

     DDEClient.Free;

   end;

end;

{ Code 3 **************************************}

// To have the locationurls from all running instances of Internet Explorer -

// including open folders and Windows Explorer - shown in a listbox.

 

uses

  shdocvw_tlb;

 

procedure TForm1.Button2Click(Sender: TObject);

var

  x: Integer;

  Sw: IShellWindows;

begin

  sw := CoShellWindows.Create;

  for x := 0 to SW.Count - 1 do

    Listbox1.Items.Add((Sw.Item(x) as IWebbrowser2).LocationUrl);

end;

 

{ Code 4 **************************************}

 

uses

  ActiveX, Shdocvw_tlb, MSHTML_TLB;

 

type

  TObjectFromLResult = function(LRESULT: lResult; const IID: TIID;

    wParam: wParam; out pObject): HRESULT;

  stdcall;

 

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;

 

function GetActiveIEURL: string;

var

  Document: IHtmlDocument2;

  IE: IWebBrowser2;

  Wnd: HWND;

  WndChild: HWND;
begin

  Wnd := GetForeGroundWindow;

  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

      //Get Iwebbrowser2 from Handle

      GetIEFromHWnd(WndChild, IE);

      if IE <> nil then

      begin

        Result := IE.LocationURL;

        // Document := IE.Document as IHtmlDocument2;

      end;

    end;

  end;

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

  Caption := GetActiveIEURL;

end;