TiltTeamsPresence/main.pas

(*************************************************
 * MAIN                                          *
 *                                               *
 * This delphi application sends three MOUSE UP  *
 * signals at the current position, every minute *
 * making Teams think you're active.             *
 * This helps make you always appear with a      *
 * green icon in Teams.                          *
 *                                               *
 * Use it accordingly to your company's policy.  *
 *                                               *
 * In no way could Tiltsoft or anybody related   *
 * to it may be responsible for any damage, harm *
 * or loss. This software is provided as-is with *
 * no responsability or guarantee whatsoever.    *
 *                                               *
 * (C) TiltSoft - 2026 to present                *
 *************************************************)
unit main;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, System.Threading,
   System.Types ;

type
   TfrmMain = class(TForm)
      btnStart    : TButton      ;
      progressBar : TProgressBar ;
      lblStatus   : TLabel       ;
      procedure FormCreate(Sender: TObject)    ;
      procedure btnStartClick(Sender: TObject) ;
      procedure FormClose(Sender: TObject; var Action: TCloseAction) ;

   private
      { Private declarations }
      FMyTask    : ITask   ;
      currentPos : TPoint  ;
      counter    : Integer ;
      procedure startTask  ;
      procedure stopTask   ;

   public
      { Public declarations }
   end;

var
   frmMain   : TfrmMain ;
   runIt     : Boolean  ;

implementation

{$R *.dfm}


(*************************************************
 * FORMCREATE                                    *
 *                                               *
 * Initialise the variables.                     *
 *************************************************)
procedure TfrmMain.FormCreate(Sender: TObject);
begin
   runIt      := False ;
   currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ;
   counter    := 0     ;
end;


(*************************************************
 * FORMCLOSE                                     *
 *                                               *
 * Stop any thread and close gracefully.         *
 *************************************************)
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   btnStart.Caption := '- Cleaning -' ;
   stopTask   ;
   Sleep(500) ;
   Application.Terminate ;
end;


(*************************************************
 * BUTTONSTARTCLICK                              *
 *                                               *
 * Start the fake activity by launching the      *
 * main thread that sends the clicks.            *
 * It changes the button caption to match the    *
 * fake "battery monitoring" action.             *
 *************************************************)
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
   runIt := NOT runIt ;
   if runIt then
      begin
         btnStart.Caption := 'Stop Monitoring' ;
         startTask ;
      end
   else
      begin
         btnStart.Caption := 'Start Monitoring' ;
         stopTask ;
      end;
end;


(*************************************************
 * STARTTASK                                     *
 *                                               *
 * This starts a background thread that tricks   *
 * Windows into thinking you're releasing the    *
 * mouse UP button thrice, sending an activity   *
 * message to your computer and Teams monitoring *
 *************************************************)
procedure TfrmMain.startTask;
begin
   lblStatus.Caption := 'Measuring' ;
  // Create and start the background task
  FMyTask := TTask.Run(
    procedure
    begin

     // Check if the Stop button was clicked
     if TTask.CurrentTask.Status = TTaskStatus.Canceled then
       Exit; // Gracefully exit the thread loop


     // Simulate work (e.g., 500ms step)
     while runIt do
     begin

     Sleep(1000);

     // Safely update the UI progress
     TThread.Queue(nil,
       procedure
       begin
         counter := counter + 1 ;
         if counter >= 60 then
         begin
            counter := 0 ;
           mouse_event(MOUSEEVENTF_LEFTUP, 0, mouse.CursorPos.X, mouse.CursorPos.Y, 0);
 	        Sleep(150);
           mouse_event(MOUSEEVENTF_LEFTUP, 0, mouse.CursorPos.X, mouse.CursorPos.Y, 0);
 	        Sleep(50);
           mouse_event(MOUSEEVENTF_LEFTUP, 0, mouse.CursorPos.X, mouse.CursorPos.Y, 0);
         end
        end)
      end
    end) ;
end;


(*************************************************
 * STOPTASK                                      *
 *                                               *
 * Stops the thread if running in background.    *
 * This will stop sending fake mouse activity    *
 * events to Windows.
 *************************************************)
procedure TfrmMain.stopTask;
begin
   if (FMyTask <> nil ) then
   begin
      runIt             := False ;
      lblStatus.Caption := ''    ;
      FMyTask.Cancel             ;
   end;
end;

end.