main.pas

Jedi Code Library JCL JVCL 组件包 JCL+JVCL超过300个组件的非可视/可视大型组件包。

          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;

end.