main.pas

一个很不错的系统信息控件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, MSI_Processes, ComCtrls, ExtCtrls, StdCtrls, MSI_Common, Menus;

type
  Twnd_Main = class(TForm)
    PrcList: TListView;
    sd: TSaveDialog;
    pc: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    DrvList: TListView;
    Button3: TButton;
    TabSheet3: TTabSheet;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    mmRefresh: TMenuItem;
    N1: TMenuItem;
    mmSaveReport: TMenuItem;
    N2: TMenuItem;
    mmExit: TMenuItem;
    sb: TStatusBar;
    Bevel1: TBevel;
    mmProcess: TMenuItem;
    mmPrcDetails: TMenuItem;
    mmPrcProps: TMenuItem;
    N3: TMenuItem;
    mmPrcKill: TMenuItem;
    mmDriver: TMenuItem;
    mmDrvProps: TMenuItem;
    mmService: TMenuItem;
    mmSvcProps: TMenuItem;
    mSvcDetails: TMenuItem;
    N4: TMenuItem;
    mmSvcStart: TMenuItem;
    mmSvcStop: TMenuItem;
    mmSvcPause: TMenuItem;
    mmSvcResume: TMenuItem;
    mmAbout: TMenuItem;
    SvcList: TListView;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    ProcList: TMiTeC_ProcessList;
    procedure FormCreate(Sender: TObject);
    procedure ListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ListColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure ListAdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure TimerTimer(Sender: TObject);
    procedure cmRefresh(Sender: TObject);
    procedure cmExit(Sender: TObject);
    procedure cmSaveReport(Sender: TObject);
    procedure cmPrcProps(Sender: TObject);
    procedure cmPrcDetails(Sender: TObject);
    procedure cmDrvProps(Sender: TObject);
    procedure pcChange(Sender: TObject);
    procedure mmAboutClick(Sender: TObject);
    procedure cmPrcKill(Sender: TObject);
    procedure cmSvcProps(Sender: TObject);
    procedure cmSvcDetails(Sender: TObject);
    procedure cmSvcStart(Sender: TObject);
    procedure cmSvcStop(Sender: TObject);
    procedure cmSvcPause(Sender: TObject);
    procedure cmSvcResume(Sender: TObject);
    procedure cmDrvDetails(Sender: TObject);
  private
  public
    procedure RefreshData(OnlyRefill: Boolean = False);
  end;

var
  wnd_Main: Twnd_Main;

implementation

uses ShellAPI, MiTeC_CtrlRtns, MiTeC_Datetime, MiTeC_Dialogs, PrcDetails,
  MiTeC_Routines, MiTeC_AdvAPI, SvcDetails, Splash, DrvDetails;

{$R *.dfm}

procedure Twnd_Main.FormCreate(Sender: TObject);
begin
  pc.ActivePage:=TabSheet1;
  if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
    PrcList.Columns[2].Caption:='Threads';
    PrcList.Columns[3].Caption:='Usage';
  end;
  RefreshData;
end;

procedure Twnd_Main.RefreshData;
var
  i: Integer;
begin
  Screen.Cursor:=crHourGlass;
  wnd_Splash.Show;
  wnd_Splash.Update;
  try
  with ProcList do begin
    if not OnlyRefill then
      Refreshdata;
    try
      PrcList.Items.BeginUpdate;
      PrcList.Items.Clear;
      for i:=0 to ProcessCount-1 do
        with PrcList.Items.Add do begin
          Caption:=Processes[i].Name;
          if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
            SubItems.Add(Format('%x',[Processes[i].PID]));
            SubItems.Add(Format('%d',[Processes[i].ThreadCount]));
            SubItems.Add(Format('%d',[Processes[i].Usage]));
          end else begin
            SubItems.Add(Format('%d',[Processes[i].PID]));
            SubItems.Add(FormatSeconds((Processes[i].UserTime.QuadPart+Processes[i].KernelTime.QuadPart)/10000000,True,False,True));
            SubItems.Add(Format('%d KB',[Processes[i].VMCounters.WorkingSetSize div 1024]));
          end;
        end;

    finally
      PrcList.Items.EndUpdate;
    end;

    if Win32Platform=VER_PLATFORM_WIN32_NT then begin
      try
        DrvList.Items.BeginUpdate;
        DrvList.Items.Clear;
        for i:=0 to DriverCount-1 do
          with DrvList.Items.Add do begin
            Caption:=ExtractFilename(Drivers[i].Name);
            SubItems.Add(Format('0x%x',[Drivers[i].Size]));
            SubItems.Add(Format('%d',[Drivers[i].LoadCount]));
            SubItems.Add(Drivers[i].Name);
          end;
      finally
        DrvList.Items.EndUpdate;
      end;

      try
        SvcList.Items.BeginUpdate;
        SvcList.Items.Clear;
        for i:=0 to ServiceCount-1 do
          with SvcList.Items.Add do begin
            Caption:=Services[i].DisplayName;
            SubItems.Add(cSvcStatus[Services[i].Status]);
            SubItems.Add(cSvcStartup[Services[i].StartUp]);
          end;
      finally
        SvcList.Items.EndUpdate;
      end;
    end;

    TabSheet1.Caption:=Format(' Processes (%d)',[ProcessCount]);
    TabSheet2.Caption:=Format(' Drivers (%d)',[DriverCount]);
    TabSheet3.Caption:=Format(' Services (%d)',[ServiceCount]);
    sb.Panels[0].Text:=Format('Threads: %d',[ThreadCount]);
    sb.Panels[1].Text:=Format('Handles: %d',[HandleCount]);
    sb.Panels[2].Text:=Format('Windows: %d',[WindowCount]);
  end;

  TabSheet2.TabVisible:=Win32Platform=VER_PLATFORM_WIN32_NT;
  TabSheet3.TabVisible:=Win32Platform=VER_PLATFORM_WIN32_NT;

  finally
    wnd_Splash.Hide;
    Screen.Cursor:=crDefault;
  end;
end;

procedure Twnd_Main.ListCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  Compare:=ListView_CustomSort(Item1,Item2,ListView_SortColumn);
  if ListView_SortDescending then
    Compare:=-Compare;
end;

procedure Twnd_Main.ListColumnClick(Sender: TObject; Column: TListColumn);
begin
  TListView(Sender).SortType:=stNone;
  if Column.Index<>ListView_SortColumn then begin
    ListView_SortColumn:=Column.Index;
    ListView_SortDescending:=False;
  end else
    ListView_SortDescending:=not ListView_SortDescending;
  TListView(Sender).SortType:=stText;
end;

procedure Twnd_Main.ListAdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
begin
  if ListView_SortColumn=0 then
    Sender.Canvas.Brush.Color:=clInfoBk
  else
    Sender.Canvas.Brush.Color:=clWhite
end;

procedure Twnd_Main.ListAdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
begin
  if ListView_SortColumn=SubItem then
    Sender.Canvas.Brush.Color:=clInfoBk
  else
    Sender.Canvas.Brush.Color:=clWhite
end;

procedure Twnd_Main.TimerTimer(Sender: TObject);
begin
  RefreshData;
end;

procedure Twnd_Main.cmRefresh(Sender: TObject);
begin
  RefreshData;
end;

procedure Twnd_Main.cmExit(Sender: TObject);
begin
  Close;
end;

procedure Twnd_Main.cmSaveReport(Sender: TObject);
begin
  if sd.Execute then
    ProcList.SaveToStorage(sd.FileName);
end;

procedure Twnd_Main.cmPrcProps(Sender: TObject);
var
  idx: Integer;
begin
  if Assigned(PrcList.Selected) then begin
    try
      idx:=ProcList.FindProcess(StrToInt(PrcList.Selected.SubItems[0]));
    except
      idx:=ProcList.FindProcess(StrToInt('$'+PrcList.Selected.SubItems[0]));
    end;
    if (idx>=0) and (ProcList.Processes[idx].PID>9) then
      ShellPropDlg(Handle,ProcList.Processes[idx].ImageName);
  end;
end;

procedure Twnd_Main.cmPrcDetails(Sender: TObject);
var
  idx: Integer;
begin
  if Assigned(PrcList.Selected) then begin
    try
      idx:=ProcList.FindProcess(StrToInt(PrcList.Selected.SubItems[0]));
    except
      idx:=ProcList.FindProcess(StrToInt('$'+PrcList.Selected.SubItems[0]));
    end;
    if idx>=0 then begin
      ShowPrcDetails(ProcList,idx);
      RefreshData(True);
    end;
  end;
end;

procedure Twnd_Main.cmDrvProps(Sender: TObject);
var
  idx: Integer;
begin
  if Assigned(DrvList.Selected) then begin
    idx:=ProcList.FindDriver(StrToInt(DrvList.Selected.SubItems[1]));
    if (idx>=0) then
      ShellPropDlg(Handle,ProcList.Drivers[idx].Name);
  end;
end;

procedure Twnd_Main.pcChange(Sender: TObject);
begin
  mmProcess.Visible:=pc.ActivePage.pageIndex=0;
  mmDriver.Visible:=pc.ActivePage.pageIndex=1;
  mmService.Visible:=pc.ActivePage.pageIndex=2;
end;

procedure Twnd_Main.mmAboutClick(Sender: TObject);
begin
  ShellAbout(Handle,PChar(Application.Title+' '+cVersion),'Copyright