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.

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;

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;