OS/2 Shareware BBS: 10 Tools/10-Tools.zip/ctcoll95.zip/PARALLEL/DSUTILS.P

Text File | 1995-03-20 | 10KB | 328 lines

{******************************************************************************}
{**}
{**  Project Name:    DropShell}
{**     File Name:    DSUtils.p}
{**}
{**   Description:    Utility routines that may be useful to DropBoxes}
{**}
{*******************************************************************************}
{**                       A U T H O R   I D E N T I T Y}
{*******************************************************************************}
{**}
{**    Initials    Name}
{**    --------    -----------------------------------------------}
{**    LDR            Leonard Rosenthol}
{**}
{*******************************************************************************}
{**                      R E V I S I O N   H I S T O R Y}
{*******************************************************************************}
{**}
{**      Date        Time    Author    Description}
{**    --------    -----    ------    ---------------------------------------------}
{**    12/09/91            LDR        Added the Apple event routines}
{**    11/24/91            LDR        Original Version}
{**}
{******************************************************************************}
unit DSUtils;
interface

    uses
        AppleTalk, Processes, PPCToolbox, EPPC, Notification, AppleEvents, Aliases, Script, DSGlobals;

{---------------------}
{Interface Definitions}
{---------------------}

    procedure CenterAlert (theID: integer);
    procedure ErrorAlert (stringListID, stringIndexID, errorID: integer);

    procedure GetAppName (var appName: Str255);
    procedure GetAppFSSpec (var appSpec: FSSpec);

    function GetTargetFromSelf (var targetDesc: AEAddressDesc): OSErr;
    function GetTargetFromSignature (processSig: OSType; var targetDesc: AEAddressDesc): OSErr;
    function GetTargetFromBrowser (promptStr: Str255; var targetDesc: AEAddressDesc): OSErr;

    procedure SendODOCToSelf (theFileSpec: FSSpec);
    procedure SendQuitToSelf;

implementation
{$S Main}

    {}
{        This routine is used to properly center an Alert before showing.}
{        }
{        It is per Human Interface specs by putting it in the top 1/3 of screen.}
{        NOTE: This same technique can be used with DLOG resources as well.}
{    }
    procedure CenterAlert (theID: integer);
        var
            theX, theY: INTEGER;
            theAlertHandle: AlertTHndl;
    begin
        theAlertHandle := AlertTHndl(GetResource('ALRT', theID));
        if theAlertHandle <> nil then
            begin
                HLock(Handle(theAlertHandle));
                with theAlertHandle^^ do
                    begin
                        with screenBits do
                            begin
                                theX := ((bounds.right - bounds.left) - (boundsRect.right - boundsRect.left)) div 2;
                                theY := ((bounds.bottom - bounds.top) + GetMBarHeight - (boundsRect.bottom - boundsRect.top)) div 2;
                                theY := theY - ((bounds.bottom - bounds.top) div 4);    {this moves it up for better viewing!}
                            end;
                        OffsetRect(boundsRect, theX - boundsRect.left, theY - boundsRect.top);
                    end;
            end;
        SetCursor(arrow);    {if you use this routine in a code resource, change this!}
    end;

    {}
{        This routine is just a quick & dirty error reporter}
{    }
    procedure ErrorAlert (stringListID, stringIndexID, errorID: integer);
        const
            alertID = 200;
        var
            item: integer;
            param, errorStr: Str255;
    begin
        if ErrorID <> 0 then
            begin
                NumToString(errorID, errorStr);
                GetIndString(param, stringListID, stringIndexID);
                ParamText(param, errorStr, '', '');
                CenterAlert(alertID);
                item := Alert(alertID, nil);
            end;
    end;

