Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/TCPOOConnections.p

Text File | 1996-11-04 | 24.1 KB | 1,065 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: DNRRecordPtr; { 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;
        DNRSearchObject = object(ConnectionBaseObject)
                object_host: Str255;
                function HandleConnection: boolean;
                override;
                procedure Terminate;
                override;
                procedure DoQuery;
                procedure Find (hostName: Str255);
                procedure Found;
            end;
        AddressSearchObject = object(DNRSearchObject)
                procedure DoQuery;
                override;
                procedure Found;
                override;
                procedure FoundAddress (ip: longint);
            end;
        HInfoSearchObject = object(DNRSearchObject)
                procedure DoQuery;
                override;
                procedure Found;
                override;
                procedure FoundHInfo ( cpu, os: Str31 );
            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: ipAddr;
        tcp_our_str: Str31;
        tcp_our_name: Str255;

    procedure StartupConnections;
    procedure ConfigureConnections( findourname: Boolean );
    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, MyStartup, MyMemory, MyAssertions, MyCStrings;

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

    const  { Tuning parameters }
        max_connections = 64;
        TO_FindAddress = 40 * second_in_ticks;
        TO_FindName = 40 * second_in_ticks;
        TO_ActiveOpen = 20 * second_in_ticks;
        TO_Closing = longint(2) * minute_in_ticks;
        TO_PassiveOpen = longint(1) * 365 * day_in_ticks;  { 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;
        gFindOurName: 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_Dead;
        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
{$unused(error)}
        tcp_our_name := name;
    end;

    function InitConnections(var msg: integer): OSStatus;
        var
            oe: OSErr;
            i: integer;
            lobj: LookupMyName;
    begin
{$unused(msg)}
        quiting := false;
        icmp_sent_out := 0;
        icmp_got_back := 0;
        for i := 1 to max_connections do begin
            connections[i].obj := nil;
        end;
        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 gFindOurName then begin
                new(lobj);
                lobj.FindName(tcp_our_ip);
            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 begin
                dummy := WaitNextEvent(everyEvent, er, 5, nil);
            end;
        end;
        CloseResolver;
    end;

    procedure StartupConnections;
    begin
        StartupTCPStuff;
        SetStartup( InitConnections, nil, 0, FinishConnections );
    end;

    procedure ConfigureConnections( findourname: Boolean );
    begin
        gFindOurName := findourname;
        StartupConnections;
    end;

    function ConnectionBaseObject.Create: OSErr;
        var
            i: integer;
            oe: OSErr;
    begin
        MoveHHi(Handle(self));
        HLock(Handle(self));
        connection_index := -1;
        drp := nil;
        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[connection_index].obj := self;
                heartbeat_period := 0;
                heartbeat_time := 0;
                timeout_time := maxLongInt;
                closedone := false;
                terminatedone := false;
                oe := MNewPtr( drp, SizeOf(DNRRecord) );
                if ( oe = noErr ) then begin
                    drp^.ioResult := noErr;
                end;
            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) & (drp^.ioResult <> inProgress) then begin { we leak the record if it is in progress - better than crashing }
            MDisposePtr(drp);
        end;
        dispose(self);
    end;

    procedure ConnectionBaseObject.Heartbeat;
    begin
    end;

    procedure ConnectionBaseObject.Failed (oe: OSErr);
    begin
{$unused(oe)}
        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 DNRSearchObject.Find (hostName: Str255);
        var
            oe: OSErr;
    begin
        oe := Create;
        if oe = noErr then begin
            object_host := hostName;
            DoQuery;
            timeout_time := TickCount + TO_FindAddress;
        end else begin
            Failed(oe);
            Destroy;
        end;
    end;

    procedure DNRSearchObject.Terminate;
    begin
        if quiting then begin
            drp := nil;
            Failed( commandTimeoutErr );
        end;
        inherited Terminate;
    end;

    procedure DNRSearchObject.DoQuery;
    begin
        Assert( false );
    end;

    procedure DNRSearchObject.Found;
    begin
        Assert( false );
    end;

    function DNRSearchObject.HandleConnection: boolean;
    begin
        if drp^.ioResult = noErr then begin
{    TCPSetCache(hi, object_host);}
            Found;
            timetodie := true;
            HandleConnection := true;
        end else if drp^.ioResult <> inProgress then begin
            Failed(drp^.ioResult);
            timetodie := true;
            HandleConnection := true;
        end else begin
            HandleConnection := inherited HandleConnection;
        end;
    end;

    procedure AddressSearchObject.DoQuery;
    begin
        DNRNameToAddr( object_host, drp, nil );
    end;

    procedure AddressSearchObject.Found;
    begin
        FoundAddress( drp^.addr );
    end;

    procedure AddressSearchObject.FoundAddress (ip: longint);
    begin
{$unused(ip)}
        Assert( false );
    end;

    procedure HInfoSearchObject.DoQuery;
    begin
        DNRNameToHInfo( object_host, drp, nil );
    end;

    procedure HInfoSearchObject.Found;
        var
            cpu, os: Str255;
    begin
        CopyC2P( @drp^.hi.hinfo.cpuType, cpu );
        if length( cpu ) > 30 then begin
            cpu[0] := chr(30);
        end;
        CopyC2P( @drp^.hi.hinfo.osType, os );
        if length( os ) > 30 then begin
            os[0] := chr(30);
        end;
        FoundHInfo( cpu, os );
    end;

    procedure HInfoSearchObject.FoundHInfo ( cpu, os: Str31 );
    begin
{$unused(cpu, os)}
        Assert( false );
    end;

    procedure NameSearchObject.FindName (hostIP: longint);
        var
            oe: OSErr;
    begin
        ip := hostIP;
        oe := Create;
        if oe = noErr then begin
            DNRAddrToName(hostIP, 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
{$unused(name, error)}
    end;

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

    procedure ConnectionObject.Established;
    begin
    end;

    procedure ConnectionObject.Closing;
    begin
        Close;
    end;

    procedure ConnectionObject.CharsAvailable (count: longint);
    begin
{$unused(count)}
    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
            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;
                    MDisposePtr(drp);
                    StartConnection;
                end;
            end else begin
                object_host := remotehost;
                DNRNameToAddr(remotehost, 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 drp^.ioResult = noErr then begin
{    TCPSetCache(myHIP(hip)^.hi, object_host);}
                    theirip := drp^.addr;
                    MDisposePtr(drp);
                    StartConnection;
                    didit := true;
                end else if drp^.ioResult <> inProgress then begin
                    Failed(drp^.ioResult);
                    timetodie := true;
                    didit := true;
                end;
            end;
            CS_Opening:  begin
                case state of
                    T_WaitingForOpen, T_Opening, T_Bored:
                        ;
                    T_Established:  begin
                        Established;
                        status := CS_Established;
                        timeout_time := maxLongInt;
                        didit := true;
                    end;
                    T_PleaseClose, T_Closing, T_Dead:  begin
                        didit := true;
                        Failed(failedToOpenError);
                        timetodie := true;
                    end;
                    otherwise begin
                        { do nothing }
                    end;
                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_Dead:  begin
                        Closing;
                        status := CS_Closing;
                        timeout_time := TickCount + TO_Closing;
                        didit := true;
                    end;
                    otherwise begin
                        { do nothing }
                    end;
                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_Dead:  begin
                        timetodie := true;
                        didit := true;
                    end;
                    otherwise begin
                        { do nothing }
                    end;
                end;
            end;
            otherwise begin
                { do nothing }
            end;
        end;
        didit := didit | inherited HandleConnection;
        HandleConnection := didit;
    end;

    function LineConnectionObject.Create: OSErr;
        var
            err, err2: OSErr;
    begin
        err := inherited Create;
        crlf := CL_CRLF;
        err2 := MNewHandle( buffer, 512 );
        if err = noErr then begin
            err := err2;
        end;
        buffer_len := 0;
        last_check := -1;
        pushFlag := true;
        line_send_error := noErr;
        Create := err;
    end;

    procedure LineConnectionObject.Destroy;
    begin
        MDisposeHandle(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
{$unused(line)}
    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);
                BlockMoveData(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;
                BlockMoveData(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;
        var
            result: boolean;
    begin
        result := inherited HandleConnection;
        if not result & (status in [CS_Established, CS_Closing]) then begin
            result := CheckLineAvailable;
        end;
        HandleConnection := result;
    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
        udpcp := nil;
        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
            Destroy;
        end;
        CreatePort := oe;
    end;

    procedure UDPObject.Terminate;
    begin
        terminatedone := true;
        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
{$unused(remoteIP, remoteport, datap, datalen)}
    end;

    procedure UDPObject.PacketsAvailable (count: integer);
        var
            oe: OSErr;
            remoteIP: longint;
            remoteport: integer;
            datap: Ptr;
            datalen: integer;
            u: UDPConnectionPtr;
    begin
{$unused(count)}
        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.