VPF::IdTcpServer/client - Форум программистов

True_Stealth

Дата 5.11.2006, 16:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 4.11.2006

Репутация: нет
Всего: нет

Итак,
1) когда через кнопку или просто закрытием приложения происходит выключения сервера, вылетает ошибка сокета...
2) как сделать так, что бы выбрать подключение из списка(TListView) и на него отправить Writeln?

Может кто-то более подскажет как правильно, опишу всю суть программы...
Запускается сервер, запускается n кол-во клиентов, приложение клиента прячется в трей, где по нажатию popupmenu может отослать запрос на помощь, должен б ыть некий стату отслеживающий, что сейчас происходит, потом на сервере появляется этот запрос, его надо подтвердить, на клиенте должен быть статус ждите, а после второго подтверждения, сброс статуса, на подключен.

Код


unit server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
  ComCtrls, StdCtrls, Winsock, IdContext, ExtCtrls, IniFiles;

const
  maxConnections = 15;
  clOn = clLime;
  clOff = clGreen;

type
  AShape = array of TShape;

  Tserver_form = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    server_ip: TLabel;
    Label2: TLabel;
    server_port: TLabel;
    Label3: TLabel;
    server_status: TLabel;
    on_off_b: TButton;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    TcpServ: TIdTCPServer;
    lv: TListView;
    Button1: TButton;
    Timer1: TTimer;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);


    function GetLocalIP: String;
    function IPAddrToName(IPAddr : string): string;

    procedure TcpServExecute(AContext: TIdContext);
    procedure on_off_bClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    ledConnected: AShape;
  public
    { Public declarations }
  end;

var
  server_form: Tserver_form;
  ini: IniFiles.TIniFile;
  port: Integer;
  ip: string;

implementation

{$R *.dfm}

procedure Tserver_form.on_off_bClick(Sender: TObject);
var
  i: Integer;
begin
  if TcpServ.Active = false then begin
    Memo1.Lines.Add('----------------------------');
    Memo1.Lines.Add('Подготовка к запуску сервера');
    Memo1.Lines.Add('Открытие порта');
    Memo1.Lines.Add('Порт '+server_port.Caption+' открыт');
    TcpServ.Active := true;
    Memo1.Lines.Add('Сервер запущен');
    Memo1.Lines.Add('Дата запуска '+DateToStr(Date));
    Memo1.Lines.Add('Время запуска '+TimeToStr(Time));
    Memo1.Lines.Add(server_ip.Caption+':'+server_port.Caption);
    Memo1.Lines.Add('----------------------------');

    on_off_b.Caption := 'Выключить';
    server_status.Caption := 'Включен';
  end else begin
    TcpServ.Active := false;
    on_off_b.Caption := 'Включить';
    server_status.Caption := 'Выключен';
  end;
end;

procedure Tserver_form.TcpServExecute(AContext: TIdContext);
var
  connected: boolean;
  line: string;
  connectionNumber: integer;
  item: TListItem;
begin
  connectionNumber := 0;
  while (ledConnected[connectionNumber].Brush.Color = clOn) do inc(connectionNumber);

  item := lv.Items.Add;
  item.Caption := IntToStr(connectionNumber + 1);
  item.SubItems.Add('IP');
  item.SubItems.Strings[0] := AContext.Connection.Socket.Binding.PeerIP;
  item.SubItems.Add('Подключен');
  item.SubItems.Add('Запросов еще небыло');

  ledConnected[connectionNumber].Brush.Color:= clOn;
  ledConnected[connectionNumber].Hint := AContext.Connection.Socket.Binding.PeerIP;
  ledConnected[connectionNumber].ShowHint := true;


  AContext.Connection.IOHandler.WriteLn('Hello');
  connected := true;

  while (connected) or (AContext.Connection.Connected) do begin
    try
      line := AContext.Connection.IOHandler.ReadLn;
      if line = 'HELP' then begin
        AContext.Connection.IOHandler.WriteLn('WAIT');
        item.SubItems.Insert(1, 'Запрос на помощь');
        item.SubItems.Insert(2, TimeToStr(Time));
      end else
      begin
        AContext.Connection.IOHandler.WriteLn('Echo>>'+line);
        memo1.Lines.add(format('[%d] %s',[connectionNumber, line]));
      end;
      if (ansiUpperCase(line) = 'BYE') or (ansiUpperCase(line) = 'QUIT') then begin
        AContext.Connection.Disconnect;
        connected := false;
      end;
    except
      connected := false;
    end;
  end;
  ledConnected[connectionNumber].Brush.Color:= clOff;
  lv.Items.Delete(lv.Items.IndexOf(item));
end;

