{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL) - Delphi Tools                                                   }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is Main.pas.                                                                   }
{                                                                                                  }
{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are     }
{ Copyright (C) of Petr Vones. All Rights Reserved.                                                }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date: 2006/01/15 11:21:32 $                                                      }
{                                                                                                  }
{**************************************************************************************************}

unit Main;

{$I jcl.inc}
{$IFDEF SUPPORTS_PLATFORM_WARNINGS}
  {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF SUPPORTS_PLATFORM_WARNINGS}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ImgList, StdCtrls, ToolWin, Menus, ActnList, ExtCtrls, IniFiles;

const
  UM_ACTIVATEMAINFORM = WM_USER + $100;

type
  TMainForm = class(TForm)
    ProcessListView: TListView;
    PriorityImagesList: TImageList;
    MainMenu: TMainMenu;
    ActionList1: TActionList;
    Exit1: TAction;
    ExitItem: TMenuItem;
    File1: TMenuItem;
    StatusBar: TStatusBar;
    Tools1: TMenuItem;
    Terminate1: TAction;
    TerminateItem: TMenuItem;
    Refresh1: TAction;
    RefreshItem: TMenuItem;
    About1: TAction;
    Help1: TMenuItem;
    AboutItem: TMenuItem;
    HotTrack1: TAction;
    HotTrackItem: TMenuItem;
    SaveToFile1: TAction;
    SaveItem: TMenuItem;
    N2: TMenuItem;
    FileProperties1: TAction;
    FilePropItem: TMenuItem;
    PopupMenu: TPopupMenu;
    RefreshItemP: TMenuItem;
    SaveItemP: TMenuItem;
    TerminateItemP: TMenuItem;
    PropertyItemP: TMenuItem;
    N3: TMenuItem;
    ChangePriority1: TAction;
    ChangePriorityItem: TMenuItem;
    N5: TMenuItem;
    ChangePriorityItemP: TMenuItem;
    BottomPanel: TPanel;
    ModulesListView: TListView;
    ThreadsListView: TListView;
    Splitter2: TSplitter;
    Splitter1: TSplitter;
    Views1: TMenuItem;
    N1: TMenuItem;
    Copy1: TAction;
    CopyItem: TMenuItem;
    CopyItemP: TMenuItem;
    DumpHeap1: TAction;
    DumpHeapItem: TMenuItem;
    DumpHeapItemP: TMenuItem;
    DumpMemory1: TAction;
    DumpMemory11: TMenuItem;
    MemoryList1: TMenuItem;
    Options1: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    RefreshButton: TToolButton;
    HottrackButton: TToolButton;
    ToolButton7: TToolButton;
    CopyButton: TToolButton;
    SaveButton: TToolButton;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    ChangePriButton: TToolButton;
    KillButton: TToolButton;
    PropertyButton: TToolButton;
    ToolButton5: TToolButton;
    InfoTip1: TAction;
    ToolButton8: TToolButton;
    InfoTip2: TMenuItem;
    BeepOnChange1: TAction;
    ToolButton9: TToolButton;
    Beeponchange2: TMenuItem;
    CheckImageBase1: TAction;
    ToolButton11: TToolButton;
    CheckImageBase2: TMenuItem;
    DumpModules1: TAction;
    ToolButton6: TToolButton;
    Moduleslist1: TMenuItem;
    N4: TMenuItem;
    Moduleslist2: TMenuItem;
    DumpPE1: TAction;
    DumpPEfile1: TMenuItem;
    ToolButton10: TToolButton;
    DumpPEfile2: TMenuItem;
    SendMail1: TAction;
    Support1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ProcessListViewCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ProcessListViewColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure Exit1Execute(Sender: TObject);
    procedure Terminate1Execute(Sender: TObject);
    procedure Refresh1Execute(Sender: TObject);
    procedure About1Execute(Sender: TObject);
    procedure Terminate1Update(Sender: TObject);
    procedure HotTrack1Execute(Sender: TObject);
    procedure SaveToFile1Update(Sender: TObject);
    procedure SaveToFile1Execute(Sender: TObject);
    procedure FileProperties1Update(Sender: TObject);
    procedure FileProperties1Execute(Sender: TObject);
    procedure ProcessListViewEnter(Sender: TObject);
    procedure ChangePriority1Execute(Sender: TObject);
    procedure Copy1Execute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StatusBarResize(Sender: TObject);
    procedure DumpHeap1Execute(Sender: TObject);
    procedure DumpMemory1Execute(Sender: TObject);
    procedure ProcessListViewSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ModulesListViewSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ProcessListViewInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: string);
    procedure ModulesListViewInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: string);
    procedure InfoTip1Execute(Sender: TObject);
    procedure BeepOnChange1Execute(Sender: TObject);
    procedure CheckImageBase1Execute(Sender: TObject);
    procedure ModulesListViewCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure DumpModules1Execute(Sender: TObject);
    procedure DumpPE1Update(Sender: TObject);
    procedure ProcessListViewDblClick(Sender: TObject);
    procedure DumpPE1Execute(Sender: TObject);
    procedure SendMail1Execute(Sender: TObject);
    procedure CoolBar1Resize(Sender: TObject);
  private
    FDisableUpdate: Boolean;
    FProcess_Cnt, FThreads_Cnt, FModules_Cnt, FModules_Size: LongWord;
    FIniFile: TIniFile;
    procedure BuildModulesList(ProcessID: DWORD);
    procedure BuildProcessList(Rebuild: Boolean = False);
    procedure BuildThreadsList(ProcessID: DWORD);
    function CheckProcessesChange: Boolean;
    function FocusedFileName: TFileName;
    procedure KillProcess(ProcessID: DWORD);
    procedure LoadSettings;
    procedure RebuildViewsMenuHotKeys;
    procedure SaveSettings;
    function SummaryInfo: string;
    procedure TimerRefresh;
    procedure UpdateListViewsOptions;
    procedure UpdateStatusLine(SummaryOnly: Boolean = False);
    procedure ViewsMenuClick(Sender: TObject);
    procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
    procedure WMMenuChar(var Msg: TWMMenuChar); message WM_MENUCHAR;
    procedure UMActivateMainForm(var Msg: TMessage); message UM_ACTIVATEMAINFORM;
  public
    procedure AddToViewsMenu(AForm: TForm; const ACaption: string);
    procedure DeleteFromViewsMenu(AForm: TForm);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  TLHelp32, About, ShellAPI, ChangePriority, HeapDump, MemoryDump, Global,
  CommCtrl, JclShell, JclSysInfo, JclFileUtils, JclAppInst, ModulesDump,
  ToolsUtils, FindDlg, PsApi;

