Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как правильно написать socks-сервер? [D7, WinXP]


Страницы:   1 2 3

zsergey ©   (2008-01-13 21:01:00) 

Привет господа! Есть такая задача: написать простой сокетный сервер, который должен обслуживать несколько подключений одновременно. Я только начал разбирать с этим вопросом, просьба, не ругать. Вот навоял небольшой работающий пример, правда без обработок ошибок:

procedure TForm1.startserverClick(Sender: TObject);
var S,AcceptedSock:TSocket;
   Addr:TSockAddr;
   Data:TWSAData;
   Len:Integer;
   buf : array[0..30] of byte;
begin
 WSAStartup($101,Data);
 S:=Socket(AF_Inet,Sock_Stream,0);
 Addr.sin_family:=PF_Inet;
 Addr.sin_port:=HToNS(5005);
 Addr.sin_addr.S_addr:=InAddr_Any;
 FillChar(Addr.Sin_Zero,SizeOf(Addr.Sin_Zero),0);
 Bind(S,Addr,SizeOf(TSockAddr));
 Listen(S,SoMaxConn);
 Len:=SizeOf(TSockAddr);
 AcceptedSock:=Accept(S,@Addr,@Len);
 Recv(AcceptedSock,buf, sizeof(buf),0);
// дальше обрабатываю данные
end;

тут используется  блокирующий сокет, который отрабатывает одно соединение. Подскажите пожалуйста, как здесь организовать обслуживание несколько подключений, в какую сторону хотя бы смотреть...


  (2008-12-04 09:43:00) [1]

Удалено модератором


Slym   (2008-05-04 04:44:00) [2]

Приведеный код был приведен на "урезанном" ScktComp :) у тебя об не урезанный...
пример простого эха- возвращает клиенту что тот ему отправил на стандартном ScktComp

program EchoDefSckt;
{$APPTYPE CONSOLE}
uses
 SysUtils,ScktComp,WinSock;

type
 TServerClientThreadEx=class(TServerClientThread)
 protected
   procedure ClientExecute; override;
 end;

procedure TServerClientThreadEx.ClientExecute;
var
 Buf:array[byte] of char;
 i:integer;
begin
 try
   while (not Terminated) and ClientSocket.Connected do
   begin
     i:=ClientSocket.ReceiveBuf(Buf,SizeOf(Buf));
     if i<=0 then
       ClientSocket.Close;
     ClientSocket.SendBuf(Buf,i);
   end;
 except
   Terminate;
   HandleException;
 end;
end;

