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
1 changed files with 1418 additions and 1352 deletions
298
main.pas
298
main.pas
|
|
@ -1,125 +1,173 @@
|
|||
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;
|
||||
|
||||
type
|
||||
TfrmMain = class(TForm)
|
||||
btnStart: TButton;
|
||||
progressBar: TProgressBar;
|
||||
lblStatus: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnStartClick(Sender: TObject);
|
||||
|
||||
private
|
||||
{ Private declarations }
|
||||
FMyTask : ITask ;
|
||||
currentPos : TPoint ;
|
||||
counter : Integer ;
|
||||
procedure startTask ;
|
||||
procedure stopTask ;
|
||||
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmMain : TfrmMain ;
|
||||
direction : Boolean ;
|
||||
runIt : Boolean ;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TfrmMain.FormCreate(Sender: TObject);
|
||||
begin
|
||||
direction := False ;
|
||||
runIt := False ;
|
||||
currentPos := Point( mouse.CursorPos.X , mouse.CursorPos.Y ) ;
|
||||
counter := 0 ;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
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;
|
||||
|
||||
|
||||
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);
|
||||
|
||||
// 2. 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);
|
||||
Sleep(150);
|
||||
mouse_event(MOUSEEVENTF_LEFTUP, 0, 1, 1, 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);
|
||||
end;
|
||||
|
||||
procedure TfrmMain.stopTask;
|
||||
begin
|
||||
if (FMyTask <> nil ) then
|
||||
begin
|
||||
lblStatus.Caption := '' ;
|
||||
FMyTask.Cancel ;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
(*************************************************
|
||||
* 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.
|
||||
|
|
|
|||
Loading…
Reference in a new issue