Solved

List all running applications and automatically refresh

Posted on 2004-10-01
6
169 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
  • 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
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 

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

ScreenConnect 6.0 Free Trial

Check out the updates in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI that improves session organization and overall user experience. See the enhancements for yourself!

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
build html 5 client that connect to indy Tidtcpserver 3 395
Delphi selector screen 2 78
Strange behavior when a form is closed 6 57
MS Access from Delphi 31 28
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…
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…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

770 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