[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