home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / fkey / pathname.sit / Pathname.Pas < prev    next >
Pascal/Delphi Source File  |  1986-07-17  |  3KB  |  125 lines
  1. { Compile as a DA! }
  2.  
  3. {$h ' '}    {we dont want a Pas$DeskAccHeader }
  4. {$c 'FKEY' 6 'Pathname' }    {Create a FKEY resource with a ID = 6}
  5. {$t FKEY RSED }
  6.  
  7. {
  8.   This is an FKEY that will present the User with the standard SFGet
  9.   dialog box.  The entire HFS pathname of the form
  10.   
  11.   disk:folder:folder: ... :file
  12.   
  13.   will be copied into the clipboard for subsequent pasting.
  14.   
  15.   This is useful for Slideshow presentations and specifying include
  16.   files.
  17.   
  18.   Written by :
  19.     Jon Pugh
  20.     Lawrence Livermore National Lab
  21.     PO Box 5509 L-561
  22.     Livermore CA 94550
  23.     (415) 423-4239
  24.  
  25.   Copyright 1986.  All rights reserved.  This may be freely distributed
  26.   as long as you don't try and claim it or sell it.  If you paid money 
  27.   for this then you have been had!
  28. }
  29.  
  30. Program FindPathName;
  31.  
  32. {$I 'MicahDrive:TML Pascal:Pascal System:MemTypes.ipas'  }
  33. {$I 'MicahDrive:TML Pascal:Pascal System:QuickDraw.ipas' }
  34. {$I 'MicahDrive:TML Pascal:Pascal System:OSintf.ipas'    }
  35. {$I 'MicahDrive:TML Pascal:Pascal System:ToolIntf.ipas'  }
  36. {$I 'MicahDrive:TML Pascal:Pascal System:PackIntf.ipas'  }
  37. {$I 'MicahDrive:TML Pascal:Pascal System:HFS.ipas'       }
  38.  
  39. Procedure PathName;
  40. Const
  41.     FSFCBLen    = $3F6;
  42. VAR
  43.     myPt    : Point;
  44.     catPB    : CInfoPBRec;
  45.     volPB    : ParamBlockRec;
  46.     anErr    : OSErr;
  47.     reply    : SFReply;
  48.     HFS    : ^Integer;
  49.     TList    : SFTypeList;
  50.     volName, Name    : Str255;
  51.     ScrapName    : Packed Array [1..255] of Char;
  52.     vRefNum, i    : Integer;
  53.     SaveVol, DirRef, Err    : LongInt;
  54.  
  55. Begin
  56. HFS := Pointer(FSFCBLen);
  57. SetPt(myPt,82,30);
  58. SFGetFile(myPt,'Filename to Copy? ',NIL,-1,TList,NIL,reply);
  59. IF reply.good THEN  
  60.     Name := reply.fName;
  61. vRefNum := reply.vRefNum;
  62. If reply.good then
  63.     Begin
  64.     If HFS^ > 0 then
  65.         Begin
  66.         volName := Name;
  67.         With catPB do
  68.             Begin
  69.             ioNamePtr := @volName;
  70.             ioCompletion := NIL;
  71.             ioVRefNum := VRefNum;
  72.             ioFDirIndex := -1;
  73.             ioDrDirID := 0;
  74.             anErr := PBGetCatInfo(@catPB,FALSE);
  75.             DirRef := ioDrParID
  76.             End;
  77.         Name := Concat(VolName,':',Name);
  78.         While DirRef <> 1 do
  79.             Begin
  80.             SaveVol := DirRef;
  81.             With catPB do
  82.                 Begin
  83.                 ioNamePtr := @volName;
  84.                 ioCompletion := NIL;
  85.                 ioVRefNum := VRefNum;
  86.                 ioFDirIndex := -1;
  87.                 ioDrDirID := DirRef;
  88.                 anErr := PBGetCatInfo(@catPB,FALSE);
  89.                 DirRef := ioDrParID
  90.                 End;
  91.             Name := Concat(VolName,':',Name)
  92.             End
  93.         End
  94.     Else
  95.         Begin
  96.         VolName := Name;
  97.         With volPB do
  98.             Begin
  99.             ioNamePtr := @volName;
  100.             ioVRefNum := VRefNum;
  101.             ioVolIndex := 0;
  102.             anErr := PBGetVInfo(@volPB,FALSE);
  103.             If anErr <> NoErr then SysBeep(3);
  104.             End;
  105.         Name := Concat(VolName,':',Name)
  106.         End;
  107.     Err := ZeroScrap;
  108.     For i := 1 to Length(Name) do
  109.         ScrapName[i] := Name[i];
  110.     Err := PutScrap (Length(Name), 'TEXT', @ScrapName)
  111.     End
  112. End;
  113.  
  114. Procedure TheFKEY;
  115. Begin
  116. InitFonts;
  117. InitWindows;
  118. InitMenus;
  119. TEInit;
  120. InitDialogs(NIL);
  121. PathName
  122. End;
  123.  
  124. Begin    { Main }
  125. End.