Скачать: 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 вся ветка

Скачать: CL | DM;



Память: 0.46 MB
Время: 0.045 c