resourcestring
  sCantOpenForTerminate = 'Can''t open this process for terminate.';
  sKill = 'Do you really want to kill process "%s" ?';
  sNotFound = 'Not found';
  sSaveProcessesList = 'ToolHelp process list';
  sSaveModulesList = 'Modules used by process %s';
  sSaveThreadsList = 'Threads created by process %s';
  sWaitTimeout = 'Timeout.';
  sProcessesSummary = 'Processes: %d, Threads: %d';
  sModulesSummary = 'Cnt: %d, Tot.Size: %.0n';
  sNotRelocated = '[base]';

const
  PROCESS_CLASS_IDLE          = 4;
  PROCESS_CLASS_NORMAL        = 8;
  PROCESS_CLASS_HIGH          = 13;
  PROCESS_CLASS_TIMECRITICAL  = 24;

function GetPriorityIconIndex(Priority: DWORD): Integer;
begin
  case Priority of
    PROCESS_CLASS_IDLE: Result := 0;
    PROCESS_CLASS_HIGH: Result := 1;
    PROCESS_CLASS_TIMECRITICAL: Result := 2;
  else
    Result := -1;
  end;
end;

function GetProcessVersion(Version: DWORD): string;
var
  C: array[0..2] of Char;
begin
  C[0] := Chr(Lo(LOWORD(Version)));
  C[1] := Chr(Hi(LOWORD(Version)));
  if C[0] < #32 then C[0] := '_';
  if C[1] < #32 then C[1] := '_';
  C[2] := #0;
  Result := Format('%s %d.%d', [C, Hi(HIWORD(Version)), Lo(HIWORD(Version))]);