procedure GetThread(Self:TObject;Sender: TObject;ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
 writeln('GetThreadEvent ',ClientSocket.RemoteAddress,':',ClientSocket.RemotePort);
 SocketThread:=TServerClientThreadEx.Create(false,ClientSocket);
end;

function Proc2Method(Code, Data: Pointer):TMethod;
begin
 result.Code:=Code;
 result.Data:=Data;
end;

var Server:TServerSocket;
begin
Server:=TServerSocket.Create(nil);
try
  Server.ServerType:=stThreadBlocking;
  Server.Port:=19;
  Server.OnGetThread:=TGetThreadEvent(Proc2Method(@GetThread,Server));
  Server.Open;
  while Server.Active do Sleep(100);
finally
  Server.Free;
end;
end.


Slym   (2008-05-04 04:35:00) [3]

ServerSocket.ServerType:=stThreadBlocking;


Сергей М.   (2008-05-02 23:40:00) [4]


> Перенес код в exe для трейса


Это еще зачем ?


glebbest   (2008-04-30 22:00:00) [5]

>>применение: rundll32.exe CharGen32.dll,StartCharGen 19

Если я правильно понял код, подключившийся в 19 порт telnet должен непрерывно выводить числа. Не выводит. Перенес код в exe для трейса - управление в GetThread не передаётся никогда.


Slym   (2008-01-18 05:32:00) [6]

zSergey   (17.01.08 15:41) [39]
применение: rundll32.exe CharGen32.dll,StartCharGen 19


library CharGen32;

uses
 SysUtils,ScktComp,Windows,WinSock;

type
 TCharGenThread=class(TServerClientThread)
 protected
   procedure ClientExecute; override;
 end;

procedure TCharGenThread.ClientExecute;
var i:integer;
begin
 Randomize;
 while (not Terminated) and ClientSocket.Connected do
 begin
   try
     i:=Random(MaxInt);
     ClientSocket.SendBuf(i,SizeOf(i));
   except
     Terminate;
     HandleException;
   end;
 end;
end;

procedure GetThread(Self:TObject;Sender: TObject;ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
 Writeln('Connected ',ClientSocket.RemoteAddress,':',ClientSocket.RemotePort);
 SocketThread:=TCharGenThread.Create(false,ClientSocket);
end;

function Proc2Method(Code, Data: Pointer):TMethod;
begin
 result.Code:=Code;
 result.Data:=Data;
end;

Function StartCharGen(hWnd: Integer;hInstance: Integer;lpCmdLine: PChar;dummy: Longint): Integer; StdCall; export;
var ServerSocket:TServerWinSocket;
 Port:integer;
begin
 Win32Check(AllocConsole);
 try
   Port:=StrToIntDef(ParamStr(1),19);
   ServerSocket:=TServerWinSocket.Create(INVALID_SOCKET);
   try
     ServerSocket.ThreadCacheSize := 3;
     ServerSocket.OnGetThread:=TGetThreadEvent(Proc2Method(@GetThread,ServerSocket));
     ServerSocket.Listen('', '', '', Port, SOMAXCONN);
     writeln('Listen port ',Port);
     while ServerSocket.Connected do
       Sleep(1000);
   finally
     ServerSocket.Free;
   end;
 finally
   FreeConsole;
 end;
 Result := 0;
end;

exports StartCharGen;

begin

end.


Сергей М.   (2008-01-17 17:09:00) [7]


> DVM ©   (17.01.08 16:44) [43]


Кстати, к вопросу о батонокидательстве, - да, своевременный коментарий.


DVM   (2008-01-17 16:44:00) [8]


> zSergey

Если очень хочется именно кидать, можно кидать на TDataModule


Сергей М.   (2008-01-17 16:03:00) [9]


> Кидаешь на форму


Для того чтобы создать экзеимпляр класса (не важно какого - будь он хоть TServerSocket хоть любой другой), вовсе не обязательно кидать его на форму.

Достаточно вызвать его конструктор явно:

SomeObject := TSomeComponentClass.Create(владелец);

В кач-ве владельца можешь на первое время указать nil


zSergey   (2008-01-17 15:54:00) [10]

> Сергей М.
Кидаешь на форму, выставляешь свойства, прописываем методы, компилишь проект. Вот собственно, так ... По логике тогда выходит что форму месте с компонентами нужно скомпилить как dll. Так ?


Сергей М.   (2008-01-17 15:47:00) [11]

А в ехе знаешь ?)
рассказывай) ..


zSergey   (2008-01-17 15:41:00) [12]


> ЧЕМ не устроили TServerSocket, TTCPServer, ICS-компоненты
> ?
> Вразумительно ты так и не объяснил)

я не знаю как эти компоненты засунуть в dll :)


Сергей М.   (2008-01-17 15:34:00) [13]


> мне вот делать нехер, низнаю чем заняться


Я вот тоже так думаю - тебе нечем более заняться)

ЧЕМ не устроили TServerSocket, TTCPServer, ICS-компоненты ?
Вразумительно ты так и не объяснил)


zSergey   (2008-01-17 15:32:00) [14]


> ты все-таки определись, тебя на WSAPI заклинило окончательно
> и бесповоротно или только блажь ?

ага мне вот делать нехер, низнаю чем заняться, WSAPI или еще чем. Уважаемый Сергей М, напоминаю, для чего мне все это нужно:

Поясняю задачу: сам сервер пишется для связки с 1с v.8.Т.к. у 1с нет стандартных средств для работы с сокетами, приходиться прибегнуть с помошью внешних компонент (dll), где собственно будет находится сам функционал сервера. Далее, приняв данные, сервер должен в реальном времени передать их приложению-хозяину, приложение в это время не находиться в режиме ожидания, а продолжает выполнять весь свой функционал. Я понимаю, что это форум отношения к 1с не имеет, потому я пока рассматриваю вариант  взаимодействия программы и сервера на delphi. Буду благодарен любым идеям.

ни внешних компонент, ни  бесплатных ActiveX контролов у меня нет, чтоб решить эту проблему, потому я вынужден ковырять wsapi ибо другого выхода я не вижу :)


Сергей М.   (2008-01-17 15:13:00) [15]

ты все-таки определись, тебя на WSAPI заклинило окончательно и бесповоротно или только блажь ?


zSergey   (2008-01-17 14:43:00) [16]


> И не возвратит.

нашел в чем ошибка:
FD_Set(Sockets[I],FDSet);в цикле не в операторских скобках;
для чего Arg:=1;
  IOCtlSocket(Sockets[I],FIONBIO,Arg);
