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

Text File | 1997-02-07 | 12.5 KB | 427 lines | [TEXT/CWIE]

unit MyProcesses;

interface

    uses
        Types, Files, Memory, Processes;

    const
        application = 'APPL';
        kApplicationToFront = true;
        kApplicationInBackground = false;

    function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
    function FindProcess (creator, typ: OSType; var process: ProcessSerialNumber; var fs: FSSpec): boolean;
    function FindAppWithHint(vrn:integer; dirID:longint; creator, typ: OSType; var app:FSSpec; var psn: ProcessSerialNumber; var isrunning:Boolean):OSErr;
    function FindControlPanel (fcreator: OSType; var fs: FSSpec): OSErr;
    function FindInFolder(vrn:integer; dirID:longint; fcreator, ftype: OSType; var fs:FSSpec):OSErr;

    function IsRunning (creator, typ: OSType): boolean;

    function LaunchWithDocument (creator, typ: OSType; fs: FSSpec; tofront: boolean):OSErr;
    function LaunchApp (creator, typ: OSType; tofront: boolean):OSErr;
    function LaunchAppWithHint(vrn:integer; dirID:longint; creator, typ: OSType; tofront: boolean):OSErr;
    function LaunchFSSpec (var fs: FSSpec; tofront: boolean):OSErr;

    function SendQuitToApplication(process: ProcessSerialNumber):OSErr;
    procedure QuitApplication (creator, typ: OSType);

    function OpenControlPanel (fcreator: OSType): boolean;
    function TellFinderToLaunch (fs: FSSpec; tofront: boolean): boolean;

