Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 5 215

/ вопрос решён /

Короче задача такая:
1. Перебрать все системные процессы. Это можно сделать так:

procedure CreateWinNTProcessList(List: TstringList);    
var    
  PIDArray: array [0..1023] of DWORD;    
  cb: DWORD;    
  I: Integer;    
  ProcCount: Integer;    
  hMod: HMODULE;    
  hProcess: THandle;    
  ModuleName: array [0..300] of Char;    
begin    
  if List = nil then Exit;    
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);    
  ProcCount := cb div SizeOf(DWORD);    
  for I := 0 to ProcCount - 1 do    
  begin    
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or    
      PROCESS_VM_READ,    
      False,    
      PIDArray[I]);    
    if (hProcess <> 0) then    
    begin    
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);    
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));    
      List.Add(ModuleName);    
      CloseHandle(hProcess);    
    end;    
  end;    
end;
2. Перебрать с первого по последний процесс и посмотреть, у какого какие длл-ки запущены.
Вот функция для определения всех выгруженных длл !!!В СИСТЕМЕ!!!:
unit ModuleProcs;    
 
interface    
 
uses Windows, Classes;    
 
type    
  TModuleArray = array[0..400] of HMODULE;    
  TModuleOption = (moRemovePath, moIncludeHandle);    
  TModuleOptions = set of TModuleOption;    
 
function GetLoadedDLLList(sl: TStrings;    
  Options: TModuleOptions = [moRemovePath]): Boolean;    
 
implementation    
 
uses SysUtils;    
 
function GetLoadedDLLList(sl: TStrings;    
  Options: TModuleOptions = [moRemovePath]): Boolean;    
type    
EnumModType = function (hProcess: Longint; lphModule: TModuleArray;    
  cb: DWord; var lpcbNeeded: Longint): Boolean; stdcall;    
var    
  psapilib: HModule;    
  EnumProc: Pointer;    
  ma: TModuleArray;    
  I: Longint;    
  FileName: array[0..MAX_PATH] of Char;    
  S: string;    
begin    
  Result := False;    
 
  (* Данная функция запускается только для Widnows NT *)    
  if Win32Platform <> VER_PLATFORM_WIN32_NT then    
    Exit;    
 
  psapilib := LoadLibrary('psapi.dll');    
  if psapilib = 0 then    
    Exit;    
  try    
    EnumProc := GetProcAddress(psapilib, 'EnumProcessModules');    
    if not Assigned(EnumProc) then    
      Exit;    
    sl.Clear;    
    FillChar(ma, SizeOF(TModuleArray), 0);    
    if EnumModType(EnumProc)(GetCurrentProcess, ma, 400, I) then    
    begin    
      for I := 0 to 400 do    
        if ma[i] <> 0 then    
        begin    
          FillChar(FileName, MAX_PATH, 0);    
          GetModuleFileName(ma[i], FileName, MAX_PATH);    
          if CompareText(ExtractFileExt(FileName), '.dll') = 0 then    
          begin    
            S := FileName;    
            if moRemovePath in Options then    
              S := ExtractFileName(S);    
            if moIncludeHandle in Options then    
              sl.AddObject(S, TObject(ma[I]))    
            else    
              sl.Add(S);    
          end;    
        end;    
    end;    
    Result := True;    
  finally    
    FreeLibrary(psapilib);    
  end;    
end;    
 
end.
3.Посмотреть, если у какого-то приложения запущена dll с именем DLLName, то узнать имя этого процесса (имя exe) и убить этот процесс.
Функция для убивания процесса по имени exe:
uses    
  Tlhelp32, Windows, SysUtils;    
 
function KillTask(ExeFileName: string): integer;    
const    
  PROCESS_TERMINATE=$0001;    
var    
  ContinueLoop: BOOL;    
  FSnapshotHandle: THandle;    
  FProcessEntry32: TProcessEntry32;    
