Shrinked down example of the program.
Rainer
program serverclient;
uses
baseunix ,
sockets,
crt;
const port_program = 12021;
procedure memclr( p : pointer ; len : longint );
var x : longint;
begin
for x := 1 to len do begin
byte( p^ ) := 0;
inc( p );
end;
end;
procedure setsockaddr( var sa : tsockaddr ; adr : string ; port : longint );
begin
memclr( @sa , sizeof( sa ) );
sa.sin_family := AF_INET;
sa.sin_addr := strtonetaddr( adr );
sa.sin_port := htons( port );
end;
procedure setnonblockingsocket( s : integer );
var arg : longint;
begin
arg := fpfcntl( s , F_GETFL );
if arg >= 0 then begin
arg := arg or O_NONBLOCK;
fpfcntl( s , F_SETFL , arg );
end;
end;
procedure ip_client( ipadress : string );
var
inetaddr_client_remote : tsockaddr;
c_socket : integer;
c : longint;
begin
setsockaddr( inetaddr_client_remote , ipadress , port_program );
c_socket := fpsocket( PF_INET , SOCK_STREAM , 0 );
if c_socket >= 0 then begin
writeln( 'open socket' );
setnonblockingsocket( c_socket ); // nonblocking connect call
repeat
c := fpconnect( c_socket , @inetaddr_client_remote ,
sizeof( inetaddr_client_remote ) );
until c = 0;
writeln( 'connected' );
crt.delay( 1000 );
closesocket( c_socket );
writeln( 'closed' );
end;
end;
procedure ip_server;
var
inetaddr_server_bind : tsockaddr;
inetaddr_server_accept : tsockaddr;
alength : integer;
l : longint;
c : byte = 0;
s_socket : integer;
s_acc_socket : integer;
s_bind : longint;
s_listen : longint;
begin
clrscr;
s_socket := fpsocket( PF_INET , SOCK_STREAM , 0 );
if s_socket <> -1 then begin
setnonblockingsocket( s_socket );
setsockaddr( inetaddr_server_bind , '' , port_program );
s_bind := fpbind( s_socket , @inetaddr_server_bind ,
sizeof( inetaddr_server_bind ) );
if s_bind <> -1 then begin
s_listen := fplisten( s_socket , 0 ); // socket , warteschlange
if s_listen = 0 then begin
alength := sizeof( inetaddr_server_accept );
repeat
// wait for incoming connection
s_acc_socket := fpaccept( s_socket , @inetaddr_server_accept ,
@alength );
write( '.' );
delay( 300 ); // little delay
until ( s_acc_socket >= 0 ) or keypressed;
if s_acc_socket >= 0 then begin
repeat
// Exception
l := fpsend( s_acc_socket , @c , sizeof( c ) , 0 );
// Exception
write( '*' ); // <- this does NOT making the exception
delay( 300 ); // little delay
until keypressed;
closesocket( s_acc_socket );
end;
end;
end;
end;
end;
const
server = true;
// server = false;
begin
if server then ip_server
else ip_client ( '192.168.178.21' ); // ip address of the server
end.
Am Mittwoch, 27. Mai 2009 20:53 schrieb Jonas Maebe:
> On 27 May 2009, at 19:24, Rainer Stratmann wrote:
> > Am Mittwoch, 27. Mai 2009 11:45 schrieb Vincent Snijders:
> >> Rainer Stratmann schreef:
> >>> Am Dienstag, 26. Mai 2009 22:27 schrieb Jonas Maebe:
> >>>> Well, as I said: it does not raise any exceptions.
> >>>
> >>> Would it be possible to catch that exception?
> >>> With the try except block?
> >>> Are other functions existing to catch linux exceptions?
> >>
> >> No, you cannot catch exception that are not raised.
> >
> > What does 'raised' exactly mean?
>
> http://www.freepascal.org/docs-html/ref/refse73.html
>
> Please provide a compilable sample that demonstrates the problem you
> are having. I'm guessing you can "solve" it by adding the sysutils
> unit to your uses clause (because currently you're probably getting a
> plain run time error, and using the sysutils unit means that it will
> be converted into an exception that you can catch), but that would
> just be a hack. You probably also would have to put the try/catch
> around the next debugging writeln, and not around the send() call to
> catch the exception (because send() does not cause any inoutres
> checks, but writeln() does)
>
> I really have no idea how the error result of send() could end up in
> inoutres though (which is, I think, the only way that could cause the
> RTL to produce a run time error in response to a failed send() call).
> There are variants of the socket routines that work on text files and
> that do set inoutres, but send() is not one of them.
>
> So please, provide source code (even if some hack seems to solve the
> problem) so we don't have to send 10 more mails guessing about what
> you might be doing and what might be going wrong.
>
>
> Jonas
> _______________________________________________
> fpc-pascal maillist - fpc-pascal@lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
