Reached at 2.0-1 Release, finally!

This commit is contained in:
PSposito 2020-02-26 01:06:24 +02:00
parent 3006af2fe3
commit e8a6bdbd88
No known key found for this signature in database
GPG Key ID: 92E2BB27E8617EFC
5 changed files with 7011 additions and 35 deletions

Binary file not shown.

BIN
Camera Control.pdf Normal file

Binary file not shown.

6796
main.frm

File diff suppressed because it is too large Load Diff

View File

@ -29,5 +29,7 @@
{"hash":226721332,"name":"tform1.menuitem32.caption","sourcebytes":[66,108,97,99,107,108,105,115,116,32,65,117,100,105,111,32,97,110,100,32,82,101,98,111,111,116],"value":"Blacklist Audio and Reboot"},
{"hash":250860404,"name":"tform1.menuitem33.caption","sourcebytes":[87,104,105,116,101,108,105,115,116,32,65,117,100,105,111,32,97,110,100,32,82,101,98,111,111,116],"value":"Whitelist Audio and Reboot"},
{"hash":4691652,"name":"tform1.menuitem44.caption","sourcebytes":[65,98,111,117,116],"value":"About"},
{"hash":315140,"name":"tform1.menuitem45.caption","sourcebytes":[69,120,105,116],"value":"Exit"}
{"hash":315140,"name":"tform1.menuitem45.caption","sourcebytes":[69,120,105,116],"value":"Exit"},
{"hash":185423705,"name":"tform1.menuitem13.caption","sourcebytes":[75,105,108,108,32,67,97,112,116,117,114,105,110,103,32,40,85,115,101,114,32,77,111,100,101,41],"value":"Kill Capturing (User Mode)"},
{"hash":200734201,"name":"tform1.menuitem37.caption","sourcebytes":[75,105,108,108,32,67,97,112,116,117,114,105,110,103,32,40,83,117,100,111,41],"value":"Kill Capturing (Sudo)"}
]}

246
main.pas
View File

