home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / My Libraries / MySystem7.unit < prev    next >
Encoding:
Text File  |  1992-04-20  |  5.0 KB  |  204 lines  |  [TEXT/PJMM]
  1. unit MySystem7;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7. {Note:  InitUtilities must be called prior to using functions marked * in this file }
  8. {            (It is normally called by InitMainLoop in MyMainLoop.unit) }
  9.  
  10.     uses
  11.         AppleTalk, Aliases, PPCToolBox, Processes, EPPC, Notification, AppleEvents;
  12.  
  13.     function MyResolveAliasFile (var vrn: integer; var dirID: longInt; var fname: str63): OSErr; { * }
  14.     function MyFindFolder (vrn: INTEGER; folder: OSType; var ovrn: INTEGER; var oDirID: LONGINT): OSErr; { * }
  15.     function MyInteractWithUser (idleproc: Ptr): OSErr; { * }
  16.     function MyGetAPPL (sig: OSType; var vrn: integer; var dirID: longInt; var fname: str63): OSErr; { * }
  17.     function GetPSN (signature: OSType; var process: ProcessSerialNumber): boolean;
  18.     procedure QuitApplication (creator: OSType);
  19.     procedure SegmentSystem7;
  20.  
  21. implementation
  22.  
  23.     uses
  24.         MyUtils, MyUtilities, MyNotifier, Folders;
  25.  
  26.     const
  27.         pref_folder = 'Preferences';
  28.  
  29. {$S System7}
  30.     procedure SegmentSystem7;
  31.     begin
  32.     end;
  33.  
  34. {$S System7}
  35.     function MyResolveAliasFile (var vrn: integer; var dirID: longInt; var fname: str63): OSErr;
  36.         var
  37.             fs: FSSpec;
  38.             isfolder, wasalias: boolean;
  39.             oe: OSErr;
  40.     begin
  41.         if system7 then begin
  42.             with fs do begin
  43.                 vRefNum := vrn;
  44.                 parID := dirID;
  45.                 name := fname;
  46.                 oe := ResolveAliasFile(fs, true, isfolder, wasalias);
  47.                 if oe = noErr then begin
  48.                     vrn := vRefNum;
  49.                     dirID := parID;
  50.                     fname := name;
  51.                 end;
  52.             end;
  53.         end
  54.         else
  55.             oe := noErr;
  56.         MyResolveAliasFile := oe;
  57.     end;
  58.  
  59. {$S Init}
  60.     function MyFindFolder (vrn: INTEGER; folder: OSType; var ovrn: INTEGER; var oDirID: LONGINT): OSErr;
  61.         var
  62.             oe: OSErr;
  63.             name: str255;
  64.             prefDirID: longInt;
  65.             pb: HParamBlockRec;
  66.     begin
  67.         if system7 then begin
  68.             oe := FindFolder(vrn, folder, true, ovrn, oDirID);
  69.         end
  70.         else begin
  71.             oe := GetDirID(sysenv.sysVRefNum, ovrn, oDirID);
  72.             if (oe = noErr) and (folder = kPreferencesFolderType) then begin
  73.                 name := pref_folder;
  74.                 oe := DirCreate(ovrn, oDirID, name, prefDirID);
  75.                 if oe = noErr then
  76.                     oDirID := prefDirID
  77.                 else begin
  78.                     with pb do begin
  79.                         ioNamePtr := @name;
  80.                         ioVRefNum := ovrn;
  81.                         ioDirID := oDirID;
  82.                         ioFDirIndex := 0;
  83.                     end;
  84.                     oe := PBGetCatInfo(@pb, false);
  85.                     if oe = noErr then
  86.                         oDirID := pb.ioDirID;
  87.                 end;
  88.                 oe := noErr;
  89.             end;
  90.         end;
  91.         MyFindFolder := oe;
  92.     end;
  93.  
  94. {$S System7}
  95.     function MyInteractWithUser (idleproc: Ptr): OSErr;
  96.         var
  97.             oe: OSErr;
  98.     begin
  99.         if system7 then
  100.             oe := AEInteractWithUser(maxLongInt, nil, idleproc)
  101.         else begin
  102.             if in_foreground then
  103.                 MyInteractWithUser := noErr
  104.             else begin
  105.                 Notify(true, true, 128, 0, 0, 0, 0);
  106. { Should wait til we are in the foreground, but its too messy }
  107.             end;
  108.         end;
  109.     end;
  110.  
  111. {$S System7}
  112.     function MyGetAPPL (sig: OSType; var vrn: integer; var dirID: longInt; var fname: str63): OSErr;
  113.         var
  114.             i: integer;
  115.             pbdt: DTPBRec;
  116.             crdate: longInt;
  117.             oe: OSErr;
  118.             found: boolean;
  119.     begin
  120.         found := false;
  121.         if system7 then begin
  122.             i := 1;
  123.             repeat
  124.                 vrn := 0;
  125.                 oe := GetVolInfo(fname, vrn, i, crdate);
  126.                 i := i + 1;
  127.                 if oe = noErr then begin
  128.                     with pbdt do begin
  129.                         fname := '';
  130.                         ioNamePtr := @fname;
  131.                         ioVRefNum := vrn;
  132.                         oe := PBDTGetPath(@pbdt);
  133.                         if oe = noErr then begin
  134.                             ioIndex := 0;
  135.                             ioFileCreator := sig;
  136.                             oe := PBDTGetAPPLSync(@pbdt);
  137.                             if oe = noErr then
  138.                                 found := true;
  139.                         end;
  140.                     end;
  141.                     oe := noErr;
  142.                 end;
  143.             until found or (oe <> noErr);
  144.         end;
  145.         if found then begin
  146.             oe := noErr;
  147.             dirID := pbdt.ioAPPLParID;
  148.         end
  149.         else begin
  150.             oe := afpItemNotFound;
  151.             vrn := 0;
  152.             dirID := 2;
  153.             fname := '';
  154.         end;
  155.         MyGetAPPL := oe;
  156.     end;
  157.  
  158. {$S System7}
  159.     function GetPSN (signature: OSType; var process: ProcessSerialNumber): boolean;
  160.         var
  161.             info: ProcessInfoRec;
  162.             s: str63;
  163.             fs: FSSpec;
  164.             oe: OSErr;
  165.             gv: longInt;
  166.     begin
  167.         GetPSN := false;
  168.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  169.             process.highLongOfPSN := 0;
  170.             process.lowLongOfPSN := kNoProcess;
  171.             info.processInfoLength := sizeof(ProcessInfoRec);
  172.             info.processName := @s;
  173.             info.processAppSpec := @fs;
  174.             while GetNextProcess(process) = noErr do begin
  175.                 if GetProcessInformation(process, info) = noErr then
  176.                     if (info.processType = longInt('APPL')) and (info.processSignature = signature) then begin
  177.                         GetPSN := true;
  178.                         leave;
  179.                     end;
  180.             end;
  181.         end;
  182.     end;
  183.  
  184. {$S System7}
  185.     procedure QuitApplication (creator: OSType);
  186.         var
  187.             process: processSerialNumber;
  188.             infoRec: processInfoRec;
  189.             targetAddress: AEAddressDesc;
  190.             AEvent, AReply: AppleEvent;
  191.             fs: FSSpec;
  192.             oe: OSErr;
  193.     begin
  194.         if GetPSN(creator, process) then begin
  195.             oe := AECreateDesc(typeProcessSerialNumber, @process, SizeOf(process), targetAddress);
  196.             oe := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, AEvent);
  197.             oe := AEDisposeDesc(targetAddress);
  198.             oe := AESend(AEvent, AReply, kAENoReply, kAEHighPriority, 5 * 60, nil, nil);
  199.             oe := AEDisposeDesc(AEvent);
  200.             oe := AEDisposeDesc(AReply);
  201.         end;
  202.     end;
  203.  
  204. end.