Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

List all running applications and automatically refresh

Posted on 2004-10-01
6
Medium Priority
?
181 Views
Last Modified: 2010-04-05
Like task manager .. applications, not processes.

I want to show a list of the exe names and captions of the main windows of every running app. And every time the user opens a new instance, for the list to be updated. And it would be nice to be able to kill an instance.

I am sure that this is well known territory - but not to me <g>

Code would be appreciated.
0
Comment
Question by:Mutley2003
[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
  • 4
  • 2
6 Comments
 
LVL 6

Expert Comment

by:Amir Azhdari
ID: 12206467
( DFM file is included )



unit unit1;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Bevel1: TBevel;
    TabSheet2: TTabSheet;
    ListView1: TListView;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    procedure N2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    s1,s2:int64;
  end;

var
  Form1: TForm1;

implementation

uses DateUtils;

{$R *.dfm}
type
  TProcessorTimeInfo = record
    IdleTime: int64;
    KernelTime: int64;
    UserTime: int64;
    DpcTime: int64;
    InterruptTime:int64;
    InterruptCount:cardinal;
  end;

  TThreadInfo = record
    ftCreationTime: TFileTime;
    dwUnknown1: DWORD;
    dwStartAddress: DWORD;
    dwOwningPID: DWORD;
    dwThreadID: DWORD;
    dwCurrentPriority: DWORD;
    dwBasePriority: DWORD;
    dwContextSwitches: DWORD;
    dwThreadState: DWORD;
    dwUnknown2: DWORD;
    dwUnknown3: DWORD;
    dwUnknown4: DWORD;
    dwUnknown5: DWORD;
    dwUnknown6: DWORD;
    dwUnknown7: DWORD;
  end;

  TProcessInfo = record
    dwOffset: DWORD;
    dwThreadCount: DWORD;
    dwUnknown1: array[0..5] of DWORD;
    ftCreationTime: TFileTime;
    ftUserTime: int64;
    ftKernelTime: int64;
  //      dwUnknown4: DWORD;
  //      dwUnknown5: DWORD;
    dwUnknown6: DWORD;
    pszProcessName: pwideChar;
    dwBasePriority: DWORD;
    dwProcessID: DWORD;
    dwParentProcessID: DWORD;
    dwHandleCount: DWORD;
    dwUnknown7: DWORD;
    dwUnknown8: DWORD;
    dwVirtualBytesPeak: DWORD;
    dwVirtualBytes: DWORD;
    dwPageFaults: DWORD;
    dwWorkingSetPeak: DWORD;
    dwWorkingSet: DWORD;
    dwUnknown9: DWORD;
    dwPagedPool: DWORD;
    dwUnknown10: DWORD;
    dwNonPagedPool: DWORD;
    dwPageFileBytesPeak: DWORD;
    dwPageFileBytes: DWORD;
    dwPrivateBytes: DWORD;
    dwUnknown11: DWORD;
    dwUnknown12: DWORD;
    dwUnknown13: DWORD;
    dwUnknown14: DWORD;
    ati: array[0..0] of TThreadInfo;
  end;

function NtQuerySystemInformation(si_class: cardinal; si: pointer; si_length: cardinal; ret_length:cardinal):cardinal; stdcall; external 'ntdll.dll';

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

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
          CanClose:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  li:TListItem;
  buf:array[0..299999] of char;
  pi: ^TProcessInfo;
  ti: ^TProcessorTimeInfo;
  i:integer;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  NtQuerySystemInformation(5, @buf, 300000, 0);
  pi:=@buf;
  repeat
  try
    li:=ListView1.Items.Add;
    li.SubItems.Add('');
    li.Caption:=WideCharToString(pi^.pszProcessName);
    if li.Caption='' then
      li.Caption:='System Idle';
    li.SubItems.Add(timetostr(((pi^.ftUserTime+pi^.ftKernelTime) div 10000000)/86400));
  except
  end;
    pi:=pointer(cardinal(pi)+pi^.dwOffset);
  until pi^.dwOffset=0;
  NtQuerySystemInformation(8, @buf, 300000, 0);
  ListView1.Items.EndUpdate;
  ti:=@buf;
  s2:=ti^.KernelTime+ti^.UserTime{+ti^.DpcTime+ti^.InterruptTime}-ti^.IdleTime;
  i:=round((s2-s1)/100000);
  s1:=s2;
  StatusBar1.Panels[1].Text:='CPU used: '+inttostr(i)+'%';
end;

end.













//   DFM FILE

object Form1: TForm1
  Left = 114
  Top = 37
  Width = 590
  Height = 480
  Caption = 'Task Maneger'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnCloseQuery = FormCloseQuery
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 0
    Top = 0
    Width = 582
    Height = 5
    Align = alTop
    Shape = bsTopLine
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 5
    Width = 582
    Height = 410
    ActivePage = TabSheet1
    Align = alClient
    TabIndex = 0
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'Processes'
      DesignSize = (
        574
        382)
      object ListView1: TListView
        Left = 8
        Top = 4
        Width = 557
        Height = 369
        Anchors = [akLeft, akTop, akRight, akBottom]
        Columns = <
          item
            Caption = 'Name'
            Width = 150
          end
          item
            Caption = 'CPU'
          end
          item
            Caption = 'CPU Time'
            Width = 100
          end>
        TabOrder = 0
        ViewStyle = vsReport
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'Speed'
      ImageIndex = 1
    end
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 415
    Width = 582
    Height = 19
    Panels = <
      item
        Width = 100
      end
      item
        Width = 100
      end
      item
        Width = 50
      end>
    SimplePanel = False
  end
  object MainMenu1: TMainMenu
    Left = 244
    Top = 65532
    object N1: TMenuItem
      Caption = 'File'
      object N2: TMenuItem
        Caption = 'Exit'
        OnClick = N2Click
      end
    end
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 352
    Top = 24
  end
end
0
 
LVL 6

Expert Comment

by:Amir Azhdari
ID: 12206486
also :

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.Timer1Timer(Sender: TObject);
var
LibInst, hSnapShot, hProcess: THandle;
SnapShot: TCreateToolhelp32Snapshot;
ProcFirst: TProcess32First;
ProcNext: TProcess32Next;
ProcEntry1: TProcessEntry32;
begin
listbox1.Clear;
LibInst := LoadLibraryA('Kernel32.DLL');
 if LibInst = 0 then
   begin
   ShowMessage('Big Trouble, this is not a windows system');
   Exit;
   end;
try
  @Snapshot := GetProcAddress(LibInst, 'CreateToolhelp32Snapshot');
  if not Assigned(Snapshot) then
    Raise Exception.Create('Process address for CreateToolhelp32Snapshot not found. . . Window Sys Error is'+#10+
                          IntToStr(GetLastError));
  @ProcFirst := GetProcAddress(LibInst, 'Process32First');
  @ProcNext := GetProcAddress(LibInst, 'Process32Next');
  hSnapShot := Snapshot(TH32CS_SNAPPROCESS, 0);
  try
  if hSnapShot = 0 then
   ShowMessage(' no Snapshot, failure') else
   begin
   ProcEntry1.dwSize := sizeof(TProcessEntry32);
   if ProcFirst( hSnapShot, ProcEntry1 ) then
     begin
     ListBox1.Items.Add(ProcEntry1.szExeFile);
     while ProcNext( hSnapShot, ProcEntry1 ) do
       ListBox1.Items.Add(ProcEntry1.szExeFile);
     end;
   end;

   finally
   CloseHandle(hSnapShot);
   end;

  finally
  FreeLibrary(LibInst);
  end;

end;

end.



// DFM FILE
object Form1: TForm1
  Left = 240
  Top = 145
  Width = 696
  Height = 480
  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 = 176
    Top = 128
    Width = 321
    Height = 305
    ItemHeight = 13
    TabOrder = 0
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 72
    Top = 16
  end
end
0
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!

 

Author Comment

by:Mutley2003
ID: 12295486
Amir
thanks for this. But the code lists processes. I am interested in applications and their titles, just like in the application tab of task manager
0
 
LVL 6

Accepted Solution

by:
Amir Azhdari earned 2000 total points
ID: 12303824
oh sorry i didn't read your q. carefully ,
Now , what about this code ? :




unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}
function enumwindowsproc(wnd:hwnd;lb:tlistbox):bool;stdcall;
var
 caption:array[0..128]of char;
begin
 result:=true;
 if iswindowvisible(wnd)and((getwindowlong(wnd,gwl_hwndparent)=0)or(hwnd(getwindowlong(wnd,gwl_hwndparent))=getdesktopwindow))and((getwindowlong(wnd,gwl_exstyle)and ws_ex_toolwindow)=0) then
  begin
   sendmessage(wnd,wm_gettext,sizeof(caption),integer(@caption));
   lb.Items.AddObject(caption,tobject(wnd));
  end;
 end;

function enumwindowsproc2(wnd:hwnd;lb:tlistbox):bool;stdcall;
var
 caption:array[0..128]of char;
begin
 result:=true;
 if iswindowvisible(wnd)and((getwindowlong(wnd,gwl_hwndparent)<>0)) then

  begin
   sendmessage(wnd,wm_gettext,sizeof(caption),integer(@caption));
   lb.Items.AddObject(caption,tobject(wnd));
  end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.Clear;
enumwindows(@enumwindowsproc,integer(listbox1));
end;



end.









//   DFM FILE
object Form1: TForm1
  Left = 346
  Top = 149
  Width = 325
  Height = 480
  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 Label3: TLabel
    Left = 27
    Top = 98
    Width = 63
    Height = 13
    Caption = 'Windows List'
  end
  object Button1: TButton
    Left = 85
    Top = 5
    Width = 103
    Height = 25
    Caption = 'Get Windows'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ListBox1: TListBox
    Left = 24
    Top = 119
    Width = 255
    Height = 284
    ItemHeight = 13
    TabOrder = 1
  end
end
0
 

Author Comment

by:Mutley2003
ID: 12304181
Amir,
thank you, that works just fine. I have some followup questions which I will post separately.

Thanks a lot

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

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Suggested Courses

688 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