procedure Tserver_form.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels.Items[0].Text := DateToStr(Date) + ' ' +  TimeToStr(Time);
end;

procedure Tserver_form.Button2Click(Sender: TObject);
begin

Memo1.Lines.Add(lv.Selected.SubItems.Text)
end;

procedure Tserver_form.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TcpServ.Active := false;
end;

procedure Tserver_form.FormCreate(Sender: TObject);
var
  sFile: String;
  x, i: Integer;
begin
  server_form.Caption := 'Сервер ('+GetLocalIP()+')';

//Дефолтовые переменные
  port := 5555;
  ip := GetLocalIP();

//Ini File, system params
  sFile := ExtractFileDir(ParamStr(0))+'\server.ini';
  ini := TIniFile.Create(sFile);

  if not fileExists(sFile) then begin
    ini.WriteString('Settings','ip', ip);
    ini.WriteInteger('Settings','port', port);
    ini.UpdateFile;
  end else begin
    ip := ini.ReadString('Settings','ip', '127.0.0.1');
    port := ini.ReadInteger('Settings','port', port);
  end;

  server_ip.Caption := ip;
  server_port.Caption := IntToStr(port);
  server_status.Caption := 'Выключен';

  TcpServ.Bindings.Add.IP := ip;
  TcpServ.Bindings.Add.Port := port;

  Memo1.Clear;
  Memo1.Lines.Add('----------------------------');
  Memo1.Lines.Add('Локальный IP '+GetLocalIP);
  Memo1.Lines.Add('Локальное имя '+IPAddrToName(GetLocalIP));
  Memo1.Lines.Add('----------------------------');

  setLength(ledConnected, maxConnections);
  x:= 160;
  for i:= 0 to (maxConnections - 1) do begin
    ledConnected[i]:= TShape.create(self);
    with ledConnected[i] do begin
      parent:= self;
      height:= 8;
      width:= 20;
      top:= 15;
      left:= x;  inc(x,25);
      brush.color:= clOff;
    end; { do with ledConnected[i] }
  end; { for i:= 0 to (maxConnections - 1) }
end;

function Tserver_form.GetLocalIP: String;
const WSVer = $101;
var
  wsaData: TWSAData;
  P: PHostEnt;
  Buf: array [0..127] of Char;
begin
  Result := '';
  if WSAStartup(WSVer, wsaData) = 0 then begin
    if GetHostName(@Buf, 128) = 0 then begin
      P := GetHostByName(@Buf);
      if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
    end;
    WSACleanup;
  end;
end;

function Tserver_form.IPAddrToName(IPAddr : string): string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  WSAStartup($101, WSAData);
  SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
  if HostEnt <> nil then
    result := StrPas(Hostent^.h_name)
  else
    result:='';
end;


end.

Matematik

Дата 5.11.2006, 17:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

OnExecute выполняется в отдельном потоке, отсюда все связанные с этим ограничения
НЕЛЬЗЯ НАПРЯМУЮ ОБРАЩАТЬСЯ К КОМПОНЕНТАМ VCL
О синхронизации в потоках читай тут http://forum.vingrad.ru/topic-60076.html
Вообще неправильно используешь OnExecute. У IdServer есть собития onConnect OnDisconnect, необходимые действия надо выполнять там.
А OnExecute и так вызывается в цикле пока есть конест, твой while лишнее

Это сообщение отредактировал(а) Matematik - 5.11.2006, 17:14

True_Stealth

Дата 5.11.2006, 22:06 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 4.11.2006

Репутация: нет
Всего: нет

Блин, может я такой ограниченный, ноя не понимаю, как мне обратиться к определенному клиенту... и откуда у меня возникает ошибка Socket и Disconnecta при выключении программы ?

Как мне в Тлисте отображать все подключения и отправлять им определенную строку ???

True_Stealth

Дата 5.11.2006, 22:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 4.11.2006

Репутация: нет
Всего: нет

>>>First chance exception at $7C812A5B. Exception class EIdSocketError with message 'Socket Error # 10054

Matematik

Дата 5.11.2006, 22:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

Объяснять долго.
У тебя реализация сервера полностью неправильная.
Вот посмотри Demo Chat Indy.
Сделан он плохо, но общий смысл работы с Indy TCP Server ясен

Это сообщение отредактировал(а) Matematik - 5.11.2006, 22:51

Присоединённый файл ( Кол-во скачиваний: 64 )

Chat.zip 19,49 Kb

True_Stealth

Дата 5.11.2006, 23:04 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 4.11.2006

Репутация: нет
Всего: нет

у меня 2006 делфи, 10 индейцы...
раньше давным давно делал на сокетах в 7 делфи, но все забыл...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »