Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Nick


Contraseña


Nuevo usuario


English
Obtener todas las URLs - direcciones web - de las ventanas de Internet Explorer abiertas - Delphi
Lenguaje de programación Borland Delphi



Este truco en Delphi 6 obtiene todas las URLs (direcciones web) actualmente abiertas con el navegador Internet Explorer. Muestra el título (caption) de la ventana y la URL visitada.

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DDEMan, shellapi, ExtCtrls, ComCtrls, Menus, ActnList;

type
  TformMenuPrincipal = class(TForm)
    dlGuardar: TSaveDialog;
    btSalir: TButton;
    tab: TPageControl;
    tabActivas: TTabSheet;
    tabEdicion: TTabSheet;
    Panel1: TPanel;
    txtVentanas: TMemo;
    btGuardar: TButton;
    Panel3: TPanel;
    LWEB: TLabel;
    be: TStatusBar;
    btObtener2: TButton;
    lsListaVentanas: TListView;
    Panel4: TPanel;
    PopupMenu1: TPopupMenu;
    actAcciones: TActionList;
    actCerrarVentana: TAction;
    Cerrarventana1: TMenuItem;
    actRefrescar: TAction;
    actSalir: TAction;
    Refrescar1: TMenuItem;
    N1: TMenuItem;
    Salir1: TMenuItem;
    Button1: TButton;
    procedure LWEBClick(Sender: TObject);
    procedure btGuardarClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure actCerrarVentanaExecute(Sender: TObject);
    procedure actRefrescarExecute(Sender: TObject);
    procedure actSalirExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

function obtenerVentanasIExplore (Handle: THandle; List: TStringList): boolean; stdcall;
var
  hWndIE, hWndIEChild : HWND;
  Buffer : array[0..255] of Char;
begin
  //obtiene el título de la ventana
  SendMessage(Handle, WM_GETTEXT, 255, integer(@Buffer[0]));
  //busca las ventanas de IExplorer con el título del valor de "Buffer"
  hWndIE := FindWindow('IEFrame', Buffer);
  if hWndIE > 0 then
  begin
    hWndIEChild := FindWindowEx(hWndIE, 0, 'WorkerW', nil);
    if hWndIEChild > 0 then
    begin
      hWndIEChild := FindWindowEx(hWndIEChild, 0, 'ReBarWindow32', nil);
      if hWndIEChild > 0 then
      begin
        hWndIEChild := FindWindowEx(hWndIEChild, 0, 'ComboBoxEx32', nil);
        if hWndIEChild > 0 then
        begin
          SendMessage(hWndIEChild, WM_GETTEXT, 255, integer(@Buffer));
          List.Add(Buffer)
        end;
      end;
    end;
  end;
  Result :=True;
end;


//otra forma

function obtenerURL (WinHandle: THandle): string;
var
  hWndIE, hWndIEChild : HWND;
  Buffer : array[0..255] of Char;
begin
  SendMessage(WinHandle, WM_GETTEXT, 255, integer(@Buffer[0]));
  //busca las ventanas de IExplorer con el título del valor de "Buffer"
  hWndIE := FindWindow('IEFrame', Buffer);
  if WinHandle > 0 then
  begin
    hWndIEChild := FindWindowEx(hWndIE, 0, 'WorkerW', nil);
    if hWndIEChild > 0 then
    begin
      hWndIEChild := FindWindowEx(hWndIEChild, 0, 'ReBarWindow32', nil);
      if hWndIEChild > 0 then
      begin
        hWndIEChild := FindWindowEx(hWndIEChild, 0, 'ComboBoxEx32', nil);
        if hWndIEChild > 0 then
        begin
          SendMessage(hWndIEChild, WM_GETTEXT, 255, integer(@Buffer));
          result := Buffer;
        end;
      end;
    end;
  end;
end;


function obtenerTextoVentana (WinHandle: THandle): string;
var
  P: array[0..256] of Char;
begin
  P[0] := #0;
  GetWindowText(WinHandle, P, 255);
  if P[0] = #0 then Result := ''
  else
    Result := P;
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

procedure TformMenuPrincipal.btGuardarClick(Sender: TObject);
begin
  if dlGuardar.Execute then
    txtVentanas.Lines.SaveToFile(dlGuardar.FileName);
end;

procedure TformMenuPrincipal.FormShow(Sender: TObject);
begin
  actRefrescarExecute (Self);
end;

procedure TformMenuPrincipal.actCerrarVentanaExecute(Sender: TObject);
begin
  if lsListaVentanas.Selected <> nil then
  begin
    PostMessage(StrToInt(lsListaVentanas.Selected.SubItems[1]), WM_CLOSE, 0, 0);
    lsListaVentanas.DeleteSelected;  
  end
  else
    MessageDlg('Debe seleccionar la ventana a cerrar.', mtInformation, [mbok], 0);
end;

procedure TformMenuPrincipal.actRefrescarExecute(Sender: TObject);
var
  Hx: THandle;
  P: array[0..256] of Char;
  Item: TListItem;
  urlOb : string;
begin
  tabActivas.Show;
  Screen.Cursor := crHourGlass;
  be.Panels[0].Text := 'Obteniendo lista de ventanas, espere por favor...';
  be.Refresh;
  lsListaVentanas.Items.Clear;
  txtVentanas.Clear;
  try
    Hx := FindWindow(nil, nil);
    GetClassName(Hx, P, SizeOf(P));
    if string(P) = 'IEFrame' then
    begin
      Item := lsListaVentanas.Items.Add;
      Item.SubItems.Add(IntToStr(Hx));
      Item.Caption := obtenerTextoVentana (Hx);
    end;
    while Hx <> 0 do
    begin
      Hx := GetWindow(Hx, GW_HWNDNEXT);
      GetClassName(Hx, P, SizeOf(P));
      if string(P) = 'IEFrame' then
      begin
        Item := lsListaVentanas.Items.Add;
        Item.Caption := obtenerTextoVentana(Hx);
        urlOb := obtenerURL(Hx);
        Item.SubItems.Add(urlOb);
        txtVentanas.Lines.Add(urlOb);
        Item.SubItems.Add(IntToStr(Hx));
      end;
    end;
    be.Panels[0].Text := 'Nº de webs activas: ' + IntToStr(lsListaVentanas.Items.Count);
    be.Refresh;
    Screen.Cursor := crDefault;
  except
    be.Panels[0].Text := 'Error al intentar obtener las URLs activas';
    be.Refresh;
    Screen.Cursor := crDefault;
  end;
end;

procedure TformMenuPrincipal.actSalirExecute(Sender: TObject);
begin
  close;
end;

end.
Si te has registrado en nuestra web (si aún lo has hecho puedes registrarte pulsando aquí gratuitamente) puedes descargar el código fuente (completo y totalmente gratuito) pulsando aquí.




Publicado el: 2005-09-18

Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+