linuxer.gr
/
camera-control-webcam-switch-indicator
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
camera-control-webcam-switc.../CameraControl.pas

1956 lines
80 KiB
Plaintext
Raw Permalink Blame History

unit CameraControl;
{$mode objfpc}{$H+}
{$warnings off}
{$hints off}
// Created at 23th of January 2020, by Linuxer (https://gitlab.com/psposito), from scratch with Free Pascal
// Redesigned and further Developed at 28th of January 2020, by Initial developer
// to provide Camera and Mic status alone with On/Off and Mute/Unmute fuctions
// Developed further for intrusion feeling and logging at 2nd of February 2020, by Initial developer
// Developed for Blacklisting/Whitelisting functions for both camera & audio at 7th of February 2020, by Initial developer
// Finalized, except traslations at 15th of February 2020.
// Further Capabilities added alone with better Logging at 22nd of February 2020
interface
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
Menus, PopupNotifier, UTF8Process, UniqueInstance, ECSpinCtrls,
VpClock, Unix, process, About, Logs, Reboot, RebootDialog,
DateUtils, LCLType, LCLTranslator, Interfaces;
type
{ TForm1 }
TForm1 = class(TForm)
ImageListCam : TImageList;
ImageListCam1 : TImageList;
ImageListStatus : TImageList;
ImageListMic : TImageList;
AProcess : TProcessUTF8;
ImageListSystem : TImageList;
MenuItem1 : TMenuItem;
MenuItem10 : TMenuItem;
MenuItem11 : TMenuItem;
MenuItem12 : TMenuItem;
MenuItem13 : TMenuItem;
MenuItem14 : TMenuItem;
MenuItem15 : TMenuItem;
MenuItem16 : TMenuItem;
MenuItem17 : TMenuItem;
MenuItem18 : TMenuItem;
MenuItem19 : TMenuItem;
MenuItem2 : TMenuItem;
MenuItem20 : TMenuItem;
MenuItem21 : TMenuItem;
MenuItem22 : TMenuItem;
MenuItem23: TMenuItem;
MenuItem24 : TMenuItem;
MenuItem25 : TMenuItem;
MenuItem26 : TMenuItem;
MenuItem27 : TMenuItem;
MenuItem28 : TMenuItem;
MenuItem29 : TMenuItem;
MenuItem3 : TMenuItem;
MenuItem31 : TMenuItem;
MenuItem32 : TMenuItem;
MenuItem33 : TMenuItem;
MenuItem34 : TMenuItem;
MenuItem36 : TMenuItem;
MenuItem37 : TMenuItem;
MenuItem38: TMenuItem;
MenuItem4 : TMenuItem;
MenuItem40 : TMenuItem;
MenuItem41 : TMenuItem;
MenuItem42 : TMenuItem;
MenuItem44 : TMenuItem;
MenuItem45 : TMenuItem;
MenuItem5 : TMenuItem;
MenuItem6 : TMenuItem;
MenuItem7 : TMenuItem;
MenuItem8 : TMenuItem;
MenuItem9 : TMenuItem;
PopupMenu1 : TPopupMenu;
PopupMenu2 : TPopupMenu;
PopupMenu3 : TPopupMenu;
PopupMenu4 : TPopupMenu;
PopupMenu5 : TPopupMenu;
PopupMenu6 : TPopupMenu;
PopupNotifier1 : TPopupNotifier;
PopupNotifier2 : TPopupNotifier;
PopupNotifier3 : TPopupNotifier;
PopupNotifier4 : TPopupNotifier;
PopupNotifier5 : TPopupNotifier;
PopupNotifier6 : TPopupNotifier;
PopupNotifier7 : TPopupNotifier;
PopupNotifier8 : TPopupNotifier;
PopupNotifier9 : TPopupNotifier;
ProcessUTF8_1 : TProcessUTF8;
Timer1 : TTimer;
TrayIcon1 : TTrayIcon;
TrayIcon2 : TTrayIcon;
TrayIcon3 : TTrayIcon;
TrayIcon4 : TTrayIcon;
TrayIcon5 : TTrayIcon;
UniqueInstance1 : TUniqueInstance;
VpClock1 : TVpClock;
procedure FormCreate(Sender: TObject);
procedure MenuItem10Click(Sender: TObject);
procedure MenuItem12Click(Sender: TObject);
procedure MenuItem13Click(Sender: TObject);
procedure MenuItem27Click(Sender: TObject);
procedure MenuItem29Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem31Click(Sender: TObject);
procedure MenuItem32Click(Sender: TObject);
procedure MenuItem33Click(Sender: TObject);
procedure MenuItem34Click(Sender: TObject);
procedure MenuItem36Click(Sender: TObject);
procedure MenuItem37Click(Sender: TObject);
procedure MenuItem38Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
procedure MenuItem7Click(Sender: TObject);
procedure MenuItem9Click(Sender: TObject);
procedure PopupNotifier1Close(Sender: TObject; var CloseAction: TCloseAction);
procedure PopupNotifier2Close(Sender: TObject; var CloseAction: TCloseAction);
procedure PopupNotifier3Close(Sender: TObject; var CloseAction: TCloseAction);
procedure PopupNotifier4Close(Sender: TObject; var CloseAction: TCloseAction);
procedure TrayIcon1Click(Sender: TObject);
procedure TrayIcon2Click(Sender: TObject);
procedure TrayIcon3Click(Sender: TObject);
procedure TrayIcon4Click(Sender: TObject);
procedure TrayIcon5Click(Sender: TObject);
procedure UniqueInstance1OtherInstance(Sender: TObject;
ParamCount: Integer; const Parameters: array of String);
procedure VpClock1SecondChange(Sender: TObject);
private
CamImageIndex : integer;
MicImageIndex : integer;
public
end;
var
ReleaseNo : String = '2.0.2';
Form1 : TForm1;
S : LongInt;
MicSwitchStr : String;
Password : String;
Password2 : String;
isMicOn : boolean;
MicStatus : boolean;
//MicSavedStatus : boolean;
CamStatus : byte;
CamSavedStatus : Byte;
HasPassword : boolean;
MicClicked : boolean;
CamClicked : boolean;
MicClicksCounter : byte;
CamClicksCounter : byte;
GridLine : Integer;
SndCardsStringList : TStringList;
SndCardsCountNumber : Integer;
n : Integer;
HomeDir : String;
CmdString : String;
FileString : String;
FileDestDir : String;
LastAction : byte;
NewWidth : Integer;
NewHeight : Integer;
Breath : Integer = 50;
VideoCapt : boolean;
//VideoStringList : TStringList;
VideoCardsCountNumber : Integer;
LoopCounter : Integer;
PopUpWebcamCaptStatus : Boolean;
V4L2Val : integer;
CameraIcon : byte;
MicIcon : byte;
FromMain : boolean;
OneVideoCard : boolean;
RebootNeededFlag : boolean;
VideoDevicesNumber : byte;
ActionTime : TDateTime;
CountNumber : Integer;
CaptureStatus : Integer;
LogsDateString : String;
LogsStringList : TStringList;
CaptureAppName : String;
SecondCaptureDevice : boolean;
SecondCaptureDeviceOn : boolean;
Str2 : String;
WantsPassword : boolean;
implementation
{$R *.res}
procedure RebootSystem; forward;
procedure AskPassword; forward;
Procedure AppendLogs; forward;
{$R *.frm}
{ TForm1 }
procedure AdjustBalloonPosition;
var
BaloonWidth : Integer;
BaloonHeight : Integer;
Width : Integer;
Height : Integer;
begin
BaloonWidth := 110;
BaloonHeight := 325;
Width := Screen.Monitors[0].Width;
NewWidth := Width div 2 - BaloonWidth;
Height := Screen.Monitors[0].Height;
NewHeight := Height div 2 - BaloonHeight;
end;
procedure PopUpWebcamOn;
begin
Form1.PopupNotifier2.Text := 'Camera is On' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/';
Form1.PopupNotifier2.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is On';
end;
procedure PopUpWebcamOff;
begin
Form1.PopupNotifier1.Text := 'No Camera' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/';
Form1.PopupNotifier1.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is Disabled';
end;
procedure PopUpWebcamCaptures;
begin
Form1.PopupNotifier7.Text := 'Camera is Capturing' + LineEnding + 'Video Device: /dev/video'
+ IntToStr(CountNumber)+ '/' + LineEnding + 'Application Name: ' + CaptureAppName;
Form1.PopupNotifier7.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is Capturing' + LineEnding + CaptureAppName;
end;
procedure PopUpWebcamNotCapturing;
begin
Form1.PopupNotifier6.Text := 'Camera is not Capturing' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/';
Form1.PopupNotifier6.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled, but is not Capturing';
end;
procedure PopUpWebcamHacked;
begin
Form1.PopupNotifier8.Text := 'Camera is Hacked' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/' + LineEnding + 'Check Logs';
Form1.PopupNotifier8.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is Hacked' + LineEnding + 'Check Logs';
end;
procedure PopUpMicHacked;
begin
Form1.PopupNotifier9.Text := 'Microphone is Hacked' + LineEnding + 'Alsa Driver Changed Status';
Form1.PopupNotifier9.ShowAtPos(NewWidth , NewHeight - 325 div 2 - 20);
Form1.TrayIcon5.Hint := 'Microphone Status' + LineEnding + 'Microphone is Hacked' + LineEnding + 'Check Logs';
end;
procedure PopUpNoWebcam;
begin
Form1.TrayIcon5.Hint := 'No Camera' + LineEnding + 'Camera is Disabled';
end;
procedure PopUpWebcamCapturing;
begin
Form1.TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled and Capturing';
end;
procedure PopUpWebcamNoCapturing;
begin
Form1.TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled, but is not Capturing';
end;
procedure PopUpMicOn;
begin
Form1.PopupNotifier3.Text := 'Microphone is Unmuted' + LineEnding + 'Alsa Driver Status: cap';
Form1.PopupNotifier3.ShowAtPos(NewWidth, NewHeight);
Form1.TrayIcon2.Hint := 'Microphone Status & Menu' + LineEnding + 'Microphone is Unmuted';
end;
procedure PopUpMicOff;
begin
Form1.PopupNotifier4.Text := 'Microphone is Muted' + LineEnding + 'Alsa Driver Status: nocap';
Form1.PopupNotifier4.ShowAtPos(NewWidth , NewHeight);
Form1.TrayIcon2.Hint := 'Microphone Status & Menu' + LineEnding + 'Microphone is Muted';
end;
procedure GetMicCaptureStatus;
var
AStringList : TStringList;
AProcess : TProcess;
begin
AProcess := TProcess.Create(nil);
AProcess.Executable := '/bin/sh';
AProcess.Parameters.Add('-c');
AProcess.Parameters.Add('amixer get Capture control');
AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
AProcess.Execute;
AStringList := TStringList.Create;
AStringList.LoadFromStream(AProcess.Output);
MicSwitchStr := TrimLeft(RightStr(AStringList.Strings[AstringList.Count-1], 5));
if CompareText(MicSwitchStr,'[On]') = 0 then
begin
isMicOn := true;
end
//if CompareText(MicSwitchStr,'[Off]') = 0 then
else
begin
isMicOn := false;
end;
AStringList.Free;
AProcess.Free;
end;
procedure RebootNeededDialog;
begin
RebootDialog.Form5.ListBox1.Clear;
RebootDialog.Form5.ListBox1.Items.Clear;
RebootDialog.Form5.ListBox1.Items.Add('The limit of 59 Hacking preventing On/Off functions');
RebootDialog.Form5.ListBox1.Items.Add('has been reached. (Check Link Below)');
RebootDialog.Form5.ListBox1.Items.Add('');
RebootDialog.Form5.ListBox1.Items.Add('You must Reboot the System in Order to Reset their');
RebootDialog.Form5.ListBox1.Items.Add('number, otherwise the application will not be able');
RebootDialog.Form5.ListBox1.Items.Add('to provide, any further Actions.');
RebootDialog.Form5.ListBox1.Items.Add('');
RebootDialog.Form5.ListBox1.Items.Add('Please Save your opened Files & Close Windows');
RebootDialog.Form5.ListBox1.Items.Add('');
RebootDialog.Form5.ListBox1.Items.Add('Press Reboot or Quit to exit the Application');
RebootDialog.Form5.Show;
end;
procedure KillCapturingApplication;
var
AStringList : TStringList;
AProcess : TProcess;
j : Integer;
Str : String;
begin
Str := 'pgrep -f ' + CaptureAppName; // Full test command is: lsof /dev | grep video && ls /dev/ | grep v4l
AStringList := TStringList.Create;
AProcess := TProcess.Create(nil);
AProcess.Executable := '/bin/sh';
AProcess.Parameters.Add('-c');
AProcess.Parameters.Add(Str);
AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
AProcess.Execute;
AStringList.LoadFromStream(AProcess.Output);
ShowMessage( 'Pids List of ' + CaptureAppName + ':' + sLineBreak +
'---------------------------' + sLineBreak + AStringList.Text);
j := 0;
while j <= AStringList.Count - 1 do
begin
S := FpSystem('kill -KILL ' + AStringList.Strings[j]);
Inc(j);
end;
end;
procedure KillCapturingApplicationSudo;
var
AStringList : TStringList;
AProcess : TProcess;
j : Integer;
Str : String;
begin
Str := 'pgrep -f ' + CaptureAppName; // Full test command is: lsof /dev | grep video && ls /dev/ | grep v4l
AStringList := TStringList.Create;
AProcess := TProcess.Create(nil);
AProcess.Executable := '/bin/sh';
AProcess.Parameters.Add('-c');
AProcess.Parameters.Add(Str);
AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
AProcess.Execute;
AStringList.LoadFromStream(AProcess.Output);
ShowMessage('Pids List of ' + CaptureAppName + ':' + sLineBreak + AStringList.Text);
j := 0;
while j <= AStringList.Count - 1 do
begin
S := FpSystem(Concat('echo ', Password, ' | sudo -S kill -KILL ' , AStringList.Strings[j]));
Inc(j);
end;
end;
procedure GetVideoCards; // VideoCards /dev/ Names
var
AStringList : TStringList;
CleanStringList : TStringList;
AProcess : TProcess;
Str : String;
SubStr : String = '(deleted)';
n : integer;
m : integer;
l : integer;
//StrLength : integer;
begin
SecondCaptureDevice := false;
m := 0;
l := 0;
CaptureStatus := 0;
CaptureAppName := '';
//StrLength := 0;
if (Length(Password2) > 0) and (HasPassword = true) then // Full test command is: lsof /dev | grep video && ls /dev/ | grep v4l
Str2 := Concat('echo ', Password2, ' | sudo -S sh -c "lsof /dev | grep video"')
else
Str2 := Concat('lsof /dev/ ' , '|' , ' grep video');
Str := Str2;
AStringList := TStringList.Create;
CleanStringList := TStringList.Create;
AProcess := TProcess.Create(nil);
AProcess.Executable := '/bin/sh';
AProcess.Parameters.Add('-c');
AProcess.Parameters.Add(Str);
AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
AProcess.Execute;
AStringList.LoadFromStream(AProcess.Output);
V4L2Val := StrToInt(BoolToStr(not DirectoryExists('/dev/v4l/')));
n := 0;
while n <= AStringList.Count - 1 do
if (CompareText(LeftStr(AStringList.Strings[n], 6), 'lsof: ') = 0) or (CompareText(LeftStr(AStringList.Strings[n], 6), ' ') = 0) then
Inc(n)
else
begin
CleanStringList.Add(AStringList.Strings[n]);
Inc(n);
end;
AStringList.Clear;
AStringList := CleanStringList;
if V4L2Val = - 1 then
begin
VideoCardsCountNumber := 0;
CaptureStatus := -1;
end;
if (AstringList.Count = 0) and (V4L2Val = 0) then
begin
VideoCardsCountNumber := 0;
CaptureStatus := 0;
end;
//if AstringList.Count = 1 then
// begin
// VideoCardsCountNumber := 0;
// VideoDevicesNumber := 0;
// end;
if (AstringList.Count >= 1) and (AstringList.Count <= 58) then
begin
for n:= 1 to AStringList.Count - 1 do
begin
if CompareText(RightStr(AStringList.Strings[n], Length(SubStr)), SubStr) = 0 then
Inc(m); // lsof /dev | grep video ---> count number of /dev/video(n) (deleted)
//write('m = ');
//write(m);
if CompareText(AStringList.Strings[n - 1], AStringList.Strings[n]) < 0 then
Inc(l); // when l < m - 1 --> webcam captures ---> GetCameraSatus procedure below, is rewriten
//write(', l = '); // when l = m --> webcam on
//writeln(l); // when V4L2Val = - 1 --> webcam off
end;
VideoCardsCountNumber := l - m;
// Note: Some of the if Conditions for Capturing are here from testing period. In any case, one more if, is not a problem to leave it here.
if (l <= m + 1) then
CaptureStatus := 1;
if (l = m) then
CaptureStatus := 0;
if V4L2Val = - 1 then
CaptureStatus := -1;
if (AstringList.Count = 1) and (V4L2Val = 0) then
VideoCardsCountNumber := 1;
VideoDevicesNumber := AstringList.Count;
if (VideoDevicesNumber = 2) and (V4L2Val = 0) and (m = 0) and (l = 0)then
CaptureStatus := 1;
If (AStringList.Count - 1) >= 0 then
CaptureAppName := LeftStr(AStringList.Strings[AStringList.Count - 1], pos(' ', AStringList.Strings[AStringList.Count - 1]));
If ((AStringList.Count - 1) >= 1) and (m = 0) and (l = 0) then
begin
CaptureAppName := LeftStr(AStringList.Strings[AStringList.Count - 1], pos(' ', AStringList.Strings[AStringList.Count - 1]));
CaptureStatus := 1;
if SecondCaptureDeviceOn = false then
SecondCaptureDeviceOn := true;
//PopUpWebcamCaptStatus := false;
SecondCaptureDevice := true;
end;
if CaptureAppName <> '' then
CaptureStatus := 1;
end;
if (AstringList.Count >= 59) then
RebootNeededFlag := true;
CountNumber := AstringList.Count;
write('CaptureStatus = ', CaptureStatus, ' VideoCardsCountNumber = ' , VideoCardsCountNumber, ' ');
//writeln(AStringList.Text);
writeln('CountNumber= ', AstringList.Count, ' m = ', m, ' l = ', l, ' ', OneVideoCard, ' VideoDevicesNumber = ', VideoDevicesNumber, ' CaptureAppName = ', CaptureAppName);
AStringList.Free;
AProcess.Free;
end;
procedure GetCameraStatus; // My way because v4l2 sucks and does not provide webcam getstatus method.
begin
/////////////// This Code will remain as fallback if the new below, faces any troubles, and for historical reasons ////////////////////
//-----------------------------------------------------------------------------------------------------------------------------------//
//V4L2Val := StrToInt(BoolToStr(not DirectoryExists('/dev/v4l/'))); // If there is another way, please make an issue
//if (VideoCardsCountNumber = 0) and (V4L2Val = -1) then // -> Camera is off
// CamStatus := 0;
//if (VideoCardsCountNumber = 0) and (V4L2Val = 0 ) then // -> Camera is On
// CamStatus := 1;
//if (VideoCardsCountNumber = 1) and (V4L2Val = -1) then // -> Camera is Capturing
// CamStatus := 1;
//if (VideoCardsCountNumber = 0) and (CountNumber = 0) and (V4L2Val = 0) then // -> Camera is On
// CamStatus := 1;
//if (VideoDevicesNumber = 1) and (CountNumber = 1) and (V4L2Val = 0) then // -> Camera Stopped Capturing
// CamStatus := 1;
//-----------------------------------------------------------------------------------------------------------------------------------//
if CaptureStatus = -1 then // -> Camera is off
CamStatus := 0;
if CaptureStatus = 0 then // -> Camera is On
CamStatus := 1;
if CaptureStatus = 1 then // -> Camera is Capturing
CamStatus := 2;
if (VideoCardsCountNumber = 1) and (V4L2Val = 0) then // -> Camera is Capturing
CamStatus := 2;
if CamStatus < 2 then
begin
Form1.MenuItem13.Visible := false;
Form1.MenuItem37.Visible := false;
end
else
begin
if HasPassword = false then
begin
Form1.MenuItem13.Visible := true;
Form1.MenuItem37.Visible := false;
end
else
begin
Form1.MenuItem13.Visible := false;
Form1.MenuItem37.Visible := true;
end;
//if Length(Password2) > 0 then
// Form1.MenuItem37.Visible := true;
end;
end;
procedure NoCapturePassword;
var
MessageStr : string;
BoxStyle : integer;
Reply : integer;
begin
BoxStyle := MB_ICONEXCLAMATION + MB_OK;
//Reply := Application.MessageBox ( 'Incorrect password input, or password ' + sLineBreak +
// 'input cancelled by user' + sLineBreak +
// ' ' + sLineBreak +
// 'The Application will catch and will' + sLineBreak +
// 'be able to kill, only Users Events.' + sLineBreak +
// ' ' + sLineBreak +
// 'For Better Protection, please provide' + sLineBreak +
// 'the sudo password, on the Menu at' + sLineBreak +
// 'Camera''s Indicator Menu', 'Camera Control for Linux', BoxStyle);
//Reply := MessageDlg('Camera Control for Linux', 'Incorrect password input, or password ' + sLineBreak +
// 'input cancelled by user' + sLineBreak +
// ' ' + sLineBreak +
// 'The Application will catch and will' + sLineBreak +
// 'be able to kill, only Users Events.' + sLineBreak +
// ' ' + sLineBreak +
// 'For Better Protection, please provide' + sLineBreak +
// 'the sudo password, on the Menu at' + sLineBreak +
// 'Camera''s Indicator Menu', mtConfirmation,[mbOk],0);
Reply := QuestionDlg ('Camera Control for Linux','Incorrect password input, or password ' + sLineBreak +
'input cancelled by user' + sLineBreak +
' ' + sLineBreak +
'The Application will catch and will' + sLineBreak +
'be able to kill, only Users Events.' + sLineBreak +
' ' + sLineBreak +
'For Better Protection, please provide' + sLineBreak +
'the sudo password, on the Menu at' + sLineBreak +
'Camera''s Indicator Menu',mtCustom,[mrOK],'');
Form1.MenuItem38.Visible := true;
end;
procedure PasswordInputQuery;
var
UserString : string;
begin
if InputQuery('Camera Control for Linux', 'For better functioning, please provide your sudo password', TRUE, UserString) then
begin
HasPassword := true;
Password2 := UserString;
end
else
begin
//NoCapturePassword;
WantsPassword := false;
Form1.MenuItem38.Visible := true;
HasPassword := false;
Password2 := '';
end;
end;
procedure GetCapturePassword;
begin
if (HasPassword = false) and (WantsPassword = true) then
begin
PasswordInputQuery;
S := FpSystem(Concat('echo ', Password2, ' | sudo -S sh -c "ls /root"'));
if S <> 0 then
begin
WantsPassword := false;
Form1.MenuItem38.Visible := true;
HasPassword := false;
Password2 := '';
NoCapturePassword;
end
else
begin
if (HasPassword = false) and (Length(Password2) > 0) then
Password := Password2;
WantsPassword := false;
Form1.MenuItem38.Visible := false;
HasPassword := true;
ShowMessage( 'Password is Correct' + sLineBreak +
'Now Kill Capturing (Sudo) is available' + sLineBreak +
'on the Camera Indicator Menu');
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//SetReleaseNo;
application.showmainform := false; // Hide Main form
HasPassword := false;
CamImageIndex := 0;
MicImageIndex := 0;
MicClicked := false;
CamClicked := false;
MicStatus := false;
CamClicksCounter := 0;
MicClicksCounter := 0;
GridLine := 1;
VideoCapt := false;
VpClock1.Active := true;
LoopCounter := 0;
PopUpWebcamCaptStatus := false;
V4L2Val := StrToInt(BoolToStr(not DirectoryExists('/dev/v4l/')));
FromMain := false;
RebootNeededFlag := false;
VideoDevicesNumber := 0;
LogsDateString := FormatDateTime('DD/MM/YYYY-hh-mm-ss',now);
LogsStringList := TStringList.Create;
SecondCaptureDeviceOn := false;
MenuItem13.Visible := false;
MenuItem37.Visible := false;
Password2 := ParamStr(1);
WantsPassword := true;
MenuItem38.Visible := false;
LogsStringList.Clear;
//Logs.Form3.StringGrid1.Clean;
AdjustBalloonPosition;
// Load Trays with Basic Icons
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
ImageListStatus.GetIcon(0, TrayIcon3.Icon);
ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListSystem.GetIcon(0, TrayIcon4.Icon);
GetVideoCards;
GetCameraStatus;
// My how-to find out camera status
// if (VideoCardsCountNumber = 0) and (V4L2Val = -1) then CamStatus := 0; // -> Camera is off
// if (VideoCardsCountNumber = 0) and (V4L2Val = 0 ) then CamStatus := 1; // -> Camera is On
// if (VideoCardsCountNumber = 1) and (V4L2Val = 0 ) then CamStatus := 2; // -> Camera is Capturing
if CamStatus = 0 then // -> Camera is off
begin
//ImageListCam.GetIcon(1, TrayIcon1.Icon);
//PopUpWebcamOff;
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CameraIcon := 0;
//ShowMessage('Camera is Off or No Camera exists');
CamClicked := false;
CamClicksCounter := 0;
CamSavedStatus := 0;
end;
if CamStatus = 1 then // -> Camera is On
begin
//ImageListCam.GetIcon(0, TrayIcon1.Icon);
//PopUpWebcamOn;
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
CameraIcon := 2;
//ShowMessage('Camera is On');
CamClicked := false;
CamClicksCounter := 0;
CamSavedStatus := 1;
end;
if CamStatus = 2 then // -> Camera is Capturing
begin
ActionTime := now;
//PopUpWebcamCaptures;
//PopUpWebcamCaptStatus := true;
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
CameraIcon := 1;
VideoCapt := true;
CamClicked := false;
CamClicksCounter := 0;
CamSavedStatus := 2;
end;
GetMicCaptureStatus;
if isMicOn = true then
begin
ImageListMic.GetIcon(0, TrayIcon2.Icon);
MicStatus := true;
MicClicked := false;
MicClicksCounter:= 0;
//PopUpMicOn;
MicIcon := 0;
end;
if isMicOn = false then
begin
ImageListMic.GetIcon(1, TrayIcon2.Icon);
MicStatus := false;
MicClicked := false;
MicClicksCounter:= 0;
//PopUpMicOff;
MicIcon := 1;
PopUpMenu6.Close;
end;
// Reload Final Icons... (cthreads, and -O3 build level not enough? lol)
ImageListCam1.GetIcon(CameraIcon, TrayIcon5.Icon);
ImageListStatus.GetIcon(0, TrayIcon3.Icon);
ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListMic.GetIcon(MicIcon, TrayIcon2.Icon);
ImageListSystem.GetIcon(0, TrayIcon4.Icon);
FromMain := true;
end;
procedure CheckSStatus;
begin
if (S <> 0) then
begin
if (S = 256) then
begin
ShowMessage('Incorrect password');
end;
if (S <> 256) then
begin
ShowMessage('Error Number: ' + IntToStr(S));
end;
HasPassword := false;
end;
end;
procedure GetSoundCards; // GetSoundCards Unique Driver Names
var
AStringList : TStringList;
AProcess : TProcess;
m : Integer;
n : Integer;
RightChar : Integer;
begin
AProcess := TProcess.Create(nil);
AProcess.Executable := '/bin/sh';
AProcess.Parameters.Add('-c');
AProcess.Parameters.Add('cat /proc/asound/modules ');
AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
AProcess.Execute;
AStringList := TStringList.Create;
SndCardsStringList := TStringList.Create;
SndCardsStringList.Sorted := true;
SndCardsStringList.Duplicates := dupIgnore;
AStringList.LoadFromStream(AProcess.Output);
m := AStringList.Count - 1;
n := 0;
SndCardsCountNumber := 0;
While (n <= m) do
begin
RightChar := Pos(' ', AStringList.Strings[n]) + 1;
SndCardsStringList.AddStrings(Copy(AStringList.Strings[n], RightChar + 2, (Length(AStringList.Strings[n]))));
inc(n);
end;
SndCardsCountNumber := SndCardsStringList.Count - 1;
AStringList.Free;
AProcess.Free;
end;
procedure AskPassword;
begin
Password := PasswordBox('Authorization Needed / User Input','Please Enter Password');
HasPassword := True;
end;
procedure TForm1.MenuItem10Click(Sender: TObject); // Exit
begin
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ',now)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Application Closed', '']);
AppendLogs;
Form1.Close;
//VideoStringList.Free;
SndCardsStringList.Free;
//SaveLogs;
LogsStringList.Free;
Halt(0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject); //Show Logs;
begin
Logs.Form3.Show;
end;
procedure TForm1.MenuItem13Click(Sender: TObject); // Kill Capturing as User
begin
KillCapturingApplication;
end;
procedure TForm1.MenuItem37Click(Sender: TObject); // Kill Capturing Sudo
begin
if HasPassword = true then
KillCapturingApplicationSudo
else
begin
AskPassword;
S := FpSystem(Concat('echo ', Password, ' | sudo -S ls /root '));
if S <> 0 then
ShowMessage('Incorrect Password')
else
KillCapturingApplicationSudo;
end;
end;
procedure MenuPasswordInputQuery;
var
UserString2 : string;
begin
if InputQuery('Camera Control for Linux', 'For better functioning, please provide your sudo password', TRUE, UserString2) then
begin
HasPassword := true;
Password := UserString2;
end
else
begin
//NoCapturePassword;
Form1.MenuItem38.Visible := true;
Password := '';
end;
end;
procedure MenuGetCapturePassword;
begin
if (HasPassword = false) then
begin
MenuPasswordInputQuery;
S := FpSystem(Concat('echo ', Password, ' | sudo -S sh -c "ls /root"'));
if S <> 0 then
begin
Form1.MenuItem38.Visible := true;
HasPassword := false;
Password2 := '';
NoCapturePassword;
end
else
begin
Password2 := Password;
Form1.MenuItem38.Visible := false;
HasPassword := true;
ShowMessage( 'Password is Correct' + sLineBreak +
'Now Kill Capturing (Sudo) is available' + sLineBreak +
'on the Camera Indicator Menu');
end;
end;
end;
procedure TForm1.MenuItem38Click(Sender: TObject);
begin
if (HasPassword = false) then
MenuGetCapturePassword;
end;
procedure DeleteOldLogs; // Deletes old Log files
var
SearchResult : TSearchRec;
LogsFilesList : TStringlist;
LogsFilesNames : TStringlist;
i : Integer;
k : integer;
DateString : String;
begin
LogsFilesList := TStringList.Create;
LogsFilesList.Clear;
LogsFilesNames := TStringList.Create;
LogsFilesNames.Clear;
HomeDir := expandfilename('~/');
DateString := FormatDateTime('DD/MM/YYYY-hh-mm-ss',now);
FileDestDir := Concat(HomeDir,'.cameracontrol-', DateString, '.log');
i := 0;
if FindFirst(Concat(HomeDir,'.cameracontrol-*'), FaAnyFile, SearchResult) = 0 then
begin
repeat
LogsFilesList.Add(SearchResult.Name + ' Deleted');
LogsFilesNames.Add(SearchResult.Name);
inc(i);
until FindNext(SearchResult) <> 0;
FindClose(SearchResult);
end;
for k := 0 to LogsFilesNames.Count - 2 do
begin
S := FpSystem(Concat('rm ', HomeDir, LogsFilesNames[k]));
//LogsFilesList.Add(SearchResult.Name + ' Deleted');
end;
if k > 1 then
ShowMessage('The following detected Old Log Filenames were deleted:' + sLineBreak + sLineBreak + LogsFilesList.Text)
else
ShowMessage('There were not detected any Old Log Filenames');
LogsFilesList.Free;
end;
//procedure SaveLogs; // not used on build, use AppendLogs on each Log
//var
// LogsStringList : TStringList;
// n : Integer;
//
//begin
// HomeDir := expandfilename('~/');
// FileDestDir := Concat(HomeDir,'.cameracontrol-', LogsDateString, '.log');
//
// LogsStringList := TStringList.Create;
// LogsStringList.Clear;
//
// n := 0;
//
// while n <= Logs.Form3.StringGrid1.RowCount - 1 do
// begin
// if Length(Form3.StringGrid1.Rows[n].Strings[0]) > 0 then
// LogsStringList.Add(Concat(Form3.StringGrid1.Rows[n].Strings[0],'/', Form3.StringGrid1.Rows[n].Strings[1],'/', Form3.StringGrid1.Rows[n].Strings[2],'/' , Form3.StringGrid1.Rows[n].Strings[3]));
// Inc(n);
// end;
//
// //ShowMessage(LogsStringList.Text);
//
// n:= 0;
//
// while n <= LogsStringList.Count - 1 do
// begin
// FileString := LogsStringList.Strings[n];
// S := FpSystem(Concat('echo ' , FileString, ' >> ', FileDestDir));
// Inc(n);
// end;
//
// LogsStringList.Free;
//end;
procedure TForm1.MenuItem34Click(Sender: TObject);
begin
DeleteOldLogs;
end;
procedure TForm1.MenuItem36Click(Sender: TObject);
begin
ImageListStatus.GetIcon(0, TrayIcon3.Icon);
end;
//procedure ClearLogs; //Save Current and Clear Logs, not used on build
//
//begin
// SaveLogs;
//
// Logs.Form3.StringGrid1.Clean;
// GridLine := 1;
// Logs.Form3.StringGrid1.InsertRowWithValues(0,['Number','DateTime Stamp', 'Event Description', 'Video Devices Number']);
// Form1.ImageListStatus.GetIcon(0, Form1.TrayIcon3.Icon);
// if CamClicked then
// CamClicked := false;
//
// CamClicksCounter := 1;
//end;
procedure TForm1.MenuItem27Click(Sender: TObject); // Blaclist Camera and Reboot
var
BlackListStr : String;
begin
Password := '';
AskPassword;
CmdString := '';
HomeDir := expandfilename('~/');
FileString := Concat(HomeDir,'.blacklistuvcvideo ');
FileDestDir := '/etc/modprobe.d/blacklistuvcvideo.conf ';
BlackListStr := '''blacklist uvcvideo''';
if (FileExists(FileDestDir) = false) then
begin
if (HasPassword = false) then
begin
AskPassword;
end;
CmdString := Concat('rm ', FileString);
S := FpSystem(CmdString);
CmdString := Concat(Concat(Concat('echo ', BlackListStr),' >> '), FileString);
S := FpSystem(CmdString);
CmdString := Concat(Concat(Concat(Concat('echo ', Password), ' | sudo -S cp '), FileString), FileDestDir);
S := FpSystem(CmdString);
CheckSStatus;
if (S = 0) then
begin
LastAction := 0;
RebootSystem;
end;
end
else
begin
ShowMessage('Camera was not Whitelisted');
end;
CmdString := '';
end;
procedure TForm1.MenuItem29Click(Sender: TObject); // Whitelist Camera and Reboot
begin
Password := '';
AskPassword;
CmdString := '';
FileDestDir := '/etc/modprobe.d/blacklistuvcvideo.conf';
if (FileExists(FileDestDir) = true) then
begin
If (HasPassword = false) then
begin
AskPassword;
end;
CmdString := Concat(Concat(Concat('echo ', Password), ' | sudo -S rm '), FileDestDir);
S := FpSystem(CmdString);
CheckSStatus;
if (S = 0) then
begin
LastAction := 1;
RebootSystem;
end;
end
else
begin
ShowMessage('Camera was not Blacklisted');
end;
CmdString := '';
end;
procedure TForm1.MenuItem2Click(Sender: TObject); // Password Reset
begin
HasPassword := false;
ShowMessage('Passsword, has been reset');
end;
procedure TForm1.MenuItem31Click(Sender: TObject);
begin
end;
procedure TForm1.MenuItem32Click(Sender: TObject); // Blacklist Audio and Reboot
begin
Password := '';
HasPassword := false;
CmdString := '';
AskPassword;
GetSoundCards;
HomeDir := expandfilename('~/');
FileString := Concat(HomeDir,'.blacklistaudio ');
FileDestDir := '/etc/modprobe.d/blacklistaudio.conf ';
S := FpSystem(CmdString);
if SndCardsStringList <> Nil then
begin
CmdString := Concat(Concat('rm ', HomeDir),'.blacklistaudio');
S := FpSystem(CmdString);
//ShowMessage(SndCardsStringList.Text);
for n := 0 to SndCardsStringList.Count - 1 do
begin
CmdString := Concat(Concat(Concat(Concat('echo blacklist ''', SndCardsStringList.Strings[n])), ''' >> '), FileString);
S:= FpSystem(CmdString);
end;
If (HasPassword = false) then
begin
AskPassword;
end;
CmdString := Concat(Concat(Concat(Concat('echo ', Password), ' | sudo -S cp '), FileString), FileDestDir);
S:= FpSystem(CmdString);
CheckSStatus;
if (S = 0) and (HasPassword = true) then
begin
LastAction := 2;
RebootSystem;
end;
end
else
begin
ShowMessage('Audio Card(s) not Whitelisted before');
end;
CmdString := '';
end;
procedure TForm1.MenuItem33Click(Sender: TObject); // Whitelistlist Audio and Reboot
begin
Password := '';
HasPassword := false;
CmdString := '';
AskPassword;
FileString := '/etc/modprobe.d/blacklistaudio.conf';
CmdString := Concat(Concat(Concat('echo ', Password), ' | sudo -S rm '), FileString);
if (FileExists(FileString) = true) then
begin
If (HasPassword = false) then
begin
AskPassword;
end;
S:= FpSystem(CmdString);
CheckSStatus;
if (S = 0) and (HasPassword = true) then
begin
LastAction := 3;
RebootSystem;
end;
end
else
begin
ShowMessage('Audio Card(s) not Blacklisted before');
end;
CmdString := '';
end;
procedure RebootSystem;
begin
Reboot.Form4.Button2.Default := true;
Reboot.Form4.ListBox1.Items.Add(' System will now Reboot!!! ');
Reboot.Form4.ListBox1.Items.Add(' ');
Reboot.Form4.ListBox1.Items.Add('Please make sure that you have saved');
Reboot.Form4.ListBox1.Items.Add('all of your files and closed all open');
Reboot.Form4.ListBox1.Items.Add('Windows, before pressing the Reboot ');
Reboot.Form4.ListBox1.Items.Add('Button below.');
Form4.Password := Password;
Form4.HasPassword := HasPassword;
Form4.LastAction := LastAction;
Reboot.Form4.Show;
end;
procedure CameraOn;
begin
S := FpSystem(Concat('echo ', Password, ' | sudo -S modprobe uvcvideo'));
CheckSStatus;
end;
procedure CameraOff;
begin
S := FpSystem(Concat('echo ', Password, ' | sudo -S rmmod -f uvcvideo'));
//S := FpSystem(Concat('echo ', Password, ' | sudo -S modprobe -rf uvcvideo'));
CheckSStatus;
end;
procedure TForm1.MenuItem3Click(Sender: TObject); // Camera Off -> On
begin
GetVideoCards;
GetCameraStatus;
if (CamStatus = 2) or (CamSavedStatus = 2) then // -> Checks if Camera is Capturing
begin
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
CamClicksCounter := 1;
CamSavedStatus := 2;
VideoCapt := true;
PopUpWebcamCaptures;
PopUpWebcamCaptStatus := true;
Logs.Form3.StringGrid1.InsertRowWithValues( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera is Captuting, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
end;
if CamStatus = 0 then
begin
if HasPassword then
begin
CameraOn;
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
CamClicksCounter := 1;
PopUpWebCamOn;
CamStatus := 1;
VideoCapt := true;
CamSavedStatus := 1;
end
else
begin
AskPassword;
CameraOn;
if HasPassword then
begin
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
CamClicksCounter := 1;
PopUpWebCamOn;
CamStatus := 1;
VideoCapt := true;
CamSavedStatus := 1;
end
end;
end;
CamClicked := true;
end;
procedure TForm1.MenuItem4Click(Sender: TObject); // Camera On -> Off
begin
GetVideoCards;
GetCameraStatus;
if CamStatus = 1 then
begin
if HasPassword then
begin
CameraOff;
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CamClicksCounter := 1;
CamClicked := true;
PopUpWebCamOff;
CamStatus := 0;
VideoCapt := false;
CamSavedStatus := 0;
end
else
begin
AskPassword;
CameraOff;
if HasPassword then
begin
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CamClicksCounter := 1;
CamClicked := true;
PopUpWebCamOff;
CamStatus := 0;
VideoCapt := false;
CamSavedStatus := 0;
end
end;
end;
if CamStatus = 2 then // Camera forced to Off
begin
if HasPassword then
begin
CameraOff;
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CamClicksCounter := 1;
CamClicked := true;
PopUpWebCamOff;
CamStatus := 0;
VideoCapt := false;
CamSavedStatus := 2;
end
else
begin
AskPassword;
CameraOff;
if HasPassword then
begin
//ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CamClicksCounter := 1;
CamClicked := true;
PopUpWebCamOff;
CamStatus := 0;
VideoCapt := false;
CamSavedStatus := 2;
end
end;
end;
end;
procedure TForm1.MenuItem6Click(Sender: TObject); // Microphone Mute
begin
If MicStatus = true then
begin
S := FpSystem('amixer set Capture nocap');
//ShowMessage('Microphone has been mutted');
ImageListMic.GetIcon(1, TrayIcon2.Icon);
PopUpMicOff;
MicClicked := true;
MicClicksCounter := 1;
MicStatus := false;
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Microphone Muted by the User', 'None']);
AppendLogs;
Inc(GridLine);
end;
end;
procedure TForm1.MenuItem7Click(Sender: TObject); // Microphone Unmute
begin
If MicStatus = false then
begin
S := FpSystem('amixer set Capture cap');
//ShowMessage('Microphone has been unmutted');
PopUpMicOn;
ImageListMic.GetIcon(0, TrayIcon2.Icon);
MicClicked := true;
MicClicksCounter := 1;
MicStatus := true;
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Microphone Unmuted by the User', 'None']);
AppendLogs;
Inc(GridLine);
end;
end;
procedure TForm1.MenuItem9Click(Sender: TObject); // About
begin
//ImageListCam1.GetIcon(0, TrayIcon5.Icon);
//About.Form2.ImageList.GetBitmap(0, About.Form2.Image.Picture.Bitmap);
About.Form2.Label1.Caption:='Developer';
About.Form2.Label2.Caption:='Licence';
About.Form2.Label3.Caption:='Project';
About.Form2.ListBox1.Items.Clear;
About.Form2.ListBox1.Items.Add(Concat('Camera & Microphone Control Switches for Linux Rel. ', ReleaseNo));
About.Form2.ListBox1.Items.Add('is an LGPL2 Free Pascal Project with LCL components,');
About.Form2.ListBox1.Items.Add('completely developed from scratch, at 23th, of January 2020 by');
About.Form2.ListBox1.Items.Add('Linuxer パスカリス スポシト');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Redesigned and further Developed at 28th of January 2020,');
About.Form2.ListBox1.Items.Add('in order to provide Camera and Mic statuses alone with On/Off and');
About.Form2.ListBox1.Items.Add('Mute/Unmute fuctions');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Final Development Stage at 6th of February 2020, for System ');
About.Form2.ListBox1.Items.Add('Blacklist/Whitelist Modules functions for Camera and Audio');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Bugs Corrected at 10th of February 2020, (Undo Audio Bug) ');
About.Form2.ListBox1.Items.Add('Password is asked every time for Blacklist/Whitelist - Better');
About.Form2.ListBox1.Items.Add('Security, and Password Reset was removed from System''s menu ');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Finalized from previous Stages, by providing exactly the same');
About.Form2.ListBox1.Items.Add('functions with Camera Monitor, plus the Off stage, so now it ');
About.Form2.ListBox1.Items.Add('has a realtime Off (Uvc Video Off), a realtime On (Uvc Video On)');
About.Form2.ListBox1.Items.Add('and a realtime Capture On/Off Icon Statuses ');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Note: A big part of code, changed in order to add these statuses');
About.Form2.ListBox1.Items.Add('because it rebased the total violations algorithms (hacks control)');
About.Form2.ListBox1.Items.Add('Done at 15th of February 2020 ');
About.Form2.ListBox1.Items.Add(' ');
About.Form2.ListBox1.Items.Add('Further Capabilities added alone with better Logging at 22nd of ');
About.Form2.ListBox1.Items.Add('February 2020');
About.Form2.Show;
end;
procedure TForm1.PopupNotifier1Close(Sender: TObject;
var CloseAction: TCloseAction);
begin
PopUpNotifier1.Hide;
end;
procedure TForm1.PopupNotifier2Close(Sender: TObject;
var CloseAction: TCloseAction);
begin
PopUpNotifier2.Hide;
end;
procedure TForm1.PopupNotifier3Close(Sender: TObject;
var CloseAction: TCloseAction);
begin
PopUpNotifier3.Hide;
end;
procedure TForm1.PopupNotifier4Close(Sender: TObject;
var CloseAction: TCloseAction);
begin
PopUpNotifier4.Hide;
end;
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
PopUpMenu4.PopUp;
end;
procedure TForm1.TrayIcon2Click(Sender: TObject);
begin
PopUpMenu3.PopUp;
end;
procedure TForm1.TrayIcon3Click(Sender: TObject);
begin
PopUpMenu2.PopUp;
end;
procedure TForm1.TrayIcon4Click(Sender: TObject);
begin
PopUpMenu5.PopUp;
end;
procedure TForm1.TrayIcon5Click(Sender: TObject);
begin
PopUpMenu6.PopUp;
end;
procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject; ParamCount: Integer; const Parameters: array of String);
begin
ShowMessage ( 'Another instance of Camera Control is running' + sLineBreak +
'and will lead in wrong External Events (Hack)' + sLineBreak +
'detection' + sLineBreak +
'Now both will Exit.' + sLineBreak +
'Run me again!' );
Halt(0);
end;
procedure CheckEvents; // Check Statuses and External Events Notifications and Logs
var
HackedTime : TDateTime;
// Str : String;
StrOff : String;
begin
with Form1 do
begin
if FromMain = true then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Application Started', ' ']);
AppendLogs;
Inc(GridLine);
// Reload Final Icons... (cthreads, and -O3 build level not enough? lol)
ImageListCam1.GetIcon(CameraIcon, TrayIcon5.Icon);
ImageListStatus.GetIcon(0, TrayIcon3.Icon);
ImageListCam.GetIcon(2, TrayIcon1.Icon);
ImageListMic.GetIcon(MicIcon, TrayIcon2.Icon);
ImageListSystem.GetIcon(0, TrayIcon4.Icon);
if CamStatus = 0 then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Camera is Off', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
PopUpWebcamOff;
end;
if CamStatus = 1 then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Camera is On', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
PopUpWebcamOn;
end;
if CamStatus = 2 then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Camera is Captuting, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
PopUpWebcamCaptures;
PopUpWebcamCaptStatus := true;
end;
If MicStatus = true then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Microphone is Unmuted', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
PopUpMicOn;
end;
If MicStatus = false then
begin
ActionTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(ActionTime), 8), 'Microphone is Muted', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
PopUpMicOff;
end;
FromMain := false;
end;
GetVideoCards;
GetCameraStatus;
if RebootNeededFlag = true then
begin
RebootNeededDialog;
//RebootNeededFlag := false;
end;
//----------------------------------------------------------------- Oldies but Goodies -----------------------------------------------------------------------//
//------------------------------------------------------------------------------------------------------------------------------------------------------------//
// VideoCardsCountNumber = 0 & V4L2Val = -1 -> CamStatus = 0 -> Camera is off
// VideoCardsCountNumber = 0 & V4L2Val = 0 -> CamStatus = 1 -> Camera is On
// VideoCardsCountNumber = 1 & V4L2Val = 0 -> CamStatus = 2 -> CameraCapturing
//Str := 'VidCardsNum = ' + IntToStr(VideoCardsCountNumber) +
// ' /dev/video1/ = ' + BoolToStr(DirectoryExists('/dev/video1/')) +
// ' V4L2Val = ' + IntToStr(V4L2Val) +
// ' CamStatus = ' + IntToStr(CamStatus) +
// ' CamSavedStat = ' + IntToStr(CamSavedStatus);
//
//writeln(Str);
//writeln('VidCardsNum = ', IntToStr(VideoCardsCountNumber), ' CamStatus = ', CamStatus, ' CamSavedStat = ', CamSavedStatus, ' V4L2Val = ', IntToStr(V4L2Val));
//-------------------------------------------------------------------------------------------------------------------------------------------------------------//
if (CamStatus = 2) and (CamSavedStatus = 0) then // Webcam Captures from Off
begin
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
PopupNotifier2.Hide;
if PopUpWebcamCaptStatus = false then
begin
ActionTime := now;
PopUpWebcamCaptures;
PopUpWebcamCaptStatus := true;
PopUpWebcamCapturing;
TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled and Capturing';
VideoCapt := true;
CamSavedStatus := 2;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera is Captuting from Off, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
end;
end;
if (CamStatus = 2) and (CamSavedStatus = 1) then // Webcam Captures from On
begin
ActionTime := now;
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
PopupNotifier2.Hide;
PopUpWebcamCaptures;
PopUpWebcamCaptStatus := true;
PopUpWebcamCapturing;
TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled and Capturing';
VideoCapt := true;
CamSavedStatus := 2;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera is Captuting from On, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
end;
if ((CamStatus = 1) and (CamSavedStatus = 1) and (CamClicked = true) and (CamClicksCounter= 1)) then // Webcam is On, User Clicked
begin
ActionTime := now;
PopUpWebcamOn;
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamCaptStatus := true;
CamClicked := false;
CamClicksCounter := 0;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera is On, by the User', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
end;
if (CamStatus = 1) and (CamSavedStatus = 2) then // Webcam Stopped Capturing from On
begin
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
if (VideoCapt = true) then
begin
ActionTime := now;
PopUpWebcamNotCapturing;
PopUpWebcamNoCapturing;
PopUpWebcamCaptStatus := false;
VideoCapt := false;
CamSavedStatus := 1;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Stopped Captuting', IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
end;
end;
//if (VideoCardsCountNumber = 1) and (CamStatus = 2) and (CamSavedStatus = 1) and (V4L2Val = 0) then
// begin
// ImageListCam1.GetIcon(2, TrayIcon5.Icon);
// if (VideoCapt = true) then
// begin
// PopUpWebcamNotCapturing;
// PopUpWebcamNoCapturing;
// PopUpWebcamCaptStatus := false;
// VideoCapt := false;
// CamSavedStatus := 1;
// end;
// end;
if ((CamStatus = 0) and (CamSavedStatus <= 2) and (CamClicked = true) and (CamClicksCounter= 1)) then // Webcam disabled, User Clicked
begin
ActionTime := now;
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
PopUpNoWebcam;
CamClicked := false;
CamClicksCounter := 0;
if CamSavedStatus = 1 then
StrOff := 'Camera is Off from On, by the User'
else
StrOff := 'Camera is Off from Capturing, by the User';
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), StrOff, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
CamSavedStatus := 0;
end;
if (VideoCardsCountNumber = 0) and (VideoDevicesNumber > 1) and (CamStatus = 2) and (SecondCaptureDevice = true) then
begin
if PopUpWebCamCaptStatus = true then
begin
ActionTime := now;
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
PopupNotifier2.Hide;
PopUpWebcamCaptures;
PopUpWebcamCaptStatus := false;
PopUpWebcamCapturing;
TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled and Capturing';
VideoCapt := true;
CamSavedStatus := 2;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', ActionTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera is Captuting from On, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
AppendLogs;
Inc(GridLine);
SecondCaptureDeviceOn := true;
end;
end;
///////////////////////////////////////////////////////////////////////////// Hacking Checks ////////////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------//
if ((CamStatus = 1) and (CamSavedStatus = 0) and (CamClicked = false) and (CamClicksCounter= 0)) then // Webcam went On from Off, No User Clicked -> Hacked
begin
HackedTime := now;
PopUpWebcamHacked;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked to On', IntToStr(VideoDevicesNumber)]);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListCam1.GetIcon(2, TrayIcon5.Icon);
//CamClicksCounter := 1;
//CamClicked := false;
CamSavedStatus := 1;
//PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamCaptStatus := true;
AppendLogs;
Inc(GridLine);
end;
if ((CamStatus = 0) and (CamSavedStatus = 2) and (CamClicked = false) and (CamClicksCounter= 0)) then // Webcam went On from Off, No User Clicked -> Hacked
begin
HackedTime := now;
PopUpWebcamHacked;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked from Captuting to Off', IntToStr(VideoDevicesNumber)]);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
//CamClicksCounter := 1;
//CamClicked := false;
CamSavedStatus := 0;
//PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamCaptStatus := true;
AppendLogs;
Inc(GridLine);
end;
//if ((VideoDevicesNumber = 0) and (CamStatus = 1) and (CamSavedStatus = 1) and (V4L2Val = -1) and (CamClicked = false) and (CamClicksCounter= 0)) then // Webcam went On from Off, No User Clicked -> Hacked
// begin
// HackedTime := now;
// PopUpWebcamHacked;
//
// Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
// + RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked to On', IntToStr(VideoDevicesNumber)]);
//
// ImageListStatus.GetIcon(1, TrayIcon3.Icon);
//
// ImageListCam1.GetIcon(2, TrayIcon5.Icon);
//
// //CamClicksCounter := 1;
// //CamClicked := false;
// CamSavedStatus := 1;
// //PopUpWebcamCaptStatus := false;
// PopUpWebcamNoCapturing;
// PopUpWebcamCaptStatus := true;
// Inc(GridLine);
// end;
if ((CamStatus = 0) and (CamSavedStatus = 1) and (CamClicked = false) and (CamClicksCounter= 0)) then // Webcam went Off from On, No User Clicked -> Hacked
begin
HackedTime := now;
PopUpWebcamHacked;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked to Off', IntToStr(VideoDevicesNumber)]);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
//CamClicksCounter := 1;
//CamClicked := false;
CamSavedStatus := 0;
//PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamCaptStatus := true;
AppendLogs;
Inc(GridLine);
end;
if ((CamStatus = 1) and (CamSavedStatus = 0) and (CamClicked = false) and (CamClicksCounter = 0)) then // Webcam disabled (Off), No User Clicked -> Hacked
begin
HackedTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked to Off', IntToStr(VideoDevicesNumber)]);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListCam1.GetIcon(0, TrayIcon5.Icon);
CamSavedStatus := 0;
//PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamHacked;
PopUpWebcamCaptStatus := false;
//CamClicked := false;
//CamClicksCounter := 1;
AppendLogs;
Inc(GridLine);
end;
if ((CamStatus = 2) and (CamSavedStatus = 0) and (CamClicked = false) and (CamClicksCounter = 0)) then // Webcam disabled (Off), No User Clicked -> Hacked
begin
HackedTime := now;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine, [IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Camera Hacked to Capture from Off, by ' + CaptureAppName, IntToStr(VideoDevicesNumber)]);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListCam1.GetIcon(1, TrayIcon5.Icon);
CamSavedStatus := 0;
//PopUpWebcamCaptStatus := false;
PopUpWebcamNoCapturing;
PopUpWebcamHacked;
PopUpWebcamCaptStatus := false;
//CamClicked := false;
//CamClicksCounter := 1;
AppendLogs;
Inc(GridLine);
end;
GetMicCaptureStatus;
if ((isMicOn = true) and (MicStatus = false) and (MicClicked = true) and (MicClicksCounter = 1)) then
begin
ImageListMic.GetIcon(0, TrayIcon2.Icon);
MicClicked := false;
MicClicksCounter := 0;
ActionTime := now;
end;
if ((isMicOn = true) and (MicStatus = false) and (MicClicked = false) and (MicClicksCounter = 0)) then
begin
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
ImageListMic.GetIcon(0, TrayIcon2.Icon);
HackedTime := now;
//ShowMessage('Microphone hacked !!! Please Check Log');
PopUpMicHacked;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Microphone Hacked to Unmuted', 'None']);
MicStatus := true;
AppendLogs;
Inc(GridLine);
end;
if ((isMicOn = false) and (MicStatus = true) and (MicClicked = true) and (MicClicksCounter = 1)) then
begin
ImageListMic.GetIcon(1, TrayIcon2.Icon);
MicClicked := false;
MicClicksCounter := 0;
end;
if ((isMicOn = false) and (MicStatus = true) and (MicClicked = false) and (MicClicksCounter = 0)) then
begin
ImageListMic.GetIcon(1, TrayIcon2.Icon);
ImageListStatus.GetIcon(1, TrayIcon3.Icon);
HackedTime := now;
//ShowMessage('Microphone hacked !!! Please Check Log');
PopUpMicHacked;
Logs.Form3.StringGrid1.InsertRowWithValues ( GridLine,[IntToStr(GridLine), FormatDateTime('dd/mm/yyyy, ', HackedTime)
+ RightStr(DateTimeToStr(VPClock1.Time), 8), 'Microphone Hacked to Muted', 'None']);
MicStatus := false;
AppendLogs;
Inc(GridLine);
end;
end;
end;
Procedure AppendLogs; // Appends each Log to the Log file Directly
begin
HomeDir := expandfilename('~/');
FileDestDir := Concat(HomeDir,'.cameracontrol-', LogsDateString, '.log');
if GridLine = 1 then
begin
FileString := Concat(Form3.StringGrid1.Rows[0].Strings[0],'/', Form3.StringGrid1.Rows[0].Strings[1],'/', Form3.StringGrid1.Rows[0].Strings[2],'/' , Form3.StringGrid1.Rows[0].Strings[3]);
S := FpSystem(Concat('echo ' , FileString, ' >> ', FileDestDir));
end;
FileString := Concat(Form3.StringGrid1.Rows[GridLine].Strings[0],'/', Form3.StringGrid1.Rows[GridLine].Strings[1],'/', Form3.StringGrid1.Rows[GridLine].Strings[2],'/' , Form3.StringGrid1.Rows[GridLine].Strings[3]);
S := FpSystem(Concat('echo ' , FileString, ' >> ', FileDestDir));
//writeln(GridLine);
end;
procedure CheckCapturePassword;
begin
Password2 := RightStr(Password2, Length(Password2) - 1);
//ShowMessage(Password2 + ', ' + IntToStr(Length(Password2)));
S := FpSystem(Concat('echo ', Password2, ' | sudo -S sh -c "ls /root"'));
if S <> 0 then
begin
Form1.MenuItem38.Visible := true;
HasPassword := false;
Password2 := '';
NoCapturePassword;
WantsPassword := true;
end
else
begin
Password := Password2;
Form1.MenuItem38.Visible := false;
HasPassword := true;
ShowMessage( 'Password is Correct' + sLineBreak +
'Now Kill Capturing (Sudo) is available' + sLineBreak +
'on the Camera Indicator Menu' + sLineBreak +
'Got correct password from startup parameter');
WantsPassword := false;
end;
end;
procedure TForm1.VpClock1SecondChange(Sender: TObject);
begin
if (FromMain = true) and (CompareText(RightStr(Password2, Length(Password2) - 1), '') > 0) and (HasPassword = false) then
CheckCapturePassword
else
if (FromMain = true) and (CompareText(RightStr(Password2, Length(Password2) - 1), '') = 0) and (HasPassword = false) then
GetCapturePassword;
CheckEvents;
end;
end.
Reference in New Issue View Git Blame Copy Permalink