/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 907
от 27.08.2007, 18:35

Вопрос № 99.183

Здравствуйте, уважаемые эксперты! Каким образом, зная идентификатор потока, изменить приоритет потока, заморозить/продолжить выполнение? не получается получить хендл самого потока.

Отправлен: 21.08.2007, 20:36 Вопрос задал: Megalamer (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Виктор Пырлик Здравствуйте, Megalamer! В приложении дан код примера - там я рассмотрел все операции о которых вы спрашиваете. Данный код будет работать только на системах Windows 2000 и старше (XP и т.д.). Так же, для более лучшего ознакомления с процессами и потоками Windows - рекомендую книгу Джефри Рихтера - Windows для профессионалов. Приложение: unit Unit1; interface uses {$DEFINE WIN32_LEAN_AND_MEAN} Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,TlHelp32,Windows; type TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; ComboBox1: TComboBox; Button5: TButton; ListBox2: TListBox; Label1: TLabel; Button6: TButton; procedure Button1Click(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); private public { Public declarations } end; const THREAD_ALL_ACCESS = $000F0000 or $00100000 or $3FF; THREAD_SUSPEND_RESUME = $0002; THREAD_TERMINATE = $0001; THREAD_GET_CONTEXT = $0008; THREAD_SET_CONTEXT = $0010; THREAD_SET_INFORMATION = $0020; THREAD_QUERY_INFORMATION = $0040; THREAD_PRIORITET:array[0..6]of integer = ( THREAD_PRIORITY_TIME_CRITICAL, THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_ABOVE_NORMAL, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_BELOW_NORMAL, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_IDLE ); type // прототип функции, которую будем вызувать из библиотеки ядра TThread32Open = function (dwAccess:DWORD; bInherited:boolean;dwThreadID:DWORD):Hwnd stdcall; var Form1: TForm1; OpenThread:TThread32Open; // переменная этой функции function GetProcessList:TStrings; function GetThreadList(dwProcID:DWORD):TStrings; implementation {$R *.dfm} //--------- получает список процессов ----------------------------------------- function GetProcessList:TStrings; var ret:longbool; h,h2:Hwnd; pe32:PROCESSENTRY32; begin result := TStringList.Create; h := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 ); if( h= INVALID_HANDLE_VALUE )then exit; pe32.dwSize := sizeof( PROCESSENTRY32 ); if(Process32First( h, pe32 ) = false)then//устанавливаем поиск в начало процессов begin CloseHandle(h); exit; end; ret := (h>0); while(ret)do//пока есть чтио искать begin h2 := OpenProcess(PROCESS_ALL_ACCESS, FALSE, pe32.th32ProcessID ); result.AddObject(String(pe32.szExeFile)+'-'+IntToStr(pe32.th32ProcessID),Pointer(pe32.th32ProcessID)); ret := Process32Next( h, pe32 ); end; CloseHandle( h ); end; //-------------- получает список потоков для конкретного процесса ------------- function GetThreadList(dwProcID:DWORD):TStrings; var th32: THREADENTRY32; crnHandle,hShap:Cardinal; hProc,hThread:THandle; ok:Bool; begin result := TStringList.Create; result.Add(''); hShap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD,dwProcID); if(hShap = INVALID_HANDLE_VALUE)then begin exit; end; hThread := 0; crnHandle :=GetModuleHandle(kernel32); @OpenThread := GetProcAddress(crnHandle, 'OpenThread'); // получаеи адрес этой функции ZeroMemory(@th32,sizeof(th32)); th32.dwSize := sizeof(th32); ok := Thread32First(hShap, th32 ); while(ok) do begin if( th32.th32OwnerProcessID = dwProcID)then begin result.AddObject(IntToStr(th32.th32OwnerProcessID),Pointer(th32.th32ThreadID)); CloseHandle(hThread); end; ok := Thread32Next(hShap, th32 ); end; CloseHandle(hShap); end; {с этого начинаем работать - заполняем список процессов} procedure TForm1.Button1Click(Sender: TObject); begin ListBox1.Items := GetProcessList; end; {получаем список потоков} procedure TForm1.ListBox1Click(Sender: TObject); var st:TStrings; prID:DWORD; begin ListBox2.Clear; prID := Cardinal(ListBox1.Items.Objects[ListBox1.ItemIndex]); st := GetThreadList(prID); if(st.Count > 0)then ListBox2.Items.AddStrings(st); end; { уничтожаем поток} procedure TForm1.Button4Click(Sender: TObject); var th:THandle; begin th := OpenThread(THREAD_TERMINATE,false,DWORD(ListBox2.Items.Objects[ListBox2.ItemIndex])); Label1.Caption := 'Результат: '+IntToStr(Ord(TerminateThread(th,0))); CloseHandle(th); end; {переводим в спячку} procedure TForm1.Button2Click(Sender: TObject); var th:THandle; begin th := OpenThread(THREAD_SUSPEND_RESUME,false,DWORD(ListBox2.Items.Objects[ListBox2.ItemIndex])); Label1.Caption := 'Результат: '+IntToStr(Ord(SuspendThread(th)<>$ffffffff)); CloseHandle(th); end; {возобновляем работу} procedure TForm1.Button3Click(Sender: TObject); var th:THandle; begin th := OpenThread(THREAD_SUSPEND_RESUME,false,DWORD(ListBox2.Items.Objects[ListBox2.ItemIndex])); Label1.Caption := 'Результат: '+IntToStr(Ord(ResumeThread(th)<>$ffffffff)); CloseHandle(th); end; {устанавливаем приоритет потока} procedure TForm1.Button5Click(Sender: TObject); var th:THandle; begin th := OpenThread(THREAD_ALL_ACCESS,false,DWORD(ListBox2.Items.Objects[ListBox2.ItemIndex])); Label1.Caption := 'Результат: '+IntToStr(Ord(SetThreadPriority(th,THREAD_PRIORITET[ComboBox1.ItemIndex]))); CloseHandle(th); end; {получить приоритет потока} procedure TForm1.Button6Click(Sender: TObject); var th:THandle; begin th := OpenThread(THREAD_ALL_ACCESS,false,DWORD(ListBox2.Items.Objects[ListBox2.ItemIndex])); ComboBox1.ItemIndex := GetThreadPriority(th); Label1.Caption := 'Результат: '+IntToStr(ComboBox1.ItemIndex); CloseHandle(th); end; end. --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 22.08.2007, 02:27

Вопрос № 99.216

Здравствуйте, Уважаемые Эксперты!!!:-) Я тут с циклами разбираюсь и что-то немного запуталась. Не могли бы Вы мне объяснить поподробнее каждый шаг программ: 1)Почему в первом примере значение x после выполнения инструкции равно нулю? Я думала, что в строке выведутся значения 25, 16, 9, 4, 1, 0. Почему выводится только последнее вычисление? 2)И еще второй пример. Почему здесь выводится строка из 12 звездочек? По какому принципу работает программа. Объясните, пожалуйста, подробно ход работы данного кода, как именно здесь все высчитывается. Заранее всем Спасибо!!!:-) Приложение: 1 Пример Var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do n:=i*i; x:=x+n; Writeln(x); Readln; end. 2 Пример Var i,j: integer; begin for i:=1 to 3 do for j:=i to 5 do Writeln('*'); Readln; end.

Отправлен: 22.08.2007, 02:10 Вопрос задала: Алена (статус: Посетитель) Всего ответов: 6 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Zwieback Здравствуйте, Алена! 1. Кое кто снова забыл поставить begin end! 2. Если вы программируете в Delphi консольное приложение, то лучше запустить пошаговую трассировку программы клавишей F7. После многократного нажатия Вы будуте видеть переход к следующему шагу программы. Во время прохождения цикла при перемещении мыши над переменными можно увидеть их текущее значение в виде подсказки. Приложение: 1 Пример Var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do begin n:=i*i; x:=x+n; Writeln(x); end; Readln; end. --------- Бывает что все удается, не пугайтесь, это пройдет!

Ответ отправил: Zwieback (статус: 1-ый класс) Ответ отправлен: 22.08.2007, 02:20 Оценка за ответ: 5

Отвечает: Виктор Пырлик Здравствуйте, Алена! Вот, смотрите, я прокомментировал пошагово.. В первом случае пропущены begin и end. И результат при всем раскладе будет таким: 25 41 50 54 55 55 x:=0; for i:=-5 to 0 do begin // <- забыли n:=i*i; // 25 16 9 4 1 0 x:=x+n; // (25 + 0) (25+16) (41+9) (50+4) (54+1) (55+0) Writeln(x); // 25 41 50 54 55 55 end; // <- забыли Readln; Во втором случае, у вас количество (повторений цикла) итераций складывается, с уменьшением каждый раз переменной I во внутреннем цикле на 1. от 1 до 5= 5 от 2 до 5= 4 от 3 до 5=3 всего = 12 итераций, т.е., 12 звездочек. for i:=1 to 3 do // повторяем 3 раза, на каждом шаге i увеличивается на 1 for j:=i to 5 do //от 1 до 5= 5 от 2 до 5= 4 от 3 до 5=3 всего = 12 Writeln('* - '); --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 22.08.2007, 03:31 Оценка за ответ: 5 Комментарий оценки: Огромное Вам спасибо, Виктор!!!:-) Вы очень подробно все разъяснили!:-) Спасибо!!!:-) Удачи Вам!:-)

Отвечает: Бурка Юрий Викторович Здравствуйте, Алена! Первый пример: Для того, чтобы в цикле выполнялось не только n:=i*i, надо использовать пару begin end; Var x, n, i: Integer; begin x:=0; for i:=-5 to 0 do begin n:=i*i; x:=x+n; Write(x,' '); end; ReadLn; end. Тогда будут выведены и остальные результаты Правда будет не 25 16 9 4 1 0, а 25 41 50 54 55 55 Ведь в Вашем коде x не обнуляется каждый шаг цикла, поэтому n все время плюсуется {25+16=41; 41+9=50; ...} {======================================================================} Второй пример Нет, здесь будет двенадцать строк, в каждой из которых одна звездочка. У Вас же WriteLN, а не просто Write. Разберем Ваш код: Var i, j: Integer; begin for i:=1 to 3 do for j:=i to 5 do Writeln('*'); Readln; end. Здесь два вложенных цикла. первый идет от 1-го до 3-х. На первом шагу {i=1} внутренний цикл 5 раз выводит звездочку {j=1..5} На втором {i=2} 4 раза {j=2..5} И на последнем {i=3} 3 раза {j=3..5} В сумме получается ровно 12 раз. --------- З.Ы. И восьми бит тебе в байте.

Ответ отправил: Бурка Юрий Викторович (статус: 1-ый класс) Ответ отправлен: 22.08.2007, 04:02 Оценка за ответ: 5 Комментарий оценки: Спасибо Вам, Юрий Викторович, за подробное объяснение!!!:-)

Отвечает: Vlad Cepesh Здравствуйте, Алена! В первом примере не хватает одного begin и end. 1 Пример Var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do n:=i*i; {Цикл выполняется до n=0} x:=x+n; {Это выражение выполнится только после полного выполнения цикла} Writeln(x); Readln; end. Во втором примере строка строится, потому что Readln переводит курсор в начало предыдущей строки. Приложение: 1 Пример Var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do begin n:=i*i; x:=x+n; end; Writeln(x); Readln; end. 2 Пример Var i,j: integer; begin for i:=1 to 3 do for j:=i to 5 do Write('*');{Выводит * в строку от i до 5} Readln; end.

Ответ отправил: Vlad Cepesh (статус: 3-ий класс) Ответ отправлен: 22.08.2007, 08:55 Оценка за ответ: 5

Отвечает: Дмитрий С. Здравствуйте, Алена! На мой взгляд, Вы неправильно оформили цикл. Если Вы хотите, чтобы выводились все результаты - см. в приложении №1 А по поводу звёздочек - по логике вещей их там должно быть 15. Или Вы хотели там что-то другое улицезреть? что Вы попросили, то Вам и вывели :) Приложение: Пример №1 Var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do begin n:=i*i; x:=x+n; Writeln(x); end; Readln; end. Пример №2 Var i,j: integer; begin for i:=1 to 3 do for j:=i to 5 do Writeln('*'); Readln; end. --------- Наши программисты самые программистые программисты!..

Ответ отправил: Дмитрий С. (статус: 3-ий класс) Ответ отправлен: 22.08.2007, 11:31 Оценка за ответ: 4

Отвечает: Mishell Здравствуйте, Алена! в примере 1 Вы забыли поставить begin...end для вашего составного оператора - Смотрите надо так: var x: integer; n: integer; i: integer; begin x:=0; for i:=-5 to 0 do begin n:=i*i; x:=x+n; Writeln(x); Readln; end; end в строке выведутся значения -25, -41, -50 и т.д. ... в примере 2 происходит двойной цикл по i и по j причем второй цикл зависит от первого и происходит внутри первого подсчитаем количество "срабатываний" циклов: первый проход по i=1 - по j от 1 до 5 = 5 раз второй проход по i=2 - по j от 2 до 5 = 4 раза третий проход по i=3 - по j от 3 до 5 = 3 раза складываем и получается 5+4+3=12 раз - вот ваши 12 звездочек

Ответ отправил: Mishell (статус: 5-ый класс) Ответ отправлен: 22.08.2007, 11:35 Оценка за ответ: 5

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.57 от 25.08.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru