Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2010.08.27;
Скачать: CL | DM;

Вниз

Падает сокет усервера на WinAPI - не могу разобраться   Найти похожие ветки 

 
_koha   (2008-08-15 17:40) [0]

Решил сотворить сервер на чистом API для нового троянца без использования классов, но почему то работает один поток, акцепт проходит удачно запускается первый поток, но как только запускается второй поток сокет первого потока уходит в SOCKET_ERROR, После запуска третьего потока сокет второго потока уходит в SOCKET_ERROR и так далее. В чем причина не могу понять вроде все правильно делал.

Вот модуль не весь и недоделанный с исправлениями:

unit TCP;

interface
Uses Windows, SysUtils, WinSock, SockErr, MsgLog;

Type
 PClientRec = ^TClientRec;
 TClientRec = Record
   TCPThrId   : LongWord;
   ClientNum  : Integer;
 end;

  PClientInfo = ^TClientInfo;
  TClientInfo = Record
    ClientSocket : TSocket;
    ClientAddr   : sockaddr_in;
    hClientThr   : THandle;
    ClientThrId  : Integer;
    ClientNum    : Integer;
  end;

TClieitInfoArray  = Array of TClientInfo;

 PAcceptRec = ^TAcceptRec;
 TAcceptRec = Record
   Var SockListen    : TSocket;
   Var ClientInfoArr : TClieitInfoArray;
 end;

Type TThrCmd = (TC_READ, TC_WRITE, TC_STOP, TC_ERROR);

Function StartTCPServer(Port: Integer): Boolean;
Function StopTCPServer: Boolean;
Procedure TCPThreadProc(Param: Pointer);
Procedure TCPClientThreadProc(Param: Pointer);
Procedure AcceptProc(Param: Pointer);

Var
 ThrCount   : Integer;
 AtrId      : LongWord;
 ReadProcId : LongWord;
 WriteProcId: LongWord;
 TCPThreadId: LongWord;
 ClientThrId: LongWord;
 WData      : TWSAData;
 SockListen : TSocket;
 LocalAddr  : sockaddr_in;
 AcceptRec  : TAcceptRec;
 hProc      : THandle;

 hTCPThread : Thandle;
 hClientThr : THandle;

 hThrArray        : Array[1..MAXIMUM_WAIT_OBJECTS] of Thandle;
 ClieitInfoArray  : TClieitInfoArray;
 MultipleThrArray : Array[1..MAXIMUM_WAIT_OBJECTS] of Thandle;

Const
 NET_MESSAGE = WM_USER+1;

implementation

Function StartTCPServer(Port: Integer): Boolean;
Var
 Err: Integer;
begin
 Result := True;

 if Not WSAStartup(MakeWord(1,1),WData) = 0 then begin
   SendDebugMsg("Err: (WSAStartup <> 0) WSAGetLastError: "+SockErrToStr(WSAGetLastError));
   Result := false;
   Exit;
 end;

 SockListen := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
 if SockListen = INVALID_SOCKET then begin
   SendDebugMsg("Error: Socket > WSAGetLastError: "+SockErrToStr(WSAGetLastError));
   Result := false;
   Exit;
 end;

 LocalAddr.sin_addr.S_addr := htonl(INADDR_ANY);
 LocalAddr.sin_family      := AF_INET;
 LocalAddr.sin_port        := htons(Port);

 if bind(SockListen, LocalAddr, sizeOf(LocalAddr)) = SOCKET_ERROR then begin
   SendDebugMsg("WSAGetLastError: "+SockErrToStr(WSAGetLastError));
   Result := false;
   Exit;
 end;

 if Listen(SockListen,MAXIMUM_WAIT_OBJECTS) = SOCKET_ERROR then begin
   SendDebugMsg("Listen GetLastError: " + SockErrToStr(WSAGetLastError));
   Result := false;
   Exit;
 end;

 hTCPThread := BeginThread(Nil,0, Addr(TCPThreadProc), 0,0, TCPThreadId);
 if hTCPThread = 0 then begin
   SendDebugMsg("Error: hTCPThread = 0 GetLastError: "+IntToStr(GetLastError));
   Result := False;
   Exit;
 end;

end;
{------------------------------- StopTCPServer --------------------------------}
Function StopTCPServer: Boolean;
begin
 //
end;
{-------------------------------- TCPThreadProc -------------------------------}
Procedure TCPThreadProc(Param: Pointer);
Var
 Msg: TMsg;
begin
 ThrCount := 0;
 FillChar(AcceptRec,SizeOf(AcceptRec),#0);
 AcceptRec.SockListen    := SockListen;
 AcceptRec.ClientInfoArr := ClieitInfoArray;

 hProc:=BeginThread(Nil,0,Addr(AcceptProc),Addr(AcceptRec),0,AtrId);
 if hProc = 0 then begin
   SendDebugMsg("Error: hProc = 0 GetLastError: "+IntToStr(GetLastError));
   Exit;
 end;

 While true do begin

   if PeekMessage(Msg,hTCPThread, WM_NULL, WM_APP, PM_NOREMOVE) then begin
     GetMessage(Msg, 0, 0, 0);
     DispatchMessage(msg);
     Case TThrCmd(MSG.wParam) of
       TC_READ  : SendDebugMsg("MSG.wParam = TC_READ "+PChar(MSG.lParam));
       TC_WRITE : SendDebugMsg("MSG.wParam = TC_WRITE");
       TC_STOP  : SendDebugMsg("MSG.wParam = TC_STOP");
     end;
   end;

   Sleep(50);
 end;

 SendDebugMsg("TCPThreadProc = End");

end;

Procedure TCPClientThreadProc(Param: Pointer);
Var
 MSG        : TMsg;
 Err        : Integer;
 BuffSize   : Integer;
 Num        : Integer;
 Buff : Array[1..1024] of Char;
 Command    : String;
begin
 Num:=PClientInfo(Param)^.ClientNum;
 BuffSize:=1024;

 While True do begin

   FillChar(Buff, BuffSize, 0);

   Err := Recv(PClientInfo(Param)^.ClientSocket, Buff, BuffSize, 0);
   SendDebugMsg("Err: "+SockErrToStr(Err));
   if Err = SOCKET_ERROR then begin
     SendDebugMsg(IntToStr(Num)+" Err = "+SockErrToStr(Err));
     SendDebugMsg(IntToStr(Num)+" Error: TCPClientThreadProc Recv = "+SockErrToStr(WSAGetLastError));
     PostThreadMessage(TCPThreadId, NET_MESSAGE, Integer(TC_ERROR), 0);
     Exit;
   end;

   Command := StrPas(PChar(@Buff));
   if Command = "" then  begin
     CloseSocket(PClientInfo(Param)^.ClientSocket);
     Exit;
   end;
   SendDebugMsg("ComStr = "+IntToStr(Length(Command)));

   /////////////////////////////////////////////////////
   // Command section
   /////////////////////////////////////////////////////

 end;

end;

{--------------------------------- AcceptProc ---------------------------------}
Procedure AcceptProc(Param: Pointer);
Var
 Size: Integer;
 Conf: PAcceptRec;
 ClientSock: TSocket;
 ClientAddr: SockAddr_in;
 ClientInfo: PClientInfo;
 Num       : Integer;
begin

 While True do begin

   New(ClientInfo);
   FillChar(ClientInfo^,SizeOf(TClientInfo), 0);

   Size       := SizeOf(ClientAddr);
   ClientSock := accept(PAcceptRec(Param).SockListen,@ClientAddr, @Size);
   if ClientSock = INVALID_SOCKET then begin
     SendDebugMsg("Error: accept ClientSock WSAGetLastError: " + SockErrToStr(WSAGetLastError));
     PostThreadMessage(TCPThreadId,NET_MESSAGE,Integer(TC_ERROR),0);
     CloseSocket(ClientSock);
     Dispose(ClientInfo);
     Continue;
   end;

   Num := Length(ClieitInfoArray);
   Inc(Num);
 
   SetLength(PAcceptRec(Param).ClientInfoArr,Num);

   PAcceptRec(Param)^.ClientInfoArr[Num]:=ClientInfo^;
   PAcceptRec(Param).ClientInfoArr[Num].ClientSocket := ClientSock;
   PAcceptRec(Param).ClientInfoArr[Num].ClientAddr   := ClientAddr;
   PAcceptRec(Param).ClientInfoArr[Num].ClientNum    := Num;

   hClientThr := BeginThread(Nil,0,Addr(TCPClientThreadProc),@PAcceptRec(Param).ClientInfoArr[Num ],0, ClientThrId);

   PAcceptRec(Param).ClientInfoArr[Num].hClientThr  := hClientThr;
   PAcceptRec(Param).ClientInfoArr[Num].ClientThrId := ClientThrId;

 end;

end;

end.


 
Rouse_ ©   (2008-08-15 17:53) [1]

Зря ты про троянца упомянул...



Страницы: 1 вся ветка

Текущий архив: 2010.08.27;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.088 c
2-1267601181
Гость
2010-03-03 10:26
2010.08.27
Упростить выражение


2-1274359047
РП
2010-05-20 16:37
2010.08.27
Байты в число и число в байты нужной размерности


2-1272104034
Kukulkan
2010-04-24 14:13
2010.08.27
Изменение TGoupBox!


4-1233843462
R13
2009-02-05 17:17
2010.08.27
Обрезка канваса при методе PrintWindow


2-1265644179
Инна
2010-02-08 18:49
2010.08.27
Решение задач