home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / hc / turbopgl.sit / Getcreator.p < prev    next >
Encoding:
Text File  |  1988-03-05  |  3.0 KB  |  111 lines  |  [TEXT/TPAS]
  1. {$R-}
  2.  
  3. (*
  4.    GetCreator -- map OSType to creator name
  5.    By Dan Winkler.  DO NOT call the author!  Contact Apple Developer 
  6.    Support on AppleLink "MacDTS" or on MCI "MacTech".
  7.  
  8.    ⌐Apple Computer, Inc. 1987
  9.    All Rights Reserved.
  10.  
  11.    Modified for Turbo Pascal by Brian Liebowitz
  12.  
  13.     You must install the DHDR resources called PasXFCN and PasXCMD 
  14.     into your copy of Turbo before compiling this XCMD.  You must also 
  15.      have compiled the unit HyperXCMD and moved it into the Turbo progam,
  16.       and the file XCMDGlue.inc must be accessible.  After compiling,use
  17.      ResEdit to change the ID from 300, and to copy the XCMD or XFCN into 
  18.     your stack or Hypercard.
  19.  
  20.  
  21. *)
  22.  
  23. Program Getcreator;
  24.  
  25. {$U-}    { Don't include runtime units}
  26. {$D PasXFCN}    {Compile as XFCN}
  27.  
  28. USES MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
  29.  
  30. PROCEDURE PasXFCN(paramPtr: XCmdPtr);
  31.   VAR creator: OSType;
  32.       appName: Str255;
  33.  
  34.   {$I XCmdGlue.inc }
  35.  
  36.     FUNCTION CreatorToString(creator: OsType): Str255;
  37.     
  38.     {  Given a document's 4-byte creator, find the application's name.   }
  39.     {  Opens APPL resource 0 in DeskTop, and scans table for first match.   }
  40.     {  Returns empty string if can't open desktop or creator not found.     }
  41.     
  42.     LABEL 9;
  43.     
  44.     TYPE ApplRecord =  RECORD
  45.           creator:    OsType;
  46.           directory: LongInt;
  47.           fileName:   Str255;
  48.              END;
  49.     
  50.     VAR refNum:    INTEGER;
  51.    errNum:    INTEGER;
  52.    hndl:    HANDLE;
  53.    applPtr:    ^ApplRecord;
  54.    size,limit: LongInt;
  55.    bump:     INTEGER;
  56.    wdParams:   WDPBRec;
  57.    result:   INTEGER;
  58.     
  59.     BEGIN
  60.       CreatorToString := '';
  61.       IF creator = 'APPL' THEN EXIT;
  62.       SetResLoad(FALSE);   { avoid slow preloads }
  63.       
  64.       (** refNum := OpenResFile('DeskTop'); **)
  65.       
  66.       { set up working directory for current path }
  67.       ZeroBytes(@wdParams,SizeOf(wdParams));
  68.       WITH wdParams DO
  69.    BEGIN
  70.      ioWDProcID := $4552494B;        { 'ERIK' so finder will delete later }
  71.      ioWDDirID := 2;            { root }
  72.    END;
  73.       result := PBOpenWD(@wdParams,FALSE);
  74.       refNum := OpenRFPerm('DeskTop',wdParams.ioVRefNum,fsRdPerm);
  75.       
  76.       SetResLoad(TRUE);
  77.       IF refnum = -1 THEN EXIT;
  78.       hndl := GetResource('APPL',0);
  79.       IF hndl = NIL THEN GOTO 9;
  80.       size := SizeResource(hndl);
  81.       applPtr := Pointer(hndl^);
  82.       limit := ORD(applPtr) + size;
  83.       REPEAT
  84.    IF applPtr^.creator = creator THEN  { we found it }
  85.      BEGIN
  86.        CreatorToString := applPtr^.fileName;
  87.        GOTO 9;
  88.      END;
  89.    bump := 9 + Length(applPtr^.fileName);
  90.    IF ODD(bump) THEN bump := bump + 1;
  91.    applPtr := Pointer(ORD(applPtr) + bump);
  92.       UNTIL ORD(applPtr) >= limit;
  93.     9: CloseResFile(refNum);
  94.     END;      
  95.   
  96.   BEGIN
  97.     WITH paramPtr^ DO
  98.       BEGIN
  99.         IF paramCount < 1 THEN EXIT;
  100.    BlockMove(params[1]^,@creator,4);
  101.    appName := CreatorToString(creator);
  102.         IF appName <> '' THEN returnValue := PasToZero(appName);
  103.       END;
  104.   END;
  105.  
  106. BEGIN
  107. END.
  108.  
  109. (*Remember to change the ID of this resource from 300*)
  110.  
  111.