//Серверное приложение.

unit server;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdContext,

IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, Data.DB,

DBAccess, Uni, MemDS, UniProvider, MySQLUniProvider, Vcl.ExtCtrls,

Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, Printers, ShellAPI, Vcl.CheckLst,

Vcl.ComCtrls, IdAntiFreezeBase, Vcl.IdAntiFreeze;

type

TForm1 = class(TForm)

log: TMemo;

Label2: TLabel;

Label3: TLabel;

IdTCPServer1: TIdTCPServer;

Button1: TButton;

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

MySQLUniProvider1: TMySQLUniProvider;

Connection: TUniConnection;

DataSource: TUniDataSource;

Button2: TButton;

StaticText1: TStaticText;

Timer1: TTimer;

Query: TUniQuery;

Button4: TButton;

SaveDialog1: TSaveDialog;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Button3: TButton;

ListBox1: TListBox;

PrintDialog1: TPrintDialog;

TrayIcon1: TTrayIcon;

Button8: TButton;

IdAntiFreeze1: TIdAntiFreeze;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure IdTCPServer1Execute(AContext: TIdContext);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure TrayIcon1DblClick(Sender: TObject);

procedure TrayIcon1Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

//---log clear---//

procedure TForm1.Button1Click(Sender: TObject);

begin

log.Clear;

end;

//---log clear---//

//---Refresh---//

procedure TForm1.Button2Click(Sender: TObject);

begin

IdAntiFreeze1.Active:=true;

ListBox1.Items.Clear;

Query.SQL.Clear;

Query.SQL.Text:=('Select * From Users where `Online`="1";');

Query.ExecSQL;

While not Query.EOF do

begin

ListBox1.Items.Add(Query.FieldByName('Login').AsString); //Заполняем

Query.Next;

end;

ListBox1.ItemIndex :=0;

Label2.Caption:='Пользователи on-line: '+IntToStr(ListBox1.Items.Count);

IdAntiFreeze1.Active:=false;

end;

//---Refresh---//

//---Таблица "users"---//

procedure TForm1.Button3Click(Sender: TObject);

begin

Query.SQL.Clear;

Query.SQL.Text:=('Select * From Users');

Query.ExecSQL;

Width:=1550;

Height:=900; //on

Left:=10;

Top:=10;

Button3.Visible:=false;

Button7.Visible:=true;

DBNavigator1.Visible:=true;

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

Width:=664;

Height:=400;

Position:=poDesktopCenter; //off

Button3.Visible:=true;

Button7.Visible:=false;

DBNavigator1.Visible:=false;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

log.Lines.Add(#13#10+('=====//Список неактивированных учетных записей:')+#13#10);

Query.SQL.Clear;

Query.SQL.Text:=('Select Login From Users where `Статус регистрации`="0";');

Query.ExecSQL;

While not Query.EOF do

begin

log.Lines.Add(Query.FieldByName('Login').AsString); //Заполняем

Query.Next;

end;

log.Lines.Add

(#13#10+('=====//')+#13#10);

end;

//---Таблица "users"---//

//---Save Memo---//

procedure TForm1.Button4Click(Sender: TObject);

var

saveDialog : TSaveDialog; // Переменная диалога сохранения

begin

saveDialog:=TSaveDialog.Create(self);

saveDialog.Title := 'Save log history';

// Разрешаем сохранять файлы типа .txt и .doc

saveDialog.Filter := 'Text file|*.txt|';

saveDialog.FileName:='Log history ['+DateToStr(Now)+']';

if saveDialog.Execute then begin

log.Lines.SaveToFile(SaveDialog.FileName+'.txt');

ShowMessage('File : '+saveDialog.FileName+' has been saved');

end else ShowMessage('Сохранение отменено!'); // Освобождения диалога

saveDialog.Free;

end;

//---Save Memo---//

//---Печать Memo---//

procedure TForm1.Button6Click(Sender: TObject);

var

Line: TextFile;

I: integer;

begin

If PrintDialog1.Execute then

begin

AssignPrn(Line);

ReWrite(Line);

Printer.Canvas.Font := log.Font;

for I := 0 to log.Lines.Count -1 do Writeln (Line, log.Lines[i]);

System.CloseFile(Line);

end;

end;

//---Печать Memo---//

//---Настройки соединения---//

procedure TForm1.FormCreate(Sender: TObject);

begin

IdTCPServer1.DefaultPort := 12345;

IdTCPServer1.Active:=true;

Connection.ProviderName:='MySQL';

Connection.Server:='localhost'; //192.168.1.29

Connection.Database:='uptrasko';

Connection.Username:='root';

Connection.Password:='';

Connection.Connected:=true;

Query.SQL.Text:=('Select * From Users');

Query.Active:=true;

end;

//---Настройки соединения---//

//---Прием данных в лог---//

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);

var

i,t: string; // строковая переменная, в которую мы будем получать

begin

i := AContext.Connection.IOHandler.ReadLn();

Button2.Click;

if ListBox1.Items.IndexOf(i)>= 0 then begin

t:=' вошел в систему!'

end else begin

t:=' вышел из системы!'

end;

log.Lines.Add('['+DateTimeToStr(Now)+'] Пользователь '+i+t+' '+AContext.Connection.Socket.Binding.PeerIP);

end;

//---Прием данных в лог---//

//---Timer---//

procedure TForm1.Timer1Timer(Sender: TObject);

begin

StaticText1.Caption:=DateTimeToStr(Now);

if StaticText1.Caption=DateToStr(Now)+' 00:01:00' then begin //AutoBackup and save log

ShellExecute(handle,'open','O:\autobackup.bat',nil,nil,SW_SHOWNORMAL);

log.Lines.SaveToFile('O:\LogBackupFolder\Log history ['+DateToStr(Now)+'].txt');

log.Lines.Clear;

end else

end;

//---Timer---//

//---Backup---//

procedure TForm1.Button5Click(Sender: TObject);

begin //Backup

ShellExecute(handle,'open','O:\backup.bat',nil,nil,SW_SHOWNORMAL);

end;

//---Backup---//

procedure TForm1.TrayIcon1Click(Sender: TObject);

begin

Form1.Visible:=false;

end;

procedure TForm1.TrayIcon1DblClick(Sender: TObject);

begin

Form1.Visible:=true;

Application.BringToFront; //поверх всех окон

end;

end.