Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.12.21;
Скачать: [xml.tar.bz2];

Вниз

Тормоза и таймер   Найти похожие ветки 

 
Alex_Ford   (2008-11-07 10:05) [0]

Привет!

Мастера у меня программа выполняет несколько задач. Все задачи выполняет таймер. Но от этого комп сильно тормозит. Используется всего один компонент таймер с интервалом в одну секунду. Что нужно сделать чтобы все работало без тормозов.

С уважением!


 
Riply ©   (2008-11-07 10:09) [1]

> [0] Alex_Ford   (07.11.08 10:05)
> Все задачи выполняет таймер. Но от этого комп сильно тормозит. Используется всего один компонент таймер с интервалом в одну секунду.
> Что нужно сделать чтобы все работало без тормозов.

Поставить интервал в один час :)
А если серьезно, то от TTimer тормозить ничего не будет.
Что у тебя в нем вызывается ?


 
clickmaker ©   (2008-11-07 10:18) [2]

> Все задачи выполняет таймер

за что ж ты его так?
почему не потоки?


 
Alex_Ford   (2008-11-07 10:28) [3]

Программа при запуске загружает список из файла.
Таймер в интервале в секунду проверяет эти значения и если все ОК то вызывает процедуру. Список очень большой 1000-1500 записей.

Мастера, подскажите пожалуйста как с потоком тогда работать, если таймер нагружает проц?


 
Плохиш ©   (2008-11-07 10:31) [4]


> Alex_Ford   (07.11.08 10:28) [3]

1. Таймер не нагружает систему
2. Систему нагружает код, который проверяет эти значения и если все ОК то вызывает процедуру

PS. Не надо валить свои проблемы на таймеры...


 
Johnmen ©   (2008-11-07 10:31) [5]


> Alex_Ford   (07.11.08 10:28) [3]
> таймер нагружает проц

Это ты нагружаешь проц, а не таймер.


 
sniknik ©   (2008-11-07 10:41) [6]

а смысл проверять? тем более раз в секунду (а сама проверка видимо отрабатывает за 3 :)). просто мониторить изменение файла, ждать событие от системы, и только тогда проверять.


 
Anatoly Podgoretsky ©   (2008-11-07 10:42) [7]

Таймер не нагружает процессор.


 
Alex_Ford   (2008-11-07 10:42) [8]

Значит, возможно проблема в том, что я не правильно расставляю скобки begin..end

Посмотрите пожалуйста мой код, что не так я сделал?


begin
 for i:=0 to checklistbox1.Items.Count-1 do
   if not checklistbox1.Checked[i] then exit else
   begin
     if checkListBox1.Checked[i] = true then
     st:= checklistbox1.Items.Strings[i];

     if findwindow(nil,pchar(st))<>0 then
        postmessage(findwindow(nil,pchar(st),),WM_CLOSE,0,0);

     if (form1.CheckBox4.Checked = true) and
        (findwindow(nil,pchar(tasklist))<>0) then
     begin
         postmessage(findwindow(nil,pchar("Диспетчер задач Windows"),),WM_CLOSE,0,0);
 end;

    begin
    if (form1.CheckBox5.Checked = true) and      
       (form1.CheckBox1.Checked = true)  then  
     begin
               
     form1.RadioButton1.Checked:= true end else

   if (form1.CheckBox5.Checked = false) and      
      (form1.CheckBox1.Checked = true) then
     begin
     for k:=0 to form1.CheckListBox1.Items.Count-1 do  
     form1.CheckListBox1.Checked[k]:=true;
     end;
   if (form1.CheckBox5.Checked = false) and
      (form1.MaskEdit1.Text = startgame.Caption)and
      (form1.CheckBox2.Checked = true) then
end;
end;
end;
end;


 
Правильный$Вася   (2008-11-07 10:44) [9]


> Программа при запуске загружает список из файла.Таймер в
> интервале в секунду проверяет эти значения

список чего?
в чем заключается проверка?


 
Плохиш ©   (2008-11-07 10:46) [10]


> Alex_Ford   (07.11.08 10:42) [8]


> Посмотрите пожалуйста мой код, что не так я сделал?

Это не код, а маразм. Советую как 2й пункт в изучении прочитать справку по findwindow, на предмет возвращаемого значения...

1й пункт - прочитать букварь.


 
Сергей М. ©   (2008-11-07 10:52) [11]


> что не так я сделал?


Абсолютно все.
Излагай подробно задачу, которую должно решать твое приложение ..


 
sniknik ©   (2008-11-07 11:04) [12]

> загружает список из файла.
?
> Посмотрите пожалуйста мой код, что не так я сделал?
как минимум ты не загружаешь список из файла...

> Излагай подробно задачу, которую должно решать твое приложение ..
задача - спрятаться от диспетчера, вернее не дать найти в нем себя мешая работе с ним.
-> postmessage(findwindow(nil,pchar("Диспетчер задач Windows"),),WM_CLOSE,0,0);


 
Alex_Ford   (2008-11-07 11:04) [13]

//Излагай подробно задачу, которую должно решать твое приложение ..

Извиняюсь!

Программа должна проверять, запущена ли папка, которая содержится в списке. Список - компонент checkListBox1. Если checked = true то папка закрывается, если галочка снята, то ее открыть можно


 
clickmaker ©   (2008-11-07 11:05) [14]

гы... это такой хитрый способ запретить юзеру открывать папку?


 
Сергей М. ©   (2008-11-07 11:09) [15]


> запущена ли папка


Кто, куда и как ее "запустил" ?
И чем она помешала будучи в "запущенном" состоянии, коль скоро нужно за этим безобразием постоянно следить ?


 
Alex_Ford   (2008-11-07 11:11) [16]

Для того кто плохо шарит в компе и так сойдет. На мой взгляд.

Короче задача такая. Не давать открывать папки и запускать exe, которые в списке и выбраны в checklistbщx.

В нете нашел код котороый убивает процессы


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;

Это помещается в список и обрабатывается каждую секунду.


 
Alex_Ford   (2008-11-07 11:12) [17]

Кто, куда и как ее "запустил" ?
И чем она помешала будучи в "запущенном" состоянии, коль скоро нужно за этим безобразием постоянно следить ?

Проблема в одном - игры, а не работа !!!!!!!!!


 
Сергей М. ©   (2008-11-07 11:16) [18]


> и так сойдет. На мой взгляд


Тебя случаем не Владимиром зовут ?)


> Проблема в одном - игры, а не работа


Все равно как играли так и играть будут. Лазейки всегда найдутся.
Проблема решается только административным путем.


 
Правильный$Вася   (2008-11-07 11:17) [19]


>  Если checked = true то папка закрывается, если галочка
> снята, то ее открыть можно

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


 
Anatoly Podgoretsky ©   (2008-11-07 11:24) [20]


> Значит, возможно проблема в том, что я не правильно расставляю
> скобки begin..end

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


 
Alex_Ford   (2008-11-07 11:33) [21]

Хорошо, буду копать, тогда скажите мне пожалуйста, почему когда список загружен из файла и ежесекундно проверяется запущена ли папка или нет, проц нагревается аж до 70% ???