end;

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
var
  FileInfo: TSHFileInfo;
  ImageListHandle: THandle;
begin
  {$IFDEF COMPILER5_UP}
  ProcessListView.OnInfoTip := ProcessListViewInfoTip;
  ModulesListView.OnInfoTip := ModulesListViewInfoTip;
  {$ELSE COMPILER5_UP}
  InfoTip1.Visible := False;
  {$ENDIF COMPILER5_UP}
  FIniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  LoadSettings;
  ImageListHandle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  SendMessage(ProcessListView.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
  SetTimer(Handle, 1, 500, nil);
  BuildProcessList;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  SaveSettings;
  FIniFile.UpdateFile;
  FIniFile.Free;
  Win32Check(KillTimer(Handle, 1));
end;

procedure TMainForm.BuildProcessList(Rebuild: Boolean = False);
var
  SnapProcHandle, ProcessHandle: THandle;
  ProcessEntry: TProcessEntry32;
  Next: Boolean;
  FileInfo: TSHFileInfo;
  ProcessVersion: DWORD;
  FindItem: TListItem;
  I: Integer;
  ProcList: TList;
  Added, Changed: Boolean;

  procedure CheckChanged;
begin
  if ProcessListView.ItemFocused = FindItem then Changed := True;
end;

begin
  if FDisableUpdate then Exit;
  ProcList := TList.Create;
  Added := False;
  Changed := False;
  with ProcessListView do
  try
    FDisableUpdate := True;
    try
      if Rebuild then
      begin
        Screen.Cursor := crHourGlass;
        Items.BeginUpdate;
        Items.Clear;
        FProcess_Cnt := 0;
        FThreads_Cnt := 0;
      end else
        SendMessage(Handle, WM_SETREDRAW, 0, 0);
      SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      if SnapProcHandle <> THandle(-1) then
      begin
        ProcessEntry.dwSize := Sizeof(ProcessEntry);
        Next := Process32First(SnapProcHandle, ProcessEntry);
        while Next do
        begin
          ProcList.Add(Pointer(ProcessEntry.th32ProcessID));
          FindItem := FindData(0, Pointer(ProcessEntry.th32ProcessID), True, False);
          with ProcessEntry do if FindItem = nil then
          begin // New Process
            Added := True;
            if IsWin2k then
            begin
              ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, th32ProcessID);
              if Handle <> 0 then
              begin
                if GetModuleFileNameEx(ProcessHandle, 0, szExeFile, SizeOf(szExeFile)) = 0 then
                  StrPCopy(szExeFile, '[Idle]');
                CloseHandle(ProcessHandle);
              end;
            end;
            ProcessVersion := SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_EXETYPE);
            SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
            with Items.Add, ProcessEntry do
            begin
              Caption := AnsiLowerCase(ExtractFileName(szExeFile));
              Data := Pointer(th32ProcessID);
              ImageIndex := FileInfo.iIcon;
              StateIndex := GetPriorityIconIndex(pcPriClassBase);
              SubItems.AddObject(Format('%.8x', [th32ProcessID]), Pointer(th32ProcessID));
              SubItems.AddObject(Format('%d', [pcPriClassBase]), Pointer(pcPriClassBase));
              SubItems.AddObject(Format('%d', [cntThreads]), Pointer(cntThreads));
              SubItems.AddObject(GetProcessVersion(ProcessVersion), Pointer(ProcessVersion));
              SubItems.Add(szExeFile);
              SubItems.AddObject(Format('(%.8x)', [th32ParentProcessID]), Pointer(th32ParentProcessID));
              Inc(FProcess_Cnt);
              Inc(FThreads_Cnt, cntThreads);
            end;
          end else
          with FindItem do
          begin // Any changes in existing process ?
            if SubItems.Objects[1] <> Pointer(pcPriClassBase) then
            begin
              SubItems.Objects[1] := Pointer(pcPriClassBase);
              SubItems.Strings[1] := Format('%d', [pcPriClassBase]);
              StateIndex := GetPriorityIconIndex(pcPriClassBase);
            end;
            if SubItems.Objects[2] <> Pointer(cntThreads) then
            begin
              Inc(FThreads_Cnt, cntThreads - DWORD(SubItems.Objects[2]));
              SubItems.Objects[2] := Pointer(cntThreads);
              SubItems.Strings[2] := Format('%d', [cntThreads]);
              CheckChanged;
            end;
          end;
          Next := Process32Next(SnapProcHandle, ProcessEntry);
        end;
        CloseHandle(SnapProcHandle);
      end;
      if Added then // find the names of parent processes
      begin
        for I := 0 to Items.Count - 1 do
        begin
          FindItem := FindData(0, Items[I].SubItems.Objects[5], True, False);
          if FindItem <> nil then Items[I].SubItems[5] := FindItem.Caption;
        end;
        AlphaSort;
      end;
      for I := Items.Count - 1 downto 0 do // delete non-existing processes
        if ProcList.IndexOf(Items[I].Data) = -1 then
        begin
          Dec(FProcess_Cnt);
          Dec(FThreads_Cnt, DWORD(Items[I].SubItems.Objects[2]));
          Items.Delete(I);
        end;
      if GetNextItem(nil, sdAll, [isSelected]) = nil then
      begin
        if ItemFocused = nil then ItemFocused := Items[0];
        ItemFocused.Selected := True;
      end else
        if Changed then BuildThreadsList(DWORD(ItemFocused.Data));
      UpdateStatusLine(True);
    finally
      if Rebuild then
        Items.EndUpdate
      else
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
  finally
    FDisableUpdate := False;
    ProcList.Free;
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.BuildThreadsList(ProcessID: DWORD);
var
  SnapProcHandle: THandle;
  ThreadEntry: TThreadEntry32;
  Next: Boolean;
