Конференция "Сети" » Падает сокет усервера на WinAPI - не могу разобраться
 
  • _koha (15.08.08 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_ © (15.08.08 17:53) [1]
    Зря ты про троянца упомянул...
 
Конференция "Сети" » Падает сокет усервера на WinAPI - не могу разобраться
Есть новые Нет новых   [134433   +24][b:0][p:0]