Форум: "Сети";
Текущий архив: 2004.01.20;
Скачать: [xml.tar.bz2];

Вниз

Работа с TTcpServer и TTcpClient   Найти похожие ветки 

← →
hellmachine   (2003-11-18 02:54) [0]

Доброе время суток! Есть программа-чат для локальной сети, скорее всего написанная на Д6; работает в режиме "с выделенным сервером" по протоколу TCP/IP, в моем распоряжении только клиентская часть - порт и адрес удаленной машины известны; нужно встроить в цепь клиент-сервер свое звено, перенаправляющее все сообщения и сохраняющее их; Я использовал компоненты TTcpServer и TTcpClient: на клинетской части приложения исправляется адрес удаленной машины на адрес моего компьютера, у TcpServer выставлятся известный локальный порт и локальный ардес хоста - IP адрес моей машины, у TcpClient выставляется известный удаленный порт и адрес удаленной машины с серверной частью чата; Ниже привожу исходный код программы:

procedure OnTCPServerClientSend(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
procedure OnTCPServerClientReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
procedure OnTCPServerClientDisconnect(Sender: TObject);
{...}
FTCPServerClient: TCustomIpClient;
{...}
procedure TFrmMain.BtnStartClick(Sender: TObject);
begin
if TCPServer.Listening then
TCPServer.Close();
try
TCPServer.LocalPort := EdtPort.Text;
TCPServer.LocalHost := EdtLocalHost.Text;
TCPServer.Open();
except
end;
end;

procedure TFrmMain.TCPServerAccept(Sender: TObject; ClientSocket: TCustomIpClient);
begin
MemoLog.Lines.Add("IN_" + ClientSocket.RemoteHost + "_CONNECTED");
ClientSocket.OnSend := OnTCPServerClientSend;
ClientSocket.OnReceive := OnTCPServerClientReceive;
ClientSocket.OnDisconnect := OnTCPServerClientDisconnect;
FTCPServerClient := ClientSocket;
if TCPClient.Active then
TCPClient.Close();
TCPClient.RemoteHost := EdtRemoteHost.Text;
TCPClient.RemotePort := EdtPort.Text;
TCPClient.Open();
end;

procedure TFrmMain.OnTCPServerClientSend(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var s: string;
begin
s := Copy(Buf, 0, DataLen);
MemoLog.Lines.Add("IN_SEND>" + s);
end;

procedure TFrmMain.OnTCPServerClientReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var s: string;
begin
s := Copy(Buf, 0, DataLen);
MemoLog.Lines.Add("IN_RECEIVE>" + s);
if TCPClient.Active then
TCPClient.SendBuf(Buf, DataLen);
end;

procedure TFrmMain.OnTCPServerClientDisconnect(Sender: TObject);
begin
MemoLog.Lines.Add("IN_" + TCustomIpClient(Sender).RemoteHost + "_DISCONNECTED");
TCPClient.Close();
end;

procedure TFrmMain.TCPClientConnect(Sender: TObject);
begin
MemoLog.Lines.Add("OUT_" + TCPClient.RemoteHost + "_CONNECTED");
end;

procedure TFrmMain.TCPClientDisconnect(Sender: TObject);
begin
MemoLog.Lines.Add("OUT_" + TCPClient.RemoteHost + "_DISCONNECTED");
end;

procedure TFrmMain.TCPClientReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var s: string;
begin
s := Copy(Buf, 0, DataLen);
MemoLog.Lines.Add("OUT_RECEIVE>" + s);
if FTCPServerClient <> nil then
FTCPServerClient.SendBuf(Buf, DataLen);
end;

procedure TFrmMain.TCPClientSend(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var s: string;
begin
s := Copy(Buf, 0, DataLen);
MemoLog.Lines.Add("OUT_SEND>" + s);
end;

Полученные результаты не удовлетворили, поэтому и обращаюсь за помощью: если у TcpServer и TcpClient BlockMode установлен в bmBlocking и bmThreadBlocking соответсвенно - клиентская часть соединяется с программой, моя программа соединяется с сервером и тут же клиентская часть почему-то отсоединяется; при остальных комбинациях соединение не устанавливается;
Можно ли решить эту задачу подбным методом и если да, то где у меня ошибка?

---

← →
dimmu   (2003-11-18 11:16) [1]

FTCPServerClient.Open() в TFrmMain.TCPServerAccept

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.01.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.01 c