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.