...die URL von Webbrowser Instanzen auslesen?

Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch

Kategorie: Internet / LAN

{ 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:
  // "http://www.swissdelphicenter.ch","SwissDelphiCenter.ch"
  
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.
// by http://www.euromind.com/iedelphi/

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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base