?
Solved

get all opened internet explorer windows

Posted on 2005-02-28
11
Medium Priority
?
877 Views
Last Modified: 2010-04-05
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
Comment
Question by:din345
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 2
  • +1
11 Comments
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13419628
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
 
LVL 17

Expert Comment

by:geobul
ID: 13420057
What is the question actually?
0
 
LVL 1

Author Comment

by:din345
ID: 13428927
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.

 
LVL 26

Expert Comment

by:EddieShipman
ID: 13429569
The import the Microsoft HTML and/or Internet Explorer libraries.
If you have TWebBrowser, you have ShDocVW!!!
0
 

Expert Comment

by:krypto2000
ID: 13437013
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
 

Expert Comment

by:krypto2000
ID: 13437100
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
 
LVL 1

Author Comment

by:din345
ID: 13447850
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
 

Expert Comment

by:krypto2000
ID: 13448550
maybe you should use

 SendMessage(MyHandle, WM_CLOSE, 0, 0);

I try it now ;-)
0
 

Accepted Solution

by:
krypto2000 earned 375 total points
ID: 13448605
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
 

Expert Comment

by:krypto2000
ID: 13448835
glad to help you ;-)
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13449476
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses
Course of the Month7 days, 20 hours left to enroll

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question