begin
  with ThreadsListView do
  try
    Items.BeginUpdate;
    Items.Clear;
    SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
    if SnapProcHandle <> THandle(-1) then
    begin
      ThreadEntry.dwSize := Sizeof(ThreadEntry);
      Next := Thread32First(SnapProcHandle, ThreadEntry);
      while Next do
      begin
        if ThreadEntry.th32OwnerProcessID = ProcessID then
          with Items.Add, ThreadEntry do
          begin
            Caption := Format('%.8x', [th32ThreadID]);
            Data := Pointer(th32ThreadID);
            SubItems.AddObject(Format('%d', [tpDeltaPri]), Pointer(tpDeltaPri));
          end;
        Next := Thread32Next(SnapProcHandle, ThreadEntry);
      end;
      CloseHandle(SnapProcHandle);
    end;
    AlphaSort;
    ListViewFocusFirstItem(ThreadsListView);
  finally
    Items.EndUpdate;
  end;
end;

procedure TMainForm.BuildModulesList(ProcessID: DWORD);
var
  SnapProcHandle: THandle;
  ModuleEntry: TModuleEntry32;
  Next: Boolean;
  ImageBase: DWORD;
begin
  with ModulesListView do
  try
    Items.BeginUpdate;
    Items.Clear;
    FModules_Cnt := 0;
    FModules_Size := 0;
    SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessID);
    if SnapProcHandle <> THandle(-1) then
    begin
      ModuleEntry.dwSize := Sizeof(ModuleEntry);
      Next := Module32First(SnapProcHandle, ModuleEntry);
      while Next do
      begin
        with Items.Add, ModuleEntry do
        begin
          Caption := AnsiLowerCase(szModule);
          SubItems.AddObject(Format('%.8x', [th32ModuleID]), Pointer(th32ModuleID));
          if CheckImageBase1.Checked then
          begin
            ImageBase := GetImageBase(szExePath);
            if ImageBase = DWORD(modBaseAddr) then
              SubItems.AddObject(sNotRelocated, Pointer(0))
            else
             SubItems.AddObject(Format('%.8x', [ImageBase]), Pointer(ImageBase));
          end else
            SubItems.Add('');
          SubItems.AddObject(Format('%p', [modBaseAddr]), Pointer(modBaseAddr));
          SubItems.AddObject(Format('%.0n', [IntToExtended(modBaseSize)]), Pointer(modBaseSize));
          SubItems.AddObject(Format('%d', [GlblcntUsage]), Pointer(GlblcntUsage));
          SubItems.AddObject(Format('%d', [ProccntUsage]), Pointer(ProccntUsage));
          SubItems.AddObject(Format('%.8x', [hModule]), Pointer(hModule));
          SubItems.Add(szExePath);
          Inc(FModules_Cnt);
          Inc(FModules_Size, modBaseSize);
        end;
        Next := Module32Next(SnapProcHandle, ModuleEntry);
      end;
      CloseHandle(SnapProcHandle);
    end;
    AlphaSort;
    ListViewFocusFirstItem(ModulesListView);
  finally
    Items.EndUpdate;
  end;
end;

function TMainForm.CheckProcessesChange: Boolean;
var
  SnapProcHandle: THandle;
  ProcessEntry: TProcessEntry32;
  Next: Boolean;
  ProcessCount: Integer;
  FindItem: TListItem;
begin
  Result := False;
  ProcessCount := 0;
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapProcHandle <> THandle(-1) then
  begin
    ProcessEntry.dwSize := Sizeof(ProcessEntry);
    Next := Process32First(SnapProcHandle, ProcessEntry);
    while Next and (not Result) do
    begin
      Inc(ProcessCount);
      FindItem := ProcessListView.FindData(0, Pointer(ProcessEntry.th32ProcessID), True, False);
      if FindItem = nil then
        Result := True
      else
      with FindItem do
        Result := (SubItems.Objects[1] <> Pointer(ProcessEntry.pcPriClassBase)) or
         (SubItems.Objects[2] <> Pointer(ProcessEntry.cntThreads));
      Next := Process32Next(SnapProcHandle, ProcessEntry);
    end;
    CloseHandle(SnapProcHandle);
  end;
  Result := Result or (ProcessCount <> ProcessListView.Items.Count);
end;

function TMainForm.FocusedFileName: TFileName;
begin
  if (ActiveControl = ProcessListView) and (ProcessListView.ItemFocused <> nil) then
    Result := ProcessListView.ItemFocused.SubItems[4] else
  if (ActiveControl = ModulesListView) and (ModulesListView.ItemFocused <> nil) then
    Result := ModulesListView.ItemFocused.SubItems[7] else
  Result := '';
end;

procedure TMainForm.KillProcess(ProcessID: DWORD);
var
  ProcessHandle: THandle;
begin
  ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_TERMINATE}, False, ProcessID);
  if ProcessHandle <> 0 then
  begin
    TerminateProcess(ProcessHandle, 0);
    if WaitForSingleObject(ProcessHandle, 10000) = WAIT_TIMEOUT then
      MessBox(sWaitTimeout, MB_ICONWARNING);
    CloseHandle(ProcessHandle);
    BuildProcessList;
  end else
    MessBox(sCantOpenForTerminate, MB_ICONERROR);
end;

