VPF::Tcp/IP connect - Форум программистов

Racer

Дата 6.1.2010, 16:15 (ссылка)

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

Загрузка ...

Шустрый

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

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

Здравствуйте, программисты.
Вот решил изучить сеть . Начал с простого: есть сервер и клиент. Клиент посылает серваку месагу а серв присылает обратно месагу+ номер мессаги smile

Когда запускаю на своей машине, то все хорошо. Но вот когда запускаю серв и клиент на разных машинах, то не работает. Работало только тогда, когда серв был запущен на WIN Server 2003. В сервере можно менять порт, в клиенте - IP и порт сервера. Брандмауэры отключал, не помогло. Код прилагается

Сервер:

Код


procedure TForm3.ShowIP;
var
  WSAData: TWSAData;
  p: PHostEnt;
  Name: array[0..$FF] of Char;
begin
  WSAStartup($0101, WSAData);
  GetHostName(name, $FF);
  p := GetHostByName(Name);
  Label3.Caption:= 'Local IP:' + (inet_ntoa(PInAddr(p.h_addr_list^)^));
  WSACleanup;
  Label4.Caption:= 'Local Port: ' + TcpServer1.LocalPort;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
//  ShowMessage('кнопка');
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
  if Edit1.Text <> '' then
  begin
    TcpServer1.LocalPort:= Edit1.Text;
    ShowIP;
    Edit1.Text:= '';
    TcpServer1.Active:= False;
    TcpServer1.Active:= True;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  TcpServer1.Active:= True;
  i:= 0;
  ShowIP;
end;

procedure TForm3.TcpServer1Accept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  s:string;
begin
  i:= i+1;
  s:= ClientSocket.ReceiveLn;
  ClientSocket.SendLn(s+IntToStr(i));
  Label1.Caption:= s;
end;

Клиент:

Код


procedure TForm3.ShowRemoteHost;
begin
  Label1.Caption:= 'Remote Host: '+ TcpClient1.RemoteHost;
  Label2.Caption:= 'Remote Port: '+ TcpClient1.RemotePort;

  if TcpClient1.Connected then Label3.Caption:= 'Status: Connected'
    else Label3.Caption:= 'Status: Disconnected'
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  TcpClient1.Connect;
  if TcpClient1.Connected then
  begin
    TcpClient1.Sendln(Edit1.Text);
    Edit1.Text:=TcpClient1.ReceiveLn();   // ждем ответ
  end;
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
  if (Edit2.Text <> '') and (Edit3.Text <> '') then
  begin
    TcpClient1.RemoteHost:= Edit2.Text;
    TcpClient1.RemotePort:= Edit3.Text;
    TcpClient1.Connect;
    ShowRemoteHost;
  end
  else ShowMessage('Not enough parameters');
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  TcpClient1.Active:= True;
  ShowRemoteHost;
end;

procedure TForm3.TcpClient1Receive(Sender: TObject; Buf: PAnsiChar;
  var DataLen: Integer);
begin
  TcpClient1.Disconnect;
end;

darkmamba

Дата 7.1.2010, 00:53 (ссылка)

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

Загрузка ...

Шустрый

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

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

Пиши лучше на Winsock'e smile

Racer

Дата 7.1.2010, 12:03 (ссылка)

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

Загрузка ...

Шустрый

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

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

Я уже тоже так подумал,но там неразбериха для меня , где идет ответ клиенту. Можешь показать пример?

darkmamba

Дата 7.1.2010, 15:06 (ссылка)

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

Загрузка ...

Шустрый

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

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

Примерно такой клиент, до идела нужно везде добавить обработку ошибок.

Код


procedure SockEvents;
var
  WSAEWENTS: TWSANETWORKEVENTS;
  len: integer;
begin
  while TRUE do begin
    WSAWaitForMultipleEvents(1, @SockEvent, FALSE, INFINITE, FALSE);
    asm
      lea eax, WSAEWENTS
      push eax
      push SockEvent
      push Sock
      call WSAEnumNetworkEvents
    end;
    case WSAEWENTS.lNetworkEvents of
      FD_READ:  begin
                  len := recv(Sock, Buf, MAX_PKT_SIZE, 0);
                  if len > 0 then MessageBox(0, @Buf, Pchar('Recv Message'), 0);
                end;
      FD_CLOSE: begin
                  CloseSocket(Sock);
                  MessageBox(0, Pchar('Socket Closed'), Pchar('Socket Message'), 0);
                end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  WSA: TWSADATA;
  Addr: TSockAddr;
  szAddr: integer;
  err, thrId: dword;
