![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как правильно написать socks-сервер? [D7, WinXP]
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, если да, то как? (просьба не смеяться и не злиться) :)