안녕하세요..

워..아직도 NT를 사용하는 곳이 있군요..

오래전 사이트를 돌아다니며 열심히 코딩했던 기억이 나서 찾아보니 있네요..

9x계열은 TlHelp32 를 사용했고, NT 계열은 PsApi 를 사용한 코드입니다.

시스템이 무엇인지를 조사해서 거기에 맞게 코딩했었습니다..

보시고, 참고하셔서 즐거운 프로그래밍 하세요~~~



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, PsApi, TlHelp32;

type
  TForm1 = class(TForm)
    Button1: TButton;
    lbProcesses: TListBox;
    lbTasksList: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure lbProcessesDblClick(Sender: TObject);
    procedure lbTasksListDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}


function GetWindowsVersion: String;
begin
  Result := '';
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS:
      case Win32MinorVersion of
        0:
          if Trim(Win32CSDVersion) = 'B' then
            Result := 'Win95OSR2'
          else
            Result := 'Win95';
        10:
          if Trim(Win32CSDVersion) = 'A' then
            Result := 'Win98SE'
          else
            Result := 'Win98';
        90:
          Result := 'WinME';
      end;
    VER_PLATFORM_WIN32_NT:
      case Win32MajorVersion of
        3:
          Result := 'WinNT3';
        4:
          Result := 'WinNT4';
        5:
          Result := 'Win2000';
      end;
  end;
end;
//------------------------------------------------------------------------------



function TForm1.RunningProcessesList(const List: TStrings; FullPath: Boolean): B
oolean;

  procedure StrResetLength(var S: AnsiString);
  begin
    SetLength(S, StrLen(PChar(S)));
  end;

  function ProcessFileName(PID: DWORD): string;
  var
    Handle: THandle;
  begin
    Result := '';
    Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
    if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
      if FullPath then
      begin
        if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          StrResetLength(Result)
        else
          Result := '';
      end
      else
      begin
        if GetModuleBaseNameA(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          StrResetLength(Result)
        else
          Result := '';
      end;
    finally
      CloseHandle(Handle);
    end;
  end;

  function BuildListTH: Boolean;
  var
    SnapProcHandle: THandle;
    ProcEntry: TProcessEntry32;
    NextProc: Boolean;
    FileName: string;
  begin
    SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
    if Result then
    try
      ProcEntry.dwSize := SizeOf(ProcEntry);
      NextProc := Process32First(SnapProcHandle, ProcEntry);
      while NextProc do
      begin
        if ProcEntry.th32ProcessID = 0 then
        begin
          // PID 0 is always the "System Idle Process" but this name cannot be
          // retrieved from the system and has to be fabricated.
          FileName := 'System Idle Process';
        end
        else
        begin
          if GetWindowsVersion = 'Win2000' then
          begin
            FileName := ProcessFileName(ProcEntry.th32ProcessID);
            if FileName = '' then FileName := ProcEntry.szExeFile;
          end
          else
          begin
            FileName := ProcEntry.szExeFile;
            if not FullPath then FileName := ExtractFileName(FileName);
          end;
        end;
        List.AddObject(FileName, Pointer(ProcEntry.th32ProcessID));
        NextProc := Process32Next(SnapProcHandle, ProcEntry);
      end;
    finally
      CloseHandle(SnapProcHandle);
    end;
  end;

  function BuildListPS: Boolean;
  var
    PIDs: array [0..1024] of DWORD;
    Needed: DWORD;
    I: Integer;
    FileName: string;
  begin
    Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed);
    if Result then
    begin
      for I := 0 to (Needed div SizeOf(DWORD)) - 1 do
      begin
        case PIDs[I] of
          0:
            FileName := 'System Idle Process';
          2:
            if GetWindowsVersion = 'WinNT4' then
              FileName := 'System Process'
            else
              FileName := ProcessFileName(PIDs[I]);
          8:
            if GetWindowsVersion = 'Win2000' then
              FileName := 'System Process'
            else
              FileName := ProcessFileName(PIDs[I]);
          else
          FileName := ProcessFileName(PIDs[I]);
        end;
        if FileName <> '' then List.AddObject(FileName, Pointer(PIDs[I]));
      end;
    end;
  end;

begin
  if (GetWindowsVersion = 'WinNT3') or (GetWindowsVersion = 'WinNT4') or
    (GetWindowsVersion = 'Win2000') then
    Result := BuildListPS
  else
    Result := BuildListTH;
end;
//------------------------------------------------------------------------------



// http://msdn.microsoft.com/library/periodic/period97/win321197.htm 참고
function GetTasksList(const List: TStrings): Boolean;

  function EnumWindowsProc(Wnd: HWND; List: TStrings): Boolean; stdcall;
  var
    ParentWnd: HWND;
    ExStyle: DWORD;
    Caption: array [0..255] of Char;
  begin
    if IsWindowVisible(Wnd) then
    begin
      ParentWnd := GetWindowLong(Wnd, GWL_HWNDPARENT);
      ExStyle := GetWindowLong(Wnd, GWL_EXSTYLE);
      if ((ParentWnd = 0) or (ParentWnd = GetDesktopWindow)) and
        ((ExStyle and WS_EX_TOOLWINDOW = 0) or (ExStyle and WS_EX_APPWINDOW <> 0)) and
        (GetWindowText(Wnd, Caption, SizeOf(Caption)) > 0) then
          List.AddObject(Caption, Pointer(Wnd));
    end;
    Result := True;
  end;

begin
  Result := EnumWindows(@EnumWindowsProc, Integer(List));
end;
//------------------------------------------------------------------------------




procedure TForm1.Button1Click(Sender: TObject);
var
  i, max_width : integer;
begin
  lbProcesses.Items.BeginUpdate;
  try
    lbProcesses.Items.Clear;
    RunningProcessesList(lbProcesses.Items, False);
  finally
    lbProcesses.Items.EndUpdate;
  end;

  lbTasksList.Items.BeginUpdate;
  try
    lbTasksList.Items.Clear;
    GetTasksList(lbTasksList.Items);
  finally
    lbTasksList.Items.EndUpdate;
  end;

  // 두 리스트 박스의 수평스크롤바 를 강제로 생성
  max_width := 0;
  for i := 0 to lbProcesses.Items.Count -1 do
  begin
    if (max_width < lbProcesses.Canvas.TextWidth(lbProcesses.items.strings[i]))
    then max_width := lbProcesses.canvas.TextWidth(lbProcesses.items.strings[i]);
  end;
  SendMessage(lbProcesses.Handle, LB_SETHORIZONTALEXTENT, max_width + 200, 0);


  max_width := 0;
  for i := 0 to lbTasksList.Items.Count -1 do
  begin
    if (max_width < lbTasksList.Canvas.TextWidth(lbTasksList.items.strings[i]))
    then max_width := lbTasksList.canvas.TextWidth(lbTasksList.items.strings[i]);
  end;
  SendMessage(lbTasksList.Handle, LB_SETHORIZONTALEXTENT, max_width + 200, 0);
end;
//------------------------------------------------------------------------------



//Running Process Kill
procedure TForm1.lbProcessesDblClick(Sender: TObject);
var
  ProcessHandle : THandle;
begin
  ProcessHandle := OpenProcess(PROCESS_TERMINATE, TRUE,
                    HWND(lbProcesses.Items.Objects[lbProcesses.ItemIndex]));
  TerminateProcess(ProcessHandle,0);
  CloseHandle(ProcessHandle);
end;
//------------------------------------------------------------------------------



//TaskList Process Kill
procedure TForm1.lbTasksListDblClick(Sender: TObject);
begin
  PostMessage(HWND(lbTasksList.Items.Objects[lbTasksList.ItemIndex]), WM_Close,
0, 0);
end;
//------------------------------------------------------------------------------



procedure TForm1.FormShow(Sender: TObject);
begin
  Button1.Click;
end;
//------------------------------------------------------------------------------



end.

감사합니다..