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 := '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

Reply via email to