@ -38,6 +38,7 @@ type
MenuItem10 : TMenuItem;
MenuItem11 : TMenuItem;
MenuItem12 : TMenuItem;
MenuItem13 : TMenuItem;
MenuItem14 : TMenuItem;
MenuItem15 : TMenuItem;
MenuItem16 : TMenuItem;
@ -63,6 +64,7 @@ type
MenuItem34 : TMenuItem;
MenuItem35 : TMenuItem;
MenuItem36 : TMenuItem;
MenuItem37 : TMenuItem;
MenuItem39 : TMenuItem;
MenuItem4 : TMenuItem;
MenuItem40 : TMenuItem;
@ -81,6 +83,7 @@ type
PopupMenu3 : TPopupMenu;
PopupMenu4 : TPopupMenu;
PopupMenu5 : TPopupMenu;
PopupMenu6 : TPopupMenu;
PopupNotifier1 : TPopupNotifier;
PopupNotifier2 : TPopupNotifier;
PopupNotifier3 : TPopupNotifier;
@ -101,6 +104,7 @@ type
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);
@ -109,6 +113,7 @@ type
procedure MenuItem33Click(Sender: TObject);
procedure MenuItem34Click(Sender: TObject);
procedure MenuItem36Click(Sender: TObject);
procedure MenuItem37Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
@ -122,6 +127,7 @@ type
procedure TrayIcon2Click(Sender: TObject);
procedure TrayIcon3Click(Sender: TObject);
procedure TrayIcon4Click(Sender: TObject);
procedure TrayIcon5Click(Sender: TObject);
procedure VpClock1SecondChange(Sender: TObject);
private
@ -138,9 +144,10 @@ var
S : LongInt;
MicSwitchStr : String;
Password : String;
Password2 : String;
isMicOn : boolean;
MicStatus : boolean;
//MicSavedStatus : boolean;
//MicSavedStatus : boolean;
CamStatus : byte;
CamSavedStatus : Byte;
HasPassword : boolean;
@ -178,13 +185,18 @@ var
LogsDateString : String;
LogsStringList : TStringList;
CaptureAppName : String;
SecondCaptureDevice : boolean;
SecondCaptureDeviceOn : boolean;
Str2 : String;
WantsPassword : boolean;
implementation
procedure RebootSystem; forward;
//procedure SaveLogs; forward;
procedure AskPassword; forward;
Procedure AppendLogs; forward;
{$R *.frm}
@ -208,14 +220,14 @@ end;
procedure PopUpWebcamOn;
begin
Form1.PopupNotifier2.Text := 'Camera is On' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/';
Form1.PopupNotifier2.ShowAtPos(NewWidth - 200 , NewHeight div 2 - 400);
Form1.PopupNotifier2.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 550);
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 - 200 , NewHeight div 2 - 400);
Form1.PopupNotifier1.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 550);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is Disabled';
end;
@ -223,21 +235,21 @@ procedure PopUpWebcamCaptures;
begin
Form1.PopupNotifier7.Text := 'Camera is Capturing' + LineEnding + 'Video Device: /dev/video'
+ IntToStr(CountNumber)+ '/' + LineEnding + 'Application Name: ' + CaptureAppName;
Form1.PopupNotifier7.ShowAtPos(NewWidth - 200 , NewHeight div 2 - 400);
Form1.PopupNotifier7.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 550);
Form1.TrayIcon5.Hint := 'Camera Status' + LineEnding + 'Camera is Capturing' + LineEnding + CaptureAppName;
end;
procedure PopUpWebcamHacked;
begin
Form1.PopupNotifier8.Text := 'Camera is Hacked' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/' + LineEnding + 'Check Logs';
Form1.PopupNotifier8.ShowAtPos(NewWidth - 200 , NewHeight div 2 - 400);
Form1.PopupNotifier8.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 550);
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 - 200 , NewHeight div 2 - 200);
Form1.PopupNotifier9.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 375);
Form1.TrayIcon5.Hint := 'Microphone Status' + LineEnding + 'Microphone is Hacked' + LineEnding + 'Check Logs';
end;
@ -254,7 +266,7 @@ end;
procedure PopUpWebcamNotCapturing;
begin
Form1.PopupNotifier6.Text := 'Camera is not Capturing' + LineEnding + 'Video Device: /dev/video' + IntToStr(CountNumber)+ '/';
Form1.PopupNotifier6.ShowAtPos(NewWidth - 200 , NewHeight div 2 - 400);
Form1.PopupNotifier6.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 550);
Form1.TrayIcon5.Hint := 'Camera On' + LineEnding + 'Camera is Enabled, but is not Capturing';
end;
@ -266,14 +278,14 @@ end;
procedure PopUpMicOn;
begin
Form1.PopupNotifier3.Text := 'Microphone is Unmuted' + LineEnding + 'Alsa Driver Status: cap';
Form1.PopupNotifier3.ShowAtPos(NewWidth - 200 , NewHeight div 2 - 200);
Form1.PopupNotifier3.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 375);
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 - 200 , NewHeight div 2 - 200);
Form1.PopupNotifier4.ShowAtPos(NewWidth - 100 , NewHeight div 2 - 375);
Form1.TrayIcon2.Hint := 'Microphone Status & Menu' + LineEnding + 'Microphone is Muted';
end;
@ -322,25 +334,14 @@ begin
RebootDialog.Form5.Show;
end;
procedure GetVideoCards; // VideoCards /dev/ Names
procedure KillCapturingApplication;
var
AStringList : TStringList;
AProcess : TProcess;
j : Integer;
Str : String;
SubStr : String = '(deleted)';
n : integer;
m : integer;
l : integer;
//StrLength : integer;
begin
m := 0;
l := 0;
CaptureStatus := 0;
CaptureAppName := '';
//StrLength := 0;
Str := 'lsof /dev/ ' + '|' + ' grep video'; // Full test command is: lsof /dev | grep video && ls /dev/ | grep v4l
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';
@ -349,8 +350,95 @@ begin
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('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 then // Full test command is: lsof /dev | grep video && ls /dev/ | grep v4l
Str2 := Concat('echo ', Password, ' | 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;
@ -385,6 +473,8 @@ begin
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;
@ -403,7 +493,18 @@ begin
CaptureStatus := 1;
If (AStringList.Count - 1) >= 0 then
CaptureAppName := LeftStr(AStringList.Strings[AStringList.Count - 1], 8);
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;
@ -456,8 +557,49 @@ begin
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
Form1.MenuItem13.Visible := true;
if Length(Password2) > 0 then
Form1.MenuItem37.Visible := true;
end;
end;
procedure GetCapturePassword;
begin
if (HasPassword = true) and (WantsPassword = true) then
begin
S := FpSystem(Concat('echo ', Password, ' | sudo -S sh -c "ls /root"'));
if S <> 0 then
AskPassword
else
Password2 := Password;
WantsPassword := true;
end
else
if (HasPassword = false) and (WantsPassword = true) then
begin
AskPassword;
S := FpSystem(Concat('echo ', Password, ' | sudo -S sh -c "ls /root"'));
if S <> 0 then
begin
ShowMessage('The Application will cath and will be able to kill, only Users Events.' + sLineBreak + 'For Better Protection, please Exit, re-run this application and provide sudo password');
WantsPassword := false;
end
else
begin
Password2 := Password;
WantsPassword := false;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
@ -484,6 +626,11 @@ begin
VideoDevicesNumber := 0;
LogsDateString := FormatDateTime('DD/MM/YYYY-hh-mm-ss',now);
LogsStringList := TStringList.Create;
SecondCaptureDeviceOn := false;
MenuItem13.Visible := false;
MenuItem37.Visible := false;
Password2 := '';
WantsPassword := true;
LogsStringList.Clear;
//Logs.Form3.StringGrid1.Clean;
@ -562,6 +709,7 @@ begin
MicClicksCounter:= 0;
PopUpMicOff;
MicIcon := 1;
PopUpMenu6.Close;
end;
// Reload Final Icons... (cthreads, and -O3 build level not enough? lol)
@ -651,6 +799,26 @@ 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 DeleteOldLogs; // Deletes old Log files
var
SearchResult : TSearchRec;
@ -1177,6 +1345,11 @@ begin
PopUpMenu5.PopUp;
end;
procedure TForm1.TrayIcon5Click(Sender: TObject);
begin
PopUpMenu6.PopUp;
end;
procedure CheckEvents; // Check Statuses and External Events Notifications and Logs
var
HackedTime : TDateTime;
@ -1378,6 +1551,28 @@ begin
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 ////////////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------//
@ -1575,6 +1770,7 @@ end;
procedure TForm1.VpClock1SecondChange(Sender: TObject);
begin
GetCapturePassword;
CheckEvents;
end;