Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/TCPOOConnections.p

Text File | 1995-10-16 | 23.1 KB | 1,009 lines | [TEXT/CWIE]

unit TCPOOConnections;

{ TCPOOConnections © Peter Lewis, April 1993 }

interface

    uses
        TCPTypes, TCPStuff, MyTypes, MyStrings;

    const
        tooManyConnections = -23099;
        timeoutError = -23098;
        failedToOpenError = -23097;

{ Sequence: }
{ new(obj) }
{ oe:=obj.Create }
{ if oe=noErr then begin }
{   do stuff}
{ end; }
{ obj.Destroy }

    type
        ConnectionBaseObject = object
                timetodie: boolean; { Set this to have Destroy called at the end of HandleConnection }
                connection_index: integer; { private! }
                closedone, terminatedone: boolean;
                heartbeat_period: longInt; { set to <=0 to disable heartbeats }
                heartbeat_time: longInt; { set to time of next heartbeat, it is automatically incrememnted by the period }
{ To enable heartbeats, set heartbeat_time to TickCount, and heartbeat_period to the period in ticks }
                timeout_time: longInt; { set to time to timeout TickCount }
                drp: ptr; { private! }
                function Create: OSErr;
                procedure Destroy;
                procedure HeartBeat;
                procedure Failed (oe: OSErr);
                procedure Timeout;
                procedure Terminate;
                procedure Close;
                function HandleConnection: boolean;
            end;
        NameSearchObject = object(ConnectionBaseObject)
                ip: longInt;
                function HandleConnection: boolean;
                override;
                procedure FindName (hostIP: longInt);
                procedure FoundName (name: str255; error: OSErr);
            end;
        AddressSearchObject = object(ConnectionBaseObject)
                object_host: str255;
                function HandleConnection: boolean;
                override;
                procedure FindAddress (hostName: str255);
                procedure FoundAddress (ip: longInt);
            end;
        UDPObject = object(ConnectionBaseObject)
                udpcp: UDPConnectionPtr;
                localport: integer;
                function Create: OSErr;
                override;
                function CreatePort (buffer_size: longInt; port: integer): OSErr;
                procedure Close;
                override;
                procedure Terminate;
                override;
                procedure Destroy;
                override;
                function HandleConnection: boolean;
                override;
                procedure PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
                procedure PacketsAvailable (count: integer);
                function SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
            end;
        statusType = (CS_LookingUpAddr, CS_Opening, CS_Established, CS_Closing);
        ConnectionObject = object(ConnectionBaseObject)
                lookingupname: boolean;
                active: boolean;
                thebuffersize: longInt;
                ourip: longInt;
                ourport: integer;
                theirip: longInt;
                theirport: integer;
                tcpc: TCPConnectionPtr;
                status: statusType;
                object_host: str255;
                procedure Destroy;
                override;
                function HandleConnection: boolean;
                override;
                procedure NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
                procedure NewPassiveConnection (buffersize: longInt; localport: integer);
                procedure NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
                procedure StartConnection;
                procedure Close;
                override;
                procedure Terminate;
                override;
                procedure BeginConnection; { override these }
                procedure Established;
                procedure Closing;
                procedure CharsAvailable (count: longInt);
                function MyCharsAvailable: longint;
            end;
        LineConnectionObject = object(ConnectionObject)
                crlf: CRLFTypes;
                buffer_len: longInt; { Current number of characters in buffer }
                buffer: handle; { Size initially set to 512 bytes, change it as you wish }
                last_check: longInt; { buffer_len when we last checked for a line, don't recheck unless it changes }
                pushFlag: boolean; { Hack for the occasionally non-pushed lines, set to true every send }
                line_send_error: OSErr;
                function Create: OSErr;
                override;
                procedure Destroy;
                override;
                procedure SendLine (s: str255);
                procedure LineAvailable (line: str255);
                function CheckLineAvailable: boolean; { You can override this and use buffer & buffer_len yourself }
                function HandleConnection: boolean;
                override;
                procedure CharsAvailable (count: longInt); { Note: includes buffer_len }
                override;
                function MyCharsAvailable: longint;
                override;
            end;

    var
        tcp_our_ip: longInt;
        tcp_our_str: str31;
        tcp_our_name: str255;

    function InitConnections (findourname: boolean): OSErr;
    procedure FinishConnections;
    function HandleConnections (maxtime: integer): boolean;
    procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
    function ConnectionsAddrToStr (ip: longInt): str255;
    function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
{ You probably wont need these: }
    procedure TerminateConnections;
    procedure CloseConnections;
    function CanQuit: boolean;

implementation

    uses
        DNR;

    const
        TCPCMagic = 'TCPC';
        TCPCBadMagic = 'badc';

    const  { Tuning parameters }
        max_connections = 64;
        TO_FindAddress = 40 * 60;
        TO_FindName = 40 * 60;
        TO_ActiveOpen = 20 * 60;
        TO_Closing = longInt(2) * 60 * 60;
        TO_PassiveOpen = longInt(1) * 365 * 24 * 3600 * 60;  { One years should be safe enough right? :-) }

    type
        myHostInfo = record
                hi: hostInfo;
                done: signedByte;
            end;
        myHIP = ^myHostInfo;

    type
        connectionRecord = record
                obj: ConnectionBaseObject;
            end;

    var
        connections: array[1..max_connections] of connectionRecord;
        quiting: boolean;

    procedure TrashHandle (h: handle);
        var
            p: ptr;
            i: longInt;
    begin
        if (h <> nil) & (h^ <> nil) then begin
            p := h^;
            for i := 1 to GetHandleSize(h) do begin
                p^ := -27;
                longInt(p) := longInt(p) + 1;
            end;
        end;
    end;

    function MyTCPState (con: TCPConnectionPtr): TCPStateType;
    begin
        if con = nil then begin
            MyTCPState := T_Closed;
        end else begin
            MyTCPState := TCPState(con);
        end;
    end;

    type
        LookupMyName = object(NameSearchObject)
                procedure FoundName (name: str255; error: OSErr);
                override;
            end;

    procedure LookupMyName.FoundName (name: str255; error: OSErr);
    begin
        error := error; { UNUSED! }
        tcp_our_name := name;
    end;

    function InitConnections (findourname: boolean): OSErr;
        var
            oe: OSErr;
            i: integer;
            lobj: LookupMyName;
    begin
        quiting := false;
        icmp_sent_out := 0;
        icmp_got_back := 0;
        for i := 1 to max_connections do begin
            connections[i].obj := nil;
        end;
        oe := TCPInit;
        if oe = noErr then begin
            oe := OpenResolver;
            if oe = noErr then begin
                oe := IPGetMyIPAddr(tcp_our_ip);
                tcp_our_str := ConnectionsAddrToStr(tcp_our_ip);
                tcp_our_name := tcp_our_str;
                if findourname then begin
                    new(lobj);
                    lobj.FindName(tcp_our_ip);
                end;
            end;
            if oe <> noErr then begin
                TCPFinish;
            end;
        end;
        InitConnections := oe;
    end;

    procedure TerminateConnections;
        var
            i: integer;
    begin
        for i := 1 to max_connections do begin
            if connections[i].obj <> nil then begin
                if not connections[i].obj.terminatedone then begin
                    connections[i].obj.Terminate;
                end;
            end;
        end;
    end;

    procedure CloseConnections;
        var
            i: integer;
    begin
        for i := 1 to max_connections do begin
            if connections[i].obj <> nil then begin
                connections[i].obj.Close;
            end;
        end;
    end;

    function CanQuit: boolean;
        var
            i: integer;
    begin
        CanQuit := icmp_sent_out = icmp_got_back;
        for i := 1 to max_connections do begin
            if connections[i].obj <> nil then begin
                CanQuit := false;
                leave;
            end;
        end;
    end;

    procedure FinishConnections;
        var
            dummy: boolean;
            er: eventRecord;
    begin
        quiting := true;
        while not CanQuit do begin
            TerminateConnections;
            if HandleConnections(3) then begin
                dummy := WaitNextEvent(everyEvent, er, 0, nil);
            end
            else
                dummy := WaitNextEvent(everyEvent, er, 5, nil);
        end;
        CloseResolver;
        TCPFinish;
    end;

    function ConnectionBaseObject.Create: OSErr;
        var
            i: integer;
            oe: OSErr;
    begin
        MoveHHi(handle(self));
        HLock(handle(self));
        if quiting then begin
            oe := -12;
        end
        else begin
            i := 1;
            while (i <= max_connections) & (connections[i].obj <> nil) do begin
                i := i + 1;
            end;
            if i <= max_connections then begin
                timetodie := false;
                connection_index := i;
                connections[i].obj := self;
                heartbeat_period := 0;
                heartbeat_time := 0;
                timeout_time := maxLongInt;
                closedone := false;
                terminatedone := false;
                drp := NewPtr(SizeOf(DNRRecord));
                oe := MemError;
            end
            else begin
                connection_index := -1;
                oe := tooManyConnections;
            end;
        end;
        Create := oe;
    end;

    procedure ConnectionBaseObject.Destroy;
    begin
        if connection_index > 0 then begin
            connections[connection_index].obj := nil;
        end;
        if drp <> nil then begin
            DisposePtr(drp);
        end;
        TrashHandle(handle(self));
        dispose(self);
    end;

    procedure ConnectionBaseObject.HeartBeat;
    begin
    end;

    procedure ConnectionBaseObject.Failed (oe: OSErr);
    begin
        oe := oe; { UNUSED! }
        timetodie := true;
    end;

    procedure ConnectionBaseObject.Timeout;
    begin
        Failed(timeoutError);
    end;

    procedure ConnectionBaseObject.Terminate;
    begin
        terminatedone := true;
    end;

    procedure ConnectionBaseObject.Close;
    begin
        closedone := true;
    end;

    function ConnectionBaseObject.HandleConnection: boolean;
        var
            now: longInt;
    begin
        HandleConnection := false;
        now := TickCount;
        if now > timeout_time then begin
            timeout_time := maxLongInt;
            Timeout;
            HandleConnection := true;
        end
        else if (heartbeat_period > 0) & (now >= heartbeat_time) then begin
            HeartBeat;
            heartbeat_time := heartbeat_time + heartbeat_period;
            HandleConnection := true;
        end;
    end;

    procedure AddressSearchObject.FindAddress (hostName: str255);
        var
            oe: OSErr;
    begin
        oe := Create;
        if oe = noErr then begin
            object_host := hostName;
            DNRNameToAddr(hostName, DNRRecordPtr(drp), nil);
            timeout_time := TickCount + TO_FindAddress;
        end;
        if oe <> noErr then begin
            Failed(oe);
            Destroy;
        end;
    end;

    procedure AddressSearchObject.FoundAddress (ip: longInt);
    begin
        ip := ip; { UNUSED! }
    end;

    function AddressSearchObject.HandleConnection: boolean;
    begin
        with DNRRecordPtr(drp)^ do begin
            if ioResult = noErr then begin
{    TCPSetCache(hi, object_host);}
                FoundAddress(addr);
                timetodie := true;
                HandleConnection := true;
            end
            else if ioResult <> inProgress then begin
                Failed(ioResult);
                timetodie := true;
                HandleConnection := true;
            end
            else begin
                HandleConnection := inherited HandleConnection;
            end;
        end; {with}
    end;

        UDPObject = object(ConnectionBaseObject)
                udpcp: UDPConnectionPtr;
                localport: integer;
                function Create: OSErr;
                override;
                function CreatePort (buffer_size: longInt; port: integer): OSErr;
                procedure Close;
                override;
                procedure Terminate;
                override;
                procedure Destroy;
                override;
                function HandleConnection: boolean;
                override;
                procedure PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
                procedure PacketsAvailable (count: integer);
                function SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
            end;



    procedure NameSearchObject.FindName (hostIP: longInt);
        var
            oe: OSErr;
    begin
        ip := hostIP;
        oe := Create;
        if oe = noErr then begin
            DNRAddrToName(hostIP, DNRRecordPtr(drp), nil);
            timeout_time := TickCount + TO_FindName;
        end;
        if oe <> noErr then begin
            Failed(oe);
            Destroy;
        end;
    end;

    procedure NameSearchObject.FoundName (name: str255; error: OSErr);
    begin
        name := name; { UNUSED! }
        error := error; { UNUSED! }
    end;

    function NameSearchObject.HandleConnection: boolean;
    begin
        with DNRRecordPtr(drp)^ do begin
            if ioResult <> inProgress then begin
                FoundName(name, ioResult);
                timetodie := true;
                HandleConnection := true;
            end
            else begin
                HandleConnection := inherited HandleConnection;
            end;
        end; {with}
    end;

    procedure ConnectionObject.Established;
    begin
    end;

    procedure ConnectionObject.Closing;
    begin
        Close;
    end;

    procedure ConnectionObject.CharsAvailable (count: longInt);
    begin
        count := count; { UNUSED! }
    end;

    function ConnectionObject.MyCharsAvailable: longint;
    begin
        MyCharsAvailable := TCPCharsAvailable(tcpc);
    end;

    procedure ConnectionObject.Destroy;
        var
            tmp_tcpc: TCPConnectionPtr;
            oe: OSErr;
    begin
        if tcpc <> nil then begin
            oe := TCPAbort(tcpc);
            tmp_tcpc := tcpc;
            oe := TCPRelease(tmp_tcpc);
        end;
        inherited Destroy;
    end;

    procedure ConnectionObject.BeginConnection;
    begin
    end;

    procedure ConnectionObject.StartConnection;
        var
            oe: OSErr;
            tmp_tcpc: TCPConnectionPtr;
    begin
        if active then begin
            oe := TCPActiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
            timeout_time := TickCount + TO_ActiveOpen;
        end
        else begin
            oe := TCPPassiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
            timeout_time := TickCount + TO_PassiveOpen;
        end;
        tcpc := tmp_tcpc;
        status := CS_Opening;
        if oe = noErr then begin
            ourport := TCPLocalPort(tcpc);
            BeginConnection;
        end
        else begin
            Failed(oe);
            timetodie := true;
        end;
    end;

    procedure ConnectionObject.NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
        var
            oe: OSErr;
            ip: longInt;
    begin
        status := CS_LookingUpAddr;
        tcpc := nil;
        oe := Create;
        if oe = noErr then begin
            active := actve;
            thebuffersize := buffersize;
            ourport := localport;
            ourip := tcp_our_ip;
            theirip := 0;
            theirport := remoteport;
            ip := 0;
            if (remotehost = '') | ConnectionsStrToAddr(remotehost, ip) then begin
                if (ip = 0) & active then begin
                    oe := -11;
                end
                else begin
                    theirip := ip;
                    DisposePtr(drp);
                    drp := nil;
                    StartConnection;
                end;
            end
            else begin
                object_host := remotehost;
                DNRNameToAddr(remotehost, DNRRecordPtr(drp), nil);
                timeout_time := TickCount + TO_FindAddress;
            end;
        end;
        if oe <> noErr then begin
            tcpc := nil;
            Failed(oe);
            timetodie := true;
        end;
        if timetodie then begin
            Destroy;
        end;
    end;

    procedure ConnectionObject.NewPassiveConnection (buffersize: longInt; localport: integer);
    begin
        NewConnection(false, buffersize, localport, '', 0);
    end;

    procedure ConnectionObject.NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
    begin
        NewConnection(true, buffersize, 0, remotehost, remoteport);
    end;

    procedure ConnectionObject.Close;
        var
            oe: OSErr;
    begin
        if not closedone and (tcpc <> nil) then begin
            oe := TCPClose(tcpc, nil);
            closedone := true;
        end;
    end;

    procedure ConnectionObject.Terminate;
        var
            oe: OSErr;
    begin
        if not terminatedone and (tcpc <> nil) then begin
            oe := TCPAbort(tcpc);
            terminatedone := true;
        end;
    end;

    function ConnectionObject.HandleConnection: boolean;
        var
            didit: boolean;
            count: longInt;
            state: TCPStateType;
    begin
        didit := false;
        state := MyTCPState(tcpc);
        case status of
            CS_LookingUpAddr:  begin
                if DNRRecordPtr(drp)^.ioResult = noErr then begin
{    TCPSetCache(myHIP(hip)^.hi, object_host);}
                    theirip := DNRRecordPtr(drp)^.addr;
                    DisposePtr(drp);
                    StartConnection;
                    didit := true;
                end
                else if DNRRecordPtr(drp)^.ioResult <> inProgress then begin
                    Failed(DNRRecordPtr(drp)^.ioResult);
                    timetodie := true;
                    didit := true;
                end;
            end;
            CS_Opening:  begin
                case state of
                    T_WaitingForOpen, T_Opening, T_Listening:
                        ;
                    T_Established:  begin
                        Established;
                        status := CS_Established;
                        timeout_time := maxLongInt;
                        didit := true;
                    end;
                    T_PleaseClose, T_Closing, T_Closed:  begin
                        didit := true;
                        Failed(failedToOpenError);
                        timetodie := true;
                    end;
                    otherwise
                        ;
                end; {case }
            end;
            CS_Established:  begin
                case state of
                    T_Established:  begin
                        count := MyCharsAvailable;
                        if count > 0 then begin
                            CharsAvailable(count);
                            didit := true;
                        end;
                    end;
                    T_PleaseClose, T_Closing:  begin
                        count := MyCharsAvailable;
                        if count > 0 then begin
                            CharsAvailable(count);
                            didit := true;
                        end else begin
                            Closing;
                            status := CS_Closing;
                            timeout_time := TickCount + TO_Closing;
                            didit := true;
                        end;
                    end;
                    T_Closed:  begin
                        Closing;
                        status := CS_Closing;
                        timeout_time := TickCount + TO_Closing;
                        didit := true;
                    end;
                    otherwise
                        ;
                end;
            end;
            CS_Closing:  begin
                case state of
                    T_PleaseClose, T_Closing, T_Established:  begin
                        count := MyCharsAvailable;
                        if count > 0 then begin
                            CharsAvailable(count);
                            didit := true;
                        end;
                    end;
                    T_Closed:  begin
                        timetodie := true;
                        didit := true;
                    end;
                    otherwise
                        ;
                end;
            end;
            otherwise
                ;
        end;
        didit := didit | inherited HandleConnection;
        HandleConnection := didit;
    end;

    function LineConnectionObject.Create: OSErr;
    begin
        crlf := CL_CRLF;
        buffer := NewHandle(512);
        buffer_len := 0;
        last_check := -1;
        pushFlag := true;
        line_send_error := noErr;
        Create := inherited Create;
    end;

    procedure LineConnectionObject.Destroy;
    begin
        DisposeHandle(buffer);
        inherited Destroy;
    end;

    procedure LineConnectionObject.SendLine (s: str255);
        var
            oe: OSErr;
    begin
        if crlf <> CL_LF then begin
            s := concat(s, cr);
        end;
        if crlf <> CL_CR then begin
            s := concat(s, lf);
        end;
        oe := TCPSendAsync(tcpc, @s[1], length(s), pushFlag, nil);
        if line_send_error = noErr then begin
            line_send_error := oe;
        end;
        pushFlag := true;
    end;

    procedure LineConnectionObject.LineAvailable (line: str255);
    begin
        line := line; { UNUSED! }
    end;

    procedure LineConnectionObject.CharsAvailable (count: longInt);
        var
            space: longint;
            oe: OSErr;
            dummy: boolean;
    begin
        count := TCPCharsAvailable(tcpc);
        space := GetHandleSize(buffer) - buffer_len;
        if count > space then begin
            count := space;
        end;
        if count > 32767 then begin
            count := 32767;
        end;
        if count > 0 then begin
            HLock(buffer);
            oe := TCPRawReceiveChars(tcpc, ptr(ord(buffer^) + buffer_len), count);
            HUnlock(buffer);
            buffer_len := buffer_len + count;
        end;
        dummy := CheckLineAvailable;
    end;

    function LineConnectionObject.MyCharsAvailable: longint;
    begin
        MyCharsAvailable := TCPCharsAvailable(tcpc) + buffer_len;
    end;

    function LineConnectionObject.CheckLineAvailable: boolean;
        var
            len: longInt;
            p: ptr;
            s: str255;
    begin
        CheckLineAvailable := false;
        if (buffer_len > 0) & (buffer_len <> last_check) then begin
            p := buffer^;
            len := 0;
            while (len < buffer_len) & (len < 255) & (p^ <> ord(lf)) & (p^ <> ord(cr)) do begin
                p := ptr(ord(p) + 1);
                len := len + 1;
            end;
            if (len = 255) | ((len < buffer_len) & ((p^ = ord(lf)) | (p^ = ord(cr)))) then begin
{$PUSH}
{$R-}
                s[0] := chr(len);
                BlockMove(buffer^, @s[1], len);
{$POP}
                if (len < buffer_len) & (p^ = ord(cr)) then begin
                    p := ptr(ord(p) + 1);
                    len := len + 1;
                end;
                if (len < buffer_len) & (p^ = ord(lf)) then begin
                    p := ptr(ord(p) + 1);
                    len := len + 1;
                end;
                BlockMove(p, buffer^, buffer_len - len);
                buffer_len := buffer_len - len;
                LineAvailable(s);
                CheckLineAvailable := true;
                last_check := -1;
            end
            else begin
                last_check := buffer_len;
            end;
        end;
    end;

    function LineConnectionObject.HandleConnection: boolean;
    begin
        HandleConnection := inherited HandleConnection | CheckLineAvailable;
    end;

    function UDPObject.Create: OSErr;
    begin
        udpcp := nil;
        localport := 0;
        Create := inherited Create;
    end;

    function UDPObject.CreatePort (buffer_size: longInt; port: integer): OSErr;
        var
            oe: OSErr;
            tmp_udpcp: UDPConnectionPtr;
    begin
        oe := Create;
        if oe = noErr then begin
            oe := UDPCreate(tmp_udpcp, buffer_size, port);
            udpcp := tmp_udpcp;
            localport := port;
            timeout_time := maxLongInt;
        end;
        if oe <> noErr then begin
            udpcp := nil;
            Destroy;
        end;
        CreatePort := oe;
    end;

    procedure UDPObject.Terminate;
    begin
        timetodie := true;
    end;

    procedure UDPObject.Close;
        var
            tmp_udpcp: UDPConnectionPtr;
            oe: OSErr;
    begin
        if udpcp <> nil then begin
            tmp_udpcp := udpcp;
            oe := UDPRelease(tmp_udpcp);
            udpcp := nil;
        end;
        timetodie := true;
    end;

    procedure UDPObject.Destroy;
    begin
        if udpcp <> nil then begin
            Close;
        end;
        inherited Destroy;
    end;

    procedure UDPObject.PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
    begin
        remoteIP := remoteIP; { UNUSED! }
        remoteport := remoteport; { UNUSED! }
        datap := datap; { UNUSED! }
        datalen := datalen; { UNUSED! }
    end;

    procedure UDPObject.PacketsAvailable (count: integer);
        var
            oe: OSErr;
            remoteIP: longInt;
            remoteport: integer;
            datap: ptr;
            datalen: integer;
            u: UDPConnectionPtr;
    begin
        count := count; { UNUSED! }
        oe := UDPRead(udpcp, 1, remoteIP, remoteport, datap, datalen);
        if oe = noErr then begin
            u := udpcp;
            PacketAvailable(remoteIP, remoteport, datap, datalen);
{ self may be nil now }
            oe := UDPReturnBuffer(u, datap);
        end;
    end;

    function UDPObject.SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
    begin
        SendPacket := UDPWrite(udpcp, remoteIP, remoteport, datap, datalen, checksum);
    end;

    function UDPObject.HandleConnection: boolean;
        var
            didit: boolean;
            count: longInt;
    begin
        didit := false;
        if udpcp <> nil then begin
            count := UDPDatagramsAvailable(udpcp);
            if count > 0 then begin
                PacketsAvailable(count);
                didit := true;
            end;
        end;
        HandleConnection := didit | inherited HandleConnection;
    end;

    function HandleConnections (maxtime: integer): boolean;
        var
            did, didany: boolean;
            start: longInt;
            i: integer;
    begin
        start := TickCount;
        didany := false;
        repeat
            did := false;
            for i := 1 to max_connections do begin
                if connections[i].obj <> nil then begin
                    if connections[i].obj.HandleConnection then begin
                        did := true;
                        didany := true;
                    end;
                    if (connections[i].obj <> nil) & (connections[i].obj.timetodie) then begin
                        connections[i].obj.Destroy;
                    end;
                end;{if}
            end; {for}
        until not did or (TickCount >= start + maxtime);
        HandleConnections := didany;
    end;

    function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
        var
            good: boolean;
        procedure Get1;
            var
                b: integer;
        begin
            if (length(s) = 0) | not (s[1] in ['0'..'9']) then begin
                good := false;
            end else begin
                b := ord(s[1]) - 48;
                s := TPCopy(s, 2, 255);
                if (s <> '') & (s[1] in ['0'..'9']) then begin
                    b := b * 10 + ord(s[1]) - 48;
                    s := TPCopy(s, 2, 255);
                end;
                if (s <> '') & (s[1] in ['0'..'9']) then begin
                    b := b * 10 + ord(s[1]) - 48;
                    s := TPCopy(s, 2, 255);
                end;
                if (s <> '') & (s[1] = '.') then begin
                    s := TPCopy(s, 2, 255);
                end;
                if b > 255 then begin
                    good := false;
                    b := 0; { avoid overflow error? }
                end;
                addr := BOR(BSL(addr, 8), b);
            end;
        end;
    begin
        good := true;
        addr := 0;
        Get1;
        Get1;
        Get1;
        Get1;
        good := good & (s = '');
        if not good then begin
            addr := 0;
        end;
        ConnectionsStrToAddr := good;
    end;

    procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
    begin
        AddrToStr(ip, addrStr);
    end;

    function ConnectionsAddrToStr (ip: longInt): str255;
        var
            s: str255;
    begin
        AddrToStr(ip, s);
        ConnectionsAddrToStr := s;
    end;

end.