VPF::содержание окна "Диспетчер устройств"

Sunvas

Дата 21.9.2006, 16:58 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

Как на форме отобразить содержание диспетчера устройств?

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

Snowy

Дата 21.9.2006, 18:57 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Ну это всё далеко не однозначно.
Можно начать копать от HKEY_LOCAL_MACHINE\HARDWARE и далее.
Но реестр недокументироват smile

Yanis

Дата 22.9.2006, 08:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Диспетчер устройств, читает все разделы (имена которых являются GUID'ами) из этой ветки реестра: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class.

--------------------

*щёлк*

Akella

Дата 22.9.2006, 17:42 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

можно сделать "слепок" диспетчера задач с пом. WinAPI

Добавлено @ 17:45

Код


uses ...


const
  PROCESS_TERMINATE         =  $0001;
  PROCESS_CREATE_THREAD     =  $0002;
  PROCESS_VM_OPERATION      =  $0008;
  PROCESS_VM_READ           =  $0010;
  PROCESS_VM_WRITE          =  $0020;
  PROCESS_DUP_HANDLE        =  $0040;
  PROCESS_CREATE_PROCESS    =  $0080;
  PROCESS_SET_QUOTA         =  $0100;
  PROCESS_SET_INFORMATION   =  $0200;
  PROCESS_QUERY_INFORMATION =  $0400;
  PROCESS_ALL_ACCESS        =
  STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $0FFF;

type

...

private
...
    Function  ExcelIsRuning:boolean;//я когдато пытался определять запущен ли Excel
    Function  GetProcessList(List: TStrings):Boolean;
    procedure GetModuleList(List: TStrings);
    function  GetProcessHandle(ProcessID: DWORD): THandle;
    procedure GetParentProcessInfo(var ID: DWORD; var Path: String);}

...

Function TfmImpExcel.GetProcessList(List: TStrings):Boolean;
var
  I: Integer;
  hSnapshoot: THandle;
  pe32: TProcessEntry32;
  cExitCode:Cardinal;
begin
  Result:=False;
  List.Clear;
  hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapshoot = -1) then
    Exit;
  pe32.dwSize := SizeOf(TProcessEntry32);
  if (Process32First(hSnapshoot, pe32)) then
    repeat
      I := List.Add(Format('%x, %x: %s',
        [pe32.th32ProcessID, pe32.th32ParentProcessID, pe32.szExeFile]));
      if POS('EXCEL',AnsiUpperCase(pe32.szExeFile))<>0 then begin
        GetExitCodeProcess(pe32.th32ProcessID, cExitCode);
//        Showmessage(pe32.szExeFile+'--'+IntToStr(pe32.th32ProcessID)+'--'+IntToStr(cExitCode));
        TerminateProcess(OpenProcess(PROCESS_ALL_ACCESS,false,pe32.th32ProcessID),1);
      end;
      List.Objects[I] := Pointer(pe32.th32ProcessID);
    until not Process32Next(hSnapshoot, pe32);
  CloseHandle (hSnapshoot);
//  if POS('EXCEL',AnsiUpperCase(List.Text))<>0 then result:=True;
end;

procedure TfmImpExcel.GetModuleList(List: TStrings);
var
  I: Integer;
  hSnapshoot: THandle;
  me32: TModuleEntry32;
begin
  List.Clear;
  hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, 0);
  if (hSnapshoot = -1) then
   Exit;
  me32.dwSize := SizeOf(TModuleEntry32);
  if (Module32First(hSnapshoot, me32)) then
    repeat
      I := List.Add(me32.szModule);
      List.Objects[I] := Pointer(me32.th32ModuleID);
    until not Module32Next(hSnapshoot, me32);
  CloseHandle (hSnapshoot);
end;

procedure TfmImpExcel.GetParentProcessInfo(var ID: DWORD; var Path: String);
var
  ProcessID: DWORD;
  hSnapshoot: THandle;
  pe32: TProcessEntry32;
begin
  ProcessID := GetCurrentProcessID;
  ID := 0;
  Path := '';
  hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapshoot = -1) then
    Exit;
  pe32.dwSize := SizeOf(TProcessEntry32);
  if (Process32First(hSnapshoot, pe32)) then
    repeat
      if pe32.th32ProcessID = ProcessID then begin
        ID := pe32.th32ParentProcessID;
        Break;
      end;
    until not Process32Next(hSnapshoot, pe32);
  if ID <> -1 then begin
    if (Process32First(hSnapshoot, pe32)) then
      repeat
        if pe32.th32ProcessID = ID then begin
          Path := pe32.szExeFile;
          Break;
        end;
      until not Process32Next(hSnapshoot, pe32);
  end;
  CloseHandle (hSnapshoot);
end;

function TfmImpExcel.GetProcessHandle(ProcessID: DWORD): THandle;
begin
  Result := OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID);
end;

function TfmImpExcel.ExcelIsRuning: boolean;
begin
  Result:=False;
  List1.Lines.Clear;
  GetProcessList(List1.Lines);
  if POS('EXCEL',AnsiUpperCase(List1.Text))<>0 then result:=True;
end;

Yanis

Дата 25.9.2006, 10:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Akella
Причём здесь диспетчер задач и Tool Help?

--------------------

*щёлк*

Akella

Дата 25.9.2006, 10:27 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

вот причём

Цитата

GetProcessList(List1.Lines);

список процессов

Yanis

Дата 25.9.2006, 10:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Akella
Я думал намёк будет понятен...
Советую перечитать вопрос Sunvas-а повнимательнее.

--------------------

*щёлк*

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »