freepascal.ru

Доброго времени суток друзья.

Есть код

Код: Выделить всё

program Chat_Server;
uses constants, winsock, windows, sysutils;
const
my_port = 666;
max_connect_count = 64{SoMaxConn};

var Sockets:array[0 .. max_connect_count-1] of TSocket; // Њ ббЁў б®ЄҐв®ў
    connect_count  : integer;    // Љ®«ЁзҐбвў® ᮥ¤Ё­Ґ­Ё©
    Addr           : TSockAddr;  // Ђ¤аЁб Є«ЁҐ­в
    Data           : TWSAData;   // ’ ­­лҐ ® ЎЁЎ«Ё®вҐЄҐ б®ЄЄҐв®ў
    Len, I, J, n   : Integer;    //
    FDWriteSet,
    FDErrorSet,
    FDReadSet      : TFDSet;     // Њ­®¦Ґбвў® б®ЄҐв®ў Ј®в®ўле Є з⥭Ёо
    FDSetCount     : LongInt;    // Љ®«ЁзҐбвў® Ј®в®ўле б®ЄҐв®ў
    ReadTimeVal : TTimeVal;      // Џа®¬Ґ¦гв®Є ®¦Ё¤ ­Ёп з⥭Ёп
    msg_buffer        : array[0 .. 1024] of byte;  // ЎгдҐа б®®ЎйҐ­Ё©
    msg_buffer_length : integer;       // ¤«Ё­  бзЁв ­­ле ¤ ­­ле
    error : integer;             // Љ®¤ ®иЁЎЄЁ
{}    Arg : u_long;
{}    comand : dword;
begin
  writeln('Start my chat server.');
  writeln;
  write('Initialisation = ');
  if WSAStartup($0101, Data) <> 0 then
  begin
   ShowError('Error', WSAGetLastError);
   exit;
  end;
  writeln('Failed');
//  WSAStartup($101,Data);
  write('Create Socket = ');
  Sockets[0]:=socket(AF_INET,SOCK_STREAM,0{IPProto_TCP});
  if Sockets[0]<0 then
  begin
   ShowError('Error', WSAGetLastError);
   exit;
  end;
  writeln('Failed');

//  Sockets[0]:=Socket(AF_Inet,Sock_Stream,0);
  Addr.sin_family:=AF_Inet;
  Addr.sin_port:=HToNS(my_port);
  Addr.sin_addr.S_addr:=InAddr_Any;
  FillChar(Addr.Sin_Zero,SizeOf(Addr.Sin_Zero),0);
  write('Open Socket = ');
  if bind(Sockets[0],@Addr,SizeOf(TSockAddr)) = Socket_Error then
  begin
   ShowError('Error', WSAGetLastError);
   exit;
  end;
  writeln('Failed');
//  Bind(Sockets[0],Addr,SizeOf(TSockAddr));
  write('Listen Socket = ');
  if Listen(Sockets[0],max_connect_count) = Socket_Error then
  begin
   ShowError('Error', WSAGetLastError);
   exit;
  end;
  writeln('Failed');
  connect_count := 1;
//  Listen(Sockets[0],SoMaxConn);
  ReadTimeVal.tv_sec:=5;
  ReadTimeVal.tv_usec:=0000;
  while True do
   begin
    // 1. ”®а¬Ёа®ў &shy;ЁҐ ¬&shy;®¦Ґбвў  б®ЄҐв®ў
      writeln('1 - FD_Zero = ”®а¬Ёа®ў &shy;ЁҐ ¬&shy;®¦Ґбвў  б®ЄҐв®ў');
    FD_Zero(FDReadSet);
    FD_Zero(FDWriteSet);
    FD_Zero(FDErrorSet);
    for I:=low(Sockets) to High(Sockets) do
    begin
     FD_Set(Sockets[i],FDReadSet);
     FD_Set(Sockets[i],FDWriteSet);
     FD_Set(Sockets[i],FDErrorSet);
    end;
    // 2. Џа®ўҐаЄ  Ј®в®ў&shy;®бвЁ б®ЄЄҐв
       writeln('2.B - Select = Џа®ўҐаЄ  Ј®в®ў&shy;®бв б®ЄЄҐв ');
    FDSetCount := Select(0,@FDReadSet,{@FDWriteSet,@FDErrorSet,}nil, nil, @ReadTimeVal);
      writeln('2.E');
    writeln('- = ',FDSetCount);
    if FDSetCount = Socket_Error then ShowError('Error', WSAGetLastError);
    if FDSetCount>0 then
     for I:=low(Sockets) to High(Sockets) do
     begin
      if FD_IsSet(Sockets[i],FDReadSet)
      then write(i,' ');
     end;
    readln;
   end;
end.


Так вот на функции Select возвращается Socket_Error и ни как не меняет FDReadSet, при этом WSAGetLastError ни чего не возвращает.

В чём проблема?

Зарание спасибо!

Код: Выделить всё

    for I:=low(Sockets) to High(Sockets) do
    begin
     FD_Set(Sockets[i],FDReadSet);
     FD_Set(Sockets[i],FDWriteSet);
     FD_Set(Sockets[i],FDErrorSet);
    end;


этот код вызывает сомнение. с точки зрения unix всё выглядит неплохо. Но в винде FDSet может быть вообще чем угодно... рекомендую заменить код на следующий:

Код: Выделить всё

     FD_Set(Sockets[0],FDReadSet);
     FD_Set(Sockets[0],FDWriteSet);
     FD_Set(Sockets[0],FDErrorSet);


в набор Read,Write и Error попадёт только 1, реально существующий сокет.