begin    
  result := 0;    
 
  FSnapshotHandle := CreateToolhelp32Snapshot    
                     (TH32CS_SNAPPROCESS, 0);    
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);    
  ContinueLoop := Process32First(FSnapshotHandle,    
                                 FProcessEntry32);    
 
  while integer(ContinueLoop) <> 0 do    
  begin    
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =    
         UpperCase(ExeFileName))    
     or (UpperCase(FProcessEntry32.szExeFile) =    
         UpperCase(ExeFileName))) then    
      Result := Integer(TerminateProcess(OpenProcess(    
                        PROCESS_TERMINATE, BOOL(0),    
                        FProcessEntry32.th32ProcessID), 0));    
    ContinueLoop := Process32Next(FSnapshotHandle,    
                                  FProcessEntry32);    
  end;    
 
  CloseHandle(FSnapshotHandle);    
end;

КАК ЭТО ВСЁ СКЛЕПАТЬ ВМЕСТЕ И ЗАСТАВИТЬ РАБОТАТЬ???
P.S. с апи работаю недолго поэтому и прошу помощи.

BigNik Вопрос решён, но можно продолжить его обсуждение в мини-форуме

Вопрос задал: BigNik (статус: 1-ый класс)
Вопрос отправлен: 19 апреля 2011, 20:37
Состояние вопроса: решён, ответов: 1.

Ответ #1. Отвечает эксперт: min@y™

Надо всё запихать в один модуль (не обязательно). Затем создать 2 TStringList. Первый скормить процедуре CreateWinNTProcessList(). Затем организовать цикл по его содержимому, скармливая в каждую итерацию 2й TStringList функции GetLoadedDLLList(). Во 2-м списке будут имена DLL-ок. Далее, с помощью метода TStrings.IndexOf() узнавать, есть ли в списке нужная DLL, и если есть, убивать процесс из 1-го TStringList функцией KillTask().

Ну, вот, типа как-то так.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 19 апреля 2011, 20:50
Оценка за ответ: 4

Комментарий к оценке: Спасибо за ответ! Я себе где-то так и представлял, но функция GetLoadedDLLList() получает инфу о длл выгруженых во всей системе, я так понял. (по описанию функции, она должна находить длл, выгруженные моей программой, но, после испытания функции было очень много выгруженных длл. Например, был длл с именем GameModue.dll. Уж моя то программа его то и не использует это точно.) Поэтому кто-нибудь может мне пожалуйста указать где в этой функции исатся длл в системе что бы я мог поменять на хендл нужного процесса? В итоге вызов функции должен получится как-то так: GetLoadedDLLList (Handle: THandle; List: TStringsList); где Handle - это хендл того процесса, у которого я хочу поискать длл.

Мини-форум вопроса

Всего сообщений: 34; последнее сообщение — 28 апреля 2011, 17:58; участников в обсуждении: 5.

Страницы: [1] [2] [Следующая »]

Егор

Егор (статус: 10-ый класс), 19 апреля 2011, 20:48 [#1]:

Цитата (BigNik):

Вот функция для определения всех выгруженных длл !!!В СИСТЕМЕ!!!:

улыбнуло :)
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
bugmenot