implementation

    uses
        AppleEvents, Aliases, Folders, GestaltEqu, Finder, Errors,
        MyTypes, MySystemGlobals, MyFileSystemUtils, MyUtils, MyAEUtils, MyMemory;

    procedure AddFSSToAEList (var list: AEDescList; row: integer; var fs: FSSpec);
        var
            fileAlias: AliasHandle;
            err: OSErr;
    begin
        err := NewAlias(nil, fs, fileAlias);
        if err = noErr then begin
            HLock(Handle(fileAlias));
            err := AEPutPtr(list, row, typeAlias, Ptr(fileAlias^), fileAlias^^.aliasSize);
            MDisposeHandle( fileAlias );
        end;
    end;

    function FindInFolder(vrn:integer; dirID:longint; fcreator, ftype: OSType; var fs:FSSpec):OSErr;
        var
            err:OSErr;
            pb: HParamBlockRec;
            i: integer;
    begin
        fs.vRefNum := vrn;
        fs.parID := dirID;
        i := 1;
        repeat
            pb.ioNamePtr := @fs.name;
            pb.ioVRefNum := vrn;
            pb.ioDirID := dirID;
            pb.ioFDirIndex := i;
            i := i + 1;
            err := PBHGetFInfoSync(@pb);
            if err = noErr then begin
                if (pb.ioFlFndrInfo.fdCreator = fcreator) & (pb.ioFlFndrInfo.fdType = ftype) then begin
                    leave;
                end;
            end;
        until (err <> noErr);
        FindInFolder := err;
    end;

    function FindControlPanel (fcreator: OSType; var fs: FSSpec): OSErr;
        var
            err: OSErr;
    begin
        err := FindFolder(kOnSystemDisk, kControlPanelFolderType, false, fs.vRefNum, fs.parID);
        if err = noErr then begin
            err := FindInFolder(fs.vRefNum, fs.parID, fcreator, 'cdev', fs);
        end;
        FindControlPanel := err;
    end;

    function TellFinderToLaunch (fs: FSSpec; tofront: boolean): boolean;
        var
            process: ProcessSerialNumber;
            err, junk: OSErr;
            targetAddress: AEDesc;
            fileList: AEDescList;
            theEvent, theReply: AppleEvent;
            sendmode: AESendMode;
            gv: longint;
            finder_fs: FSSpec;
    begin
        err := -1;
        if (Gestalt(gestaltFinderAttr, gv) = noErr) & btst(gv, gestaltOSLCompliantFinder) then begin
            if FindProcess('MACS', 'FNDR', process, finder_fs) then begin
                AECreate(theEvent);
                AECreate(theReply);
                AECreate(fileList);
                AECreate(targetAddress);
                err := CreateProcessSerialNumberDesc(process, targetAddress);
                if err = noErr then begin
                    err := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
                end;
                AEDestroy(targetAddress);
                if err = noErr then begin
                    err := AECreateList(nil, 0, false, fileList);
                end;
                if err = noErr then begin
                    AddFSSToAEList(fileList, 1, fs);
                end;
                if err = noErr then begin
                    err := AEPutParamDesc(theEvent, keyDirectObject, fileList);
                end;
                if err = noErr then begin
                    sendmode := kAENoReply;
                    if not tofront then begin
                        sendmode := sendmode + kAENeverInteract;
                    end;
                    err := AESend(theEvent, theReply, sendmode, kAEHighPriority, kNoTimeOut, nil, nil);
                end;
                AEDestroy(theEvent);
                AEDestroy(theReply);
                AEDestroy(fileList);
                if (err = noErr) & tofront then begin
                    junk := SetFrontProcess(process);
                end;
            end;
        end;
        TellFinderToLaunch := err = noErr;
    end;

    function OpenControlPanel (fcreator: OSType): boolean;
        var
            fs: FSSpec;
    begin
        OpenControlPanel := false;
        if FindControlPanel(fcreator, fs) = noErr then begin
            OpenControlPanel := TellFinderToLaunch(fs, true);
        end;
    end;

    function ConfirmApplicationExists (creator: OSType; var fs: FSSpec): OSErr;
        var
            err: OSErr;
            info: FInfo;
    begin
        err := HGetFInfo(fs.vRefNum, fs.parID, fs.name, info);
        if err = noErr then begin
            if (info.fdType <> application) or (info.fdCreator <> creator) then begin
                err := afpItemNotFound;
            end; (* if *)
        end; (* if *)
        ConfirmApplicationExists := err;
    end;

    function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
        var
            i: integer;
            pbdt: DTPBRec;
            crdate: longint;
            oe: OSErr;
            found: boolean;
    begin
        found := false;
        if system7 then begin
            i := 1;
            repeat
                fs.vRefNum := 0;
                oe := GetVolInfo(fs.name, fs.vRefNum, i, crdate);
                i := i + 1;
                if oe = noErr then begin
                    with pbdt do begin
                        fs.name := '';
                        ioNamePtr := @fs.name;
                        ioVRefNum := fs.vRefNum;
                        oe := PBDTGetPath(@pbdt);
                        if oe = noErr then begin
                            ioIndex := 0;
                            ioFileCreator := creator;
                            oe := PBDTGetAPPLSync(@pbdt);
                            if oe = noErr then begin
                                fs.parID := pbdt.ioAPPLParID;
                                found := ConfirmApplicationExists(creator,fs)=noErr;
                            end;
                        end;
                    end;
                    oe := noErr;
                end;
            until found or (oe <> noErr);
        end;
        if found then begin
            oe := noErr;
        end else begin
            oe := afpItemNotFound;
            fs.vRefNum := 0;
            fs.parID := 2;
            fs.name := '';
        end;
        FindApplication := oe;
    end;

    function FindProcess (creator, typ: OSType; var process: ProcessSerialNumber; var fs: FSSpec): boolean;
        var
            info: ProcessInfoRec;
    begin
        FindProcess := false;
        if has_LaunchControl then begin
            process.highLongOfPSN := 0;
            process.lowLongOfPSN := kNoProcess;
            info.processInfoLength := sizeof(ProcessInfoRec);
            info.processName := nil;
            info.processAppSpec := @fs;
            while GetNextProcess(process) = noErr do begin
                if GetProcessInformation(process, info) = noErr then begin
                    if (info.processType = longint(typ)) and (info.processSignature = creator) then begin
                        FindProcess := true;
                        leave;
                    end;
                end;
            end;
        end;
    end;

    function IsRunning (creator, typ: OSType): boolean;
        var
            process: ProcessSerialNumber;
            fs: FSSpec;
    begin
        IsRunning := FindProcess(creator, typ, process, fs);
    end;

    procedure PrepareToLaunch (var theEvent: AppleEvent; tofront: boolean; var launchThis: LaunchParamBlockRec);
        var
            oe: OSErr;
            launchDesc: AEDesc;
    begin
        oe := AECoerceDesc(theEvent, typeAppParameters, launchDesc);
        HLock(Handle(launchDesc.dataHandle));
        launchThis.launchAppParameters := AppParametersPtr(launchDesc.dataHandle^);
        launchThis.launchBlockID := extendedBlock;
        launchThis.launchEPBLength := extendedBlockLen;
        launchThis.launchFileFlags := 0;
        launchThis.launchControlFlags := launchContinue + launchNoFileFlags;
        if not tofront then begin
            launchThis.launchControlFlags := launchThis.launchControlFlags + launchDontSwitch;
        end;
    end;

    function LaunchApplicationOptionallyMinimum(var launchThis: LaunchParamBlockRec):OSErr;
        var
            err:OSErr;
    begin
        err := LaunchApplication(@launchThis);
        if err = memFullErr then begin
            launchThis.launchControlFlags := BOR(launchThis.launchControlFlags, launchUseMinimum);
            err := LaunchApplication(@launchThis);
        end;
        LaunchApplicationOptionallyMinimum:=err;
    end;

    function LaunchWithDocument (creator, typ: OSType; fs: FSSpec; tofront: boolean):OSErr;
        var
            psn: ProcessSerialNumber;
            targetAddress: AEDesc;
            theEvent, theReply: AppleEvent;
            fileList: AEDescList;
            app_fs: FSSpec;
            launchThis: LaunchParamBlockRec;
            oe: OSErr;
            sendmode: AESendMode;
            t, c: longint;
    begin
        LaunchWithDocument := -1;
        PurgeSpace(t, c);
        if has_LaunchControl & (c > 4096) then begin
            if FindProcess(creator, typ, psn, app_fs) then begin
                oe := CreateProcessSerialNumberDesc(psn, targetAddress);
                oe := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
                AEDestroy(targetAddress);

                oe := AECreateList(nil, 0, false, fileList);
                AddFSSToAEList(fileList, 1, fs);
                oe := AEPutParamDesc(theEvent, keyDirectObject, fileList);
                AEDestroy(fileList);

                sendmode := kAENoReply;
                if not tofront then begin
                    sendmode := sendmode + kAENeverInteract;
                end;
                oe := AESend(theEvent, theReply, sendmode, kAEHighPriority, kNoTimeOut, nil, nil);
                AEDestroy(theEvent);
                AEDestroy(theReply);
                if tofront then begin
                    LaunchWithDocument := SetFrontProcess(psn);
                end;
            end else begin
                if FindApplication(creator, app_fs) = noErr then begin
                    oe := CreateSignatureDesc(creator, targetAddress);
                    oe := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
                    AEDestroy(targetAddress);

                    oe := AECreateList(nil, 0, false, fileList);
                    AddFSSToAEList(fileList, 1, fs);
                    oe := AEPutParamDesc(theEvent, keyDirectObject, fileList);
                    AEDestroy(fileList);

                    launchThis.launchAppSpec := @app_fs;
                    PrepareToLaunch(theEvent, tofront, launchThis);
                    LaunchWithDocument := LaunchApplicationOptionallyMinimum(launchThis);
                    AEDestroy(theEvent);
                end;
            end;
        end;
    end;

    function LaunchFSSpec (var fs: FSSpec; tofront: boolean):OSErr;
        var
            launchThis: LaunchParamBlockRec;
    begin
        LaunchFSSpec := -1;
        if has_LaunchControl then begin
            launchThis.launchBlockID := extendedBlock;
            launchThis.launchEPBLength := extendedBlockLen;
            launchThis.launchFileFlags := 0;
            launchThis.launchControlFlags := launchContinue + launchNoFileFlags + launchUseMinimum;
            if not tofront then begin
                launchThis.launchControlFlags := launchThis.launchControlFlags + launchDontSwitch;
            end;
            launchThis.launchAppSpec := @fs;
            launchThis.launchAppParameters := nil;
            LaunchFSSpec := LaunchApplicationOptionallyMinimum(launchThis);
        end;
    end;

    function LaunchApp (creator, typ: OSType; tofront: boolean):OSErr;
        var
            psn: ProcessSerialNumber;
            app: FSSpec;
    begin
        LaunchApp := -1;
        if has_LaunchControl then begin
            if FindProcess(creator, typ, psn, app) then begin
                if tofront then begin
                    LaunchApp := SetFrontProcess(psn);
                end else begin
                    LaunchApp := noErr;
                end;
            end else begin
                if FindApplication(creator, app) = noErr then begin
                    LaunchApp := LaunchFSSpec(app, tofront);
                end;
            end;
        end;
    end;

    function FindAppWithHint(vrn:integer; dirID:longint; creator, typ: OSType; var app:FSSpec; var psn: ProcessSerialNumber; var isrunning:Boolean):OSErr;
        var
            err:OSErr;
    begin
        err := -1;
        if has_LaunchControl then begin
            if FindProcess(creator, typ, psn, app) then begin
                isrunning := true;
                err := noErr;
            end else begin
                isrunning := false;
                err := FindInFolder(vrn, dirID, creator, typ, app);
                if err <> noErr then begin
                    err := FindApplication(creator, app);
                end;
            end;
        end;
        FindAppWithHint := err;
    end;

    function LaunchAppWithHint(vrn:integer; dirID:longint; creator, typ: OSType; tofront: boolean):OSErr;
        var
            err:OSErr;
            psn: ProcessSerialNumber;
            app: FSSpec;
            isrunning: Boolean;
    begin
        err := FindAppWithHint(vrn, dirID, creator, typ,  app, psn, isrunning);
        if err = noErr then begin
            if isrunning then begin
                if tofront then begin
                    err := SetFrontProcess(psn);
                end;
            end else begin
                err := LaunchFSSpec(app, tofront);
            end;
        end;
        LaunchAppWithHint := err;
    end;

    function SendQuitToApplication(process: ProcessSerialNumber):OSErr;
        var
            err, junk: OSErr;
            targetAddress: AEAddressDesc;
            AEvent, AReply: AppleEvent;
    begin
        junk := CreateProcessSerialNumberDesc(process, targetAddress);
        junk := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, AEvent);
        AEDestroy(targetAddress);
        err := AESend(AEvent, AReply, kAENoReply, kAEHighPriority, 5 * second_in_ticks, nil, nil);
        AEDestroy(AEvent);
        AEDestroy(AReply);
        SendQuitToApplication := err;
    end;

    procedure QuitApplication (creator, typ: OSType);
        var
            junk:OSErr;
            process: ProcessSerialNumber;
            fs: FSSpec;
    begin
        if FindProcess(creator, typ, process, fs) then begin
            junk:=SendQuitToApplication(process);
        end;
    end;

end.