function TMainForm.SummaryInfo: string;
begin
  if (ActiveControl = ProcessListView) then
    Result := Format(sProcessesSummary , [FProcess_Cnt, FThreads_Cnt]) else
  if (ActiveControl = ModulesListView) then
    Result := Format(sModulesSummary , [FModules_Cnt, IntToExtended(FModules_Size)]) else
  Result := '';
end;

procedure TMainForm.TimerRefresh;
begin
  if not Application.Terminated and IsWindowEnabled(Handle) and CheckProcessesChange then
  begin
    BuildProcessList;
    if BeepOnChange1.Checked then MessageBeep(MB_OK);
  end;
end;

procedure TMainForm.UpdateStatusLine(SummaryOnly: Boolean = False);
var
  FileName: TFileName;
begin
  FileName := FocusedFileName;
  with StatusBar.Panels do
  begin
    BeginUpdate;
    if not SummaryOnly then
    begin
      Items[0].Text := '';
      Items[1].Text := '';
      if VersionResourceAvailable(FileName) then
      try
        with TJclFileVersionInfo.Create(FileName) do
        try
          StatusBar.Panels.Items[0].Text := FileVersion;
          StatusBar.Panels.Items[1].Text := FileDescription;
        finally
          Free;
        end;
      except
      end else
        Items[0].Text := sNotFound;
    end;
    Items[2].Text := SummaryInfo;
    EndUpdate;
  end;
end;

procedure TMainForm.ProcessListViewCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  LVCompare(TListView(Sender), Item1, Item2, Compare);
end;

procedure TMainForm.ProcessListViewColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  LVColumnClick(Column);
end;

procedure TMainForm.ProcessListViewEnter(Sender: TObject);
begin
  UpdateStatusLine;
end;

procedure TMainForm.Exit1Execute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.BeepOnChange1Execute(Sender: TObject);
begin
  with BeepOnChange1 do
    Checked := not Checked;
end;

procedure TMainForm.HotTrack1Execute(Sender: TObject);
begin
  with HotTrack1 do
  begin
    Checked := not Checked;
    UpdateListViewsOptions;
  end;
end;

procedure TMainForm.InfoTip1Execute(Sender: TObject);
begin
  with InfoTip1 do
  begin
    Checked := not Checked;
    UpdateListViewsOptions;
  end;
end;

procedure TMainForm.CheckImageBase1Execute(Sender: TObject);
begin
  with CheckImageBase1 do
  begin
    Checked := not Checked;
    ProcessListViewSelectItem(nil, ProcessListView.Selected, Assigned(ProcessListView.Selected));
  end;    
end;

procedure TMainForm.Terminate1Execute(Sender: TObject);
begin
  with ProcessListView do if (ItemFocused <> nil) and
    (MessBoxFmt(sKill, [ItemFocused.Caption], MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2) = ID_YES) then
      KillProcess(DWORD(ItemFocused.Data));
end;

procedure TMainForm.Refresh1Execute(Sender: TObject);
begin
  BuildProcessList(True);
end;

procedure TMainForm.About1Execute(Sender: TObject);
begin
  ShowToolsAboutBox;
end;

procedure TMainForm.ChangePriority1Execute(Sender: TObject);
begin
  with TChangePriorityDlg.Create(Application) do
  try
    ProcessID := DWORD(ProcessListView.ItemFocused.Data);
    ShowModal;
  finally
    Free;
  end;
end;

procedure TMainForm.Terminate1Update(Sender: TObject);
begin
  TAction(Sender).Enabled := (ActiveControl = ProcessListView) and
    (ProcessListView.ItemFocused <> nil);
end;

procedure TMainForm.SaveToFile1Update(Sender: TObject);
begin
  TAction(Sender).Enabled := ActiveControl is TListView;
end;

procedure TMainForm.SaveToFile1Execute(Sender: TObject);
var
  FileName: string;
begin
  if ActiveControl = ProcessListView then
    FileName := sSaveProcessesList else
  if ActiveControl = ThreadsListView then
    FileName := Format(sSaveThreadsList, [ProcessListView.ItemFocused.Caption]) else
  if ActiveControl = ModulesListView then
    FileName := Format(sSaveModulesList, [ProcessListView.ItemFocused.Caption]);
  GlobalModule.ListViewToFile(ActiveControl as TListView, FileName);
end;

procedure TMainForm.FileProperties1Update(Sender: TObject);
begin
  FileProperties1.Enabled :=
    (ActiveControl = ProcessListView) or (ActiveControl = ModulesListView);
end;

procedure TMainForm.FileProperties1Execute(Sender: TObject);
begin
  DisplayPropDialog(Application.Handle, FocusedFileName);
end;

procedure TMainForm.AddToViewsMenu(AForm: TForm; const ACaption: string);
var
  Item: TMenuItem;
begin
  Item := TMenuItem.Create(Views1);
  Item.Caption := ACaption;
  Item.Tag := Integer(AForm);
  Item.OnClick := ViewsMenuClick;
  Views1.Add(Item);
  RebuildViewsMenuHotKeys;
end;

procedure TMainForm.DeleteFromViewsMenu(AForm: TForm);
var
  I: Integer;
begin
  with Views1 do
    for I := 0 to Count - 1 do
      if Pointer(Items[I].Tag) = AForm then
      begin
        Items[I].Free;
        System.Break;
      end;
  RebuildViewsMenuHotKeys;
end;

procedure TMainForm.ViewsMenuClick(Sender: TObject);
begin
  TForm(TMenuItem(Sender).Tag).BringToFront;
end;

procedure TMainForm.RebuildViewsMenuHotKeys;
var
  I: Integer;
begin
  for I := 0 to Views1.Count - 1 do
    if I < 9 then
      Views1.Items[I].ShortCut := ShortCut(I + 49, [ssAlt])
    else
      Views1.Items[I].ShortCut := 0;
  Views1.Visible := Views1.Count > 0;
end;

procedure TMainForm.Copy1Execute(Sender: TObject);
begin
  GlobalModule.ListViewToClipboard(ActiveControl as TListView);
end;

procedure TMainForm.WMTimer(var Msg: TWMTimer);
begin
  if Msg.TimerID = 1 then
  begin
    TimerRefresh;
    Msg.Result := 0;
  end else inherited;
end;

procedure TMainForm.WMMenuChar(var Msg: TWMMenuChar);
begin
  inherited;
  if Msg.Result = MNC_IGNORE then
    PostMessage(Handle, UM_ACTIVATEMAINFORM, 0, 0);
end;

procedure TMainForm.UMActivateMainForm(var Msg: TMessage);
begin
  BringToFront;
end;

procedure TMainForm.StatusBarResize(Sender: TObject);
begin
  with StatusBar do
    Panels[1].Width := Width - Panels[0].Width - Panels[2].Width;
end;

procedure TMainForm.DumpHeap1Execute(Sender: TObject);
begin
  FDisableUpdate := True;
  try
    with THeapDumpForm.Create(Application) do
    begin
      with ProcessListView.ItemFocused do SetParams(DWORD(Data), Caption);
      Show;
    end;
  finally
    FDisableUpdate := False;
  end;
end;

procedure TMainForm.DumpMemory1Execute(Sender: TObject);
begin
  FDisableUpdate := True;
  try
    with TMemoryDumpForm.Create(Application) do
    try
      with ProcessListView.ItemFocused do SetParams(DWORD(Data), Caption);
      Show;
    except
      Free;
      raise
    end;
  finally
    FDisableUpdate := False;
  end;
end;

procedure TMainForm.ProcessListViewSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Selected then
  begin
    BuildThreadsList(DWORD(Item.Data));
    BuildModulesList(DWORD(Item.Data));
    UpdateStatusLine;
  end;
end;

procedure TMainForm.ModulesListViewSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Selected and TWinControl(Sender).Focused then UpdateStatusLine;
end;

procedure TMainForm.ProcessListViewInfoTip(Sender: TObject;
  Item: TListItem; var InfoTip: string);
begin
  InfoTip := InfoTipVersionString(Item.SubItems[4]);
end;

procedure TMainForm.ModulesListViewInfoTip(Sender: TObject;
  Item: TListItem; var InfoTip: string);
begin
  InfoTip := InfoTipVersionString(Item.SubItems[7]);
end;

procedure TMainForm.LoadSettings;
begin
  with FIniFile do
  begin
    Left := ReadInteger(Name, 'Left', Left);
    Top := ReadInteger(Name, 'Top', Top);
    Width := ReadInteger(Name, 'Width', Width);
    Height := ReadInteger(Name, 'Height', Height);
    HotTrack1.Checked := ReadBool('Options', HotTrack1.Name, HotTrack1.Checked);
    InfoTip1.Checked := ReadBool('Options', InfoTip1.Name, InfoTip1.Checked);
    BeepOnChange1.Checked := ReadBool('Options', BeepOnChange1.Name, BeepOnChange1.Checked);
    CheckImageBase1.Checked := ReadBool('Options', CheckImageBase1.Name, CheckImageBase1.Checked);
  end;
  UpdateListViewsOptions;
end;

procedure TMainForm.SaveSettings;
begin
  with FIniFile do
  begin
    WriteInteger(Name, 'Left', Left);
    WriteInteger(Name, 'Top', Top);
    WriteInteger(Name, 'Width', Width);
    WriteInteger(Name, 'Height', Height);
    WriteBool('Options', HotTrack1.Name, HotTrack1.Checked);
    WriteBool('Options', InfoTip1.Name, InfoTip1.Checked);
    WriteBool('Options', BeepOnChange1.Name, BeepOnChange1.Checked);
    WriteBool('Options', CheckImageBase1.Name, CheckImageBase1.Checked);
  end;
end;

procedure TMainForm.UpdateListViewsOptions;
begin
  ProcessListView.HotTrack := HotTrack1.Checked;
  ThreadsListView.HotTrack := HotTrack1.Checked;
  ModulesListView.HotTrack := HotTrack1.Checked;
  ProcessListView.ShowHint := InfoTip1.Checked;
  ThreadsListView.ShowHint := InfoTip1.Checked;
  ModulesListView.ShowHint := InfoTip1.Checked;
end;

procedure TMainForm.ModulesListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item.SubItems.Objects[1] <> nil then
    Sender.Canvas.Font.Style := [fsunderline];
end;

procedure TMainForm.DumpModules1Execute(Sender: TObject);
begin
  if not Assigned(ModulesDumpForm) then
    ModulesDumpForm := TModulesDumpForm.Create(Application);
  ModulesDumpForm.Show;
end;

procedure TMainForm.DumpPE1Update(Sender: TObject);
begin
  DumpPE1.Enabled := GlobalModule.PeViewerRegistred and (Length(FocusedFileName) > 0);
end;

procedure TMainForm.ProcessListViewDblClick(Sender: TObject);
begin
  DumpPE1.Execute; 
end;

procedure TMainForm.DumpPE1Execute(Sender: TObject);
begin
  GlobalModule.ViewPE(FocusedFileName);
end;

procedure TMainForm.SendMail1Execute(Sender: TObject);
begin
  SendEmail;
end;

procedure TMainForm.CoolBar1Resize(Sender: TObject);
begin
  D4FixCoolBarResizePaint(Sender);
end;

// History:

// $Log: Main.pas,v $
// Revision 1.3  2006/01/15 11:21:32  outchy
// Removed Log tag
// Changed DELPHI5 to COMPILER5
//
// Revision 1.2  2005/10/27 01:44:51  rrossmair
// - added MPL headers and CVS Log tags
//

end.