bugmenot (статус: 3-ий класс), 20 апреля 2011, 00:12 [#2]:

А мне понравилось открытие вопроса словом короче \m/

Судя по разношёрстности копипасты, OP получит даже больше экспы, чем переписав самостоятельно.
виконання програми розпочинається з того самого мiсця, де призупинилося.

BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 15:52 [#3]:

Немного не понял последнего сообщения...
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 15:53 [#4]:

Навскидку: вместо GetCurrentProcess подставляй хэндл нужного процесса.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 16:35 [#5]:

Проблема в том, что если подставить хендл другого прцесса то вылетает вот такая ошибка: Access ciolation at address 004BD7B9 in module Project3.exe. Read of address 0000133C
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 16:44 [#6]:

Ну так прогони для начала под дебаггером, локализуй ошибку, а дальше - посмотрим.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 17:06 [#7]:

вот мною переделанная функция:
function GetLoadedDLLList(sl: TStrings; hProcess: THandle;
  Options: TModuleOptions = [moRemovePath]): Boolean;
type
EnumModType = function (hProcess: Longint; lphModule: TModuleArray;
  cb: DWord; var lpcbNeeded: Longint): Boolean; stdcall;
var
  psapilib: HModule;
  EnumProc: Pointer;
  ma: TModuleArray;
  I: Longint;
  FileName: array[0..MAX_PATH] of Char;
  S: string;
begin
  Result := False;
 
  (* Данная функция запускается только для Widnows NT *)
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    Exit;
 
  psapilib := LoadLibrary('psapi.dll');
  if psapilib = 0 then
    Exit;
  try
    EnumProc := GetProcAddress(psapilib, 'EnumProcessModules');
    if not Assigned(EnumProc) then
      Exit;
    sl.Clear;
    FillChar(ma, SizeOF(TModuleArray), 0);
    if EnumModType(EnumProc)(hProcess, ma, 400, I) then
    begin
      for I := 0 to 400 do
        if ma[i] <> 0 then
        begin
          FillChar(FileName, MAX_PATH, 0);
          GetModuleFileName(ma[i], FileName, MAX_PATH);
          if CompareText(ExtractFileExt(FileName), '.dll') = 0 then
          begin
            S := FileName;
            if moRemovePath in Options then
              S := ExtractFileName(S);
            if moIncludeHandle in Options then
              sl.AddObject(S, TObject(ma[I]))
            else
              sl.Add(S);
          end;
        end;
    end;
    Result := True;
  finally
    FreeLibrary(psapilib);
  end;
end;

с помощью брейкпоинтов я определил что после sl.Clear он почемуто сразу идёт на FreeLibrary(psapilib) и выдаёт ошибку...
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 19:24 [#8]:

Цитата (BigNik):

с помощью брейкпоинтов я определил что после sl.Clear он почемуто сразу идёт на FreeLibrary(psapilib) и выдаёт ошибку...

Значит sl либо равен nil, либо был освобождён до вызова функции, либо не был создан.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 19:36 [#9]:

в функцию были вставлены такие строчки
if sl= nil then exit; // прошёл успешно
    try
     sl.Create;               // прошёл успешно
    finally
     sl.Clear;                // сразу отсюда переходит на ФриЛайбрери
    end;
результат не изменился...
в чём может быть проблема???
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 19:51 [#10]:

Ууууууууууууу, брателло, я вижу, ты даже азов и матчасти не знаешь, а уже лезешь лабать серьёзные проги. Вот откуда, оказывается, ласты растут. Такой бред мог бы написать какой-нить первокурсник-двоечник, но никак не программист.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 19:56 [#11]:

ну уж =) математику то я знаю а уж азы тем более. Начнём с того что я учусь в 9м классе и делфи изучаю уже 1-1.5 года так что я знаю что пишу. Но насчёт не создан... создать это Create ведь так? а в моём коде я проверяю на нулёвость и создаю этот стрингс. Если это не правильно, то что можете вы предложить?
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 19:59 [#12]:

А и ещё... если вызвать оригинал функции, то есть без моих изменений, то она работает без ошибок со стрингс-ом
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 20:09 [#13]:

Цитата (BigNik):

ну уж =) математику то я знаю а уж азы тем более.

БУГАГАГАГА!!!! Причём здесь математика??!!111 :) Матчасть - материальная часть, изучается после азов и к математике не имеет никакого отношения.

Цитата (BigNik):

Начнём с того что я учусь в 9м классе и делфи изучаю уже 1-1.5 года

Ты начал не с этого, а с трёх спижженых из интернета функций, причём, как они работают, ты не знаешь.

Цитата (BigNik):

так что я знаю что пишу.

Если бы знал, тебя бы тут не было. К тому же, это не ты писал, а другие люди, причём, решавшие свои конкретные задачи.

Цитата (BigNik):

Но насчёт не создан... создать это Create ведь так?

Да, да и ещё раз да! Но нихрена не так, как ты пишешь.

Цитата (BigNik):

а в моём коде я проверяю на нулёвость и создаю этот стрингс. Если это не правильно, то что можете вы предложить?

Это бред. Предложить могу только одно: накачать книжек и читать, читать, читать!

Цитата (BigNik):

А и ещё... если вызвать оригинал функции, то есть без моих изменений, то она работает без ошибок со стрингс-ом

Это ничего не значит, если не понимаешь, что происходит внутри функции.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 20:18 [#14]:

=) ну про матчасть я не понял.. да =)
1. да эти функции я взял из интернета и дня эдак 4 уже ковыряю и в общем я понимаю что они делают кроме пары строчек.
2. может я и не знаю что у каждой функции внутри, но я могу поменять значения так как мне надо и могу переделать функцию под меня, но я уже заколебался это делать...
3. если мне чёто не понятно из функций - мой делфи мне все значения этой функции покажет и в крайнем случае есть Индекс и интернет...
но сейчас не про это...
вы уж пожалуйста помогите мне а? а если чё мне не понятно - залезу в инет...
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 20:27 [#15]:

Цитата (BigNik):

=) ну про матчасть я не понял.. да =)

Айяйяй!

Цитата (BigNik):

да эти функции я взял из интернета и дня эдак 4 уже ковыряю и в общем я понимаю что они делают кроме пары строчек.

Дык обращайся к авторам этих функций. Какого хрена тебе от нас-то надо?

Цитата (BigNik):

может я и не знаю что у каждой функции внутри, но я могу поменять значения так как мне надо и могу переделать функцию под меня, но я уже заколебался это делать...

Раз заколебался, значит не можешь. Думаешь, ты один тут такой? Да вас 80%!

Цитата (BigNik):

вы уж пожалуйста помогите мне а? а если чё мне не понятно - залезу в инет...

Слы, братан, ты просто не с той стороны решаешь проблему. Надо наоборот.
Но, поверь мне, тебе ещё рано такими вещами заниматься. ОЧЕНЬ СИЛЬНО РАНО. Отложи эту задачу года на 3. Ты не знаешь элементарнейших вещей, а уже хочешь быть властелином своего компа. Так не бывает. Не спеши. Если будешь продолжать заниматься такими вещами, программист из тебя не получится, т.к. это тебе скоро надоест и ты это забросишь.
Читай книжки. Всё и сразу бывает только в кино. Поверь мне.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 20:40 [#16]:

1. Авторы.... Темы форумов на которых я брал умерли давно...
2. Я заколебался потому что оно не работает. Я знаю что там надо пару значений поменять и знаю каких. Но оно не пашет. Буду копать дальше. Хотя были уже такие вроде как без исходные случаи но только вот с базами данных и МуСиКюЭль. Справился сам как-никак.
3. =) Про теорию... Я уже чиал про это. Где в exe хранятся списки выгружаемых длл и т.д. но это всё надо на практике сделать...
4. На счёт сложности... А в Малой Академии Наук бывают лёгкие программы а? ну время полно так что придётся, кажись самому копать...=( а я так надеялся на шару.. сначала сделать а потом разбирать что и как.. но не судьба... кажись...
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 20:48 [#17]:

Такова селяви, брателло. За тебя тут никто ничего делать не будет. Разве что за бабки.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
BigNik

BigNik (статус: 1-ый класс), 20 апреля 2011, 20:52 [#18]:

ну я ж не просил за меня делать, я просил помочь, а это две разные вещи. я ведь параллельно сам тоже думаю над этой проблемой...
min@y™

min@y™ (статус: Доктор наук), 20 апреля 2011, 21:02 [#19]:

Я повторяю: ты не знаешь элементарных вещей, таких, например, как создание и освобождение объектов. Дальнейший базар не имеет смысла.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Егор

Егор (статус: 10-ый класс), 20 апреля 2011, 21:03 [#20]:

sl: TStrings;
...
s1 := TStrings.Create;
...
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.

Страницы: [1] [2] [Следующая »]

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 3 июня 2023, 11:06
Выполнено за 0.05 сек.
Рейтинг@Mail.ru