Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.09.2011, 10:28   #1
Den7656
Форумчанин
 
Аватар для Den7656
 
Регистрация: 08.06.2011
Сообщений: 103
По умолчанию Не успеваю получить результат выполнения функции в процедуре

Приветствую Вас. С Delphi работаю совсем не давно и столкнулся с такими трудностями. А собственно, нужна помощь в таком вопросе.
По таймеру с интервалом 1 мс получаю список процессов, если нахожу новый - добавляю его в Memo, так же в процедуре OnTimer необходимо получить результат функции, которая по ProcessID возвращает полный путь.
PHP код:
procedure TMonitorForm.Timer1Timer(SenderTObject);
......
......
memo1.lines.add(ProcessFileName(strtoint(NewPIDList.Strings[i]))+' - '+NewPIDList.Strings[i]);
..... 
Вся проблема в том, что при интервале 1 мс функция не успевает возвратить результат и в Memo вместо полного пути файла (результата функции) добавляется пустая строка. При интервале таймера 1 сек. все работает отлично, но к сожалению мне нужен интервал не в 1 сек а в 1 мсек.

Список процессов получаю через
PHP код:
TlHelp32.CreateToolHelp32SnapShot(TlHelp32.TH32CS_SNAPPROCESS4); 
а полный путь с именем файла получаю через
PHP код:
GetModuleFileNameEx(Handle0PAnsiChar(Result), MAX_PATH
.

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

Ув. модеры, прошу извинения если поместил не в тот топик, думал разместить в API, но сама суть вопроса, как я думаю, из общих знаний по Delphi.
Жизнь хорошая штука -и⊥ʎdʞ ин ʞɐʞ

Последний раз редактировалось Den7656; 12.09.2011 в 10:45. Причина: Дополнение вопроса
Den7656 вне форума Ответить с цитированием
Старый 12.09.2011, 10:39   #2
veniside
Старожил
 
Регистрация: 03.01.2011
Сообщений: 2,508
По умолчанию

> функция не успевает возвратить результат

ерунда, причина в чём-то другом. Сам подход, когда в мемо пытаются занести некие значения 1000 раз в секунду в корне неверный.
Кто мешает собирать данные в TStringList, а затем из него несколько (но не 1000!) раз в секунду переносить строки в мемо.
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума Ответить с цитированием
Старый 12.09.2011, 10:39   #3
notHaker
Форумчанин
 
Аватар для notHaker
 
Регистрация: 01.12.2009
Сообщений: 569
По умолчанию

Эммм. Вот полезная статейка на вашу тематику - http://www.rsdn.ru/article/qna/baseserv/enumproc.xml. Если есть проблемы с синхронизацией, то есть ещё функции используемые вкупе с CreateToolHelp32SnapShot вот такие : Process32First и Process32Next, которые заполняют структуру PROCESSENTRY32 в которой есть такое вот поле - szExeFile, которое содежрит полный путь к ехе файлу.

Цитата:
когда в мемо пытаются занести некие значения 1000 раз
Солидарен. Мемо вообще отличается своими тормозами при обновлении строк, но 1000 раз в секунду это каэш перебор.
Код - это работа, а работа стоит денег.

pz-game.ru. 2d зомби-сурвивал для олдфагов.

Последний раз редактировалось notHaker; 12.09.2011 в 10:42.
notHaker вне форума Ответить с цитированием
Старый 12.09.2011, 10:47   #4
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Боюсь, все даже проще (хотя сказанное до меня верно, безусловно).. Можешь показать код процедуры на таймере?
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 12.09.2011, 10:50   #5
Den7656
Форумчанин
 
Аватар для Den7656
 
Регистрация: 08.06.2011
Сообщений: 103
По умолчанию

Да, но он (код) не пишет в Memo тысячу раз в секунду, он просто добавляет новый процесс в список, если он найден.

PHP код:
function ProcessFileName(PIDDWORD): string;
   var
     
HandleTHandle;
     
FullPath:boolean;
   
begin
        FullPath
:=true;
     
Result := '';
     
Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READFalsePID);
     if 
Handle <> 0 then
       
try
         
SetLength(ResultMAX_PATH);
         if 
FullPath then
         begin
           
if GetModuleFileNameEx(Handle0PAnsiChar(Result), MAX_PATH) > 0 then
             SetLength
(ResultStrLen(PAnsiChar(Result)))
           else
             
Result := '';
         
end
         
else
         
begin
           
if GetModuleBaseNameA(Handle0PAnsiChar(Result), MAX_PATH) > 0 then
             SetLength
(ResultStrLen(PAnsiChar(Result)))
           else
             
Result := '';
         
end;
       finally
         
CloseHandle(Handle);
       
end;
   
end;
.....................
.....................
.....................
.....................
procedure TMonitorForm.Timer1Timer(SenderTObject);
var
 
today TDateTime;
  
ProcessCountiDWORD;
  
pe32TlHelp32.TProcessEntry32;
  
HandleTHandle;
    
ProcInfoTProcessEntry32;
begin
today 
:= Time;
  
NewPIDList.Clear;
  
NewProcessList.Clear;
  
Handle := TlHelp32.CreateToolHelp32SnapShot(TlHelp32.TH32CS_SNAPPROCESS4);
  if 
Handle <> 0 then
  begin
      ProcInfo
.dwSize := SizeOf(ProcInfo);
    
pe32.dwSize := SizeOf(TlHelp32.ProcessEntry32);
    while 
TlHelp32.Process32Next(Handlepe32) = True do
    
begin
      NewPIDList
.Add(IntToStr(pe32.th32ProcessID));
      
NewProcessList.Add(pe32.szExeFile);
    
end;
    
CloseHandle(Handle);
  
end;

  if (
NewPIDList.Text <> PIDList.Textthen
  begin

    
if NewPIDList.Count 0 then
    begin
      
for := 0 to NewPIDList.Count do
      
begin
        
if PIDList.IndexOf(NewPIDList.Strings[i]) = -1 then
        begin

          
if not RefreshFirstTime then
         begin
// memo add
ADD('1',            // номер
TimeToStr(today),  // время
'RUN'// action
NewProcessList.Strings[i], //process
inttostr(gethandle(NewProcessList.Strings[i])),  //handle
NewPIDList.Strings[i],  //PID
ProcessFileName(strtoint(NewPIDList.Strings[i]))+' - '+NewPIDList.Strings[i], //path
'86776'// размер
'g'); // цвет
application.processmessages;
          
end;
        
end;
      
end;
    
end
а насчет szExeFile - она возвращает только имя файла, а не его полный путь с именем.
Жизнь хорошая штука -и⊥ʎdʞ ин ʞɐʞ

Последний раз редактировалось Den7656; 12.09.2011 в 10:56. Причина: Дополнение вопроса
Den7656 вне форума Ответить с цитированием
Старый 12.09.2011, 10:57   #6
veniside
Старожил
 
Регистрация: 03.01.2011
Сообщений: 2,508
По умолчанию

Нда уж.. application.processmessages; вызывает новый вход в обработчик таймера (т.к. 1 мс уже давно прошла), где вы первым делом делаете NewPIDList.Clear();, и когда этот повторный обработчик выходит, управление возвращается в ваш цикл "for i := 0 to NewPIDList.Count - 1 do".. как это всё работает, одному БГ известно.

Проще всего не входить в обработчик таймера повторно, проверять флаг глобальный.
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума Ответить с цитированием
Старый 12.09.2011, 11:03   #7
notHaker
Форумчанин
 
Аватар для notHaker
 
Регистрация: 01.12.2009
Сообщений: 569
По умолчанию

Цитата:
а насчет szExeFile - она возвращает только имя файла, а не его полный путь с именем.
Ссори. В документации говорится про путь к файлу.

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

Application.porcessmessages в таймере не нужен.
Код - это работа, а работа стоит денег.

pz-game.ru. 2d зомби-сурвивал для олдфагов.
notHaker вне форума Ответить с цитированием
Старый 12.09.2011, 11:04   #8
Den7656
Форумчанин
 
Аватар для Den7656
 
Регистрация: 08.06.2011
Сообщений: 103
По умолчанию

Как проверить глобальный флаг не знаю. Попробовал убрать application.processmessages и получать полный путь с именем файла в самой процедуре OnTimer, все равно результат - пустая строка.
Жизнь хорошая штука -и⊥ʎdʞ ин ʞɐʞ
Den7656 вне форума Ответить с цитированием
Старый 12.09.2011, 11:07   #9
Den7656
Форумчанин
 
Аватар для Den7656
 
Регистрация: 08.06.2011
Сообщений: 103
По умолчанию

Ладно, попробую поиздеваться еще над этим кодом, может че и получится
Если нет, буду разбираться с Hook'ами.
Жизнь хорошая штука -и⊥ʎdʞ ин ʞɐʞ
Den7656 вне форума Ответить с цитированием
Старый 12.09.2011, 11:09   #10
veniside
Старожил
 
Регистрация: 03.01.2011
Сообщений: 2,508
По умолчанию

Проверять просто:

Код:
var
  flag: Boolean = false;

procedure TMonitorForm.Timer1Timer(Sender: TObject);
begin
  if (not flag) then begin
    //
    flag := True;
    try
      // тут ваш код
    finally
      flag := False;
    end;
  end;
end;
Но и сам вызов CreateToolHelp32SnapShot() 1000! раз в секунду попахивает керосином. Надо менять подход.
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как проверить результат выполнения хранимой процедуры kizl БД в Delphi 2 09.05.2011 19:33
Результат выполнения программы g001501 Общие вопросы C/C++ 19 03.11.2010 21:16
Определить результат выполнения программы. Joker<777> Паскаль, Turbo Pascal, PascalABC.NET 2 23.04.2010 02:15
Математика. Получить параметр функции зная результат Stilet Общие вопросы по программированию, компьютерный форум 2 06.03.2009 08:51
как отобразить в dbgrid результат выполнения commandText двух adodataset? Гузель БД в Delphi 2 13.08.2008 16:17