Task Manager DAL

{
Programmer : Jean Riko Kurniawan Putra
blog Delphi Anime Lover / Djean Software : djeansoftware.blogspot.com
}
unit UTM;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ComCtrls, StdCtrls, Grids, TlHelp32, Shellapi;

type
  TFTask = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    StringGrid1: TStringGrid;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    PB1: TPaintBox;
    GroupBox2: TGroupBox;
    pb2: TPaintBox;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    Setting1: TMenuItem;
    mnu11: TMenuItem;
    PopupMenu1: TPopupMenu;
    EndProcess1: TMenuItem;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnu11Click(Sender: TObject);
    procedure EndProcess1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    Function GetCpuUsage(a:Byte):Extended;
    Function ListProcesses(ProcessNameList :TStrings; ProcessPidList :TStrings; ProcessUsageList :TStrings):Boolean;
    Function ShowList(ProcessNameList :TStrings; ProcessPidList :TStrings; ProcessUsageList :TStrings):Boolean;
  public
    { Public declarations }
  end;

var
  FTask: TFTask;
  total: Extended;
  donthide: Boolean;
  usagelist,pidlist,pidlisttemp,kerneltimelist,kerneltimelisttemp,usertimelist,usertimelisttemp,dtlist,dtlisttemp: TStrings;

implementation

{$R *.dfm}

Function  TFTask.GetCpuUsage(a:byte):Extended;
var
   i:Shortint;
   usertime,kerneltime,delaytime:Extended;
begin
  i:=pidlisttemp.IndexOf(pidlist.Strings[a]);//checks if this a new process or not
  if i = -1 then //if this is a new process then it's informations will be saved
    begin
      pidlisttemp.Add(pidlist.Strings[a]);
      kerneltimelisttemp.Add(kerneltimelist.Strings[a]);
      usertimelisttemp.Add(usertimelist.Strings[a]);
      dtlisttemp.Add(dtlist.Strings[a]);
      Result:=0;
    end
  else
    begin
      delaytime:=strtofloat(dtlist.Strings[a])-strtofloat(dtlisttemp.Strings[i]);
      kerneltime:=strtofloat(kerneltimelist.Strings[a])-strtofloat(kerneltimelisttemp.Strings[i]);
      usertime:=strtofloat(usertimelist.Strings[a])-strtofloat(usertimelisttemp.Strings[i]);
      { CPU Usage Gets From ( ( (NewUserTime-OldUsertime) + (NewKernelTime-OldKernelTime) ) / (Time Between These Two Calculate) }
      Result:=(usertime+kerneltime)/(delaytime*100);
      if Result<0 then
      Result:=0;
      dtlisttemp.Strings[i]:=dtlist.Strings[a];
      kerneltimelisttemp.Strings[i]:=kerneltimelist.Strings[a];
      usertimelisttemp.Strings[i]:=usertimelist.Strings[a];
    end;
end;

Function TFTask.ListProcesses(ProcessNameList :TStrings; ProcessPidList :TStrings; ProcessUsageList :TStrings):Boolean;
var
  ExeName : String;
  _vt,_ct,_et,_kt,_ut:_FILETIME;
  kt,ut:int64;
  b1:LongBool;
  prnum:Byte;
  cpuuse:Extended;
  proc: PROCESSENTRY32;
  hSnap: HWND;
  pid, k1: cardinal;// k1 is the Application Id Which Windows Uses In Kernel
  Looper: BOOL;
begin
  total:=0;
  prnum:=0;// I Think It's a bug coz In BDS2006 local variables don't automatically change to zero so we should do it
  pidlist.Clear;
  usertimelist.Clear;
  kerneltimelist.Clear;
  dtlist.Clear;
  proc.dwSize := SizeOf(Proc);//Give proc.dwSize the Size of bytes of PROCESSENTRY32
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
  Looper := Process32First(hSnap,proc);
  b1:=False;
  pidlist.Clear;
  kerneltimelist.Clear;
  usertimelist.Clear;
  while Integer(Looper) <> 0 do begin
    ExeName := ExtractFileName(proc.szExeFile);
    k1:=OpenProcess($1F0FFF,b1,proc.th32ProcessID);//Don't ask me why just do It! this is a Routine I don't know Where of Memory is :$1F0FFF
    GetProcessTimes(k1,_ct,_et,_kt,_ut);// This procedure Returns value of used time of cpu for a certain Application. _et & _ct should be used But We don't need them.
    dtlist.Add(inttostr(GetTickCount));// This list saves time in miliseconds for further use
    kt:=_kt.dwHighDateTime;// kt is kernel time
    kt:=kt * 4294967296;// Use This multiple BeCause ( shl ) and ( shr ) don't work with 64bit variables
    kt:=kt+_kt.dwLowDateTime;// Kt is total of _kt.dwLowDateTime and _kt.dwHighDateTime
    ut:=_ut.dwHighDateTime;// ut Is User Time
    ut:=ut * 4294967296;
    ut:=ut+_ut.dwLowDateTime;
    ProcessPidList.Add(inttostr(proc.th32ProcessID));
    pidlist.Add(inttostr(proc.th32ProcessID));// pid is Process ID and pidlist stores them
    kerneltimelist.Add(inttostr(kt));
    usertimelist.Add(inttostr(ut));
    cpuuse:=GetCpuUsage(prnum);// cpuuse is Used Cpu Usage by current Application
    ProcessNameList.Add(ExeName);
    ProcessUsageList.Add(FormatFloat('00.00',cpuuse));
    total:=total + strtofloat(ProcessUsageList.Strings[prnum]);// total is total of used cpu by all of applications
    Looper := Process32Next(hSnap,proc);//Looper is oposite Zero until there is a program to process by this function
    prnum:=prnum+1;//This calculates number of Applications
  end;
  CloseHandle(hSnap);
end;

Function TFTask.ShowList(ProcessNameList :TStrings; ProcessPidList :TStrings; ProcessUsageList :TStrings):Boolean;
var
  I: Integer;
begin
  if PageControl1.ActivePage = TabSheet1 then begin
    StringGrid1.RowCount:=ProcessNameList.Count + 1;
    for I := 0 to ProcessNameList.Count - 1 do begin
      StringGrid1.Cells[0,i+1]:=inttostr(i+1);
      StringGrid1.Cells[1,i+1]:=ProcessNameList.Strings[i];
      StringGrid1.Cells[2,i+1]:=ProcessUsageList.Strings[i];
      StringGrid1.Cells[3,i+1]:=ProcessPidList.Strings[i];
    end;
  end;
  StatusBar1.Panels[0].Text:='Processes : ' + inttostr(ProcessNameList.Count);
  StatusBar1.Panels[1].Text:='CPU Usage : ' + floattostr(total) + '%';
end;

procedure TFTask.FormShow(Sender: TObject);
begin
  With StatusBar1 Do Begin
    Panels[0].Width:=Self.Width div 3;
    Panels[1].Width:=Self.Width div 3;
    Panels[2].Width:=Self.Width div 3;
  End;
end;

procedure TFTask.FormCreate(Sender: TObject);
begin
  pidlist:=TStringList.Create;
  kerneltimelist:=TStringList.Create;
  usertimelist:=TStringList.Create;
  dtlist:=TStringList.Create;
  pidlisttemp:=TStringList.Create;
  kerneltimelisttemp:=TStringList.Create;
  usertimelisttemp:=TStringList.Create;
  dtlisttemp:=TStringList.Create;
  usagelist:=TStringList.Create;
  StringGrid1.Cells[1,0]:='Nama';
  StringGrid1.Cells[2,0]:='Pemakaian Cpu';
  StringGrid1.Cells[3,0]:='Cpu ID';
end;

procedure TFTask.mnu11Click(Sender: TObject);
begin
  if mnu11.Checked then begin
    mnu11.Checked:=False;
    Self.FormStyle:=fsNormal;
  end
  else begin
    mnu11.Checked:=True;
    Self.FormStyle:=fsStayOnTop;
  end;
end;

procedure TFTask.EndProcess1Click(Sender: TObject);
begin
  if MessageDlg('Are You Sure You Want To Terminate This Process ?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
  if Not TerminateProcess(OpenProcess(PROCESS_TERMINATE,Bool(1),strtoint(pidlist.Strings[StringGrid1.Selection.Top - 1])),0) then  //Terminates the OpenProcess
  MessageDlg('This Process Is A Critical System Application So Wont Be Closed', mtError, [mbOk], 0);
end;

procedure TFTask.Timer1Timer(Sender: TObject);
var
  i,i1: Byte;
  lf : TLogFont;
  tf : TFont;
  ProcessNameList, ProcessPidList, ProcessUsagelist: TStrings;
begin
  ProcessNameList:=TStringList.Create;
  ProcessPidList:=TStringList.Create;
  ProcessUsagelist:=TStringList.Create;
  ListProcesses(ProcessNameList,ProcessPidList,ProcessUsagelist);
  if total>100 then total:=100;
  usagelist.Add(inttostr(trunc((total * 85) / 100) + 1 ));
  if usagelist.Count > 100 then begin
    usagelist.Move(100,0);
    usagelist.Delete(100);
  end; //end if usagelist.Count
  if PageControl1.ActivePage=TabSheet2 then begin
    with pb2.Canvas do begin
      Pen.Color:=$0046EEEA;
      Pen.Width:=1;
      Brush.Style:=bsSolid;
      Brush.Color:=ClBlack;
      Rectangle(0,0,551,89);
      FloodFill(1,1,ClBlack,fsSurface);
      Pen.Color:=ClLime;
      Pen.Width:=2;
      MoveTo(525,88 - strtoint(usagelist.Strings[0]));
      for I := 1 to usageList.Count - 1 do LineTo(525 -(5*i),88 - strtoint(usagelist.Strings[i]));
    end; //end with pb2.Canvas
    with pb1.Canvas do begin
      Pen.Color:=$0046EEEA;
      Pen.Width:=1;
      Brush.Style:=bsSolid;
      Brush.Color:=ClBlack;
      FloodFill(1,1,ClBlack,fsSurface);
      Rectangle(0,0,551,200);
      Brush.Color := clBtnFace;
      Rectangle(0,202,551,313);
      FloodFill(1,1,clBtnFace,fsSurface);
      Font.Charset:=ARABIC_CHARSET;
      Font.Name := 'Tahoma';
      Font.Size := 9;
      Font.Style := Font.Style - [fsBold];
      Font.Color := clBlack;
      tf := TFont.Create;
      try//This piece of code will rotate text 90 degrees. Special thanks to Zarko Gajic About.com Guide to Delphi Programming
        tf.Assign(Font);
        GetObject(tf.Handle, sizeof(lf), @lf);
        lf.lfEscapement := 900;
        tf.Handle := CreateFontIndirect(lf);
        Font.Assign(tf);
      finally
        tf.Free;
      end; //end try
    end; //end with pb1.Canvas
    for I := 0 to ProcessNameList.Count - 1 do begin
      i1:=trunc(strtofloat(ProcessUsagelist.Strings[i]));
      case i1 of
      0..33   :
        begin
          pb1.Canvas.Brush.Color:=ClGreen;
          pb1.Canvas.Rectangle((i*15) + 1, 199-(trunc(strtofloat(ProcessUsagelist.Strings[i]))*2),(i*15)+14,200);
          pb1.Canvas.FloodFill((i*15) + 1, 199, ClGreen,fsSurface);
        end;
      34..67  :
        begin
          pb1.Canvas.Brush.Color:=ClYellow;
          pb1.Canvas.Rectangle((i*15) + 1, 199-(trunc(strtofloat(ProcessUsagelist.Strings[i]))*2),(i*15)+14,200);
          pb1.Canvas.FloodFill((i*15) + 1, 199, ClYellow,fsSurface);
        end;
      68..100 :
        begin
          pb1.Canvas.Brush.Color:=ClRed;
          pb1.Canvas.Rectangle((i*15) + 1, 199-(trunc(strtofloat(ProcessUsagelist.Strings[i]))*2),(i*15)+14,200);
          pb1.Canvas.FloodFill((i*15) + 1, 199, ClRed,fsSurface);
        end;
      end; // end case i1 of
      with Pb1.Canvas do begin
        Brush.Color := clBtnFace;
        TextOut((i*15) + 1, 308, ProcessNameList.Strings[i]);
      end; // end  with Pb1.Canvas
    end; //end for I := 0
    pb1.Update;
  end; //end if PageControl1.ActivePage=TabSheet2
  ShowList(ProcessNameList,ProcessPidList,ProcessUsagelist);
  ProcessNameList.Free;
  ProcessPidList.Free;
  ProcessUsagelist.Free;
end;

end.