-
Решил сотворить сервер на чистом 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.
-
Зря ты про троянца упомянул...
|