Solved

List all running applications and automatically refresh

Posted on 2004-10-01
6
166 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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

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…
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…
This video discusses moving either the default database or any database to a new volume.
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

708 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now