Текущий архив: 2004.05.30;
Скачать: CL | DM;

Вниз

Sockets: SysError, code = 1400...   Найти похожие ветки 

← →
Makhanev A.S. ©   (2004-04-14 12:27) [0]

Многопоточный сервер сокет.
При закрытии приложения получаю SysError, code = 1400, "неверный дескриптор окна".
Потоки соединений освобождаются нормально.

Где возможны ошибки?

Если это необходимо, могу привести код.

---

← →
Digitman ©   (2004-04-14 12:30) [1]

> могу привести код.


приводи

---

← →
Makhanev A.S. ©   (2004-04-14 12:52) [2]

Кода много (лдя форума), неважные участки вырезаны.


unit ServerNetInterface;
...
 TServerNetInterface = class(TComponent)
 private
   { Private declarations }
   FServerSocket: TServerSocket;
...
   procedure SetPort(const Value: Integer);
   function GetPort: Integer;
   function GetActive: Boolean;
   procedure SetActive(const Value: Boolean);
 protected
   { Protected declarations }
...
   procedure DoOnGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
     var SocketThread: TServerClientThread);

   procedure DoOnThreadStart(Sender: TObject; Thread: TServerClientThread);
...
 public
   { Public declarations }
   property ServerSocket: TServerSocket read FServerSocket;
...
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   { Published declarations }
...
   property Port: Integer read GetPort write SetPort;
   property Active: Boolean read GetActive write SetActive;
 end;
...
{ TServerNetInterface }

constructor TServerNetInterface.Create(AOwner: TComponent);
begin
 inherited;
...
 FServerSocket := TServerSocket.Create(Self);
 with FServerSocket do
 begin
   ServerType := stThreadBlocking;
   OnGetThread := DoOnGetThread;
   OnThreadStart := DoOnThreadStart;
   ThreadCacheSize := 0;
 end;
end;

destructor TServerNetInterface.Destroy;
begin      
 FServerSocket.Free;
 inherited;
end;

procedure TServerNetInterface.DoOnGetThread(Sender: TObject;
 ClientSocket: TServerClientWinSocket;
 var SocketThread: TServerClientThread);
begin
 SocketThread := TMyServerSocketThread.Create(False, ClientSocket);
 with TMyServerSocketThread(SocketThread) do
 begin
   OnStreamRecieved := DoOnStreamReceived;
   OnStreamRecieveError := DoOnStreamReceiveError;
   OnDisconnect := DoOnClientDisonnected2;
 end;
end;

procedure TServerNetInterface.DoOnThreadStart(Sender: TObject;
 Thread: TServerClientThread);
begin
 if Assigned(FOnClientConnected) then
 begin
   FOnClientConnected(Self, ClientInfo);  // просто генерим событие
 end;
end;

function TServerNetInterface.GetActive: Boolean;
begin
 Result := FServerSocket.Active;
end;

function TServerNetInterface.GetPort: Integer;
begin
 Result := FServerSocket.Port;
end;

procedure TServerNetInterface.SetActive(const Value: Boolean);
var
 i: Integer;
begin
 try
   FServerSocket.Active := Value;
 except
   DoOnError(ecCon_CantActivate);  // просто генерится событие
 end;
end;

procedure TServerNetInterface.SetPort(const Value: Integer);
begin
 FServerSocket.Port := Value;
end;

end.

{********}

unit ServerSocketThrd;

interface

...

type
 TClientThrdErrorCode = (ctecLength, ctecBadInfo, ctecBroken);

 TOnStreamRecieveError = procedure(Sender: TObject; ErrorCode: TClientThrdErrorCode) of object;

 TOnDisconnectEvent = procedure(Address, Host: string) of object;

 TMyServerSocketThread = class(TServerClientThread)
 private
   SockStream: TWinSocketStream;
   FRcvStream: TMemoryStream;
   FOnStreamRecieved: TNotifyEvent;
   FOnStreamRecieveError: TOnStreamRecieveError;
   FStreamType: TStreamType;
   FOnDisconnect: TOnDisconnectEvent;
   FRemoteAddress, FRemoteHost: string;
 protected
   procedure ClientExecute; override;
   procedure DoStreamRecieved;
   procedure DoStreamRecieveError(ErrorCode: TClientThrdErrorCode);
 public
   constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
   destructor Destroy; override;
   procedure SendStream(Stream: TStream);    
   property RcvStream: TMemoryStream read FRcvStream;
   property StreamType: TStreamType read FStreamType;
   property OnStreamRecieved: TNotifyEvent read FOnStreamRecieved write FOnStreamRecieved;
   property OnStreamRecieveError: TOnStreamRecieveError read FOnStreamRecieveError write FOnStreamRecieveError;
   property OnDisconnect: TOnDisconnectEvent read FOnDisconnect write FOnDisconnect;
 end;

implementation

uses SysUtils;

const
 ReplyTimeOut = 2000;

{ TMyClientSocketThread }

constructor TMyServerSocketThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
 inherited Create(CreateSuspended, ASocket);
 FRemoteAddress := ClientSocket.RemoteAddress;
 FRemoteHost := ClientSocket.RemoteHost;  
 FRcvStream := TMemoryStream.Create;
end;

destructor TMyServerSocketThread.Destroy;
begin
 if Assigned(FOnDisconnect) then
   FOnDisconnect(FRemoteAddress, FRemoteHost);
 FRcvStream.Free;
 inherited;
end;

procedure TMyServerSocketThread.DoStreamRecieved;
begin
 if Assigned(FOnStreamRecieved) then
   FOnStreamRecieved(Self);
end;

procedure TMyServerSocketThread.DoStreamRecieveError(ErrorCode: TClientThrdErrorCode);
begin
 if Assigned(FOnStreamRecieveError) then
   FOnStreamRecieveError(Self, ErrorCode);
end;

procedure TMyServerSocketThread.ClientExecute;
var
 Captured: Boolean;   // флаг "захвата" потока
 StrType: TStreamType;
 StrLen: Integer;
begin
 Captured := False;
 StrLen := 0;

 SockStream := TWinSocketStream.Create(ClientSocket, 20000);

 try
   while (not Terminated) and (ClientSocket.Connected) do
   begin
     if SockStream.WaitForData(ReplyTimeOut) then
     begin
       if not Captured then
         FRcvStream.Clear;
       FRcvStream.Position := FRcvStream.Size;
       if FRcvStream.CopyFrom(SockStream, ClientSocket.ReceiveLength) = 0 then
         Break;

       if (not Captured) and (FRcvStream.Size > 0) then
       begin   //   FRcvStream.SaveToFile("c:\test.txt");
         if GetSignedStreamInfo(FRcvStream, StrType, StrLen) then
         begin
           if StrLen < 20 then
             DoStreamRecieveError(ctecLength);
           FStreamType := StrType;
           Captured := True;
         end
         else
           DoStreamRecieveError(ctecBadInfo);   // генерим событие
       end
     end
     else begin                   // Истёк ReplyTimeOut: если размер совпадает и поток не пуст...
       if (StrLen = FRcvStream.Size) then
       begin
         if (FRcvStream.Size > 0) then
           // получили "нормальный" поток, генерим событие получения
           DoStreamRecieved;    // извещает о том, чтобы прочесть данные из RcvStream
         StrLen := 0;  
       end
       else begin        // получили "битый" поток, генерим событие Error"а
         DoStreamRecieveError(ctecBroken);
         FRcvStream.Clear; // очищаем битый поток от "мусора"
         StrLen := 0;
       end;
       Captured := False;
     end;
   end;

 finally
   SockStream.Free;
 end;
end;

procedure TMyServerSocketThread.SendStream(Stream: TStream);
var
 s: PChar;
begin
 GetMem(s, Stream.Size+1);
 s := (Stream as TMemoryStream).Memory;
 SockStream.Write(s^, Stream.Size);
 Stream.Free;  
end;

end.

{***}
procedure TfrmMain.btnServerActiveClick(Sender: TObject);
begin
 sniMain.Port := StrToInt(ledPort.Text);
 sniMain.Active := btnServerActive.Down;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 sniMain.Active := False;
end;


---

← →
Digitman ©   (2004-04-14 14:08) [3]

ошибка не здесь
окнами в при веденном коде и не пахнет ...

кстати, а чем обоснована строчка

ThreadCacheSize := 0;

?

ненулевой (по умолчанию) кэш потоков установлен Борландом не от балды ! Старт нового потока сродни старту двигателя автомобиля в мороз ... а ты при каждом коннекте-дисконнекте стартуешь/финишируешь трансп.поток ... не есть это корошо( ..

кр.того, в целях отладки (да и вообще - полезная практика !) заключи ВЕСЬ алгоритм в теле ClientExecute-метода в блок try..except   ... не исключены ошибки (в первую очередь - транспортные), которые никоим образом нельзя не обрабатывать .. в блоке except веди лог непредусмотренных тобой исключений ... это даст макс.ясность происходящего в трансп.потоке ..

---

← →
Makhanev   (2004-04-14 14:27) [4]

> кстати, а чем обоснована строчка
>
> ThreadCacheSize := 0;

Тем, что я так ловлю ClientDisconnect (дестроится поток клиента).
Если это так накладно, тогда буду ловить его по-другому (когда чтение сокета возвращает true и нулевое число байт - вариант?).

---

← →
Digitman ©   (2004-04-14 14:58) [5]

опять же не есть корошо ...

дисконнект - это дисконнект (штатный разрыв вирт.петли соединения), а терминирование потока, осуществлявшего транспорт через этот бывший коннект - это иное ...

imho, следует возбуждать событие OnDisconnect по факту возбуждения исключения при вызове метода Read()

см. исходники :

function TWinSocketStream.Read(var Buffer; Count: Longint): Longint;
var
 Overlapped: TOverlapped;
 ErrorCode: Integer;
begin
 FSocket.Lock;
 try
   FillChar(OVerlapped, SizeOf(Overlapped), 0);
   Overlapped.hEvent := FEvent.Handle;
   if not ReadFile(FSocket.SocketHandle, Buffer, Count, DWORD(Result),
     @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
   begin
     ErrorCode := GetLastError;
     raise ESocketError.CreateResFmt(@sSocketIOError, [sSocketRead, ErrorCode,
       SysErrorMessage(ErrorCode)]);    end;
   if FEvent.WaitFor(FTimeOut) <> wrSignaled then
     Result := 0
   else
   begin
     GetOverlappedResult(FSocket.SocketHandle, Overlapped, DWORD(Result), False);
     FEvent.ResetEvent;
   end;
 finally
   FSocket.Unlock;
 end;
end;

---

← →
Verg ©   (2004-04-14 15:28) [6]

> procedure TMyServerSocketThread.SendStream(Stream: TStream);
> var
>  s: PChar;
> begin
>  GetMem(s, Stream.Size+1);
>  s := (Stream as TMemoryStream).Memory;
>  SockStream.Write(s^, Stream.Size);
>  Stream.Free;  
> end;


Что это такое?
Выделил память размером STream.Size:

GetMem(s, Stream.Size+1);

Потом благополучно ее "забил":
s := (Stream as TMemoryStream).Memory;

Вроде очевидная утечка памяти.

Что тут происходит?

---

← →
Verg ©   (2004-04-14 15:34) [7]

Ха, или ты думаешь, что этот оператор:


> s := (Stream as TMemoryStream).Memory;


сделает что-то подобное?

move(Stream.Memory^, S^, StreamSize);

А Stream.Free как-то догадается сделать FreeMem непонятно чего, но размером Stream.Size+1? Кстати, а почему +1?

---

← →
Digitman ©   (2004-04-14 15:56) [8]

> Verg ©   (14.04.04 15:34) [7]


я что-то даже не посмотрел на эту лажу) .. а ведь - натурально лажа !)

вопрос-то о другом прозвучал ..

---

← →
Makhanev A.S. ©   (2004-04-14 19:31) [9]

Насчет лажи:
То есть GetMem -  не нужен?

---

← →
Verg ©   (2004-04-14 19:44) [10]

> procedure TMyServerSocketThread.SendStream(Stream: TStream);
> begin
>  SockStream.Write((Stream as TMemoryStream).Memory^, Stream.Size);
>  Stream.Free;  
> end;


Ты просто проверь: может у тебя по всей проге такие "понятия" о pchar раскиданы.

---

← →
Makhanev A.S. ©   (2004-04-14 19:59) [11]

> Verg ©   (14.04.04 19:44) [10]

Ок, спасибо.
Поэтому PChar я использую редко, за его незнанием:))

---

← →
Makhanev A.S. ©   (2004-04-15 00:46) [12]

Кстати, насчет сабжа...
Есть огромные подозрения, то это из-за работы с TMemo на невидимой закладке PageControl"а :)

---

← →
Digitman ©   (2004-04-15 08:08) [13]

> Есть огромные подозрения, то это из-за работы с TMemo на
> невидимой закладке PageControl"а :)


а вот это уже "ближе к телу" ... там и окна как раз фигурируют ..

---

← →
Makhanev A.S. ©   (2004-04-15 12:27) [14]

Прошу прощения за оффтопик:

> Digitman ©

Написал Вам письмо на адрес, указанный в анкете.
Надеюсь, Вы ответите.

---

Страницы: 1 вся ветка

Текущий архив: 2004.05.30;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.05 c