begin
  WSAStartUp($202, WSA);
  szAddr := SizeOf(Addr);
  WSAStringToAddress(Pchar(Edit1.Text), AF_INET, nil, Addr, szAddr);
  Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  SockEvent := WSACreateEvent;
  if Connect(sock, @Addr, SizeOf(Addr)) <> SOCKET_ERROR then begin
       WSAEventSelect(Sock, SockEvent, FD_READ or FD_CLOSE);
       CreateThread(nil, 0, @SockEvents, nil, 0, thrId);
  end else
  MessageBox(0, 'облом', Pchar('Error# '+IntToStr(WSAGetLastError)), 0);
end;

Сервер маленько посложнее, нужно оперировать масивом сокетов.

Код


procedure SocketEvents;
var
  WSAEVENTS: TWSANETWORKEVENTS;
  len, szCliAddr: integer;
  Index: cardinal;
begin
  CurrentClientCount := 1;
  while TRUE do begin
    Index := WSAWaitForMultipleEvents(CurrentClientCount, @EventArray, false, INFINITE, false);
    if Index = WSA_WAIT_FAILED then ToLog('Falied on WSAWaitForMultipleEvents',1)
    else Index := Index - WSA_WAIT_EVENT_0;
    WSAEnumNetworkEvents(SockArray[Index], EventArray[Index], @WSAEVENTS);
{    asm
      lea eax, WSAEVENTS
      push eax
      push EventArray[Index]
      push offset SockArray[Index]
      call WSAEnumNetworkEvents
    end;           }
    case WSAEVENTS.lNetworkEvents of
      FD_READ:    begin
                    len := recv(SockArray[Index], buf, MAX_PKT_SIZE, 0);
                    if len > 0 then ToLog('Recv -> '+buf);
                  end;
      FD_CLOSE: ToLog('Socket Close');
      FD_ACCEPT:  begin
                    szCliAddr := SizeOf(CliAddr);
                    SockArray[CurrentClientCount] := accept(SockArray[0], CliAddr, szCliAddr);
                    ToLog('Client accepting address : '+inet_ntoa(CliAddr.sin_addr)+':'+IntToStr(ntohs(CliAddr.sin_port)));
                    if SockArray[CurrentClientCount] <> SOCKET_ERROR then
                    EventArray[CurrentClientCount] := WSACreateEvent;
                    if EventArray[CurrentClientCount]<> WSA_INVALID_EVENT then
                    if WSAEventSelect(SockArray[CurrentClientCount],
                                      EventArray[CurrentClientCount],
                                      FD_READ or FD_CLOSE) <> SOCKET_ERROR then begin
                      inc(CurrentClientCount);
                      ToLog('Client accepted');
                    end;
                  end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  WSA: TWSADATA;
  szAddr: integer;
  thrId: dword;
begin
  if WSAStartUp($202, WSA) = 0 then ToLog('Winsock Init');
  szAddr := SizeOf(Addr);
  if WSAStringToAddress(Pchar(Edit1.Text), AF_INET, nil, Addr, szAddr) = 0 then
    ToLog('Address OK')
  else ToLog('Failed on WSAStringToAddress', 1);
  SockArray[0] := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if SockArray[0] = SOCKET_ERROR then ToLog('Failed on Socket',1);
  if bind(SockArray[0], @Addr, SizeOf(Addr)) = 0 then
    ToLog('Bind OK')
  else ToLog('Failed on Bind',1);
  EventArray[0] := WSACreateEvent;
  if WSAEventSelect(SockArray[0], EventArray[0], FD_ACCEPT or FD_CLOSE) = 0 then
    CreateThread(nil, 0, @SocketEvents, nil, 0, thrId)
  else ToLog('Failed on WSAEventSelect', 1);
  Listen(SockArray[0], 2);
end;

Когда приходят данные, прилетает сообщение FD_READ. FD_WRITE - срабатывает если приконектился. FD_ACCEPT - для сервера, срабатывает у ListenSocket. Весь перечень в мсдн.

Это сообщение отредактировал(а) darkmamba - 7.1.2010, 15:14

Racer

Дата 7.1.2010, 16:28 (ссылка)

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

Загрузка ...

Шустрый

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

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

спасибо тебе большое. вот теперь понятно.

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