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-01-17 10:59:00) [21]

Но этот факт не меняет сути - логика repeat-цикла в кл.потоке с учетом неблок.режима не верна в принципе


Сергей М.   (2008-01-17 10:56:00) [22]


> Slym ©   (17.01.08 04:28) [23]


Впрочем ни ты ни я не правы  - ClientSocket у автора работает именно в неблок.режиме.

Цитата из справки по accept():

newly created socket has the same properties as s including asynchronous events registered with WSAAsyncSelect or with WSAEventSelect


Сергей М.   (2008-01-17 10:42:00) [23]


> if GetSockOpt(s, SOL_SOCKET, SO_RCVBUF, pointer(@BuffSize),
>  OptLen) <> 0 then exit;


Совершенно непонятно, в каких случаях GetSockOpt может вернуть ошибку и для чего вообще запрашивается размер буфера приема, если этот полученный размер далее по ходу дела нигде не используется


DVM   (2008-01-17 10:34:00) [24]


> zsergey   (16.01.08 19:53) [22]

Лучше бы ты на асинхронных неблокирующих сокетах сделал. На сообщениях. Ей богу проще для твоего случая. И доп потоки не нужны.


Сергей М.   (2008-01-17 10:21:00) [25]


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


Угу.
Но при этом в слушающем потоке, работающем с неблокирующим ListenSocket, почему-то нет ни намека на WSAEWOULDBLOCK, зато в клиентских потоках, работающих с блокирующими ClientSocket, WSAEWOULDBLOCK с какого-то перепугу фигурирует.


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


> ShowMessage


Что еще за VCL-выкрутасы в дополнительномпотоке ?


Slym   (2008-01-17 04:32:00) [27]

ты понацеплял ComObj, ActiveX, testlib_TLB, StdVcl, Dialogsи тебе жалко 10кб на нормальный сокет? ты еще сом-объект руками сваяй...
Slym ©   (17.01.08 4:28) [23]
4. в com объекте с потоками огребеш не зная предметной области


Slym   (2008-01-17 04:28:00) [28]

zsergey   (16.01.08 19:53) [22]
не блокирующие сокеты

1. и нафега BeginThreadв твоем не блокирующемсокете?
2. чтобы он стал полноценно неблокирующим нужно вызвать Select функцию и в нее передать дескриптор окнав которое будут приходить сообщения об событиях сокета
3. неблокирующий у тебя только слушающий сокет (listen), остальные (accept) блокирующие т.к. становится им неблокирующими ты им не сказал


zsergey   (2008-01-16 19:53:00) [29]

Привет знатокам!
Написал сокет-сервер как сом-объект на WinApi (*.dll). Все хорошо, сокет открывается, слушается, данные из него читаются, но само приложение, использующее библиотеку, тормозит и дальше программа не может выполнить остальные свои функции, что не есть хорошо. Используются не блокирующие сокеты. Выкладываю весь исходник:

unit Utestlib;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
 ComObj, ActiveX, testlib_TLB, StdVcl, Dialogs, WinSock, SysUtils, Windows;

type
 TApp = class(TAutoObject, IApp)
 protected
   procedure OpenSocket; safecall;
end;

type
ThreadData = record
  Socket: TSocket;
end;
PThreadData = ^ThreadData;

var
WSAData: TWSAData;
ListenSocket, ClientSocket: TSocket;
Info: PThreadData;
SockAddr: TSockAddr;
ThreadId: THandle;
hClientThread: Thandle;

Arg : u_long;
s: TSocket;
const
Port = word(5555);

implementation

uses ComServ;
//////////////////////////////////////////
procedure SocketThread(Info: PThreadData);
var
SockName: TSockAddr;
NameLen, OptLen: Integer;
buf : array[0..35] of byte;
RecvSize: integer;

BuffSize,k: integer;
str : string;
error : integer;

begin
s := Info^.Socket;
try
  NameLen := SizeOf(TSockAddr);
  if GetPeerName(s, SockName, NameLen) <> 0 then exit;
  ShowMessage('Client accepted');
  OptLen := SizeOf(BuffSize);
  if GetSockOpt(s, SOL_SOCKET, SO_RCVBUF, pointer(@BuffSize), OptLen) <> 0 then exit;
  try
    repeat
      RecvSize := recv(s, Buf[0], Length(Buf), 0);
      if  RecvSize = SOCKET_ERROR then
         Begin
           error := WSAGetLastError();
           if (error<>WSAEWOULDBLOCK) then
               continue
           else RecvSize := 1
         end
      else
      sleep(5);
      if RecvSize > 1 then
         ShowMessage('Received from client ...');
    until RecvSize <= 0;
  finally
