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:
parent
f321a6ebea
commit
758cc6be4b
4 changed files with 1418 additions and 1352 deletions
|
|
@ -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>
|
||||
|
|
|
|||
51
README.md
51
README.md
|
|
@ -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
|
||||
|
|
|
|||
29
main.dfm
29
main.dfm
|
|
@ -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
|
||||
|
|
|
|||
108
main.pas
108
main.pas
|
|
@ -1,18 +1,38 @@
|
|||
(*************************************************
|
||||
* 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)
|
||||
btnStart: TButton;
|
||||
progressBar: TProgressBar;
|
||||
lblStatus: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnStartClick(Sender: TObject);
|
||||
btnStart : TButton ;
|
||||
progressBar : TProgressBar ;
|
||||
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;
|
||||
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;
|
||||
|
|
|
|||
Loading…
Reference in a new issue