[fpc-pascal]Weird ANSI string behavior?
Roderick van Domburg
gog at gamepoint.net
Sun Jan 28 19:27:02 CET 2001
I was looking at a couple of TCP/IP programming examples provided by
Sebastian Koppehel, attached below. I was experimenting with ANSI strings,
and thought I'd compile the entire bunch below with the {$H+} mode switch.
Then I was dumbfounded when I found out that it compiles perfectly alright,
but immediately drops to the command line -- but just in {$H+} mode, without
ANSI strings it works just fine. Note that I have tried compiling both with
ANSI strings enabled in just the 'mulserv', and with ANSI strings enabled in
'mulserv' *and* the 'inetaux' and 'myerror' units. I've even tried making
the entire 'myerror' unit redundant by replacing all of the custom write
functions by simple Writeln's, but it gave the same results.
Do you have any ideas as to why, and how this can be fixed?
=== mulserv.pas ==========
program mulserv;
{ A server that can handle multiple client connections. }
uses
winsock, sockets, inetaux, myerror;
const
ListenPort : Word = $AFFE;
MaxConn = 5;
MaxClients = 5;
type
ClientRec = record
cSock : LongInt;
adstr : String;
sin, sout : Text;
end;
var
lSock, uSock : LongInt;
sAddr : TInetSockAddr;
Len, i, j : LongInt;
Line : String;
Clients : array[1..MaxClients] of ClientRec;
NumClients : LongInt;
MaxFD : LongInt;
ReadSet : FDSet;
sin, sout : Text;
begin
lSock := Socket(af_inet, sock_stream, 0);
if lSock = -1 then SockError('Socket: ');
with sAddr do
begin
Family := af_inet;
Port := htons(ListenPort);
Addr := 0;
end;
if not Bind(lSock, sAddr, sizeof(sAddr)) then SockError('Bind: ');
if not Listen(lSock, MaxConn) then SockError('Listen: ');
Say('Waiting...');
fd_zero(ReadSet);
NumClients := 0;
repeat
MaxFD := 0;
for i := 1 to NumClients do with Clients[i] do
begin
fd_set(cSock, ReadSet);
if cSock > MaxFD then MaxFD := cSock;
end;
fd_set(lSock, ReadSet);
if lSock > MaxFD then MaxFD := lSock;
Inc(MaxFD);
Select(MaxFD, @ReadSet, nil, nil, nil); { No timeout! }
{ New connections? }
if fd_isset(lSock, ReadSet) then
begin
Say('Incoming connection.');
Len := sizeof(sAddr);
uSock := Accept(lSock, sAddr, Len);
if uSock = -1 then SockSay('Accept: ')
else
begin
if NumClients < MaxClients then
begin
Inc(NumClients);
with Clients[NumClients] do
begin
cSock := uSock;
Sock2Text(cSock, sin, sout);
Reset(sin);
Rewrite(sout);
adstr := AddrToStr(sAddr.Addr);
Say('Accepted connection from ' + adstr);
end;
end
else { client limit reached }
begin
Sock2Text(uSock, sin, sout);
Rewrite(sout);
Writeln(sout, 'Sorry, we are fully booked.');
Close(sout);
Shutdown(uSock, 2);
end;
end;
end;
{ And/or an event on an existing connection? }
for i := 1 to NumClients do if fd_isset(Clients[i].cSock, ReadSet)
then
begin
if eof(Clients[i].sin) then { Connection has been closed? }
begin
with Clients[i] do
begin
Close(sin);
Close(sout);
Shutdown(cSock, 2);
Say('Disconnected ' + adstr);
end;
for j := i to NumClients - 1 do Clients[j] := Clients[j + 1];
Dec(NumClients);
end
else { No -> Data can be read }
begin
Say('Received message from ' + Clients[i].adstr + '...');
Readln(Clients[i].sin, Line);
Say(Line);
for j := 1 to NumClients do if i <> j then
Writeln(Clients[j].sout, Line);
end;
end;
until False;
end.
=== myerror.pas ==========
unit MyError;
{
Custom error reporting routines.
*** WINDOWS VERSION ***
}
interface
procedure Say(msg : String);
procedure SockError(msg : String);
procedure SockSay(msg : String);
procedure GenError(msg : String);
implementation
uses sockets;
procedure Say(msg : String);
begin
Writeln(stderr, msg);
end;
procedure SockError(msg : String);
begin
Writeln(stderr, msg, SocketError);
Halt(1);
end;
procedure SockSay(msg : String);
begin
Writeln(stderr, msg, SocketError);
end;
procedure GenError(msg : String);
begin
Say(msg);
Halt(1);
end;
end.
=== inetaux.pas ==========
unit inetaux;
{
Auxiliary routines for TCP/IP programming.
0.2
25. 4. 2000
Sebastian Koppehel, <basti at bastisoft.de>
}
interface
{
Switch between host and network byte order for words and longints.
Note: These routines assume that you are on an Intel(R) machine.
}
function htons(i : Integer) : Integer;
function ntohs(i : Integer) : Integer;
function hton(l : LongInt) : LongInt;
function ntoh(l : LongInt) : LongInt;
{
Convert between dotted-decimal and longint ip addresses.
Note 1: LongInts are in network byte order.
Note 2: Plain numbers (without dots) are not recognized.
}
function StrToAddr(s : String) : LongInt;
function AddrToStr(addr : LongInt) : String;
implementation
function htons(i : Integer) : Integer;
begin
htons := lo(i) shl 8 or hi(i);
end;
function ntohs(i : Integer) : Integer;
begin
ntohs := htons(i);
end;
function hton(l : LongInt) : LongInt;
begin
hton := (lo(lo(l)) shl 8 or hi(lo(l))) shl 16
or (lo(hi(l)) shl 8 or hi(hi(l)));
end;
function ntoh(l : LongInt) : LongInt;
begin
ntoh := hton(l);
end;
function StrToAddr(s : String) : LongInt;
var
r, i, p, c : LongInt;
t : String;
begin
StrToAddr := 0;
r := 0;
for i := 0 to 3 do
begin
p := Pos('.', s);
if p = 0 then p := Length(s) + 1;
if p <= 1 then exit;
t := Copy(s, 1, p - 1);
Delete(s, 1, p);
Val(t, p, c);
if (c <> 0) or (p < 0) or (p > 255) then exit;
r := r or p shl (i * 8);
end;
StrToAddr := r;
end;
function AddrToStr(addr : LongInt) : String;
var
r, s : String;
i : LongInt;
begin
r := '';
for i := 0 to 3 do
begin
Str(addr shr (i * 8) and $FF, s);
r := r + s;
if i < 3 then r := r + '.';
end;
AddrToStr := r;
end;
end.
More information about the fpc-pascal
mailing list