Код можно было сократить и сделать его более красивым, но тупо лень.
Код: Выделить всё
unit Unit1; // Сергей Хахакеров ... ((( ^_^ )))
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, JvBalloonHint, JvComponentBase, JvTrayIcon,
Menus, TlHelp32, Spin;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
tl1: TLabel;
Bevel1: TBevel;
tl2: TLabel;
Label3: TLabel;
tl4: TLabel;
tl5: TLabel;
tl6: TLabel;
Bevel2: TBevel;
Button1: TButton;
Button2: TButton;
PopupMenu1: TPopupMenu;
JvTrayIcon1: TJvTrayIcon;
JvBalloonHint1: TJvBalloonHint;
Timer1: TTimer;
N1: TMenuItem;
GroupBox1: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Bevel3: TBevel;
Label7: TLabel;
N2: TMenuItem;
Memo2: TMemo;
Image1: TImage;
Timer2: TTimer;
GroupBox2: TGroupBox;
Edit1: TEdit;
Label8: TLabel;
Button3: TButton;
Button4: TButton;
Button5: TButton;
N3: TMenuItem;
N4: TMenuItem;
procedure xXx(Sender: TObject);
procedure GoToTray(Sender: TObject);
procedure RestoreFromTray(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm} {$R v.res}
const
week:array[1..7] of string = ('Воскресенье','Понедельник','Вторник',
'Среда','Четверг','Пятница','Суббота');
function GetUserFromWindows: string; // определяем имя учёточки ...
var
UserName : string;
UserNameLen : Dword;
begin
UserNameLen := 255;
SetLength(userName, UserNameLen);
if GetUserName(PChar(UserName), UserNameLen) then
Result := Copy(UserName,1,UserNameLen - 1)
else
Result := 'Unknown';
end;
function GetProcessByEXE(exename: string): THandle; //определяем запущена программа или нет
var
hSnapshoot: THandle;
pe32: TProcessEntry32;
begin
Result:= 0;
hSnapshoot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapshoot = 0) then Exit;
pe32.dwSize:= SizeOf(TProcessEntry32);
if (Process32First(hSnapshoot, pe32)) then
repeat
if (pe32.szExeFile = exename) then
begin
Result:= pe32.th32ProcessID;
exit;
end;
until not Process32Next(hSnapshoot, pe32);
end;
procedure TForm1.GoToTray(Sender: TObject); // Свернуть в трэй
begin
JvTrayIcon1.HideApplication;
end;
procedure TForm1.RestoreFromTray(Sender: TObject); // Развернуть из трэй
begin
Form1.Show;
Form1.Visible:=True;
Form1.Enabled:=True;
Application.Restore;
end;
procedure TForm1.xXx(Sender: TObject); // Работаем с тагами
var day:integer;
begin
if tl4.Caption = 'Определяю...' then
begin
GoToTray(Sender); // Если юзер пытается закрыть программу, прячем её ва трей
Timer2.Enabled:=FALSE;
end;
case TComponent(Sender).Tag of
1: MessageBox(Handle,'Привет! Я Следоратор! Я слежу, чтобы резервные копии документов, '+
'баз 1с и прочих файлов сервера были очень хорошо сохранены и зашифрованы без потерь и ошибок.'+#13#13+
'Разработал: Хахакеров Сергей Алексеевич'+#13+
'Для: ООО КОМЕТА'+#13+
'Версия: 0.1 (тестовая) от 28.01.2021',
'О программме: Следоратор',MB_OK or MB_ICONASTERISK); // выводим окно О_проге!
2:
begin
day:=DayOfWeek(date); //определяем день недели ...
Label6.caption:=FormatDateTime(week[day]+' (DD.MM.YY)',now);
Label7.caption:=FormatDateTime('HH:NN:SS',now); // текущее время
// Запускаем сканер
if (Label7.caption = '15:59:55') OR (Label7.caption = '16:59:55')
OR (Label7.caption = '17:59:55')
OR (Label7.caption = '18:59:55')
OR (Label7.caption = '19:59:55')
then Timer2.Enabled:=TRUE else begin
if (Label7.caption = '16:00:05')
OR (Label7.caption = '17:00:05')
OR (Label7.caption = '18:00:05')
OR (Label7.caption = '19:00:05')
OR (Label7.caption = '20:00:05')
then Timer2.Enabled:=FALSE;
end;
end;
3:
begin
GoToTray(Sender); // Если юзер пытается закрыть программу, прячем её ва трей
Timer2.Enabled:=FALSE;
end;
4:
begin
//SpinEdit1.Value:=SpinEdit1.Value+1;
//Определяем запущена 1с или нет ...
if GetProcessByEXE('1cv8c.exe') OR GetProcessByEXE('1cv8.exe') OR GetProcessByEXE('1cv8s.exe') = 0
then
begin
tl4.Caption:='Закрыт';
tl4.font.Color:=clBlue;
end
else
begin
tl4.Caption:='Открыт';
tl4.font.Color:=clRed;
// Если 1с работает то выаодим окно оповещения ...
if (Label7.caption = '15:59:59') OR (Label7.caption = '16:59:59')
OR (Label7.caption = '17:59:59')
OR (Label7.caption = '18:59:59')
OR (Label7.caption = '19:59:59')
then
begin
RestoreFromTray(Sender); // показываем окно .
memo2.Lines.Clear; // очищаем лог..
// загружаем лог если есть
try memo2.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt'); except end;
Memo2.Lines.Add('Не закрыта программа 1с '
+Label7.caption+' '
+Label6.caption+' '
+GetUserFromWindows);
// сохраняем логи для админа (если юзер косячит)
memo2.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt');
end;
end;
//Определяем запущен ворд или нет ...
if GetProcessByEXE('winword.exe') OR GetProcessByEXE('WINWORD.EXE') = 0
then
begin
tl5.Caption:='Закрыт';
tl5.font.Color:=clBlue;
end
else
begin
tl5.Caption:='Открыт';
tl5.font.Color:=clRed;
// Если ворд работает то выводим окно оповещения ...
if (Label7.caption = '15:59:58') OR (Label7.caption = '16:59:58')
OR (Label7.caption = '17:59:58')
OR (Label7.caption = '18:59:58')
OR (Label7.caption = '19:59:58')
then
begin
RestoreFromTray(Sender);
memo2.Lines.Clear;
try memo2.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt'); except end;
Memo2.Lines.Add('Не закрыта программа word '
+Label7.caption+' '
+Label6.caption+' '
+GetUserFromWindows);
memo2.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt');
end;
end;
//Определяем запущен эксель или нет ...
if GetProcessByEXE('excel.exe') OR GetProcessByEXE('EXCEL.EXE') = 0
then
begin
tl6.Caption:='Закрыт';
tl6.font.Color:=clBlue;
end
else
begin
tl6.Caption:='Открыт';
tl6.font.Color:=clRed;
// Если эксель работает то выводим окно оповещения ...
if (Label7.caption = '15:59:57') OR (Label7.caption = '16:59:57')
OR (Label7.caption = '17:59:57')
OR (Label7.caption = '18:59:57')
OR (Label7.caption = '19:59:57')
then
begin
RestoreFromTray(Sender);
memo2.Lines.Clear;
try memo2.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt'); except end;
Memo2.Lines.Add('Не закрыта программа excel '
+Label7.caption+' '
+Label6.caption+' '
+GetUserFromWindows);
memo2.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'sledlog\'+GetUserFromWindows+'.txt');
end;
end;
end;
5: application.Terminate;
6: timer1.Enabled:=FALSE;
7: if edit1.Text = GetUserFromWindows+'2020' then
begin
Button4.Enabled:=TRUE;
Button5.Enabled:=TRUE;
N4.Enabled:=TRUE;
Button3.Enabled:=FALSE;
Edit1.Enabled:=FALSE;
memo2.Lines.Add('Вы вошли в систему');
end
else memo2.Lines.Add('Пароль не верный!');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Определяем уникальный id пользователя ...
form1.Caption:='Следоратор ['+GetUserFromWindows+']';
end;
// если юзер хитрый и может закрыть прогу , делаем запрет и сворачиваем с трей!.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Application.Minimize;
GoToTray(Sender);
end;
end.