![]() |
| ||
|
|
Новости |
Поиск |
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-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;перенес под Accept(); теперь заработало, НО само приложение в "замороженном" состоянии, будь там блокирующие сокеты или не блокирующие, будут там нити или нет. Я почти все перепробовал. Повторюсь, сервер должен не только обрабатывать подключения, но и одновременно сохранять другие свои ф-ции, короче, чтобы все контролы на форме были доступными. Вроде понятно объяснил.
IOCtlSocket(Sockets[I],FIONBIO,Arg);
> Лучше бы ты на асинхронных неблокирующих сокетах сделал.
> На сообщениях. Ей богу проще для твоего случая. И доп потоки
> не нужны.
Господа, дайте пож-ста простой примерчик, на который мне можно было опереться в данном случае.
Сергей М. (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);
этого для слушателя достаточно, а для ацепнутого сокета никаких Эвентов не прописано...