end;
  ShowMessage('Client disconnected ...');
finally
  CloseSocket(s);
  Dispose(Info);
end;
end;
//////////////////////////////////////////

procedure TApp.OpenSocket;
begin
ShowMessage('WSA Initialize ...');
if WSAStartup($101, WSAData) <> 0 then exit;
try
  ListenSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
  // non bloking
   Arg:=1;
   IOCtlSocket(ListenSocket,FIONBIO,Arg);
  //
  if ListenSocket = INVALID_SOCKET then exit;
  try
    FillChar(SockAddr, SizeOf(TSockAddr), 0);
    SockAddr.sin_family := AF_INET;
    SockAddr.sin_port := htons(Port);
    SockAddr.sin_addr.S_addr := INADDR_ANY;
    if Bind(ListenSocket, SockAddr, SizeOf(TSockAddr)) <> 0 then exit;
      if listen(ListenSocket, SOMAXCONN) <> 0 then exit;
        repeat
           
          ClientSocket := accept(ListenSocket, nil, nil);
          if ClientSocket <> INVALID_SOCKET then
            begin
              New(Info);
              Info^.Socket := ClientSocket;
              hClientThread := BeginThread(nil, 0, @SocketThread, Info, 0, ThreadId);
              if hClientThread <> 0 then CloseHandle(hClientThread);
            end;
        until false;
  finally
  Arg:=0;
  IOCtlSocket(ListenSocket,FIONBIO,Arg);
  CloseSocket(ListenSocket);
  end;
finally
  WSACleanup;
end;
end;

initialization
 TAutoObjectFactory.Create(ComServer, TApp, Class_App,
   ciMultiInstance, tmApartment);
end.


что я не так делал?


DVM   (2008-01-15 17:33:00) [30]


> zSergey

Delphi автоматически позволяет создавать ActiveX только на основе потомков TWinControl кажется.


Сергей М.   (2008-01-15 14:18:00) [31]


> где можно про это почитать


Дык в справке стандартной и почитай


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


> Почему бы и нет ?

Не посчитайте назойливым, может дадите сылочку, где можно про это почитать... В книжке Архангельского подобного ничего нет.


Сергей М.   (2008-01-15 14:04:00) [33]


> с нуля написать?


Почему бы и нет ?


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


> мне интересно, а возжно и проще решить энту задачу через АХ


Ходить в гости к соседу по двору через Китай тоже можно.


> как написать АХ на основе TSockerServer


Никак.


zSergey   (2008-01-15 14:02:00) [35]

> Сергей М. ©
Напиши сам, делов-то на 10 минут.- Здесь вы имели в виду с нуля написать?


zSergey   (2008-01-15 13:56:00) [36]


> Зато у одноэсины есть механизм использования надстроек (1C
> Add-ins)
> И она не имеет ни малейшего отношения к AX.

это я понимаю! Просто мне интересно, а возжно и проще решить энту задачу через АХ. Итак, не посчитайте меня назойливым, как написать АХ на основе TSockerServer ?


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


> zSergey   (15.01.08 13:48) [13]


Зато у одноэсины есть механизм использования надстроек (1C Add-ins)
И она не имеет ни малейшего отношения к AX.


zSergey   (2008-01-15 13:48:00) [38]


> Сначала поясни, зачем тебе понадобился именно AX-контрол,
>  да еще и невизуальный ?

потому что
> у 1с нет стандартных средств для работы с сокетами, приходиться
> прибегнуть с помошью внешних компонент (dll),

или еще как вариант - ActiveX :)


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

Сначала поясни, зачем тебе понадобился именно AX-контрол, да еще и невизуальный ?


zSergey   (2008-01-15 13:33:00) [40]


> вот с той же адынцэ — это тебе ActiveX писать. где, кстати,
>  пофигу, компоненты али не компоненты — всё равно будет
> жирное (если ты, конечно, не хардкорщик, желающий ваять
> ActiveX «с нуля»).

Тоже хорошая идея, навоять собственный ActiveX контрол, чтобы было проще, на основе того же TServerSocket. Как это сделать? Полез я  визард 'ActiveX control wizard', там нет родителя для TServerSocket, как я понял, так можно замутить только для визуальный компонент. возможно ли в данном случае сделать свой ActiveX на основе TSocketServer, если да, то как? (просьба не смеяться и не злиться) :)


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

Наверх

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