{*** These routines use the Process Manager to give you information about yourself ***}

    procedure GetAppName (var appName: Str255);
        var
            err: OSErr;
            info: ProcessInfoRec;
            curPSN: ProcessSerialNumber;
    begin
        err := GetCurrentProcess(curPSN);

        with info do
            begin
                processInfoLength := sizeof(ProcessInfoRec);    {ALWAYS USE sizeof!}
                processName := @appName;                        {so it returned somewhere}
                processAppSpec := nil;                            {I don't care!}
            end;
        err := GetProcessInformation(curPSN, info);
    end;

    procedure GetAppFSSpec (var appSpec: FSSpec);
        var
            err: OSErr;
            info: ProcessInfoRec;
            appName: Str255;
            curPSN: ProcessSerialNumber;
    begin
        err := GetCurrentProcess(curPSN);

        with info do
            begin
                processInfoLength := sizeof(ProcessInfoRec);    {ALWAYS USE sizeof!}
                processName := @appName;                        {so it returned somewhere}
                processAppSpec := @appSpec;                        {and here's where the spec goes}
            end;
        err := GetProcessInformation(curPSN, info);
    end;


{ ÑÑÑ Apple event routines begin here ÑÑÑ }

{}
{    This routine will create a targetDesc for sending to self.}
{}
{    We take IM VI's advice and use the typePSN form with }
{    kCurrentProcess as the targetPSN.}
{}
    function GetTargetFromSelf (var targetDesc: AEAddressDesc): OSErr;
        var
            err: OSErr;
            psn: ProcessSerialNumber;
    begin
        with psn do
            begin
                highLongOfPSN := 0;
                lowLongOfPSN := kCurrentProcess;
            end;
        err := AECreateDesc(typeProcessSerialNumber, @psn, sizeof(ProcessSerialNumber), targetDesc);
        GetTargetFromSelf := err;
    end;

{This routine will create a targetDesc using the apps signature}
    function GetTargetFromSignature (processSig: OSType; var targetDesc: AEAddressDesc): OSErr;
        var
            err: OSErr;

    begin
        err := AECreateDesc(typeApplSignature, @processSIG, sizeof(processSig), targetDesc);
        GetTargetFromSignature := err;
    end;

{This routine will create a targetDesc by bringing up the PPCBrowser}
    function GetTargetFromBrowser (promptStr: Str255; var targetDesc: AEAddressDesc): OSErr;
        var
            err: OSErr;
            theTarget: TargetID;
            portInfo: PortInfoRec;

    begin
        err := PPCBrowser(promptStr, '', FALSE, theTarget.location, portInfo, nil, '');
        if (err = noErr) then
            begin
                theTarget.name := portInfo.name;
                err := AECreateDesc(typeTargetID, @theTarget, sizeof(TargetID), targetDesc);
            end;
        GetTargetFromBrowser := err;
    end;


{}
{    This routine is the low level routine used by the SendODOCToSelf}
{    routine.  It gets passed the list of files (in an AEDescList)}
{    to be sent as the data for the 'odoc', builds up the event}
{    and sends off the event.  }
{}
{    It is broken out from SendODOCToSelf so that a SendODOCListToSelf could}
{    easily be written and it could then call this routine - but that is left}
{    as an exercise to the reader.}
{    }
{    Read the comments in the code for the order and details}
{}
    procedure _SendDocsToSelf (aliasList: AEDescList);
        var
            err: OSErr;
            theTarget: AEAddressDesc;
            openDocAE: AppleEvent;
            replyAE: AppleEvent;

    begin
    {}
{        First we create the target for the event.   We call another}
{        utility routine for creating the target.}
{    }
        err := GetTargetFromSelf(theTarget);
        if (err = noErr) then
            begin
        {Next we create the Apple event that will later get sent.}
                err := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, theTarget, kAutoGenerateReturnID, kAnyTransactionID, openDocAE);

                if err = noErr then
                    begin
            {Now add the aliasDescList to the openDocAE}
                        err := AEPutParamDesc(openDocAE, keyDirectObject, aliasList);

                        if err = noErr then
                            begin
                {}
{                    and finally send the event}
{                    Since we are sending to ourselves, no need for reply.}
{                }
                                err := AESend(openDocAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority, 3600, nil, nil);

                {}
{                    NOTE: Since we are not requesting a reply, we do not need to}
{                    need to dispose of the replyAE.  It is there simply as a }
{                    placeholder.}
{                }
                            end;

            {    }
{                Dispose of the aliasList descriptor}
{                We do this instead of the caller since it needs to be done}
{                before disposing the AEVT}
{            }
                        err := AEDisposeDesc(aliasList);
                    end;

        {and of course dispose of the openDoc AEVT itself}
                err := AEDisposeDesc(openDocAE);
            end;
    end;

{}
{    This is the routine called by SelectFile to send a single odoc to ourselves.}
{    }
{    It calls the above low level routine to do the dirty work of sending the AEVT -}
{    all we do here is build a AEDescList of the file to be opened.}
{}
    procedure SendODOCToSelf (theFileSpec: FSSpec);
        var
            err: OSErr;
            aliasList: AEDescList;
            aliasDesc: AEDesc;
            aliasH: AliasHandle;
    begin
    {Create the descList to hold the list of files}
        err := AECreateList(nil, 0, FALSE, aliasList);

        if err = noErr then
            begin
        {First we setup the type of descriptor}
                aliasDesc.descriptorType := typeAlias;

        {}
{            Now we add the file to descList by creating an alias and then}
{            adding it into the descList using AEPutDesc}
{        }
                err := NewAlias(nil, theFileSpec, aliasH);
                aliasDesc.dataHandle := Handle(aliasH);
                err := AEPutDesc(aliasList, 0, aliasDesc);
                DisposeHandle(Handle(aliasH));

        {Now call the real gut level routine to do the dirty work}
                _SendDocsToSelf(aliasList);

        {_SendDocsToSelf will dispose of aliasList for me}
            end;
    end;


    procedure SendQuitToSelf;
        var
            err: OSErr;
            theTarget: AEAddressDesc;
            QuitAE: AppleEvent;
            replyAE: AppleEvent;

    begin
    {}
{        First we create the target for the event.   We call another}
{        utility routine for creating the target.}
{    }
        err := GetTargetFromSelf(theTarget);
        if (err = noErr) then
            begin
        {Next we create the Apple event that will later get sent.}
                err := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, theTarget, kAutoGenerateReturnID, kAnyTransactionID, QuitAE);

                if err = noErr then
                    begin
            {}
{                and send the event}
{                Since we are sending to ourselves, no need for reply.}
{            }
                        err := AESend(QuitAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority, 3600, nil, nil);

            {}
{                NOTE: Since we are not requesting a reply, we do not need to}
{                need to dispose of the replyAE.  It is there simply as a }
{                placeholder.}
{            }
                    end;

        {Dispose of the quit AEVT itself}
                err := AEDisposeDesc(QuitAE);
            end;
    end;

end.