var
 Form1: TForm1;
 i: integer;
 st: string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 for i:=0 to 1000 do
 begin
   checklistbox1.Items.Add("items "+inttostr(i));
   checklistbox1.Checked[i]:= true;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 checklistbox1.Items.SaveToFile("C:\test.txt");
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 checklistbox1.Items.LoadFromFile("C:\test.txt");
 for i:=0 to form1.CheckListBox1.Items.Count-1  do
 checklistbox1.Checked[i]:= true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 for i:=0 to form1.CheckListBox1.Items.Count-1  do
 if checklistbox1.Items.Count = 0 then exit else
     if checkListBox1.Checked[i] = true then
     st:= checklistbox1.Items.Strings[i];
     if findwindow(nil,pchar(st))<>0 then
        postmessage(findwindow(nil,pchar(st),),WM_CLOSE,0,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 form1.Button3Click(self);
end;

end.


 
Anatoly Podgoretsky ©   (2008-11-07 11:34) [22]

> Alex_Ford  (07.11.2008 11:12:17)  [17]

Приказ, вокзал, дорога
Как видишь программист здесь не фигурирует.


 
Сергей М. ©   (2008-11-07 11:40) [23]


> Alex_Ford   (07.11.08 11:33) [21]


За каким лешим ты дважды вызываешь FindWindow ?
Один раз вызвал, нашел окно, получил его хэндл и передал параметром в PostMessage !


 
Alex_Ford   (2008-11-07 11:49) [24]

В посте 21 FindWindow я вызывал один раз.

Вот переделанный код. Кажется работает.


procedure TForm1.Timer1Timer(Sender: TObject);
begin
 for i:=0 to form1.CheckListBox1.Items.Count-1  do
 if checklistbox1.Items.Count = 0 then exit else
     if checkListBox1.Checked[i] = true then
     begin
     st:= checklistbox1.Items.Strings[i];
     if findwindow(nil,pchar(st))<>0 then
        postmessage(findwindow(nil,pchar(st),),WM_CLOSE,0,0);
        end;
end;


 
Alex_Ford   (2008-11-07 11:49) [25]

Удалено модератором


 
Anatoly Podgoretsky ©   (2008-11-07 11:57) [26]

> Alex_Ford  (07.11.2008 11:33:21)  [21]

Процессор нагревается когда он выполняет операции.


 
Anatoly Podgoretsky ©   (2008-11-07 11:58) [27]

> Сергей М.  (07.11.2008 11:40:23)  [23]

Что бы нагреть процессор.


 
Сергей М. ©   (2008-11-07 12:00) [28]


> Что бы нагреть процессор.
>


А прогу, соответственно, переименовать в Утюг.ехе


 
Правильный$Вася   (2008-11-07 12:01) [29]


> for i:=0 to form1.CheckListBox1.Items.Count-1  do
>   if checklistbox1.Items.Count = 0 then exit

просто песня!

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


 
Сергей М. ©   (2008-11-07 12:17) [30]


> Правильный$Вася   (07.11.08 12:01) [29]


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


 
Alex_Ford   (2008-11-07 12:21) [31]

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


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;



 
Сергей М. ©   (2008-11-07 12:42) [32]


> Alex_Ford   (07.11.08 12:21) [31]


Вызывай эту функцию с параметром st


 
Правильный$Вася   (2008-11-07 12:48) [33]


> Вызывай эту функцию с параметром st

у него заголовки окон, а не список экзешников


 
Alex_Ford   (2008-11-07 12:54) [34]

Товарищи!

Посмотрите, что так и что не так:

Сама функция убивающая ехе


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;




Обрабатываю в таймере с интервалом 3 секунды так.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 for i:=0 to form1.CheckListBox1.Items.Count-1  do
 if checklistbox1.Items.Count = 0 then exit else
     if checkListBox1.Checked[i] = true then
     begin
     st:= checklistbox1.Items.Strings[i];
     KillTask(st);     //уничтожим процессы из списка
end;


 
clickmaker ©   (2008-11-07 13:02) [35]

> for i:=0 to form1.CheckListBox1.Items.Count-1  do
> if checklistbox1.Items.Count = 0 then exit

сам-то понял, что написал?


 
Vlad Oshin ©   (2008-11-07 13:11) [36]

checklistbox1.Items.Strings[i]; это окна

GetWindowThreadProcessId  - процесс по окну

потом его kill


 
Johnmen ©   (2008-11-07 13:19) [37]

Как можно что-то объяснить человеку, если он ничего, кроме копи-паста, не знает и не умеет?


 
Anatoly Podgoretsky ©   (2008-11-07 16:35) [38]

И в 21 и в 24 все равно два раза

    if findwindow(nil,pchar(st))<>0 then
       postmessage(findwindow(nil,pchar(st),),WM_CLOSE,0,0);


 
clickmaker ©   (2008-11-07 16:49) [39]

> [38] Anatoly Podgoretsky ©   (07.11.08 16:35)
> И в 21 и в 24 все равно два раза

это на случай, если очень шустрый пользователь успеет переоткрыть окно между вызовами


 
Anatoly Podgoretsky ©   (2008-11-07 18:44) [40]

Так во втором случае нет проверки - а это уже ошибка в этом случае.



Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.12.21;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.55 MB
Время: 0.048 c
2-1226300937
cyborg
2008-11-10 10:08
2008.12.21
Что за ошибка "Отказано в доступе"?


4-1197385902
dest81
2007-12-11 18:11
2008.12.21
GetVolumeInformation


2-1226387812
Kesha
2008-11-11 10:16
2008.12.21
отправка рисунка на принтер


2-1226500334
Res
2008-11-12 17:32
2008.12.21
TJpegImage


2-1226277502
ЛамерЪХ
2008-11-10 03:38
2008.12.21
Поиск всех главных окон





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский