unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ExtCtrls, IdException, Menus, Buttons, shellapi,
  jpeg;

type
  TfrmClient = class(TForm)
    GroupBox1: TGroupBox;
    txtMessage: TEdit;
    cmbSend: TButton;
    lstUsers: TListBox;
    GroupBox2: TGroupBox;
    txtServer: TEdit;
    Label1: TLabel;
    cmbConnect: TButton;
    txtUser: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    TCPClient: TIdTCPClient;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    Label6: TLabel;
    N8: TMenuItem;
    N9: TMenuItem;
    GroupBox3: TGroupBox;
    Button2: TButton;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button7: TButton;
    Button8: TButton;
    Image1: TImage;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N10: TMenuItem;
    GroupBox4: TGroupBox;
    txtChat: TMemo;
    Image2: TImage;
    Image3: TImage;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N16: TMenuItem;
    N15: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    procedure cmbConnectClick(Sender: TObject);
    procedure cmbSendClick(Sender: TObject);
    procedure lstUsersDblClick(Sender: TObject);
    procedure TCPClientConnected(Sender: TObject);
    procedure TCPClientDisconnected(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure Button2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button8MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button5MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button7MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N6Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N20Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmClient: TfrmClient;

implementation

{Процедура осуществляет манипулиции при подключении к серверу}
procedure Connect();
begin
  with frmClient do
  begin
    cmbConnect.Caption := 'Отключиться';
    txtUser.Enabled := False;
    txtServer.Enabled := False;

    Caption := 'Разговорник [' + txtUser.Text + ' подключен к '
     + txtServer.Text + ']';

    lstUsers.Enabled := True;
    cmbSend.Enabled := True;
    txtMessage.Enabled := True;
    txtChat.Enabled := True;
  end;
end;

{Процедура осуществляет манипуляции при отключении от сервера}
procedure Disconnect();
begin
  with frmClient do
  begin
    cmbConnect.Caption := 'Подключиться';
    txtUser.Enabled := True;
    txtServer.Enabled := True;

    Caption := 'Разговорник';

    lstUsers.Enabled := False;
    lstUsers.Clear;
    cmbSend.Enabled := False;
    txtMessage.Enabled := False;
    txtChat.Enabled := False;
  end;
end;

{Процедура обрабатывает сообщение от севера}
procedure ProcessMessage(strMessage: string);
var
  strAction: string;  //Тип сообщения (префикс сообщения)
  len: Integer;       //Длина строки strAction
begin
  //Определим тип сообщения и выполним соответствующие действия
  len := Pos(':', strMessage);
  strAction := Copy(strMessage,1,len-1);
  Delete(strMessage,1,len);
  if (strAction = 'ok') then
  begin
    //Регистрация пользователя завершена - можно отправлять сообщения
    Connect;
  end
  else if (strAction = 'error') then
  begin
    //Ошибка!!!
    frmClient.TCPClient.Disconnect;
    Disconnect;
    MessageDlg(strMessage, mtError, [mbOK], 0);
  end
  else if (strAction = 'adduser') then
  begin
    //К разговору присоединился новый пользователь
    frmClient.lstUsers.Items.Add(strMessage);
  end
  else if (strAction = 'deluser') then
  begin
    //Какой-то пользователь отсоединился
    frmClient.lstUsers.Items.Delete(
    frmClient.lstUsers.Items.IndexOf(strMessage));
  end
  else begin
    //Покажем принятое сообщение
    frmClient.txtChat.Lines.Add(strMessage);
  end;
end;

{
 ******************************************************************************
 * Далее идут процедуры обработки сообщений                                   *
 ******************************************************************************
}

{$R *.dfm}

procedure TfrmClient.cmbConnectClick(Sender: TObject);
begin
  if (cmbConnect.Caption = 'Подключиться') then
  begin
    //Проверим, чтобы были введены имя сервера и имя пользователя
    if (txtServer.Text = '')then
    begin
      MessageDlg('Введите имя сервера в текстовое поле.',
       mtInformation, [mbOK], 0);
      Exit;
    end
    else if (txtUser.Text = '')then
    begin
      MessageDlg('Введите имя пользователя в текстовое поле.',
       mtInformation, [mbOK], 0);
      Exit;
    end;

    //Пытаемся подключиться к серверу
    try
      TCPClient.Host := txtServer.Text;
      TCPClient.Connect;
    except
      MessageDlg('Не удается соединиться с сервером',mtError, [mbOK], 0);

    end;
  end
  else
    //Отключаемся от сервера
    TCPClient.Disconnect;
end;

procedure TfrmClient.cmbSendClick(Sender: TObject);
begin
  if (txtMessage.Text <> '') then
  begin
    //Отправка сообщения всем собеседникам
    TCPClient.WriteLn('text:' + txtMessage.Text);
    txtMessage.Text := '';
    txtMessage.SetFocus;
  end;
end;

procedure TfrmClient.lstUsersDblClick(Sender: TObject);
begin
  if ((lstUsers.ItemIndex >= 0) and (txtMessage.Text <> '')) then
  begin
    //Отправим сообщение только для выбранного собеседника
    //(сообщение вида "имя_собеседника:текст_сообщения")
    TCPClient.WriteLn(lstUsers.Items.Strings[lstUsers.ItemIndex] +
     ':' + txtMessage.Text);
    txtMessage.SetFocus;
  end;
end;

procedure TfrmClient.TCPClientConnected(Sender: TObject);
begin
  //Отправляем на сервер имя пользователя
  TCPClient.WriteLn('name:' + txtUser.Text);
end;

procedure TfrmClient.TCPClientDisconnected(Sender: TObject);
begin
  //Обновим форму для отсоединенного от сервера состояния
  Disconnect;
end;

procedure TfrmClient.Timer1Timer(Sender: TObject);
var strMessage: string;
begin
  //Проверим, нет ли для нас сообщения
  if (TCPClient.Connected)then
  begin
    try
      strMessage := TCPClient.ReadLn;
      if (strMessage <> '')then
        ProcessMessage(strMessage);
    except
      on EIdReadTimeout do ; //Ошибки таймаута игнорируем
      else
        //При остальных ошибках отсоединяемся от сервера
        TCPClient.Disconnect;
    end;
  end;
end;

procedure TfrmClient.N5Click(Sender: TObject);
begin
close;
end;

procedure TfrmClient.N4Click(Sender: TObject);
begin
close;
end;

procedure TfrmClient.N2Click(Sender: TObject);
begin
  showmessage('Сегодня = '+ TimeToStr(Time));
end;

procedure TfrmClient.N3Click(Sender: TObject);
begin
 ShowMessage('Сегодня = '+DateToStr(Date));
end;

procedure TfrmClient.N9Click(Sender: TObject);
  var
  hToken: THandle;
  tkp: TTokenPrivileges;
  ReturnLength: Cardinal;
begin
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, hToken) then
  begin
    LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
      ExitWindowsEx(EWX_ShutDown,0);// Выключение
  end;
