Solved

List all running applications and automatically refresh

Posted on 2004-10-01
6
175 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
 
LVL 6

Expert Comment

by:Amir Azhdari
ID: 12206503
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 500 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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

749 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