UDPServer OnUDPRead reagiert nicht

[sirius]

Hier eine andere Möglichkeit:

Delphi-Quellcode:

program Project2;

{$APPTYPE CONSOLE}

uses
  MEssages, Classes, SysUtils, Windows, Winsock;


const cPort=12000;
      WM_Socket=WM_User;


type TProgram=class
       Constructor Create;
       Destructor Destroy; override;
      private
       FSocket:TSocket;
       Fwnd:hwnd;
       procedure WMSocket(var msg:TMEssage); message WM_Socket;
      protected
       procedure WndProc(var msg:TMessage);
       procedure DoUDPRead(const IP:String; Port:Word;
                           const msg:String); virtual;
      public
       procedure Run;
     end;



procedure showError(const msg:String);
begin
  writeln(msg);
  readln;
end;



procedure startProgram;
var wsadata:TWSAData;
    myProgram:TPRogram;
begin
  if WSAStartup($0202,wsadata)<>0 then
    showError('Fehler beim Initialisieren der Sockets');
  try
    myProgram:=TProgram.Create;
    try
      myProgram.Run;
    finally
      myProgram.Free;
    end;
  except
    on e:Exception do
      showError(e.Message);
  end;
  WSACleanup;
end;

{ TProgram }

constructor TProgram.Create;
var addr:TSockAddrIn;
begin
  Fwnd:=allocatehwnd(wndProc);

  FSocket:=socket(af_inet,SOCK_DGRAM,IPPROTO_UDP);
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('Socket: '+syserrormessage(wsagetlasterror));

  addr.sin_family:=af_inet;
  addr.sin_port:=htons(cPort);
  addr.sin_addr.S_addr:=INADDR_ANY;
  if bind(FSocket,addr,sizeof(addr))=Socket_Error then
    raise Exception.Create('Bind: '+syserrormessage(wsagetlasterror));

  WSAAsyncSelect(FSocket,Fwnd,WM_Socket,FD_Read);


end;

destructor TProgram.Destroy;
begin
  closesocket(FSocket);
  DeallocateHWnd(Fwnd);
end;

procedure TProgram.Run;
var msg:Tmsg;
begin
  while getmessage(msg,0,0,0) do
    dispatchmessage(msg);
end;

procedure TProgram.WMSocket(var msg: TMEssage);
var addr:TSockAddrIn;
    addrlen:Integer;
    buf:string;
    len:Integer;
    msgbuf:String;
    res:Integer;
    err:Integer;
    Port:Word;
    IP:string;
begin
  addrlen:=sizeof(addr);
  msgbuf:='';
  repeat
    setlength(buf,1024);
    len:=length(buf);
    res:=recvfrom(FSocket,buf[1],len,0,addr,addrlen);
    if res=socket_error then
    begin
      err:=wsagetlasterror;
      case err of
        WSAEWOULDBLOCK: break;
        WSAEMSGSIZE: begin
          msgbuf:=msgbuf+buf;
          //hier evtl noch Addresse merken
        end;
        else
          raise Exception.Create(syserrormessage(err));
      end;
    end else
    begin
      setlength(buf,res);
      msgbuf:=msgbuf+buf;
      break;
    end;
  until false;

  Port:=ntohs(addr.sin_port);
  IP:=inet_ntoa(addr.sin_addr);

  //Abbruchbedingung:
  if msgBuf='Ende' then PostQuitMEssage(0);

  DoUDPRead(IP,Port,msgbuf);
end;

procedure TPRogram.DoUDPRead(const IP:string; Port:Word; const Msg:String);
begin
  writeln(IP+':'+inttostr(Port)+'  '+Msg);
end;

procedure TProgram.WndProc(var msg: TMessage);
begin
  try
    dispatch(msg);
  except
    on e:Exception do
      showerror(e.Message);
  end;
end;

begin
  startProgram;
end.