home *** CD-ROM | disk | FTP | other *** search
/ Mac Expert 1995 Winter / Mac Expert - Winter 95.iso / Les fichiers / Utilitaires divers / Divers / AliasMaker ƒ / AliasMaker.p < prev    next >
Encoding:
Text File  |  1994-07-04  |  6.0 KB  |  236 lines  |  [TEXT/PJMM]
  1. { This application demonstrates the use of the Alias Manager to create an alias to a file. }
  2. {}
  3. { Simply, we will allow the user to choose a file from standard get file and then will }
  4. { ask the user to name an alias to that file using standard put file. The alias file will then }
  5. { be created to the originally selected file. }
  6. {}
  7. { NOTE: Aliases made in this manner will be automatically updated by the Finder whenever }
  8. { the original file moves. }
  9. {}
  10. { NOTE: This is a quick & dirty demonstration…resources should be used for strings, etc. }
  11. { but are not being used due to time. }
  12. {}
  13. { by Joe Zobkiw 6/12/91 }
  14. {}
  15. { contact information: }
  16. { AOL: AFL Zobkiw }
  17. { CIS: 70712,515 }
  18. { Internet: 70712.515@compuserve.com }
  19. {}
  20.  
  21. program AliasMaker;
  22.     uses
  23.         Types, OSUtils, Files, Aliases;
  24.  
  25.     const
  26.         kSystem7 = $0700;                    { system 7.0 }
  27.         kAliasNameExtension = ' alias';        { filename extension }
  28.         kAliasResourceID = 0;                { resource ID of ‘alis’ resource }
  29.         kIsAliasFlag = 32768;                { to set Finder flag }
  30.  
  31. {____________________________________________________________}
  32. { This routine initializes the Macintosh Toolbox }
  33. {____________________________________________________________}
  34.     procedure InitMacintosh;
  35.     begin
  36.         InitGraf(@thePort);
  37.         InitFonts;
  38.         InitWindows;
  39.         InitMenus;
  40.         TEInit;
  41.         InitDialogs(nil);
  42.         FlushEvents(EveryEvent, 0);
  43.         InitCursor;
  44.     end;
  45.  
  46. {____________________________________________________________}
  47. { make sure we can run, we should really check Gestalt here }
  48. {____________________________________________________________}
  49.     procedure CheckEnvironment;
  50.         var
  51.             env: SysEnvRec;
  52.             err: OSerr;
  53.     begin
  54.         err := SysEnvirons(1, env);
  55.         if (err <> noErr) then
  56.             ExitToShell;
  57.         if (env.systemVersion < kSystem7) then
  58.             ExitToShell;
  59.     end;
  60.  
  61. {____________________________________________________________}
  62. { this function gets a file to alias }
  63. {____________________________________________________________}
  64.     procedure GetFileToAlias (var reply: SFReply; var spec: FSSpec);
  65.         var
  66.             where: Point;
  67.             typeList: SFTypeList;
  68.             vRefNum: integer;
  69.             parDirID: longint;
  70.             procID: longint;
  71.             err: OSerr;
  72.     begin
  73.         SetPt(where, 0, 0);
  74.         SFGetFile(where, '', nil, -1, typeList, nil, reply);
  75.  
  76.         if reply.good then
  77.             begin
  78.         { get some working directory information for the original file }
  79.                 err := GetWDInfo(reply.vRefNum, vRefNum, parDirID, procID);
  80.                 if (err <> noErr) then
  81.                     ExitToShell;
  82.  
  83.         { fill in the spec record now }
  84.                 spec.vRefNum := vRefNum;
  85.                 spec.parID := parDirID;
  86.                 spec.name := reply.fName;
  87.  
  88.             end;
  89.     end;
  90.  
  91. {____________________________________________________________}
  92. { find out where to save the alias }
  93. {____________________________________________________________}
  94.     procedure GetAliasInformation (fName: Str31; var reply: SFReply);
  95.         var
  96.             where: Point;
  97.             typeList: SFTypeList;
  98.             origName: Str63;
  99.  
  100.     begin
  101.         SetPt(where, 0, 0);
  102.         origName := Concat(fName, kAliasNameExtension);
  103.         SFPutFile(where, 'Save the alias as:', origName, nil, reply);
  104.     end;
  105.  
  106. {____________________________________________________________}
  107. { create an alias file…this is the meat of this program! }
  108. {____________________________________________________________}
  109.     function CreateAlias (originalReply: SFReply; aliasReply: SFReply; spec: FSSpec): OSErr;
  110.         var
  111.             err: OSErr;
  112.             myAliasHandle: AliasHandle;
  113.             aliasFileRefNum: integer;
  114.             saveResFile: integer;
  115.             fndrInfo: FInfo;
  116.             vRefNum: integer;
  117.             parDirID: longint;
  118.             procID: longint;
  119.  
  120.         procedure Fail (err: OSErr);
  121.         begin
  122.             if (err <> noErr) then
  123.                 begin
  124.                     CreateAlias := err;
  125.  
  126.                     UseResFile(saveResFile);
  127.  
  128.                     if myAliasHandle <> nil then
  129.                         DisposHandle(Handle(myAliasHandle));
  130.  
  131.                     Exit(CreateAlias);
  132.                 end;
  133.         end;
  134.  
  135.     begin
  136.         CreateAlias := noErr;
  137.  
  138.     { save our current file }
  139.         saveResFile := CurResFile;
  140.  
  141.     { create the new alias }
  142.         err := NewAlias(nil, spec, myAliasHandle);
  143.         Fail(err);
  144.  
  145.     { check the handle for nil }
  146.         if (myAliasHandle = nil) then
  147.             Fail(memFullErr);
  148.  
  149.     { get some working directory information for the alias file }
  150.         err := GetWDInfo(aliasReply.vRefNum, vRefNum, parDirID, procID);
  151.         Fail(err);
  152.  
  153.     { create the alias file tech note 241}
  154.         HCreateResFile(aliasReply.vRefNum, parDirID, aliasReply.fName);
  155.         err := ResError;
  156.         if (err = dupFNErr) then
  157.             begin
  158.                 err := HDelete(aliasReply.vRefNum, parDirID, aliasReply.fName);
  159.                 Fail(err);
  160.                 HCreateResFile(aliasReply.vRefNum, parDirID, aliasReply.fName);
  161.             end
  162.         else
  163.             begin
  164.                 Fail(err);
  165.             end;
  166.  
  167.     { open the alias file }
  168.         aliasFileRefNum := HOpenResFile(aliasReply.vRefNum, parDirID, aliasReply.fName, fsWrPerm);
  169.         if (aliasFileRefNum = -1) then
  170.             Fail(aliasFileRefNum);
  171.  
  172.     { use the alias resource file }
  173.         UseResFile(aliasFileRefNum);
  174.         Fail(ResError);
  175.  
  176.     { add a resource for the alias of type 'alis' }
  177.         AddResource(Handle(myAliasHandle), rAliasType, kAliasResourceID, aliasReply.fName);
  178.         Fail(ResError);
  179.  
  180.     { write it out }
  181.         WriteResource(Handle(myAliasHandle));
  182.         Fail(ResError);
  183.  
  184.     { add icons here also if you wish but you don’t have to }
  185.     { ICN# -16496 }
  186.     { ics# -16496 }
  187.     { SICN -16496 }
  188.  
  189.     { close the new alias }
  190.         CloseResFile(aliasFileRefNum);
  191.         Fail(ResError);
  192.  
  193.     { we need the creator of the original file }
  194.         err := HGetFInfo(originalReply.vRefNum, spec.parID, originalReply.fName, fndrInfo);
  195.         Fail(err);
  196.  
  197.     { make sure we set it up as an alias }
  198.         fndrInfo.fdFlags := kIsAliasFlag;
  199.  
  200.     { set the info of the new file }
  201.         err := HSetFInfo(aliasReply.vRefNum, parDirID, aliasReply.fName, fndrInfo);
  202.         Fail(err);
  203.  
  204.      { restore our file }
  205.         UseResFile(saveResFile);
  206.         Fail(ResError);
  207.     end;
  208.  
  209. {____________________________________________________________}
  210. { this is our main }
  211. {____________________________________________________________}
  212.     var
  213.  
  214.         err: OSErr;
  215.         originalReply: SFReply;
  216.         aliasReply: SFReply;
  217.         spec: FSSpec;
  218.  
  219. begin
  220.  
  221.     InitMacintosh;
  222.     CheckEnvironment;
  223.  
  224.     GetFileToAlias(originalReply, spec);
  225.     if (not originalReply.good) then
  226.         ExitToShell;
  227.  
  228.     GetAliasInformation(originalReply.fName, aliasReply);
  229.     if (not aliasReply.good) then
  230.         ExitToShell;
  231.  
  232.     err := CreateAlias(originalReply, aliasReply, spec);
  233.     if (err <> noErr) then
  234.         ExitToShell;
  235.  
  236. end.