Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Utilities/Toxic Waste 1.8/Toxic Recieve Code/TRecieve

Text File | 1994-01-08 | 16.3 KB | 754 lines | [TEXT/PJMM]

program ToxicRecieve;

{TOXIC RECIEVER version 1.8}
{By David Peck: [e-mail]}

{Toxic Waste's system extension to actually DO what the Toxic Sender wants...}
{This program operates quite invisibly in the target computer's background, until}
{the Toxic Sender wants it to do something... }

    uses
        Script, AppleEvents, disks, ShutDown, sound;

    const
        sleepyTime = $FFFFFFFF;
        wakeUp = 0;

    type
        SessStat = (sessNotBegun, sessOpenPend, sessOpenDone, sessInformPend, sessInformDone, sessReadPend, sessReadDone, sessRespPend, sessRespDone, sessEndPend, sessEndDone);
        AlertStat = (alertNotSent, alertSent);

    const
{What kinds of things can you do?}
        MeltScreen = 1;
        BlankScreen = 2;
        InvertScreen = 3;
        RandomIcons = 4;

        Beep = 6;
        RandomBeep = 7;

        EjectDisks = 9;
        StartEject = 10;
        EndEject = 11;

        Restart = 13;
        PowerDown = 14;

        Message = 16;

    type

        delayMethod = (timeDelay, mouseDelay, activeMouseDelay);

        ElementInfo = record
                when: longint;
                method: delayMethod;
                what: integer;
                numTimes: integer;
                mess: Str255;
            end;
        ElementInfoArray = array[1..6] of ElementInfo;
        QInfo = record
                num: integer;
                els: ElementInfoArray;
            end;

        DataRecord = record
{Items for a message being SENT by Toxic Sender.}
                what: integer;            {What I actually want you to do}
                mess: Str255;
                numTimes: integer;    {For "Beep" and "Random Icons" message}
                isDelayed: boolean;    {Is this event a delayed event?}
                dMethod: delayMethod;    {Method of delaying the event}
                numSecs: longint;        {If it is delayed, how many seconds long?}
                usageCheck: boolean;    {TRUE if user wants to know if the Mac is being used}

{Items for a message being RECIEVED from Toxic Reciever.}
                notMovedSince: longint;{How long has it been since the user moved the mouse?}
                notQ: boolean;                {TRUE if the Toxic Reciever's Queue was full}
                QCheck: QInfo;                {Returned if user selected usageCheck to view Q data}
                                                            {THIS IS NOT A COMPLETE Q. If it was, there would be}
                                                            {an infinitely recursive data structure...}
            end;

        PDataHdl = ^PDataPtr;
        PDataPtr = ^PDataRec;
        PDataRec = record
                pblock: PPCParamBlockRec;
                port: PPCPortRec;
                location: LocationNameRec;
                user: Str32;
                portRef: integer;
                sessionRef: integer;
                buffer: DataRecord;
                err: OSErr;
                errMessage: Str255;
                sessionStatus: SessStat;
                alertStatus: AlertStat;
            end;

    var
        pdata: PDataPtr;
        pd: PDataPtr;
        g_quit: boolean;
        g_psn: ProcessSerialNumber;
        g_sleepTicks: longint;
        err: OSErr;
        tr: rect;
        gEjects: boolean;
        gFontBloat: boolean;

    procedure _______G_______;
    begin
    end;

    type
        Element = record
                when: longint;
                method: delayMethod;
                event: DataRecord;
            end;
        ElementArray = array[1..6] of Element;
        QType = record
                num: integer;
                els: ElementArray;
            end;
{Globals}
    var
        gLastMoved: longint;        {How long since mouse moved?}
        gLastPos: point;
        gQError: boolean;            {Was there a previous Q Error?}
        gQ: QType;                    {The event Queue}

    function AEOpenHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEOpenHandler := errAEEventNotHandled;
    end;

    function AEOpenDocHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEOpenDocHandler := errAEEventNotHandled;
    end;

    function AEQuitHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
        var
            err: OSErr;
    begin
        g_Quit := true;
        err := WakeUpProcess(g_PSN);
        AEQuitHandler := noErr;
    end;

    function AEPrintHandler (var messageIn: AppleEvent; var reply: AppleEvent; refIn: longint): OSErr;
    begin
        AEPrintHandler := errAEEventNotHandled;
    end;

    procedure InitAEStuff;
        var
            e: OSErr;
    begin
        e := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @AEOpenHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @AEOpenDocHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @AEQuitHandler, 0, false);
        e := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @AEPrintHandler, 0, false);
    end;

    procedure Quit;
        var
            err: OSErr;
            pd: PDataPtr;
            pr: PPCParamBlockPtr;

    begin
        pd := pdata;
        pr := PPCParamBlockPtr(pdata);

        if (pd^.sessionRef <> 0) then
            begin
                pr^.endParam.ioCompletion := nil;
                err := PPCEnd(@pr^.endParam, true);
            end;
        if (pd^.portRef <> 0) then
            begin
                pr^.closeParam.ioCompletion := nil;
                pr^.closeParam.portRefNum := pd^.portRef;
                err := PPCClose(@pr^.closeParam, false);
            end;
    end;

    procedure EndDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessEndDone;
    end;

    procedure DoEnd (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
            err: OSErr;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessEndPend;
        pb^.endParam.ioCompletion := @EndDone;

        err := PPCEnd(PPCEndPBPtr(pb), true);
    end;

    procedure RespondDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessRespDone;

        PDataPtr(pb)^.err := pb^.writeParam.ioResult;
    end;

    procedure PutQData (pd: PDataPtr);
        var
            count: integer;
    begin
        pd^.buffer.QCheck.num := gQ.num;
        for count := 1 to gQ.num do
            with pd^.buffer.QCheck.els[count] do
                begin
                    when := gQ.els[count].when;
                    method := gQ.els[count].method;
                    what := gQ.els[count].event.what;
                    numTimes := gQ.els[count].event.numTimes;
                    mess := gq.els[count].event.mess;
                end;
    end;

    procedure DoRespond (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
            tim: longint;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessRespPend;

        pb^.writeParam.ioCompletion := @RespondDone;
        pb^.writeParam.bufferLength := SizeOf(pd^.buffer);
        pb^.writeParam.bufferPtr := @pd^.buffer;
        pb^.writeParam.more := false;
        pb^.writeParam.userData := 0;
        pb^.writeParam.blockCreator := 'BIOZ';
        pb^.writeParam.blockType := 'RESP';

        GetDateTime(tim);
        pd^.buffer.notMovedSince := tim - gLastMoved;
        pd^.buffer.notQ := gQError;
        gQError := false;
        if pd^.buffer.usageCheck then
            PutQData(pd);

        pd^.err := PPCWrite(PPCWritePBPtr(pb), true);
    end;

    function aRandom (upperBound: Integer): Integer;
        var
            rand: Integer;
    begin
        if upperBound > 0 then
            rand := abs(random) mod upperBound + 1
        else
            rand := 1;
        aRandom := rand;
    end;

    procedure Swap (var a, b: integer);
        var
            t: integer;
    begin
        t := a;
        a := b;
        b := t;
    end;

    procedure Melt;
        var
            m: Point;
            gp: GrafPtr;
            theEvent: EventRecord;
            mine: boolean;
            ar, br: rect;
            drawingPort: GrafPtr;
            count: integer;

    begin
        GetPort(gp);
        SetRect(ar, 0, 0, 150, 150);
        drawingPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(drawingPort);
        SetPort(drawingPort);
        SetPortBits(screenbits);

        for count := 1 to 750 do
            begin
                SetRect(ar, ARandom(screenBits.bounds.right), ARandom(screenBits.bounds.bottom), ARandom(screenBits.bounds.right), ARandom(screenBits.bounds.bottom));
                if (ar.top > ar.bottom) then
                    Swap(ar.top, ar.bottom);
                if (ar.left > ar.right) then
                    Swap(ar.left, ar.right);
                br := ar;
                OffsetRect(br, ARandom(10) - 5, ARandom(6));
                CopyBits(drawingPort^.portBits, drawingPort^.portBits, ar, br, srcCopy, nil);
            end;

        SetPort(gp);
    end;

    procedure IScreen;
        var
            m: Point;
            gp: GrafPtr;
            theEvent: EventRecord;
            mine: boolean;
            ar, br: rect;
            drawingPort: GrafPtr;
            count: integer;

    begin
        GetPort(gp);
        SetRect(ar, 0, 0, 150, 150);
        drawingPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(drawingPort);
        SetPort(drawingPort);
        SetPortBits(screenbits);
        InvertRect(screenBits.bounds);
        SetPort(gp);
    end;

    procedure BScreen;
        var
            m: Point;
            gp: GrafPtr;
            theEvent: EventRecord;
            mine: boolean;
            ar, br: rect;
            drawingPort: GrafPtr;
            count: integer;

    begin
        GetPort(gp);
        SetRect(ar, 0, 0, 150, 150);
        drawingPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(drawingPort);
        SetPort(drawingPort);
        SetPortBits(screenbits);
        FillRect(screenBits.bounds, black);
        SetPort(gp);
    end;

    function POffsetRect (r: rect; a, b: integer): rect;
    begin
        OffsetRect(r, a, b);
        POffsetRect := r;
    end;

    procedure RIcons (rep: integer);
        var
            m: Point;
            gp: GrafPtr;
            mine: boolean;
            ar, br: rect;
            drawingPort: GrafPtr;
            count: integer;
        const
            maxNum = 15;
        var
            endThis: boolean;
            theEvent: EventRecord;
            sRec, oLC: rect;
            numIcons: integer;
            icn: Handle;
            loc: Rect;
            c: integer;
            actNum: integer;

    begin
        GetPort(gp);
        SetRect(ar, 0, 0, 150, 150);
        drawingPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(drawingPort);
        SetPort(drawingPort);
        SetPortBits(screenbits);

        numIcons := CountResources('ICON');
        actNum := NumIcons;
        if numIcons > maxNum then
            numIcons := maxNum;
        SetRect(sRec, 0, 0, 32, 32);

        for c := 1 to rep do
            begin
                icn := GetIndResource('ICON', ARandom(actNum));
                loc := POffsetRect(sRec, ARandom(screenBits.bounds.right - 33), ARandom(screenBits.bounds.bottom - 33));
                PlotIcon(loc, icn);
                InvertRect(loc);
            end;

        SetPort(gp);
    end;

    procedure RBeep (rep: integer);
        var
            numSnds: integer;
            theSound: Handle;
            err: OSErr;
            count: integer;
    begin
        numSnds := CountResources('snd ');

        for count := 1 to rep do
            begin
                theSound := GetIndResource('snd ', ARandom(numSnds));
                err := SndPlay(nil, theSound, FALSE);
            end;
    end;

    procedure ShowMessage (me: Str255);
        var
            m: Point;
            gp: GrafPtr;
            mine: boolean;
            ar, br: rect;
            drawingPort: GrafPtr;
            count: integer;
        const
            maxNum = 15;
        var
            endThis: boolean;
            theEvent: EventRecord;
            sRec, oLC: rect;
            numIcons: integer;
            icn: Handle;
            loc: Rect;
            c: integer;
            actNum: integer;
            testSize: integer;

    begin
        GetPort(gp);
        SetRect(ar, 0, 0, 150, 150);
        drawingPort := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(drawingPort);
        SetPort(drawingPort);
        SetPortBits(screenbits);

        testSize := 128;
        TextMode(srcCopy);
        TextFace([Bold]);
        TextSize(72);        {PICK BIG TEXT SIZE}
        while (testSize > 10) and (StringWidth(me) > (screenBits.bounds.right - 20)) do
            begin            {TRY AND FIT THE TEXT ON THE SCREEN}
                testSize := testSize - 4;
                TextSize(testSize);
            end;

        MoveTo((screenBits.bounds.right div 2) - (StringWidth(me) div 2), screenBits.bounds.bottom div 2);
        DrawString(me);

        SetPort(gp);
    end;

    procedure DoChoice (what, rep: integer; m: Str255);
        var
            err: OSErr;
            count: integer;
    begin
        case what of
            MeltScreen:
                Melt;
            Beep:
                for count := 1 to rep do
                    SysBeep(10);
            RandomBeep:
                RBeep(rep);
            Restart:
                ShutDwnStart;
            InvertScreen:
                IScreen;
            BlankScreen:
                BScreen;
            EjectDisks:
                begin
                    err := DiskEject(1);
                    err := DiskEject(2);
                end;
            StartEject:
                gEjects := true;
            EndEject:
                gEjects := false;
            RandomIcons:
                RIcons(rep);
            PowerDown:
                ShutDwnPower;
            Message:
                ShowMessage(m);
            otherwise
                begin
                end;
        end;
    end;

    procedure AddQ (rec: DataRecord);
        var
            tim: longint;
    begin
        gQError := false;
        if gQ.num = 6 then
            gQError := true
        else
            begin
                gQ.num := gQ.num + 1;
                gQ.els[gQ.num].event := rec;
                GetDateTime(tim);
                gQ.els[gQ.num].when := tim + rec.numSecs;
                gQ.els[gQ.num].method := rec.dMethod;
            end;
    end;

    procedure DoAlert (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
            err: OSErr;
            str: Ptr;

    begin
        if not pd^.buffer.usageCheck then
            if not pd^.buffer.isDelayed then
                DoChoice(pd^.buffer.what, pd^.buffer.numTimes, pd^.buffer.mess)
            else
                AddQ(pd^.buffer);
        pd^.alertStatus := alertSent;
    end;

    procedure ReadDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessReadDone;
        PDataPtr(pb)^.err := pb^.readParam.ioResult;
    end;

    procedure DoRead (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pblock;

        pd^.sessionStatus := sessReadPend;

        pb^.readParam.ioCompletion := @ReadDone;
        pb^.readParam.bufferLength := SizeOf(DataRecord);
        pb^.readParam.bufferPtr := @pd^.buffer;

        pd^.err := PPCRead(PPCReadPBPtr(pb), true);
    end;

    procedure InformDone (pb: PPCParamBlockPtr);
        var
            err: OSErr;
    begin
        g_sleepTicks := wakeUp;        {Time to do some work!}

        PDataPtr(pb)^.sessionStatus := sessInformDone;
        PDataPtr(pb)^.err := pb^.informParam.ioResult;

        err := WakeUpProcess(g_PSN);        {Hello, world!}
    end;

    procedure DoInform (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pblock;

        pd^.sessionRef := 0;
        pd^.buffer.what := 0;
        pd^.buffer.numTimes := 0;
        pd^.err := noErr;
        pd^.errMessage := '';
        pd^.alertStatus := alertNotSent;

        pb^.informParam.ioCompletion := @InformDone;
        pb^.informParam.portRefNum := pd^.portRef;
        pb^.informParam.autoAccept := true;
        pb^.informParam.portName := @pd^.port;
        pb^.informParam.locationName := @pd^.location;
        pb^.informParam.userName := @pd^.user;

        pd^.sessionStatus := sessInformPend;
        pd^.err := PPCInform(PPCInformPBPtr(pb), true);

        g_sleepTicks := 10;
    end;

    procedure OpenDone (pb: PPCParamBlockPtr);
    begin
        PDataPtr(pb)^.sessionStatus := sessOpenDone;
        PDataPtr(pb)^.err := pb^.openParam.ioResult;
        PDataPtr(pb)^.portRef := PDataPtr(pb)^.pBlock.openParam.portRefNum;
    end;

    procedure DoOpen (pd: PDataPtr);
        var
            pb: PPCParamBlockPtr;
    begin
        pb := @pd^.pBlock;

        pd^.port.nameScript := smRoman;
        pd^.port.name := 'Message Reciever';
        pd^.port.portKindSelector := ppcByCreatorAndType;
        pd^.port.portCreator := 'CHAT';
        pd^.port.portType := 'RECV';

        pd^.location.locationKindSelector := ppcNBPTypeLocation;
        pd^.location.nbpType := 'Message Reciever';

        pb^.openParam.ioCompletion := @OpenDone;
        pb^.openParam.serviceType := ppcServiceRealTime;
        pb^.openParam.resFlag := 0;
        pb^.openParam.portName := @pd^.port;
        pb^.openParam.locationName := @pd^.location;
        pb^.openParam.networkVisible := true;

        pd^.sessionStatus := sessOpenPend;
        pd^.err := PPCOpen(PPCOpenPBPtr(pb), true);
    end;

    procedure InitPData (var pd: PDataPtr);
    begin
        pd := PDataPtr(NewPtrClear(sizeOf(PDataRec)));
        pd^.user := '';
        pd^.portRef := 0;
        pd^.sessionRef := 0;
        pd^.buffer.what := 0;
        pd^.buffer.numTimes := 0;
        pd^.buffer.mess := '';
        pd^.err := noErr;
        pd^.errMessage := '';
        pd^.sessionStatus := sessNotBegun;
        pd^.alertStatus := alertNotSent;
    end;

    procedure QCheck;
        var
            tim: longint;
            c, e: integer;
    begin
        c := 0;
        while c < gQ.num do
            begin
                c := c + 1;

                if (gQ.els[c].method = timeDelay) or (gQ.els[c].method = activeMouseDelay) then
                    begin
                        GetDateTime(tim);
                        if tim - gQ.els[c].when > 1 then
                            begin
                                DoChoice(gQ.els[c].event.what, gQ.els[c].event.numTimes, gQ.els[c].event.mess);
                                for e := c to gQ.num - 1 do
                                    gQ.els[e] := gQ.els[e + 1];
                                gQ.num := gQ.num - 1;
                            end;
                    end
                else                    {Mouse Delay!}
                    begin
                        GetDateTime(tim);
                        if tim - gLastMoved < 10 then
                            begin            {Mouse moved within 10 seconds ago; O.K. to start.}
                                gQ.els[c].method := activeMouseDelay;
                                gQ.els[c].when := tim + gQ.els[c].event.numSecs;
                            end;
                    end;

            end;
    end;

    procedure EventLoop;
        var
            evt: EventRecord;
            err: OSErr;
            pd: PDataPtr;
            str: Str255;
            i: integer;
            mine: boolean;
            mLoc: Point;

    begin
        pd := pdata;

        while not g_quit do
            begin

                mine := WaitNextEvent(everyEvent, evt, g_sleepTicks, nil);
                GetMouse(mLoc);
                if (mLoc.h <> gLastPos.h) or (mLoc.v <> gLastPos.v) then
                    begin
                        GetDateTime(gLastMoved);
                        gLastPos := mLoc;
                    end;
                if (g_quit) then
                    exit(EventLoop);
                if gEjects then
                    begin
                        err := DiskEject(1);
                        err := DiskEject(2);
                    end;
                QCheck;

                if (pd^.sessionStatus = sessInformDone) then
                    DoRead(pd)
                else if ((pd^.sessionStatus = sessReadDone) and (pd^.alertStatus = alertNotSent)) then
                    begin
                        DoAlert(pd);
                        DoRespond(pd);
                    end
                else if pd^.sessionStatus = sessRespDone then
                    DoEnd(pd)
                else if (pd^.sessionStatus = sessOpenDone) or (pd^.sessionStatus = sessEndDone) then
                    DoInform(pd);
                if evt.what = kHighLevelEvent then
                    err := AEProcessAppleEvent(evt);

            end;
    end;

    procedure Initialize;
    begin
        InitGraf(@thePort);
        InitFonts;
        InitMenus;
        TEInit;
        InitDialogs(nil);
    end;

    procedure InitGlobs;
    begin
        gQ.num := 0;
        gQError := false;
        GetDateTime(gLastMoved);
        GetMouse(gLastPos);
    end;

{$I-}
begin
    Initialize;
    InitGlobs;
    gEjects := false;
    gFontBloat := false;
    g_sleepTicks := WakeUp;
    g_quit := false;

    InitAEStuff;
    err := PPCInit;
    InitPData(pdata);
    pd := pdata;
    err := GetCurrentProcess(g_psn);

    DoOpen(pd);

    EventLoop;
    Quit;
end.