перенес под Accept(); теперь заработало, НО само приложение в "замороженном" состоянии, будь там блокирующие сокеты или не блокирующие, будут там нити или нет. Я почти все перепробовал. Повторюсь, сервер должен не только обрабатывать подключения, но и одновременно сохранять другие свои ф-ции, короче, чтобы все контролы на форме были доступными. Вроде понятно объяснил.
> Лучше бы ты на асинхронных неблокирующих сокетах сделал.
>  На сообщениях. Ей богу проще для твоего случая. И доп потоки
> не нужны.

Господа, дайте пож-ста простой примерчик, на который мне можно было опереться в данном случае.


Сергей М.   (2008-01-17 11:45:00) [17]


> select не возвращает сокеты для чтения


И не возвратит.

Куда у тебя accept()-то пропал ? Без него select как мертвому припарка)


Сергей М.   (2008-01-17 11:41:00) [18]


> Slym ©   (17.01.08 11:08) [31]


> ниодного select я не увидел


Причем здесь select ?
Ну нет его и нет - и фиг с ним, я о другом сейчас.

Я о твоей ремарке

> остальные (accept) блокирующиет.к. становится им неблокирующими
> ты им не сказал


и о своей


> в клиентских потоках, работающих с блокирующимиClientSocket


А это неверно, поскольку слушающий сокет перед вызовом accept() переведен в неблок.режим (т.е. для него явно установлено опция-"свойство" nonblocking), что, с учетом цитаты в [29], при успешном вызове accept()  порождает новое неблокирующее гнездо.


zSergey   (2008-01-17 11:38:00) [19]


> 2. чтобы он стал полноценно неблокирующим нужно вызвать
> Select функцию


> ниодного select я не увидел...
> если бы и увидел то было выглядело бы так:
> WSAAsyncSelect(ListenSocket,hWnd,FD_ACCEPT,WM_USER);

Хорошо, вот переделанный сервер с селектом (не СОМ)

program Project1;
uses
 SysUtils,
 WinSock;

{$APPTYPE CONSOLE}
var Sockets:array of TSocket;
   Addr:TSockAddr;
   Data:TWSAData;
   Len,I,J:Integer;
   FDSet:TFDSet;
   arrBuf : array [0..35] of byte;
   Arg:u_long;
   tv : Ttimeval;

begin
 WSAStartup($101,Data);
 SetLength(Sockets,1);
 Sockets[0]:=Socket(AF_Inet,Sock_Stream,0);
 Addr.sin_family:=AF_Inet;
 Addr.sin_port:=HToNS(21001);
 Addr.sin_addr.S_addr:=InAddr_Any;
 FillChar(Addr.Sin_Zero,SizeOf(Addr.Sin_Zero),0);
 Bind(Sockets[0],Addr,SizeOf(TSockAddr));
 Listen(Sockets[0],SoMaxConn);
 while True do
  begin
   FD_Zero(FDSet);
   for I:=0 to High(Sockets) do
   Arg:=1;
   IOCtlSocket(Sockets[I],FIONBIO,Arg);
   FD_Set(Sockets[I],FDSet);

   tv.tv_sec := 5;
   tv.tv_usec := 0;

   Select(0,@FDSet,nil,nil,@tv);

   if FDSet.fd_count=0 then Continue;
   sleep(100);
   writeln('wait');
   
   I:=1;
   while I<=High(Sockets) do
    begin
     if FD_IsSet(Sockets[I],FDSet) then
      if Recv(Sockets[I],arrBuf, sizeOf(arrBuf),0) <=0 then
       begin
       
        writeln('disconnect, socket close');
        CloseSocket(Sockets[I]);
        for J:=I to High(Sockets)-1 do
         Sockets[J]:=Sockets[J+1];
        Dec(I);
        SetLength(Sockets,Length(Sockets)-1)
       end
      else
       begin
        writeln('Receive data');

       end;
     Inc(I)
    end;
   

   if FD_IsSet(Sockets[0],FDSet) then
    begin
   
     writeln('new client connected');
     SetLength(Sockets,Length(Sockets)+1);
     Len:=SizeOf(TSockAddr);
     Sockets[High(Sockets)]:=Accept(Sockets[0],@Addr,@Len)
    end
  end;
end.


Но почему-то при тестировании select не возвращает сокеты для чтения, чего не должно быть. Где ошибка?


Slym   (2008-01-17 11:08:00) [20]

Сергей М. ©   (17.01.08 10:56) [29]
Select

я то как раз прав...
ниодного select я не увидел...
если бы и увидел то было выглядело бы так:
WSAAsyncSelect(ListenSocket,hWnd, FD_ACCEPT,WM_USER);
этого для слушателя достаточно, а для ацепнутого сокета никаких Эвентов не прописано...


Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо