Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

почему не срабатывает таймер? [D7, WinXP]


Страницы:   1 2 3

Dmitry_177 ©   (2007-10-29 13:44:00) 

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


program TimeServ;

uses
 Windows,
 Messages,
 Classes,
 IniFiles,
 SysUtils;

var
 AMessage: TMsg;
 hTimers: array of THandle;

procedure TimerAPCProc(lpArgToCompletionRoutine: PChar; dwTimerLowValue: DWORD; dwTimerHighValue: DWORD); stdcall;
begin
 MessageBox(0, '1', '1', 0);  // не срабатывает почему то..
end;

function InstallTimers: BOOL;
var
 Sections: TStrings;
 iTimer: integer;
 sysTime: SYSTEMTIME;
 fTime: FILETIME;
begin
   try
     Sections := TStringList.Create;

     with TIniFile.Create('TimeManager.ini') 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);  // запись происходит функцией DateTimeToStr, в переменной sysTime смотрел дата с временем правильно считывается..
                 SystemTimeToFileTime(sysTime, fTime);
                 LocalFileTimeToFileTime(fTime, fTime);
                 SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), 0, @TimerAPCProc, nil, false);
               end;
           end;
       finally
         Free;
       end;

   finally
     Sections.Free;
   end;
end;

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

begin
 InstallTimers;

 while GetMessage(AMessage, 0, 0, 0) do
   DispatchMessage(AMessage);

 UninstallTimers;
end.


Подскажите пожалуйста..

Dmitry_177   (2007-11-05 14:02:00) [1]

на самом деле как тогда удалять DataTimer? вот задам я таймер в той программе, в этой создастся DataTimer и установится таймер.. А потом в той программе удалю этот таймер.. то что будет с DataTimer? Как его удалять?

Dmitry_177   (2007-11-01 23:33:00) [2]

а действительно так заработало, как я написал в Dmitry_177   (01.11.07 21:58) [51]

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

Leonid Troyanovsky   (2007-11-01 22:11:00) [3]


> Dmitry_177   (01.11.07 21:58) [51]

RTFM бы ты, Джеф Рихтер: Windows для профи.
Ну, или, хотя б, msdn.

--
Regards, LVT.

Dmitry_177   (2007-11-01 21:58:00) [4]


> Чем не устроила WaitForSingleObjectEx прямо в основном потоке
> ?

А как ее применить в основном потоке? Вот так?


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;

Сергей М.   (2007-11-01 16:52:00) [5]

А нафига этот поток нужен вообще ?

Чем не устроила WaitForSingleObjectEx прямо в основном потоке ?
И почем в осн.потоке нет цикла вызова Ex-функции ? Ты вообще в [8] вник ?

Dmitry_177   (2007-11-01 16:48:00) [6]

смотрел, 100% совпадают.. еслиб даже не совпадали бы то в FormClose не сработало бы условие: if GetLastError = ERROR_ALREADY_EXISTS then Значение EventName как вы наверно догадались я генерировал Ctl+Shift+G

Сергей М.   (2007-11-01 16:43:00) [7]

Значит константы EventName в этих проектах не совпадают.

Dmitry_177   (2007-11-01 16:32:00) [8]

странно, но почему тогда событие не работает? останавливается на WaitForSingleObject в ThreadEvent и все..

Сергей М.   (2007-11-01 16:26:00) [9]

Все понятно.
Но причем здесь SleepEx ? Она не имеет никакого отношения к потоку, выполняющему ф-цию ThreadEvent.

Dmitry_177   (2007-11-01 16:16:00) [10]

странно почему тогда оно не срабатывает, приведу весь код:

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

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% дергается..

Сергей М.   (2007-11-01 16:12:00) [11]

Каким боком SleepEx относится к "срабатыванию события" ?
Никаким.

Dmitry_177   (2007-11-01 16:08:00) [12]

чтобы в такой "конструкции" событие срабатывало или может как-то подругому сделать..

Сергей М.   (2007-11-01 15:51:00) [13]


> Dmitry_177   (01.11.07 15:37) [41]



> SleepEx уже не спасает


А от чего он должен "спасти" ?

От "несрабатывания таймера" он тебя "спас", что ты еще от него хочешь ?

Dmitry_177   (2007-11-01 15:37:00) [14]

Dmitry_177   (30.10.07 18:59) [35] и Dmitry_177   (30.10.07 19:07) [36]

Сергей М.   (2007-11-01 08:30:00) [15]

Причем здесь другой поток ?

SleepEx у тебя сработал ? Сработал.
TimerAPCProc вызывается при этом ? Вызывается.
Ответ на вопрос ты получил ? Получил.

Так в чем же дело ?

Dmitry_177   (2007-10-31 21:59:00) [16]

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

Сергей М.   (2007-10-31 08:20:00) [17]


> SleepEx уже не спасает


> останавливается на WaitForSingleObject и все


У попа была собака..

Goto [4]

MetalFan   (2007-10-30 21:28:00) [18]

тебе не надоело на куче формов одно и то же писать? ))

Dmitry_177   (2007-10-30 19:07:00) [19]

т.е. дело в том что событие не срабатывает.. сделал трассировку, в функции события ThreadEvent останавливается на WaitForSingleObject и все..

Dmitry_177   (2007-10-30 18:59:00) [20]

Блин! Решил еще добавить событие на считывание новых значений из этого же файла.. SleepEx уже не спасает..


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;

...
 InstallTimers;

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

 while true do
   SleepEx(INFINITE, True);

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо