[twsocket] Infinite loop in TCustomWSocket.ASyncReceive

2015-04-11 Thread Nicolas MARCHAND 

Hello,

I use Delphi 7 with ICS V8.

I would like to update an existing program wich uses TDirMon component 
designed by François Piette for communication between server and clients 
by using TWSocket and TWSocketServer.


I try to reproduce step by step the example from  Wilfried Mestdagh 
SendFile.zip (http://mestdagh.biz/ics/index.html) (attached).


The only difference is that the TWSocket is in a datamodule.

When I post a custom message to my datamodule, it results in an infinite 
loop in TCustomWSocket.AsyncReceive.


Could you please help ?

Thanks

This is the datamodule code (project attached) :

unit ucltServeur;

interface

uses
   Windows, Messages, SysUtils, Classes, OverbyteIcsWndControl, 
OverbyteIcsWSocket;


const
   WM_TEST = WM_USER + 0;

type
   TfcltServeur = class(TDataModule)
 socServeur: TWSocket;
 procedure DataModuleCreate(Sender: TObject);
 procedure DataModuleDestroy(Sender: TObject);
 procedure socServeurDnsLookupDone(Sender: TObject; ErrCode: Word);
 procedure socServeurDataSent(Sender: TObject; ErrCode: Word);
 procedure socServeurDataAvailable(Sender: TObject; ErrCode: Word);
 procedure socServeurSessionClosed(Sender: TObject; ErrCode: Word);
   private
 { Déclarations privées }
 FHandle : HWND;
 FEnCours : Boolean;
 FSucces : Boolean;
 procedure TraiterMessages(var vMsg: TMessage);
 procedure EnvoiBloc();
   public
 { Déclarations publiques }
 property Handle : HWND read FHandle;
 function TestServeur() : Boolean;
   end;

var
   fcltServeur: TfcltServeur;

   gServeurNom : string;
   gServeurPort : string;

implementation

{$R *.dfm}

uses
   uClient;

procedure TfcltServeur.DataModuleCreate(Sender: TObject);
begin
   // Création d'un handle pour le datamodule
   FHandle := Classes.AllocateHWnd(TraiterMessages);
end;

procedure TfcltServeur.TraiterMessages(var vMsg: TMessage);
begin
   if vMsg.Msg = WM_TEST then
   begin
 EnvoiBloc();
   end
   else
   begin
 vMsg.Result := DefWindowProc(FHandle, vMsg.Msg, vMsg.wParam, 
vMsg.lParam);

   end;
end;

procedure TfcltServeur.DataModuleDestroy(Sender: TObject);
begin
   // Suppression du handle du datamodule
   Classes.DeallocateHWnd(FHandle);
end;

procedure TfcltServeur.socServeurDnsLookupDone(Sender: TObject; ErrCode: 
Word);

begin
   if ErrCode  0 then
   begin
 // ---log---
 FEnCours := False;
 Exit;
   end;

   socServeur.Addr := socServeur.DnsResult;
   socServeur.Port := gServeurPort;
   socServeur.Connect();
end;

procedure TfcltServeur.socServeurDataSent(Sender: TObject; ErrCode: Word);
begin
   if ErrCode  0 then
   begin
 // ---log---
 FEnCours := False;
 Exit;
   end;

   if FEnCours then
   begin
 PostMessage(Self.Handle, WM_TEST, 0, 0);
   end;
end;

procedure TfcltServeur.EnvoiBloc();
begin
   Beep;
   FSucces  := True;
   FEnCours := False;
end;

procedure TfcltServeur.socServeurDataAvailable(Sender: TObject; ErrCode: 
Word);

begin
   //
end;

procedure TfcltServeur.socServeurSessionClosed(Sender: TObject; ErrCode: 
Word);

begin
   FEnCours := False;
end;

function TfcltServeur.TestServeur() : Boolean;
begin
   gServeurNom := 'localhost';
   gServeurPort := '2';

   FEnCours := True;
   FSucces := False;

   socServeur.DnsLookup(gServeurNom);

   while FEnCours do fClient.Wait();

   Result := FSucces;
end;

end.

--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be

Re: [twsocket] Infinite loop in TCustomWSocket.ASyncReceive

2015-04-11 Thread Wilfried Mestdagh 

Hello,

You have an OnDataAvailable event, but you don't receive anything in 
there. So it is immediatly called again until all data is received. So 
in this case you end up with infinitive loop.


rgds, Wilfried


Op 11-04-15 om 13:29 schreef Nicolas MARCHAND:

Hello,

I use Delphi 7 with ICS V8.

I would like to update an existing program wich uses TDirMon component
designed by François Piette for communication between server and clients
by using TWSocket and TWSocketServer.

I try to reproduce step by step the example from  Wilfried Mestdagh
SendFile.zip (http://mestdagh.biz/ics/index.html) (attached).

The only difference is that the TWSocket is in a datamodule.

When I post a custom message to my datamodule, it results in an infinite
loop in TCustomWSocket.AsyncReceive.

Could you please help ?

Thanks

This is the datamodule code (project attached) :

unit ucltServeur;

interface

uses
Windows, Messages, SysUtils, Classes, OverbyteIcsWndControl,
OverbyteIcsWSocket;

const
WM_TEST = WM_USER + 0;

type
TfcltServeur = class(TDataModule)
  socServeur: TWSocket;
  procedure DataModuleCreate(Sender: TObject);
  procedure DataModuleDestroy(Sender: TObject);
  procedure socServeurDnsLookupDone(Sender: TObject; ErrCode: Word);
  procedure socServeurDataSent(Sender: TObject; ErrCode: Word);
  procedure socServeurDataAvailable(Sender: TObject; ErrCode: Word);
  procedure socServeurSessionClosed(Sender: TObject; ErrCode: Word);
private
  { Déclarations privées }
  FHandle : HWND;
  FEnCours : Boolean;
  FSucces : Boolean;
  procedure TraiterMessages(var vMsg: TMessage);
  procedure EnvoiBloc();
public
  { Déclarations publiques }
  property Handle : HWND read FHandle;
  function TestServeur() : Boolean;
end;

var
fcltServeur: TfcltServeur;

gServeurNom : string;
gServeurPort : string;

implementation

{$R *.dfm}

uses
uClient;

procedure TfcltServeur.DataModuleCreate(Sender: TObject);
begin
// Création d'un handle pour le datamodule
FHandle := Classes.AllocateHWnd(TraiterMessages);
end;

procedure TfcltServeur.TraiterMessages(var vMsg: TMessage);
begin
if vMsg.Msg = WM_TEST then
begin
  EnvoiBloc();
end
else
begin
  vMsg.Result := DefWindowProc(FHandle, vMsg.Msg, vMsg.wParam,
vMsg.lParam);
end;
end;

procedure TfcltServeur.DataModuleDestroy(Sender: TObject);
begin
// Suppression du handle du datamodule
Classes.DeallocateHWnd(FHandle);
end;

procedure TfcltServeur.socServeurDnsLookupDone(Sender: TObject; ErrCode:
Word);
begin
if ErrCode  0 then
begin
  // ---log---
  FEnCours := False;
  Exit;
end;

socServeur.Addr := socServeur.DnsResult;
socServeur.Port := gServeurPort;
socServeur.Connect();
end;

procedure TfcltServeur.socServeurDataSent(Sender: TObject; ErrCode: Word);
begin
if ErrCode  0 then
begin
  // ---log---
  FEnCours := False;
  Exit;
end;

if FEnCours then
begin
  PostMessage(Self.Handle, WM_TEST, 0, 0);
end;
end;

procedure TfcltServeur.EnvoiBloc();
begin
Beep;
FSucces  := True;
FEnCours := False;
end;

procedure TfcltServeur.socServeurDataAvailable(Sender: TObject; ErrCode:
Word);
begin
//
end;

procedure TfcltServeur.socServeurSessionClosed(Sender: TObject; ErrCode:
Word);
begin
FEnCours := False;
end;

function TfcltServeur.TestServeur() : Boolean;
begin
gServeurNom := 'localhost';
gServeurPort := '2';

FEnCours := True;
FSucces := False;

socServeur.DnsLookup(gServeurNom);

while FEnCours do fClient.Wait();

Result := FSucces;
end;

end.


--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be