список dll

[Mr_ViK]

Здарова народ!
Мне позарез нужно узнать список dll загруженных в процесс программно на delphi. В нете нашел функцию но она на старую версию delphi и не работает.
Подскажите как мне определить список загруженных dll
P.S.лучше всего чтоб они были в стринговском массиве
Спасибо!

[Человек_Борща]

Адаптируйте старое к новому. И нет проблем. Или это новая мода "ни строчки своего кода"?

[Mr_ViK]

Я специализируюсь на VB. На delphi я пишу сейчас только 1 dll. Делфи не знаю как таково.. азы похожи как на VB. Я попросил помочь. Можете хотябы на функции указать?

[Mr_ViK]

Еще вопрос. Возможно ли заблокировать процесс от загрузки других dll и от доступа к нему других процессов. Знаю что это возможно(блокируется даже от Диспетчера задач изменение приоритета). Но возможно ли реализовать такое на delphi?

[Aliens_wolfs]

Вот нашел нужные функции. В свой проект добавь в Uses TLHelp32, PSApi

var
  Form1: TForm1;
  PID: DWORD=0;

implementation

{$R *.dfm}

//Процедура завершает процесс по PID
Function ProcessTerminate(PID: Cardinal): Boolean;
Var
HToken: THandle;
SeDebugNameValue: Int64;
Tkp: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
HProcess: THandle;
Begin
Result:=False;
If Not OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES
Or TOKEN_QUERY,HToken) Then
Exit;
If Not LookupPrivilegeValue(Nil,'SeDebugPrivilege',SeDebugNameValue) Then
Begin
CloseHandle(HToken);
Exit;
End;
Tkp.PrivilegeCount:=1;
Tkp.Privileges[0].Luid:=SeDebugNameValue;
Tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(HToken,False,Tkp,SizeOf(Tkp),Tkp,ReturnLength);
If GetLastError()<> ERROR_SUCCESS Then
Exit;
HProcess:=OpenProcess(PROCESS_TERMINATE,FALSE,PID);
If HProcess=0 Then
Exit;
If Not TerminateProcess(HProcess,DWORD(-1)) Then
Exit;
CloseHandle(HProcess);
Tkp.Privileges[0].Attributes:=0;
AdjustTokenPrivileges(HToken,FALSE,Tkp,SizeOf(Tkp),Tkp,ReturnLength);
If GetLastError() <> ERROR_SUCCESS Then
Exit;
Result:=True;
End;

//Процедура убивает процесс
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 ((AnsiUpperCase(ExtractFileName(FProcessEntry32.SzExeFile)) =
AnsiUpperCase(ExeFileName)) Or (AnsiUpperCase(FProcessEntry32.SzExeFile) =
AnsiUpperCase(ExeFileName))) Then
Result:=Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,Bool(0),
FProcessEntry32.Th32ProcessID),0));
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
End;
CloseHandle(FSnapshotHandle);
End;

//Процедура задает приоритет процессу по PID
Function SetPriorityProc(Priority: Dword; PID: Cardinal): Boolean;
Var
ProcessHandle: THandle;
Begin
Result:=False;
ProcessHandle:=OpenProcess(PROCESS_SET_INFORMATION,False,PID);
If SetPriorityClass(ProcessHandle,Priority) Then
Begin
SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
CloseHandle(ProcessHandle);
Result:=True;
End;
End;

//Процедура выводит модули процесса по PID
Procedure GetModule(PID: Cardinal; Modul: TStrings);
Var
I: Integer;
HSnapshot: THandle;
Me32: TModuleEntry32;
Begin
Modul.Clear;
HSnapshot:=CreateToolHelp32Snapshot({TH32CS_SNAPMODULE}TH32CS_SNAPALL,PID);
Me32.DwSize:=SizeOf(TModuleEntry32);
If (Module32First(HSnapshot,Me32)) Then
Repeat
I:=Modul.Add(Me32.SzModule);
Modul.Objects[I]:=Pointer(Me32.TH32ModuleId);
Until Not Module32Next(HSnapshot,Me32);
CloseHandle(HSnapshot);
End;

//Процедура узнает PID процесса по exe файлу
Function GetProcessPID(ExeFileName: String): Cardinal;
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 ((AnsiUpperCase(ExtractFileName(FProcessEntry32.SzExeFile)) =
AnsiUpperCase(ExeFileName)) Or (AnsiUpperCase(FProcessEntry32.SzExeFile) =
AnsiUpperCase(ExeFileName))) Then
Result:=FProcessEntry32.Th32ProcessID;
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
End;
CloseHandle(FSnapshotHandle);
End;

//Процедура выводит процессы в лист
Procedure GetProcessList(Proc: TStrings; ViewID: Boolean=false);
Var
HSnapshot: THandle;
Pe32: TProcesSentry32;
Begin
Proc.Clear;
HSnapshot:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
Pe32.DwSize:=SizeOf(TProcesSentry32);
If (Process32First(HSnapshot,Pe32)) Then
Repeat
if ViewID then
Proc.Add(IntToStr(Pe32.TH32ProcessId) + ': ' + Pe32.SzExeFile)
else
Proc.Add(Pe32.SzExeFile);
Until Not Process32Next(HSnapshot,Pe32);
CloseHandle(HSnapshot);
End;

//Используем так
//Загружаем список процессов в лист1 при создании формы
procedure TForm1.FormCreate(Sender: TObject);
begin
GetProcessList(ListBox1.Items);
end;

//Далее при нажатии на процесс в листе1 загружаем список dll в лист2
procedure TForm1.ListBox1Click(Sender: TObject);
begin
PID:=GetProcessPID(ListBox1.Items[ListBox1.ItemIndex]);
GetModule(PID,ListBox2.Items);
end;

//Задаем приоритет выбранному в листе1 процессу
procedure TForm1.Button1Click(Sender: TObject);
begin
if ListBox1.ItemIndex > -1 then
 SetPriorityProc(NORMAL_PRIORITY_CLASS, PID);
end;

//Убиваем процесс
procedure TForm1.Button2Click(Sender: TObject);
begin
if ListBox1.ItemIndex > -1 then
KillTask(ListBox1.Items[ListBox1.ItemIndex]);
Либо так
ProcessTerminate(PID);
end;

[Aliens_wolfs]

А вот ссылка на процедуру по изменению привилегии доступа к процессу с помощью ее можно завершить процесс даже Каспера http://www.programmersforum.ru/showthread.php?t=159305

Некоторые процессы могут быть недоступны даже при просмотре их модулей, при изменении привилегии доступа можно тогда работать и с недоступными.

Может что нибудь вам из описаных выше процедур пригодится.