VPF::почему не срабатывает таймер? - Форум программистов

MetalFan

Дата 30.10.2007, 21:17 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

кста, и почему bManualReset = false?

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

There are always someone smarter than you...

Dmitry_177

Дата 30.10.2007, 21:54 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Цитата

так а кто ж его дёрнет, чтобы WaitForSingleObject вышла?

в другой программе..

Dmitry_177

Дата 30.10.2007, 22:56 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Цитата

кста, и почему bManualReset = false?

событие с автоматическим сбросом =)

MetalFan

Дата 31.10.2007, 08:58 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

Dmitry_177, а зачем? ) если "ожидатель" только один, то ладно.

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

There are always someone smarter than you...

maxim1000

Дата 31.10.2007, 12:06 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 3334
Регистрация: 11.1.2003
Где: Киев

Репутация: нет
Всего: 110

Цитата(Dmitry_177 @ 30.10.2007, 21:54

)

в другой программе..

ну, похоже на то, что программа та программа не дёргает...

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

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

qqq

Dmitry_177

Дата 31.10.2007, 19:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

не.. та именно дергает.. вот код из другой программы которая дергает:

Код


  hEvent := CreateEvent(nil, false, false, EventName);
  SetEvent(hEvent);
  CloseHandle(hEvent);

EventName - строковая константа, и там и там одна и таже..

MetalFan

Дата 31.10.2007, 20:10 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

Dmitry_177, а где проверка на возможные ошибки?

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

There are always someone smarter than you...

Dmitry_177

Дата 31.10.2007, 20:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

MetalFan, чтобы сократить код я их убрал, я показал сам смысл я в той программе дергаю это событие..

maxim1000

Дата 31.10.2007, 22:32 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 3334
Регистрация: 11.1.2003
Где: Киев

Репутация: нет
Всего: 110

хм... а не получается ли так:
1. первая программа создаёт событие
2. дёргает его
3. успевает удалить его до того, как его откроет вторая программа
4. вторая программа создаёт уже новое событие
и т.д.
?

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

qqq

Dmitry_177

Дата 31.10.2007, 22:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Цитата

да нет.. не может быть такого в моем случае..

я вот думаю, может этот SleepEx срабатывает первей и не дает сработать WaitForSingleObject-у в другом потоке?

maxim1000

Дата 1.11.2007, 00:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 3334
Регистрация: 11.1.2003
Где: Киев

Репутация: нет
Всего: 110

в общем, лучше было бы выложить тут два текста программ, которые ведут себя вышеописанным способом, если они, конечно, не очень большие (тогда их стоит минимизировать с сохранением непонятного поведения)

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

qqq

Dmitry_177

Дата 1.11.2007, 01:15 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Ок, и так поехали:

первая программа, та которая устанавливает таймеры и реагирует на событие для считывания новых таймеров из файла(запущена постоянно):

Код


program TimeServ;

uses
  Windows,
  Messages,
  ShFolder,
  Classes,
  IniFiles,
  SysUtils;

const
  EventName = '{58F4D8A4-CAD7-46DA-A3D1-238B95659E68}';

type
  PDataTimer = ^TDataTimer;

  TDataTimer = packed record   // структура, адрес переменной которой передается в TimerAPCProc
    hTimer: THandle;
    StrDateTime: PChar;
  end;

var
  hEvent: THandle;
  idThread: DWORD;
  hTimers: array of THandle;
  StrFilePath: string;
  Sections: TStrings;

function GetStrFilePath: string;
var
  StrBuffer: array [0 .. MAX_PATH - 1] of Char;
  StrAppDataFolder: string;
begin
  ShGetFolderPath(0, CSIDL_APPDATA, 0, 0, StrBuffer);
  StrAppDataFolder := StrBuffer + '\TimeManager';
  if not DirectoryExists(StrAppDataFolder) then
    ForceDirectories(StrAppDataFolder);
  Result := StrAppDataFolder + '\TimeManager.ini';
end;

procedure TimerAPCProc(lpArgToCompletionRoutine: PDataTimer; dwTimerLowValue: DWORD; dwTimerHighValue: DWORD); stdcall;
begin
  with TIniFile.Create(StrFilePath) do
    try
      if MessageBox(0, PChar(ReadString(lpArgToCompletionRoutine.StrDateTime, 'Note', '') + #13#10#13#10 + 'Удалить это напоминание?'), 'Напоминание', MB_ICONQUESTION or MB_YESNO) = idYes then
        begin
          CancelWaitableTimer(lpArgToCompletionRoutine.hTimer);
          CloseHandle(lpArgToCompletionRoutine.hTimer);
          EraseSection(lpArgToCompletionRoutine.StrDateTime);
          Dispose(lpArgToCompletionRoutine);
        end;
    finally
      Free;
    end;
end;

procedure InstallTimers;
var
  iTimer: integer;
  sysTime: SYSTEMTIME;
  fTime: FILETIME;
  DataTimer: PDataTimer;
begin
  with TIniFile.Create(StrFilePath) do
    try
      ReadSections(Sections);
      if Sections.Count > 0 then
        begin
          SetLength(hTimers, Sections.Count);
          for iTimer := 0 to Sections.Count - 1 do
            begin
              hTimers[iTimer] := CreateWaitableTimer(nil, false, nil);
              DateTimeToSystemTime(StrToDateTime(Sections[iTimer]), sysTime);
              SystemTimeToFileTime(sysTime, fTime);
              LocalFileTimeToFileTime(fTime, fTime);
              New(DataTimer);
              DataTimer.hTimer := hTimers[iTimer];
              DataTimer.StrDateTime := PChar(Sections[iTimer]);
              SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), Round(Frac(StrToDateTime(ReadString(Sections[iTimer], 'Period', '0'))) * 86400) * 1000, @TimerAPCProc, DataTimer, false);   // период записывается в формате DateTime, перевожу в миллисекунды
            end;
        end;
    finally
      Free;
    end;
end;

procedure UninstallTimers;
var
  iTimer: integer;
begin
  for iTimer := 0 to Length(hTimers) - 1 do
    begin
      CancelWaitableTimer(hTimers[iTimer]);
      CloseHandle(hTimers[iTimer]);
    end;
  SetLength(hTimers, 0);
  Sections.Clear;
end;

function ThreadEvent(Param: Pointer): DWORD; stdcall;
begin
  while true do
    begin
      if WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0 then
        begin
          UninstallTimers;
          InstallTimers;
        end;
    end;
  Result := 0;
end;

begin
  StrFilePath := GetStrFilePath; 
  Sections := TStringList.Create;

  InstallTimers;

  hEvent := CreateEvent(nil, false, false, EventName);
  CloseHandle(CreateThread(nil, 0, @ThreadEvent, nil, 0, idThread));

  while true do
    SleepEx(INFINITE, True);

  UninstallTimers;
  Sections.Free;
end.

теперь вторая, та которая записывает таймеры и дергает событие(запускается нерегулярно):
в ней в принципе ничего сложного нету, она записывает в файл таймеры, которые вводятся с использованием форм и по завершению дергает событие.. Я думаю саму запись ненужно показывать, приведу FormClose, который собственно и дергает событие:

Код


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);   // Close
var
  hEvent: THandle;
begin
  hEvent := CreateEvent(nil, false, false, EventName);
  if hEvent = INVALID_HANDLE_VALUE then
    Exit;
  if GetLastError = ERROR_ALREADY_EXISTS then
    SetEvent(hEvent);
  CloseHandle(hEvent);
end;

Код трассировал, SetEvent срабатывает, т.е. само событие 100% дергается..

Это сообщение отредактировал(а) Dmitry_177 - 1.11.2007, 01:27

dumb

Дата 1.11.2007, 04:06 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 7
Всего: 158

Цитата(Dmitry_177 @ 30.10.2007, 19:00

)

т.е. дело в том что событие не срабатывает..

подозреваю, что событие то срабатывает, а вот таймеры после переустановки - уже нет. и причина тому очевидна - ты устанавливаешь заново таймеры в рабочем потоке, который вовсе не находится в alertable-состоянии во время ожидания события hEvent.

надо сделать примерно так:

Код


function ThreadEvent(Param: Pointer): DWORD; stdcall;
begin
  while true do
    begin
      if WaitForSingleObjectEx(hEvent, INFINITE, true) = WAIT_OBJECT_0 then
        begin
          UninstallTimers;
          InstallTimers;
        end;
    end;
  Result := 0;
end;

begin
  StrFilePath := GetStrFilePath;
  Sections := TStringList.Create;
//  InstallTimers;
  hEvent := CreateEvent(nil, false, false, EventName);
  SetEvent(hEvent); // initial install timers
  hThread := CreateThread(nil, 0, @ThreadEvent, nil, 0, idThread);
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
  UninstallTimers;
  Sections.Free;
end.

MetalFan

Дата 1.11.2007, 08:49 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

давай код примера приложения в аттач... что так пальцем в небо тыкать...

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

There are always someone smarter than you...

Dmitry_177

Дата 1.11.2007, 23:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Я сделал вот так:

Код


InstallTimers;

hEvent := CreateEvent(nil, false, false, EventName);
while true do
 begin
   if WaitForSingleObjectEx(hEvent, INFINITE, True) = WAIT_OBJECT_0 then
     begin
       UninstallTimers;
       InstallTimers;
     end;
 end;

и все заработало smile

кстати мы создаем в InstallTimers, структуры TDataTimer: New(DataTimer); удаляем их в TimerAPCProc: Dispose(lpArgToCompletionRoutine);.. А если время срабатывания будет удалено в той второй программе, то получается DataTimer не удалится?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »