unit1.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, TLHelp32, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,clipbrd;

type
  TProcessInfo = record
    ExeFile: string;
    ProcessId: DWORD;
  end;
  ProcessInfo = ^TProcessInfo;
  TForm1 = class(TForm)
    Timer1: TTimer;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Button2: TButton;
    Button1: TButton;
    ListBox1: TListBox;
    TabSheet2: TTabSheet;
    Button3: TButton;
    ListBox2: TListBox;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure ProcessList(var pList: TList);
    procedure My_RunFileScan(ListboxRunFile: TListBox);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ListBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    Current: TList;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ProcessList(var pList: TList);
var
  p: ProcessInfo;
  ok: Bool;
  ProcessListHandle: THandle;
  ProcessStruct: TProcessEntry32;
begin
  PList := TList.Create;
  PList.Clear;
  ProcessListHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  ProcessStruct.dwSize := Sizeof(ProcessStruct);
  ok := Process32First(ProcessListHandle, ProcessStruct);
  while Integer(ok) <> 0 do
    begin
      new(p);
      p.ExeFile := ProcessStruct.szExeFile;
      p.ProcessID := ProcessStruct.th32ProcessID;
      PList.Add(p);
      ok := Process32Next(ProcessListHandle, ProcessStruct);
    end;
  CloseHandle(ProcessListHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  h: THandle;
  a: DWORD;
  p: PRocessInfo;
begin
  if ListBox1.ItemIndex >= 0 then
    begin
      p := Current.Items[ListBox1.ItemIndex];
      h := openProcess(Process_All_Access, true, p.ProcessID);
      GetExitCodeProcess(h, a);
      if Integer(TerminateProcess(h, a)) <> 0 then
        begin
          My_RunFileScan(ListBox1);
        end;
    end
  else
    showmessage('请选择一个进程');
end;

procedure TForm1.My_RunFileScan(ListboxRunFile: TListBox);
var
  i: Integer;
  p: PRocessInfo;
begin
  current := TList.Create;
  Current.Clear;
  ListboxRunFile.Clear;
  ProcessList(Current);
  for i := 0 to Current.Count - 1 do
    begin
      p := Current.Items[i];
      ListboxRunFile.Items.Add(p.ExeFile);
      dispose(p);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  My_RunFileScan(ListBox1);
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   i:integer;
begin
   i:=listbox1.ItemAtPos(Point(x,y),true);
   if i<>-1 then
   begin
     listbox1.hint:=listbox1.items[i];
     Clipboard.AsText:=listbox1.items[i]
   end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Button2Click(sender);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  hCurrentWindow:HWnd;
  szText:array[0..254]of char;
begin
  listbox2.clear;
  hCurrentWindow:=GetWindow(Handle,GW_HWNDFIRST);
  While hCurrentWindow<>0 Do
  Begin
    If GetWindowText(hCurrentWindow,@szText,255)>0 then
      ListBox2.Items.Add(Strpas(@szText));
      hCurrentWindow:=GetWindow(hCurrentWindow,GW_HWNDNEXT);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
   timer1.Enabled:=checkbox1.checked;
end;

procedure TForm1.ListBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   i:integer;
begin
   i:=listbox2.ItemAtPos(Point(x,y),true);
   if i<>-1 then
   begin
     listbox2.hint:=listbox2.items[i];
     Clipboard.AsText:=listbox2.items[i]
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,700,longint(0));
   SendMessage(ListBox2.Handle,LB_SetHorizontalExtent,700,longint(0));   
end;

end.