Delphi & Pascal

**nons** · 25.01.2006 21:02

в cmd (ID) сначала надо сначало задать идентификатор того прооцесса который ты "убиваешь"

**qwas** · 26.01.2006 00:27

Напиши пожалуста пример:
При нажатии кнопки убивается к примеру Winamp.exe.

**qwas** · 26.01.2006 21:02

Чё трудно пример написать?:(

**nons** · 26.01.2006 21:16

мля, некогда мне переделывать код чтоб он те winamp убивал :mad:
вот те кусок кода RеmoteControl - сам разбирайся

Код:

...
//список процессов
var
  H:THandle;
  FProcessEntry32:TProcessEntry32;
  Count:Integer;
  ID:Integer;

procedure FillList;
begin
  with FprocessEntry32,CtrlSrvFrm.ListView.Items.Add do
    begin
      Caption := Format('$%x',[Th32ProcessID]);
      SubItems.Add(ExtractFileName(szExeFile));
    end;
  Inc(Count);
end;

...

  //процессы компа-сервера
  else if  cmd = 'process'
    then
      begin
        CtrlSrvFrm.ListView.Items.Clear;
        H:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
        if H<>INVALID_HANDLE_VALUE
        then
          CtrlSrvFrm.ListView.Items.Clear;
        begin
          FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);
          Count:=0;
          if Process32First(h,FProcessEntry32) then FillList;
          while Process32Next(h,FProcessEntry32) do FillList;
          CloseHandle(h);
        end;
        i := 0;
        Socket.SendText(#13#10 + '----------------------------------' + #13#10 +
                                 '          ПРОЦЕССЫ:' + #13#10 +
                                 '----------------------------------' + #13#10 +
                                 '      ID       |     Имя' + #13#10 +
                                 '----------------------------------' + #13#10);
        while i < CtrlSrvFrm.ListView.Items.Count do
          begin
            Socket.SendText(ListView.Items.Item[i].Caption + '    ' + ListView.Items.Item[i].SubItems.Text);
            i := i+1;
          end
        end

...

  //Удалить процесс на компе-сервере
  else if (copy(cmd,1,9) = 'KillProc:')
    then
      begin
        Delete(cmd,1,9);
        try
          try
            ID:=StrToInt(cmd);
          except
            begin
              Socket.SendText('Ошибочка вышла!!!');
              exit;
            end;
          end;
          H:=OpenProcess(Process_ALL_ACCESS,false,ID);
          if H<>INVALID_HANDLE_VALUE then
            begin
              TerminateProcess(h,0);
              CloseHandle(h);
              Sleep(400);
            end;
          Socket.SendText('Процесс удален!!!');
        except
          begin
            Socket.SendText('Ошибочка вышла!!!');
            exit;
          end;
        end;
      end

...

**qwas** · 27.01.2006 22:37

Хоть бы коменты написал, нехрена не понятно !
А лудше дай инфы по этой теме, и по WindowsAPI не помешало бы, в книгах маловато написанно:( .

**nons** · 27.01.2006 22:48

Сообщение от Kolyan

Хоть бы коменты написал, нехрена не понятно !
А лудше дай инфы по этой теме, и по WindowsAPI не помешало бы, в книгах маловато написанно:( .

млин...я ж сказал разбирайся сам...готовое те никто не даст
а насчет винапи - ссылка

**dwemer** · 28.01.2006 02:43

Код:

Function DebugKillProcess(ProcessId: dword): boolean;
var
 pHandle: dword;
 myPID: dword;
 HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX;
 r: dword;
begin
 Result := false;
 myPID := GetCurrentProcessId();
 if not EnableDebugPrivilege() then Exit;
 //Подключаемся к системе отладки.
 if DbgUiConnectToDbg() <> STATUS_SUCCESS then Exit;
 pHandle := OpenProcessEx(ProcessId);
 //Включаем отладку процесса
 if DbgUiDebugActiveProcess(pHandle) <> STATUS_SUCCESS then Exit;
 //Надо найти полученый DebugObject
 HandlesInfo := GetInfoTable(SystemHandleInformation);
 if HandlesInfo = nil then Exit;
 for r := 0 to HandlesInfo^.NumberOfHandles do
  if (HandlesInfo^.Information[r].ProcessId = myPID) and
     (HandlesInfo^.Information[r].ObjectTypeNumber = $8)  //DebugObject
     then begin
       //Зкрываем DebugObject, что приводит к уничтоженю процесса
       CloseHandle(HandlesInfo^.Information[r].Handle);
       Result := true;
       break;
     end;
 VirtualFree(HandlesInfo, 0, MEM_RELEASE);
end;

открываем чужой процесс под отладкой, затем завершаем отладку и процесс умирает.
но это на ХР. на младших осях отладку завершить так просто не получится, нужно собственный процесс завершать, тогда и "жертва" умрет

забивание гвоздей микроскопом конечно ) но убьются многие процессы которые защищают себя от убийства))

но, имхо, чтоб винамп убить можно просто послать wm_close какой нить его окну ))

а по Win32 API - читайте MSDN. первоисточник.(http://msdn.microsoft.com) Еще на сайте мелкософта не так давно можно было заказать комплект ВизуалСтудии 2005 бета. и там ДВД с МСДН прилагается. может щас еще высылают. бесплатно

..
ах да, для отладки нужны привилегии соответствующие,
SuDebug вроде

**nons** · 28.01.2006 02:51

dwemer, тут могут опять же возникнуть вопросы по ID процесса ;)

а чтоб окно убить -

Код:

procedure CloseWnd;
var
  h: hWind; //хендл окна
begin
  h:=FindWindow(nil, 'Winamp'); //поиск окна с заголовком Winamp
  if h=0 then exit; //если ничего не нашли выходим
  SendMessage(h, WM_DESTROY,0,0);//закрытие(уничтожение) окна
end;

но надо чтоб тока окно точно называлось Winamp - иначе нифига...а при проигравании песен - название меняется

**dwemer** · 28.01.2006 03:04

дык по имени процесса ПИД узнаем , и все

а то что название окна меняется в винампе..... так слово winamp там все равно присутствует !? ) вот и ищем все окна с этим словом - и под нож )

**nons** · 28.01.2006 04:57

вопсчем чтобы не разводить лишний флуд вот написал все таки процедурку, которая находит и уничтожает Winamp

Код:

procedure killWinamp;
var
    h, hwndWinamp, PID : THandle;
begin
  hwndWinamp:= FindWindow('Winamp v1.x',nil); //находим винамп
  GetWindowThreadProcessId(hwndWinamp,PID); //получаем пид
//  ShowMessage(IntToStr(PID)); //так...для наглядности выводил его %)
  try
    H:=OpenProcess(Process_ALL_ACCESS,false,PID);
    if H<>INVALID_HANDLE_VALUE then 
      begin
        TerminateProcess(h,0); // уничтожаем процесс
        CloseHandle(h);
        Sleep(400);
      end;
    ShowMessage('Процесс удален!!!');
  except
    begin
      ShowMessage('Ошибочка вышла!!!');
      exit;
    end;
  end;
end;

проверил, все точно работает!

**qwas** · 28.01.2006 06:23

Сообщение от n0ns3ns3

вопсчем чтобы не разводить лишний флуд вот написал все таки процедурку, которая находит и уничтожает Winamp

Код:

procedure killWinamp;
var
    h, hwndWinamp, PID : THandle;
begin
  hwndWinamp:= FindWindow('Winamp v1.x',nil); //находим винамп
  GetWindowThreadProcessId(hwndWinamp,PID); //получаем пид
//  ShowMessage(IntToStr(PID)); //так...для наглядности выводил его %)
  try
    H:=OpenProcess(Process_ALL_ACCESS,false,PID);
    if H<>INVALID_HANDLE_VALUE then 
      begin
        TerminateProcess(h,0); // уничтожаем процесс
        CloseHandle(h);
        Sleep(400);
      end;
    ShowMessage('Процесс удален!!!');
  except
    begin
      ShowMessage('Ошибочка вышла!!!');
      exit;
    end;
  end;
end;

проверил, все точно работает!

Сэнкю вери мач.

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

procedure CloseWnd;

var
h: hWind; //хендл окна
begin
h:=FindWindow(nil, 'Winamp'); //поиск окна с заголовком Winamp
if h=0 then exit; //если ничего не нашли выходим
SendMessage(h, WM_DESTROY,0,0);//закрытие(уничтожение) окна
end;
------------------------------------------------------------------------------------------------------------
Это тоже работает, конечно если название окна др. то хрен на палочке

.

**qwas** · 21.06.2006 20:06

Кароче задачка.
Надо что бы в поле memo адрес "http://forum.bratsk.org" отображался как сцилочка. Типа как в ворде.

**nons** · 21.06.2006 20:13

используй компоненту RxRichEdit из библиотечки RxLib
в нем

Код:

RxRichEdit1.AutoURLDetect := true;

и пишешь обработчик на событие OnURLClick

**qwas** · 21.06.2006 20:20

Оброчик типа чтоб браузер открывал.

**nons** · 21.06.2006 20:24

Сообщение от qwas

Оброчик типа чтоб браузер открывал.

это мысль или вопрос? (%
если вопрос, то да (;

**qwas** · 22.06.2006 12:59

Чё та у меня нет такой либы или я не там ищю?
Кстати у меня 2005 Делфа.

**JiF** · 22.06.2006 13:20

Сообщение от qwas

Чё та у меня нет такой либы или я не там ищю?
Кстати у меня 2005 Делфа.

Rxlib давно примкнул к проекту JEDI (вроде http://jvcl.sourceforge.net/) ... Последний Rx есть только для Delphi 6 (если пропатчить, попрёт на 7ой) ...

**qwas** · 23.06.2006 19:00

Кароче задачка.
Сделать сцилку в memo!

**nons** · 23.06.2006 20:33

Сообщение от qwas

Кароче задачка.
Сделать сцилку в memo!

RxLib ... (:

**qwas** · 25.06.2006 20:30

Вот такая хрень. ):

Тема: Delphi & Pascal

Опции темы

Отображение

Информация о теме

Пользователи, просматривающие эту тему

Похожие темы

Многоадресная рассылка в Delphi (IP Multicasting)

delphi 2005

Ваши права