end;




procedure TfrmClient.Button2Click(Sender: TObject);
begin
{Button2.Hint:='Нажмите на кнопочку чтобы посмотреть время!';
Button2.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=2500; }
showmessage('Сегодня = '+ TimeToStr(Time));
//Label7.Caption := TimeToStr(Time)
end;


procedure TfrmClient.Button1Click(Sender: TObject);
begin
ShowMessage('Сегодня = '+DateToStr(Date));
{Button1.Hint:='Нажми на меня и Вы увидите какое сегодня число';
Button1.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000; }
//MessageBox(0, 'My Information Message', 'WARNING', mb_IconInformation + mb_OK + mb_TaskModal);
end;

procedure TfrmClient.Button3Click(Sender: TObject);
begin
close;
{Button3.Hint:='Нажмёте эту кнопочку и Вы закроете это окно и придётся его открывать снова';
Button3.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;}
end;

procedure TfrmClient.Button5Click(Sender: TObject);
 var
  hToken: THandle;
  tkp: TTokenPrivileges;
  ReturnLength: Cardinal;
begin
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, hToken) then
  begin
    LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
      ExitWindowsEx(EWX_ShutDown,0);// Выключение
{Button5.Hint:='Ну я думаю тут и так все понятно :)';
Button5.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;}
  end;
end;

procedure TfrmClient.Button4Click(Sender: TObject);
begin
showmessage('Данная программа является темой курсового проекта "Розробка програми обміну повідомленнями з використнням сокетів" ');
{Button4.Hint:='Что же делает эта программа? Нажмите на кнопочку: О Программе';
Button4.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000; }
end;

procedure TfrmClient.Button7Click(Sender: TObject);
begin
showmessage('Розработчик программы: Студент 351 группы, Комляков Андрей');
{Button7.Hint:='Кто же создал меня? =)';
Button7.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000; }
end;

procedure TfrmClient.Button6Click(Sender: TObject);
begin
showmessage(' ');
end;

procedure TfrmClient.Button8Click(Sender: TObject);
begin
//Application.HelpFile := 'help.chm';
ShellExecute(Application.Handle,nil,'help.chm',nil,nil,sw_show);
//Application.HelpFile := ExtractFilePath(Application.ExeName)+'help.chm'
{Button8.Hint:='Помощь по чату';
Button8.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;  }

end;

procedure TfrmClient.N7Click(Sender: TObject);
begin
showmessage('Данная программа является темой курсового проекта "Розробка програми обміну повідомленнями з використнням сокетів" ');
//ShellExecute(Application.Handle,'open','help.chm',nil,nil,0);
end;

procedure TfrmClient.Button2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button2.Hint:='Нажмите на кнопочку чтобы посмотреть время!';
Button2.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=2500;
end;

procedure TfrmClient.Button1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button1.Hint:='Нажми на меня и Вы увидите какое сегодня число';
Button1.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.Button8MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button8.Hint:='Помощь по чату';
Button8.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.Button4MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button4.Hint:='Что же делает эта программа? Нажмите на кнопочку: О Программе';
Button4.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.Button5MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button5.Hint:='Ну я думаю тут и так все понятно :)';
Button5.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.Button7MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button7.Hint:='Кто же создал меня? =)';
Button7.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.Button3MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
Button3.Hint:='Нажмёте эту кнопочку и Вы закроете это окно и придётся его открывать снова';
Button3.ShowHint:=true;
Application.HintColor:=clLime;
Application.HintPause:=100;
Application.HintHidePause:=1000;
end;

procedure TfrmClient.N6Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'help.chm',nil,nil,sw_show);
end;

procedure TfrmClient.N10Click(Sender: TObject);
begin
showmessage('Розработчик программы: Студент 351 группы, Комляков Андрей');
end;

procedure TfrmClient.Edit1Change(Sender: TObject);
begin
showmessage('Сегодня = '+ TimeToStr(Time));
end;

procedure TfrmClient.N12Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'cmd.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N13Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'calc.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N14Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'wmplayer.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N15Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'charmap.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N16Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'notepad.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N17Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'osk.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N18Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'Lock.exe',nil,nil,sw_show);
end;

procedure TfrmClient.N20Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,'blocks.exe',nil,nil,sw_show);
end;

end.