Разобрался в чем тут дело, в indy9 и indy10 ф-ии и процедуры отличаются, тобишь в indy10 в ф-ии IdTCPServer1Execute вместо Adata - AContext, с др возможностями.
Собрал проект Server- client для передачи текста по сети, используя TCP
при попытке отключения клиента и сервера (по запросу от клиента) появляется сообщение от сервера:
"Ошибка получения сообщения "Connection closed gracefully"
файл на проект:
http://webfile.ru/4817210
фото Form
http://pixs.ru/showimage/scrnJPG_6524918_1074062.jpg
код:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessage, ComCtrls, ToolWin, ActnMan, ActnCtrls, ActnMenus, ExtCtrls,
ActnList, IdException, IdGlobal, IdContext,
IdCustomTCPServer, IdTCPServer;
type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Label2: TLabel;
Label5: TLabel;
Button1: TButton;
Button2: TButton;
IdTCPClient1: TIdTCPClient;
Label8: TLabel;
Edit2: TEdit;
Button3: TButton;
RichEdit1: TRichEdit;
Label9: TLabel;
RichEdit3: TRichEdit;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
Timer1: TTimer;
TimerOFFserver: TTimer;
Button4: TButton;
RichEdit2: TEdit;
Label6: TLabel;
Button5: TButton;
Label7: TLabel;
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TimerOFFserverTimer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure IdTCPClient1Disconnected(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var l: string;
begin
try
//l := TrimRight(AContext.Connection.IOHandler.ReadLn(enUTF8));
l:=AContext.Connection.Socket.ReadLn(enUTF8);
if l='exit' then
begin
//AContext.Connection.Socket.WriteLn('exit_ok');
AContext.Connection.IOHandler.WriteLn('exit_ok');
Label6.Caption:='Off через 5 сек';
TimerOFFserver.Enabled:=true;
end else
AContext.Connection.Socket.WriteLn('Получил пакет');
//AContext.Connection.Disconnect;
RichEdit3.Lines.Append(l);
except
//Обработка ошибок получения сообщения
on E: EIdException do
begin
ShowMessage('Ошибка получения сообщения: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
IdTCPServer1.Active := not IdTCPServer1.Active;
if IdTCPServer1.Active
then
begin
label3.Caption := 'Статус: Активен';
Label6.Caption:='';
end
else label3.Caption := 'Статус: Не активен';
except
on E: EIdException do
begin
ShowMessage('Ошибка активации: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//Client
IdTCPClient1.Disconnect;
Action := caFree;
//сервер
try
IdTCPServer1.Active := False;
label3.Caption := 'Статус: Не активен';
Action := caFree;
except
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
with IdTCPClient1 do
if (Connected)
then
try
//IOHandler.WriteLn(RichEdit2.Text, enUTF8);
Socket.WriteLn(RichEdit2.Text, enUTF8);
RichEdit1.Lines.Append(RichEdit2.Text);
except
//Обработка ошибок передачи сообщения
on E: EIdException do
begin
ShowMessage('Ошибка передачи сообщения' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL' + E.Message);
end;
end
else
ShowMessage('Необходимо подключиться к серверу');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
IdTCPClient1.Host:=Edit2.Text;
with IdTCPClient1 do
if (Connected)
then
try
Disconnect;
except
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end
else
try
Connect;
except
//Обработка ошибок подключения
on E: EIdException do
begin
ShowMessage('Ошибка подключения: ' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL: ' + E.Message);
end;
end;
end;
procedure GetNewMessages;
var l:string;
begin
l:='';
l:=form1.IdTCPClient1.Socket.ReadLn(enUTF8);
if l='exit_ok' then form1.IdTCPClient1.Disconnect else
if l<>'' then showmessage('Я знаю что сервер получил пакет');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
s:string;
begin
Timer1.Interval:=1000;
if IdTCPClient1.Connected then
begin
i:=IdTCPClient1.Socket.InputBuffer.Size;
if i>0 then GetNewMessages;
end;
end;
procedure TForm1.TimerOFFserverTimer(Sender: TObject);
begin
IdTCPServer1.Active:=false;
label3.Caption := 'Статус: Не активен';
TimerOFFserver.Enabled:=false;
Label6.Caption:='';
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
with IdTCPClient1 do
if (Connected)
then
try
Socket.WriteLn('exit', enUTF8);
except
//Обработка ошибок передачи сообщения
on E: EIdException do
begin
ShowMessage('Ошибка передачи сообщения' + E.Message);
end;
on E: Exception do
begin
ShowMessage('Ошибка VCL' + E.Message);
end;
end;
end;
//клиент
procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
label4.Caption := 'Статус: Не активен';
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
label4.Caption := 'Статус: Подключен';
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
RichEdit2.Text:=inttostr(random(100));
end;
end.