[twsocket] Infinite loop in TCustomWSocket.ASyncReceive

[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 := '20000';

   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