First Release

- Cleaned up useless actions
- Removed fake clicks to focus only on Mouse UP events
- Gracefully terminate threads when stoping or leaving the application
This commit is contained in:
Steve Jordi 2026-09-30 17:07:32 +02:00
commit 758cc6be4b
4 changed files with 1418 additions and 1352 deletions

File diff suppressed because it is too large Load diff

View file

@ -1,26 +1,43 @@
# TiltTeamPresence # TiltTeamPresence
Simulates a fake activity on your computer by moving the mouse back and forth by 2 pixels to keep the session active. ##What it does
Fake "battery health measurement" app that actually moves the mouse 2 pixels in each directions, back and forth. This Windows application simulates a fake activity on your computer by sending fake Mouse UP signals to Windows to keep the Teams session active.
This is to simulate an activity from the user so that apps like Teams don't switch the Green status to Orange one (present but inactive).
It uses a thread so the user still can click the Stop button to regain control. 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 at your own risks and responsabilities.
It has not been tested with other solutions, but it should have the same effect on them since Windows is handling the activity.
2029-09-29
Initial push
## Warning
2029-09-29 Use it accordingly to your company's policy.
Requires to add a click at 0:0 each 1 minute as moving the mouse is not enough for Teams
procedure ClickAt(X, Y: Integer); ## Disclaimer
begin In no way could Tiltsoft or anybody related to it may be responsible for any damage, harm or any kind of loss.
// Move cursor to specific screen coordinates This software is provided as-is with no responsabilities or guarantees whatsoever.
SetCursorPos(X, Y);
## The name
// Simulate mouse button press and release To make the app less suspicious, it has been named BatterHealth so the users can prentend they are monitoring the battery helath of their computer.
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); ## Info for developers
end; The app has been written with Delphi 13.n but should work with most lower versions.
It uses only default VCL components.
The app uses a thread in order not to steal the resources and also lets the user still click the Stop button to regain control and stop the fake activity.
## License
Creative Commons Attribution-NonCommercial-ShareAlike (CC BY-NC-SA 4.0)
If you use this code you have to follow the following:
* BY (Attribution): You must give credit to this original.
* NC (Non-Commercial): You never can use it or sell it for commercial advantages or monetary compensation.
There is a permanent ban on monetization of parts or full source code.
* SA (ShareAlike): If you modify or fork it, you must share your modified version under this exact same license—ensuring your forks stay free forever.
## Copyrights
(C) TiltSoft - 2026 to presenty<br>
https://www.tiltsoft.com

View file

@ -10,6 +10,7 @@ object frmMain: TfrmMain
Font.Height = -12 Font.Height = -12
Font.Name = 'Segoe UI' Font.Name = 'Segoe UI'
Font.Style = [] Font.Style = []
OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
TextHeight = 15 TextHeight = 15
object lblStatus: TLabel object lblStatus: TLabel
@ -19,6 +20,21 @@ object frmMain: TfrmMain
Height = 15 Height = 15
AutoSize = False AutoSize = False
end end
object progressBar: TProgressBar
Left = 8
Top = 39
Width = 273
Height = 20
Enabled = False
ParentShowHint = False
Position = 87
MarqueeInterval = 0
BarColor = clLime
Step = 1
State = pbsPaused
ShowHint = False
TabOrder = 1
end
object btnStart: TButton object btnStart: TButton
Left = 8 Left = 8
Top = 8 Top = 8
@ -28,17 +44,4 @@ object frmMain: TfrmMain
TabOrder = 0 TabOrder = 0
OnClick = btnStartClick OnClick = btnStartClick
end end
object progressBar: TProgressBar
Left = 8
Top = 39
Width = 273
Height = 17
Enabled = False
Position = 87
MarqueeInterval = 0
BarColor = clLime
Step = 1
State = pbsPaused
TabOrder = 1
end
end end

298
main.pas
View file

@ -1,125 +1,173 @@
unit main; (*************************************************
* MAIN *
interface * *
* This delphi application sends three MOUSE UP *
uses * signals at the current position, every minute *
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, * making Teams think you're active. *
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, System.Threading; * This helps make you always appear with a *
* green icon in Teams. *
type * *
TfrmMain = class(TForm) * Use it accordingly to your company's policy. *
btnStart: TButton; * *
progressBar: TProgressBar; * In no way could Tiltsoft or anybody related *
lblStatus: TLabel; * to it may be responsible for any damage, harm *
procedure FormCreate(Sender: TObject); * or loss. This software is provided as-is with *
procedure btnStartClick(Sender: TObject); * no responsability or guarantee whatsoever. *
* *
private * (C) TiltSoft - 2026 to present *
{ Private declarations } *************************************************)
FMyTask : ITask ; unit main;
currentPos : TPoint ;
counter : Integer ; interface
procedure startTask ;
procedure stopTask ; uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
public Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, System.Threading,
{ Public declarations } System.Types ;
end;
type
var TfrmMain = class(TForm)
frmMain : TfrmMain ; btnStart : TButton ;
direction : Boolean ; progressBar : TProgressBar ;
runIt : Boolean ; lblStatus : TLabel ;
procedure FormCreate(Sender: TObject) ;
implementation procedure btnStartClick(Sender: TObject) ;
procedure FormClose(Sender: TObject; var Action: TCloseAction) ;
{$R *.dfm}
private
{ Private declarations }
FMyTask : ITask ;
currentPos : TPoint ;
procedure TfrmMain.FormCreate(Sender: TObject); counter : Integer ;
begin procedure startTask ;
direction := False ; procedure stopTask ;
runIt := False ;
currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ; public
counter := 0 ; { Public declarations }
end; end;
var
frmMain : TfrmMain ;
procedure TfrmMain.btnStartClick(Sender: TObject); runIt : Boolean ;
begin
runIt := NOT runIt ; implementation
if runIt then
begin {$R *.dfm}
btnStart.Caption := 'Stop Monitoring' ;
startTask ;
end (*************************************************
else * FORMCREATE *
begin * *
btnStart.Caption := 'Start Monitoring' ; * Initialise the variables. *
stopTask ; *************************************************)
end; procedure TfrmMain.FormCreate(Sender: TObject);
end; begin
runIt := False ;
currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ;
procedure TfrmMain.startTask; counter := 0 ;
begin end;
lblStatus.Caption := 'Measuring' ;
// Create and start the background task
FMyTask := TTask.Run( (*************************************************
procedure * FORMCLOSE *
begin * *
// Check if the Stop button was clicked * Stop any thread and close gracefully. *
if TTask.CurrentTask.Status = TTaskStatus.Canceled then *************************************************)
Exit; // Gracefully exit the thread loop procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btnStart.Caption := '- Cleaning -' ;
// Simulate work (e.g., 500ms step) stopTask ;
while runIt do Sleep(500) ;
begin Application.Terminate ;
end;
Sleep(1000);
// 2. Safely update the UI progress (*************************************************
TThread.Queue(nil, * BUTTONSTARTCLICK *
procedure * *
begin * Start the fake activity by launching the *
direction := Not direction ; * main thread that sends the clicks. *
counter := counter + 1 ; * It changes the button caption to match the *
if counter >= 60 then * fake "battery monitoring" action. *
begin *************************************************)
counter := 0 ; procedure TfrmMain.btnStartClick(Sender: TObject);
// Move cursor to specific screen coordinates begin
currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ; runIt := NOT runIt ;
mouse.CursorPos := Point( 1, 1 ) ; if runIt then
// Simulate mouse button press and release begin
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 1, 1, 0); btnStart.Caption := 'Stop Monitoring' ;
Sleep(150); startTask ;
mouse_event(MOUSEEVENTF_LEFTUP, 0, 1, 1, 0); end
Sleep(50); else
mouse_event(MOUSEEVENTF_LEFTUP, 0, 1, 1, 0); begin
// Get back to position btnStart.Caption := 'Start Monitoring' ;
mouse.CursorPos := currentPos ; stopTask ;
end; end;
end;
if direction then
mouse.CursorPos := Point( mouse.CursorPos.X + 2, mouse.CursorPos.Y + 2 )
else (*************************************************
mouse.CursorPos := Point( mouse.CursorPos.X - 2, mouse.CursorPos.Y - 2 ) * STARTTASK *
end); * *
end; * This starts a background thread that tricks *
end); * Windows into thinking you're releasing the *
end; * mouse UP button thrice, sending an activity *
* message to your computer and Teams monitoring *
procedure TfrmMain.stopTask; *************************************************)
begin procedure TfrmMain.startTask;
if (FMyTask <> nil ) then begin
begin lblStatus.Caption := 'Measuring' ;
lblStatus.Caption := '' ; // Create and start the background task
FMyTask.Cancel ; FMyTask := TTask.Run(
end; procedure
end; begin
end. // 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.