WinAPI Timers unit

unit Timers;
(*
  Timer class, based on WinAPI SetTimer
  Version: 1.1
  Date:    08.08.2013
  Author:  HEX0x29A

  History:
  07.08.2013 - 1.0
  *First version
  08.08.2013 - 1.1
  *Added KillTimer injection into lpTimerFunc instead of user callback
*)
interface

uses
  Windows;

type
  TTimer = class
  private
    ATimerInterval: UINT;
    ATimerId      : UINT;
    ATimerProc    : Pointer;
    ATimerEvent   : Pointer;
    function  TimerProcToMem(TimerProc: Pointer): Pointer;
    function  GetTimerEnabled: BOOL;
    procedure TimerFreeMem;
    procedure SetTimerInterval(const Value: UINT);
    procedure SetTimerEnabled(const Value: BOOL);
    procedure SetTimerEvent(const Value: Pointer);
  public
    constructor Create(const Interval : UINT    = 1000;
                       const TimerProc: Pointer = nil;
                       const Enabled  : BOOL    = False);
    destructor  Destroy; override;
    property    Enabled: BOOL       read GetTimerEnabled write SetTimerEnabled;
    property    Interval: UINT      read ATimerInterval  write SetTimerInterval;
    property    TimerEvent: Pointer read ATimerEvent     write SetTimerEvent;
  end;

implementation

type
  //Структура - переходник с системного обработчика lpTimeFunc на пользовательский
  TTimerProcAsm = packed record  //E8 FF FF FF FF 83 C4 10 C3
    _call: BYTE;  //E8          | CALL
    _addr: DWORD; //FF FF FF FF | TimerProc / (DestAddr(TimerProc)-CallAddr(ThisCallInMemory)-5(BinCallLengthInBytes))
    _end : DWORD; //83 C4 10 C3 | ADD ESP, 10 / RET (Pop 4x4 bytes from stack and return)
  end;

{ TTimer }

//Создание объекта с возможностью быстрого старта таймера
//Interval - Интервал срабатывания таймера
//TimerProc - Функция-обработчик пользователя
//Enabled - Активация/Деактивация таймера
constructor TTimer.Create(const Interval : UINT    = 1000;
                          const TimerProc: Pointer = nil;
                          const Enabled  : BOOL    = False);
begin
  ATimerProc := nil;           //Очищаем адрес обработчика
  ATimerId   := 0;             //Обнуляем Id таймера
  if Interval > 0 then         //Если интервал положительный
    ATimerInterval := Interval //Сохраняем его
  else                         //иначе
    ATimerInterval := 0;       //выставляем 0
  SetTimerInterval(Interval);  //Устанавливаем интервал
  SetTimerEvent(TimerProc);    //Устанавливаем пользовательский обработчик
  SetTimerEnabled(Enabled);    //Активируем таймер
end;

//Деструктор
destructor TTimer.Destroy;
begin
  TimerFreeMem; //убиваем таймер, если включен, и чистим память
  inherited;
end;

//Возвращает состаяние таймера
function TTimer.GetTimerEnabled: BOOL;
begin
  //Если ATimerId не ноль, значит таймер работает
  Result := (ATimerId <> 0);
end;

//Активация/Деактивация таймера
procedure TTimer.SetTimerEnabled(const Value: BOOL);
begin
  //Если "Включить", не включен сейчас и обработчик с интервалом заданы
  if (Value)and(not Enabled)and(ATimerProc <> nil)and(ATimerInterval > 0) then
  begin
    TimerProcToMem(ATimerEvent); //Восстанавливаем обработчик
    if ATimerProc <> nil then    //Если всё успешно
      //Пускаем новый таймер с установленными параметрами и текущим Id
      ATimerId := SetTimer(0, ATimerId, ATimerInterval, ATimerProc);
  end else                       //Иначе
    if Enabled then              //Если таймер включен
      TimerFreeMem;              //чистим память
end;

//Установка функции-обработчика пользователя
procedure TTimer.SetTimerEvent(const Value: Pointer);
begin
  ATimerEvent := Value;        //сохраняем обработчик
  TimerProcToMem(ATimerEvent); //устанавливаем новый обработчик
end;

//Установка интервала срабатывания таймера
procedure TTimer.SetTimerInterval(const Value: UINT);
begin
  //Если интервал положительный и не равен текущему
  if (Value > 0)and(value <> ATimerInterval) then
  begin
    ATimerInterval := Value;        //устанавливаем новый интервал
    if Enabled then                 //Если таймер включен
    begin
      TimerFreeMem;                 //чистим память
      TimerProcToMem(ATimerEvent);  //Восстанавливаем обработчик
      if ATimerProc <> nil then     //Если всё успешно
        //Пускаем новый таймер с новым интервалом и текущим Id
        ATimerId := SetTimer(0, ATimerId, ATimerInterval, ATimerProc);
    end;
  end else                          //иначе
    ATimerInterval := Value;        //устанавливаем новый интервал
end;

//Функция освобождения памяти с предварительной остановкой таймера
procedure TTimer.TimerFreeMem;
begin
  if ATimerProc = nil then                     //Если обработчик ведёт вникуда
    Exit;                                      //выходим
  if (ATimerProc <> nil)or(ATimerId <> 0) then //Если память выделена или таймер работает
  begin
    //Убиваем таймер
    if not KillTimer(0, ATimerId) then begin   //Если не убился
      //Инжектим вместо обработчика юзера KillTimer без параметров, т.к.
      //нужные hWnd и nIDEvent уже в стеке, остались от lpTimeFunc
      TimerProcToMem(@KillTimer);
    end;
    VirtualFree(ATimerProc, SizeOf(TTimerProcAsm), MEM_RELEASE); //Освобождаем память
    ATimerId   := 0;                           //Обнуляем id
    ATimerProc := nil;                         //обнуляем обработчик
  end;
end;

//Функция выделения памяти с последующей записью в неё
//переходника с lpTimeFunc на обработчик юзера
//TimerProc - VA обработчика пользователя (@UserProc)
function TTimer.TimerProcToMem(TimerProc: Pointer): Pointer;
var
  BytesWritten: DWORD;
  TimerProcAsm: TTimerProcAsm;
begin
  Result := nil;
  if TimerProc = nil then       //Если обработчик ведёт вникуда
  begin
    TimerFreeMem;               //чистим всё
    Exit;                       //и выходим
  end;
  if ATimerProc = nil then      //Если обработчик ведёт вникуда
    //выделяем память под переходник с lpTimeFunc на обработчик юзера
    ATimerProc := VirtualAlloc(nil, SizeOf(TTimerProcAsm), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  if ATimerProc <> nil then     //Если память выделена
  begin
    with TimerProcAsm do        //Заполняем структуру - переходник
    begin
      _call := $E8;             //call
      _addr := DWORD(DWORD(TimerProc) - 5 - DWORD(ATimerProc)); //offset обработчика юзера
      if not (TimerProc = @KillTimer) then                      //Если обработчик не KillTimer
        _end:= $C310C483        //add esp, 10 / ret чистим стек от 4x параметров по соглашению stdcall и делаем возврат системе
      else                      //иначе
        _end:= $C308C483;       //add esp, 08 / ret чистим стек от 2x параметров, т.к. 2 взял KillTimer
    end;
    //Пишем в выделенную память текущего процесса структуру - переходник
    if WriteProcessMemory(GetCurrentProcess, ATimerProc, @TimerProcAsm, SizeOf(TTimerProcAsm), BytesWritten)
    and(BytesWritten <> 0) then //если записалось
      Result := ATimerProc      //сохраняем адрес памяти
    else                        //иначе
      TimerFreeMem;             //чистим память
  end;
end;

end.