Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 882
  • Last Modified:

get all opened internet explorer windows

I want to get all opened internet explorer windows and add the window's caption to a ListBox.
i don't want the program to unselect the selected item in the listbox when it gets updated by the timer, so it does a for-loop and checks if the content in the stringlist (IEWndsList) has been changed, if so, then it puts the content in the listbox.

i use the following code:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    ListBox1: TListBox;
    Closewindow1: TMenuItem;
    Timer1: TTimer;
    procedure Closewindow1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IEWndsList: TStringList;
  index: integer;

implementation

{$R *.dfm}

function EnumIEWndsProc(hWnd, lParam: Integer): Boolean; stdcall;
var Cap: PChar;
    Len: Integer;
    cn: array[0..7] of Char;
begin
 Result := True;
 GetClassName(hWnd, cn, 8);
 if cn = 'IEFrame' then begin
   Len := GetWindowTextLength(hWnd) + 1;
   GetMem(Cap, Len);
   GetWindowText(hWnd, Cap, Len);
   IEWndsList.Add(Cap);
   FreeMem(Cap);
 end;
end;

procedure SetHorizontalScroll(alb: TListBox);
var i, len, lbsw: integer;
begin
lbsw := 0;
 with alb do begin
  for i := 0 to Items.Count - 1 do begin
   len := Canvas.TextWidth(Items[i]);
   if len > lbsw then lbsw := len;
  end;
  Perform(LB_SETHORIZONTALEXTENT, lbsw + 7, 0);
 end;
end;

procedure TForm1.Closewindow1Click(Sender: TObject);
begin
 if ListBox1.ItemIndex <> -1 then SendMessage(FindWindow(nil, PChar(ListBox1.Items.Strings[ListBox1.ItemIndex])), WM_SYSCOMMAND, SC_CLOSE, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var a, b: integer;
    BreakIt: Boolean;
begin
 // timer interval = 1
 BreakIt := False;
 index := listbox1.ItemIndex;
 IEWndsList.Clear;
 EnumWindows(@EnumIEWndsProc, 0);
 for a := 0 to IEWndsList.Count - 1 do begin
    for b := 0 to ListBox1.Items.Count - 1 do begin
       if IEWndsList[a] <> ListBox1.Items[b] then begin
         ListBox1.Items.Assign(IEWndsList);
         SetHorizontalScroll(ListBox1);
         listbox1.ItemIndex := index;
         BreakIt := True;
         Break;
       end;
    end;
    if BreakIt then Break;
 end;
 // now you wonder why i wrote "if IEWndsList[a]..."? i wrote it
 // because when i select an item in the listbox and it gets
 // updated (by the timer, every 1 ms) and when i right-click
 // on it and want to close the window, it gets unselected.
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 IEWndsList := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 IEWndsList.Free;
end;

end.
0
din345
Asked:
din345
  • 5
  • 3
  • 2
  • +1
1 Solution
 
Eddie ShipmanAll-around developerCommented:
Use IShellWindows and get the document title, that is what IE places in the Caption:


uses  .., SHDocVw, mshtml
procedure TForm1.Button1Click(Sender: TObject);
var
  x : Integer;
  sw: IShellWindows;
  wb: IWebbrowser2;
  Doc: IHTMLDocument2;
begin
  sw := CoShellWindows.Create;
  for x := 0 to sw.count do
  begin
    WB := Sw.Item(x) as IWebbrowser2;
    if wb<>nil then
    begin
      doc := WB.Document as IHTMLDocument2;
      ListBox1.Items.Add(Doc.Title);
    end;
  end;
end;
0
 
geobulCommented:
What is the question actually?
0
 
din345Author Commented:
EddieShipman: i don't have SHDocVw and mshtml (i have delphi 7 personal...)

geobul: i want to create a program like task manager, but it should only add all internet explorer windows captions to a listbox. how can i do that?
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Eddie ShipmanAll-around developerCommented:
The import the Microsoft HTML and/or Internet Explorer libraries.
If you have TWebBrowser, you have ShDocVW!!!
0
 
krypto2000Commented:
try this

  var
      currentHandle,NextHandle: Hwnd;
      Title : array[0..255] of char;

  currentHandle := FindWindow('IEFrame',nil);
  ListBox1.Items.Add(GetWindowText(currentHandle,Title,255));
  NextHandle := GetWindow(NextHandle, GW_HWNDNEXT);

I would make an working example if is not sufficent for you ;-)
0
 
krypto2000Commented:
Here is a solution :

just put one ListBox (listBox1) and one Button (button1)

-----------------------------------------------------------------------------------------

function EnumWindowsProc(wHandle: HWND; lb: TListBox): Bool; stdcall; export;
var
  Title, ClassName: array[0..255] of char;
begin
  Result := True;
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) and (ClassName='IEFrame') then
     lb.Items.Add(string(Title) + '-' + string(ClassName));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  EnumWindows(@EnumWindowsProc, Integer(Listbox1));
end;
-----------------------------------------------------------------------------------------

0
 
din345Author Commented:
i have solved the problem:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    ListBox1: TListBox;
    Closewindow1: TMenuItem;
    Timer1: TTimer;
    procedure Closewindow1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IEWndsList: TStringList;
  index, scrollPos: integer;

implementation

{$R *.dfm}

function EnumIEWndsProc(hWnd, lParam: Integer): Boolean; stdcall;
var Cap: PChar;
    Len: Integer;
    cn: array[0..7] of Char;
begin
 Result := True;
 GetClassName(hWnd, cn, 8);
 if cn = 'IEFrame' then begin
   Len := GetWindowTextLength(hWnd) + 1;
   GetMem(Cap, Len);
   GetWindowText(hWnd, Cap, Len);
   IEWndsList.Add(Cap);
   FreeMem(Cap);
 end;
end;

procedure SetHorizontalScroll(alb: TListBox);
var i, len, lbsw: integer;
begin
lbsw := 0;
 with alb do begin
  for i := 0 to Items.Count - 1 do begin
   len := Canvas.TextWidth(Items[i]);
   if len > lbsw then lbsw := len;
  end;
  Perform(LB_SETHORIZONTALEXTENT, lbsw + 7, 0);
 end;
end;

procedure TForm1.Closewindow1Click(Sender: TObject);
begin
 if ListBox1.ItemIndex <> - 1 then SendMessage(FindWindow(nil, PChar(ListBox1.Items.Strings[ListBox1.ItemIndex])), WM_SYSCOMMAND, SC_CLOSE, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var a, b: integer;
begin
 // timer interval = 1
 index := listbox1.ItemIndex;
 IEWndsList.Clear;
 EnumWindows(@EnumIEWndsProc, 0);
 for a := 0 to IEWndsList.Count - 1 do begin
    if ListBox1.Items.IndexOf(IEWndsList[a]) = - 1 then begin
      ListBox1.Items.Assign(IEWndsList);
      SetHorizontalScroll(ListBox1);
      listbox1.ItemIndex := index;
      Break;
    end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 IEWndsList := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 IEWndsList.Free;
end;

end.

but i got a new problem now.. when i rightclick on an item and click 'Close window' on the popupmenu, the item is still in the listbox, how can i delete it? (shouldn't EnumWindows() delete it...??)
0
 
krypto2000Commented:
maybe you should use

 SendMessage(MyHandle, WM_CLOSE, 0, 0);

I try it now ;-)
0
 
krypto2000Commented:
here is a working code i have tested on my machine...

DFM :
--------------------------------------------------------------
object Form1: TForm1
  Left = 192
  Top = 103
  Width = 583
  Height = 233
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 575
    Height = 171
    Align = alTop
    ItemHeight = 13
    TabOrder = 0
    OnDblClick = ListBox1DblClick
  end
  object Button1: TButton
    Left = 5
    Top = 177
    Width = 75
    Height = 22
    Caption = 'Close'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 540
    Top = 175
  end
end
--------------------------------------------------------------

PAS :
--------------------------------------------------------------
unit IEFrame;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Timer1: TTimer;
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1    : TForm1;
  myHwnd   : hWnd;
  nextHwnd : hWnd;
  title    : array [0..255] of char;

implementation

{$R *.dfm}


function EnumWindowsProc(wHandle: HWND; lb: TListBox): Bool; stdcall; export;
var
  Title, ClassName: array[0..255] of char;
begin
  Result := True;
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) and (ClassName='IEFrame') then
     lb.Items.Add(string(Title));
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
  if ListBox1.ItemIndex >= 0 then
     SendMessage(FindWindow('IEFrame',PChar(ListBox1.Items[ListBox1.Itemindex])),WM_SYSCOMMAND, SC_CLOSE,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  self.Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ListBox1.Items.Clear;
  EnumWindows(@EnumWindowsProc, Integer(Listbox1));
end;

end.
--------------------------------------------------------------

0
 
krypto2000Commented:
glad to help you ;-)
0
 
Eddie ShipmanAll-around developerCommented:
That has to go through ALL Windows whereby the ShellWindows solution only has to go
through the IE Windows.

Too bad the OP didn't see that or know how to import MSHTML/IE Type Libs...
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 3
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now