Падает сокет усервера на 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]

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

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