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

View file

@ -1,10 +1,10 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6B5250F9-78DF-4722-87AB-697436D5E3AC}</ProjectGuid>
<ProjectVersion>20.4</ProjectVersion>
<ProjectVersion>20.5</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">BatteryHealth</ProjectName>
<TargetedPlatforms>2097155</TargetedPlatforms>
@ -110,7 +110,7 @@
<DCC_UsePackage>VCLTMSFNCMapsPkg;vclwinx;DataSnapServer;FMXTMSFNCUIPackPkg;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;VCLTMSFNCWebSocketPkg;FMXTMSFNCAppToolsPkg;IndyProtocols;VCLTMSFNCDashboardPackPkg;vclx;VCLTMSFNCBloxPkg;dbxcds;vcledge;VCLTMSFNCGanttChartPkg;aurelius;FrameStandPackage_11_1;FmxTeeUI;DBXFirebirdDriver;FireDACSqliteDriver;DbxClientDriver;TMSScripter_IDE;soapmidas;TeeUI;dbexpress;inet;vcltouch;FireDACDBXDriver;fmxdae;tmsbcl;CustomIPTransport;FireDACMSSQLDriver;VCLTMSFNCCloudPackPkg;IndySystem;VCLTMSFNCBloxToolBarsPkg;TMSFNCCorePkg;ibxbindings;VCLTMSFNCChartPkg;vclFireDAC;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;TMSAIStudioPkg;TMSScripter_VCL;bindcompdbx;rtl;FireDACMySQLDriver;remotedb;DBXSqliteDriver;FMXTMSFNCChartPkg;DBXSybaseASEDriver;FMXTMSFNCBloxToolBarsPkg;vclimg;DataSnapFireDAC;inetdbxpress;FireDAC;VCLTMSFNCUIPackPkg;xmlrtl;ibxpress;dsnap;xdata;FireDACDb2Driver;DBXOracleDriver;DBXInformixDriver;FMXTMSFNCWebSocketPkg;vclib;fmxobj;bindcompvclsmp;DataSnapNativeClient;FMXTMSFNCMapsPkg;DatasnapConnectorsFreePascal;FMXTMSFNCCorePkg;TMSScripter_Memo;FMXTMSFNCChartGridAdapterPkg;emshosting;sparkle;FireDACCommonDriver;sphinx;IndyIPClient;FMXTMSFNCCloudPackPkg;bindcompvclwinx;emsedge;bindcompfmx;inetdb;ibmonitor;FireDACASADriver;Tee;vclactnband;FMXTMSFNCWXPackPkg;TMSMQTTPkg;fmxFireDAC;TMSScripter;FireDACInfxDriver;DBXMySQLDriver;VclSmp;DataSnapCommon;fmxase;DBXOdbcDriver;VCLTMSFNCWXPackPkg;dbrtl;FireDACOracleDriver;VCLTMSFNCAppToolsPkg;TeeDB;FireDACMSAccDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;FMXTMSFNCGanttChartPkg;VCLTMSFNCChartGridAdapterPkg;FireDACTDataDriver;Skia.Package.VCL;vcldb;FMXTMSFNCDashboardPackPkg;bindcomp;inetstn;IndyCore;RESTBackendComponents;TMSMQTTPkgDE;dmvcframeworkDT;FireDACADSDriver;RESTComponents;TMSAIStudioPkgExtensions;IndyIPServer;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;TMSScripter_Legacy;FMXTMSFNCRESTClientEditorPkg;TMSFNCPushNotificationsPkg;DBXDb2Driver;FMXTMSFNCBloxPkg;VCLTMSFNCRESTClientEditorPkg;emsclientfiredac;FireDACPgDriver;FireDACDSDriver;dmvcframeworkRT;tethering;bindcompvcl;CloudService;DBXSybaseASADriver;VCLTMSFNCCorePkg;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Keys>CompanyName=TiltSoft;FileDescription=Battery Health;FileVersion=1.0.0.0;InternalName=batteryhealth;LegalCopyright=(C) 2026-present by TiltSoft;LegalTrademarks=;OriginalFilename=;ProgramID=com.tiltsoft.batteryhealth;ProductName=BatteryHealth;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>$(ProjectName).Artwork\Windows\AppIcon.ico</Icon_MainIcon>
<Icns_MainIcns>$(ProjectName).Artwork\Windows\AppIcon.icns</Icns_MainIcns>
@ -150,6 +150,7 @@
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Icon_MainIcon>$(ProjectName).Artwork\Windows\AppIcon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_WinARM64EC)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@ -198,9 +199,6 @@
<Source Name="MainSource">BatteryHealth.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDS)\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkgDE370.bpl">File c:\radstudio\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkgDE370.bpl not found</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkgLib370.bpl">File c:\radstudio\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkgLib370.bpl not found</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkg370.bpl">File c:\radstudio\AddOns\TMS\TMS Setup\.tmssetup\build\bpl\Win32\TMSWEBCorePkg370.bpl not found</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k370.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp370.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k370.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>

View file

@ -1,26 +1,43 @@
# 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 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).
This Windows application simulates a fake activity on your computer by sending fake Mouse UP signals to Windows to keep the Teams session active.
It uses a thread so the user still can click the Stop button to regain control.
Use it at your own risks and responsabilities.
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.
2029-09-29
Initial push
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
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);
begin
// Move cursor to specific screen coordinates
SetCursorPos(X, Y);
## Warning
Use it accordingly to your company's policy.
// Simulate mouse button press and release
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
## Disclaimer
In no way could Tiltsoft or anybody related to it may be responsible for any damage, harm or any kind of loss.
This software is provided as-is with no responsabilities or guarantees whatsoever.
## The name
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.
## Info for developers
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.Name = 'Segoe UI'
Font.Style = []
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 15
object lblStatus: TLabel
@ -19,6 +20,21 @@ object frmMain: TfrmMain
Height = 15
AutoSize = False
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
Left = 8
Top = 8
@ -28,17 +44,4 @@ object frmMain: TfrmMain
TabOrder = 0
OnClick = btnStartClick
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

View file

@ -1,10 +1,29 @@
(*************************************************
* 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;
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, System.Threading,
System.Types ;
type
TfrmMain = class(TForm)
@ -13,6 +32,7 @@ type
lblStatus : TLabel ;
procedure FormCreate(Sender: TObject) ;
procedure btnStartClick(Sender: TObject) ;
procedure FormClose(Sender: TObject; var Action: TCloseAction) ;
private
{ Private declarations }
@ -28,7 +48,6 @@ type
var
frmMain : TfrmMain ;
direction : Boolean ;
runIt : Boolean ;
implementation
@ -36,18 +55,41 @@ implementation
{$R *.dfm}
(*************************************************
* FORMCREATE *
* *
* Initialise the variables. *
*************************************************)
procedure TfrmMain.FormCreate(Sender: TObject);
begin
direction := False ;
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 ;
@ -64,6 +106,14 @@ begin
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' ;
@ -71,6 +121,7 @@ begin
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
@ -82,41 +133,38 @@ begin
Sleep(1000);
// 2. Safely update the UI progress
// Safely update the UI progress
TThread.Queue(nil,
procedure
begin
direction := Not direction ;
counter := counter + 1 ;
if counter >= 60 then
begin
counter := 0 ;
// Move cursor to specific screen coordinates
currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ;
mouse.CursorPos := Point( 1, 1 ) ;
// Simulate mouse button press and release
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 1, 1, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, mouse.CursorPos.X, mouse.CursorPos.Y, 0);
Sleep(150);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 1, 1, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, mouse.CursorPos.X, mouse.CursorPos.Y, 0);
Sleep(50);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 1, 1, 0);
// Get back to position
mouse.CursorPos := currentPos ;
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 )
end);
end;
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;