
Законченный романтик
  
Профиль
Группа: Завсегдатай
Сообщений: 1784
Регистрация: 11.3.2009
Где: Земля
Репутация: 1 Всего: 19
|
Ранее у меня был однопоточный сервер приложений, который 10 одновременных коннектов клали только так, переделал на многопоточный вариант, всё оказалось очень даже не сложно, но периодически возникает вот такая ошибка. | Цитата | Windows socket error: (-1073741247), on API 'closesocket'
|
Я работаю через компонент TServerSocket который работает в режиме stThreadBlocking, т.е. каждому соединению по потоку. Я самостоятельно нигде CloseSocket не вызываю. В потоке в случае ошибок я вызываю Terminate, как я посмотрел в исходниках при разрушении потока он сам вызовет закрытие сокета. Т.е. ошибка вылетает где-то ещё, но отловить её не могу, пробовал ставить исполняемый файл с EurekaLog, так ошибка зараза не вылетала, мистика Подскажите в какую сторону здесь копать? Сам код потока | Код | unit MyClientThread;
interface
uses System.Classes, System.Win.ScktComp, System.SysUtils, Winapi.Messages, Vcl.Forms, ServerConsts, Winapi.Windows, UniverFun, ServerTypes, MyFormsInterfaces;
type TMyClientThread = class(TServerClientThread) private FUpdateItems:TUpdateItems; FFullClientMessage:AnsiString; FLicenseString:AnsiString; fSocketStream :TWinSocketStream; FLog:ILog; protected procedure ClientExecute; override; procedure Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer); override; public property UpdateItems:TUpdateItems read FUpdateItems write FUpdateItems; property LicenseString:AnsiString read FLicenseString write FLicenseString; property Log:ILog read FLog write FLog; end;
implementation
{ TMyClientThread }
procedure TMyClientThread.ClientExecute;
procedure SendResponseUpdateFilesMessage(ClientMessage:string);
function CompareClientFileListWithServer(SourceFileList:TStringList):TStringList; Var FClientFiles:TUpdateItems; NewItem:TUpdateKASMUItem; FilesList:TStringList; i, j:integer; IsExistFile:boolean; begin Result:=TStringList.Create;
FClientFiles:=TUpdateItems.Create(); for i:=0 to SourceFileList.Count-1 do begin NewItem:=TUpdateKASMUItem.Create(copy(SourceFileList[i], pos('=', SourceFileList[i])+1, LastDelimiter('=', SourceFileList[i])-pos('=', SourceFileList[i])-3), copy(SourceFileList[i], LastDelimiter('=', SourceFileList[i])+3, Length(SourceFileList[i])-LastDelimiter('=', SourceFileList[i])-2)); FClientFiles.Add(NewItem); end;
for i:=0 to FUpdateItems.Count-1 do begin IsExistFile:=False;
for j:=0 to FClientFiles.Count-1 do begin if (UpperString(FUpdateItems.Items[i].ShortPath)=UpperString(FClientFiles.Items[j].ShortPath))and(UpperString(FUpdateItems.Items[i].MD5Hash)=UpperString(FClientFiles.Items[j].MD5Hash)) then begin IsExistFile:=True; break; end; end;
if not IsExistFile then begin Result.Add(FUpdateItems[i].ShortPath); end; end; FreeAndNil(FClientFiles); end;
Var i:integer; ResponseMessageToClient:AnsiString; RecievedMessage, NewFiles:TStringList; begin ClientMessage:=StringReplace(ClientMessage, 'BEGIN#', '', []); ClientMessage:=StringReplace(ClientMessage, 'END#', '', []);
try RecievedMessage:=BreakOfLine(ClientMessage,'|'); NewFiles:=CompareClientFileListWithServer(RecievedMessage); ResponseMessageToClient:='LISTUPDATENEWFILE'; for i := 0 to NewFiles.Count-1 do // Отправляет клиету информацию о новых файлах по очереди begin ResponseMessageToClient:=ResponseMessageToClient+'|NEWFILE='+NewFiles.Strings[i]+'|'; end; FreeAndNil(NewFiles); except ResponseMessageToClient:='LISTUPDATENEWFILE'; end;
FLog.AppendRecord(Self.ClassName, clTCP, Self.Handle, 'Отправляем список файлов клиенту: '+ResponseMessageToClient);
fSocketStream.WriteBuffer(Pointer(ResponseMessageToClient)^, Length(ResponseMessageToClient) * SizeOf(AnsiChar)); end;
Var ClientMessage:AnsiString; begin FFullClientMessage:='';
fSocketStream := TWinSocketStream.Create( ClientSocket, 100000 ); fSocketStream.Position:=0; fSocketStream.WriteBuffer(Pointer(FLicenseString)^, Length(FLicenseString) * SizeOf(AnsiChar));
try while ( not Terminated ) and ( ClientSocket.Connected ) do try ClientMessage:='';
if (not Terminated) and (not fSocketStream.WaitForData(2000)) then begin
end;
SetLength(ClientMessage, -1); SetLength(ClientMessage, 10);
while fSocketStream.Read(ClientMessage[1], 10)>0 do begin sleep(1);
FFullClientMessage:=FFullClientMessage+ClientMessage;
if (FFullClientMessage='CHECK_LOCK')or(FFullClientMessage='CRITICAL_UPDATE_COMPLETE')or((Pos('BEGIN#', FFullClientMessage)>0)and(Pos('END#', FFullClientMessage)>0)) then break;
SetLength(ClientMessage, -1); SetLength(ClientMessage, 10); end;
FLog.AppendRecord(Self.ClassName, clTCP, Self.Handle, 'Получено сообщение от клиента: '+FFullClientMessage); if FFullClientMessage='' then Terminate;
if (Pos('BEGIN#', FFullClientMessage)>0)and(Pos('END#', FFullClientMessage)>0) then begin SendResponseUpdateFilesMessage(FFullClientMessage); end;
if FFullClientMessage='CHECK_LOCK' then begin ClientMessage:='SERVER_RECEIVE_OK'; fSocketStream.Position:=0; fSocketStream.WriteBuffer(Pointer(ClientMessage)^, Length(ClientMessage) * SizeOf(AnsiChar)); FLog.AppendRecord(Self.ClassName, clTCP, Self.Handle, 'Отправляем клиенту: SERVER_RECEIVE_OK');
sleep(1);
case SendMessage(Application.MainFormHandle, WM_CHECK_LOCK, 0, 0) of 0:begin ClientMessage:='False'; fSocketStream.Position:=0; fSocketStream.WriteBuffer(Pointer(ClientMessage)^, Length(ClientMessage) * SizeOf(AnsiChar));
FLog.AppendRecord(Self.ClassName, clTCP, Self.Handle, 'Отправляем клиенту: False'); end; 1:begin ClientMessage:='True'; fSocketStream.Position:=0; fSocketStream.WriteBuffer(Pointer(ClientMessage)^, Length(ClientMessage) * SizeOf(AnsiChar));
FLog.AppendRecord(Self.ClassName, clTCP, Self.Handle, 'Отправляем клиенту: True'); end; end;
sleep(1); end;
if FFullClientMessage='CRITICAL_UPDATE_COMPLETE' then begin sleep(1); SendMessage(Application.MainFormHandle, WM_CRITICAL_UPDATE_COMPLETE, 0, 0); sleep(1);
ClientMessage:='SERVER_RECEIVE_OK'; fSocketStream.Position:=0; fSocketStream.WriteBuffer(Pointer(ClientMessage)^, Length(ClientMessage) * SizeOf(AnsiChar));
sleep(1); end; except on e:exception do begin FLog:=nil; Terminate; end; end; except on e:exception do begin FLog:=nil; Terminate; end; end; FreeAndNil(fSocketStream); FLog:=nil; end;
procedure TMyClientThread.Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin ErrorCode:=0; FLog:=nil; Terminate; end;
end.
|
И вот так он создаётся | Код | procedure TDMServerModule.ServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread); begin SocketThread:=TMyClientThread.Create(True, ClientSocket); (SocketThread as TMyClientThread).UpdateItems:=FUpdateItems; (SocketThread as TMyClientThread).LicenseString:=FLicenseString; (SocketThread as TMyClientThread).Log:=FLog; SocketThread.Suspended:=False; end;
|
--------------------
"И твоя голова всегда в ответе за то куда сядет твой зад..." "Я студент - скажите с какого я ВУЗа..."
|