home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyNewPreferences.p < prev    next >
Encoding:
Text File  |  1997-01-22  |  6.3 KB  |  240 lines  |  [TEXT/CWIE]
  1. unit MyNewPreferences;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Files, MyCollections;
  7.  
  8.     var
  9.         the_prefs_folder_vrn: integer;
  10.         the_prefs_folder_dirID: longint;
  11.         our_prefs_folder_vrn: integer;
  12.         our_prefs_folder_dirID: longint;
  13.         prefs_fs: FSSpec;
  14.         prefs: Collection;
  15.  
  16.     procedure InitNewPreferences(strhId, folderindex, fileindex: integer; fcreator: OSType);
  17.     procedure FinishPreferences;
  18.     procedure SetupPreferenceFolder;
  19.     procedure SetupOurPreferenceFolder(strhId, folderindex: integer);
  20.     procedure DeletePrefsFile;
  21.     function WritePrefsData: OSErr;
  22.     procedure ReadPrefsData;
  23.     procedure JustReadPrefsData;
  24.     procedure ReadPrefsCollection (c: Collection; res_id: integer);
  25.     function WritePrefsCollection (c: Collection; res_id: integer): OSErr;
  26.     function PutResource (hhhh: Handle; typ: ResType; id: integer): OSErr; { Handle remains unchanged, and is detatched }
  27.     procedure ReadPrefsHandle (var hhhh: Handle; typ: ResType; id: integer);
  28.     function WritePrefsHandle (hhhh: Handle; typ: ResType; id: integer): OSErr;
  29.     procedure SetDefaultLong (code: OSType; def: longint);
  30.  
  31. implementation
  32.  
  33.     uses
  34.         Resources, GestaltEqu, Folders, AppleTalk, Aliases, TextUtils, 
  35.         MyFileSystemUtils, MyFDFlags, MyMemory, MyMathUtils;
  36.  
  37.     const
  38.         prefs_restype = 'PRFN';
  39.         prefs_resid = 128;
  40.         prefs_type = 'pref';
  41.  
  42.     var
  43.         prefs_creator: OSType;
  44.         prefs_mdate: longint;
  45.         
  46.     procedure DeletePrefsFile;
  47.         var
  48.             junk: OSErr;
  49.     begin
  50.         junk := HDelete(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name);
  51.     end;
  52.  
  53.     procedure ReadPrefsHandle (var hhhh: Handle; typ: ResType; id: integer);
  54.         var
  55.             resfile: integer;
  56.     begin
  57.         resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdPerm);
  58.         hhhh := GetResource(typ, id);
  59.         if hhhh <> nil then begin
  60.             DetachResource(hhhh);
  61.         end;
  62.         if resfile <> -1 then begin
  63.             CloseResFile(resfile);
  64.         end;
  65.     end;
  66.  
  67.     procedure ReadPrefsCollection (c: Collection; res_id: integer);
  68.         var
  69.             hhhh: Handle;
  70.     begin
  71.         ReadPrefsHandle(hhhh, prefs_restype, res_id);
  72.         if hhhh <> nil then begin
  73.             HackUpdateHandleToCollection(hhhh);
  74.             c.SetDataHandle(hhhh);
  75.         end;
  76.     end;
  77.  
  78.     procedure JustReadPrefsData;
  79.     begin
  80.         ReadPrefsCollection(prefs, prefs_resid);
  81.         prefs.safeget := true;
  82.     end;
  83.  
  84.     function PutResource (hhhh: Handle; typ: ResType; id: integer): OSErr;
  85.         var
  86.             err: OSErr;
  87.             old: Handle;
  88.             xid: integer;
  89.             xtyp: ResType;
  90.             name: Str255;
  91.     begin
  92.         name := '';
  93.         old := Get1Resource(typ, id);
  94.         if old <> nil then begin
  95.             GetResInfo(old, xid, xtyp, name);
  96.             RemoveResource(old);
  97.             MDisposeHandle(old);
  98.         end;
  99.         AddResource(hhhh, typ, id, name);
  100.         err := ResError;
  101.         if err = noErr then begin
  102.             WriteResource(hhhh);
  103.             err := ResError;
  104.             DetachResource(hhhh);
  105.         end;
  106.         PutResource := err;
  107.     end;
  108.  
  109.     function WritePrefsHandle (hhhh: Handle; typ: ResType; id: integer): OSErr;
  110.         var
  111.             err, junk: OSErr;
  112.             resfile: integer;
  113.     begin
  114.         junk := HCreate(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, prefs_creator, prefs_type);
  115.         HCreateResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name);
  116.         resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdWrPerm);
  117.         err := ResError;
  118.         if resfile <> -1 then begin
  119.             err := PutResource(hhhh, typ, id);
  120.             CloseResFile(resfile);
  121.             junk := FlushVol(nil, prefs_fs.vRefNum);
  122.         end;
  123.         WritePrefsHandle := err;
  124.     end;
  125.  
  126.     function WritePrefsCollection (c: Collection; res_id: integer): OSErr;
  127.         var
  128.             hhhh: Handle;
  129.     begin
  130.         hhhh := c.GetDataHandle;
  131.         WritePrefsCollection := WritePrefsHandle(hhhh, prefs_restype, res_id);
  132.     end;
  133.  
  134.     function WritePrefsData: OSErr;
  135.     begin
  136.         WritePrefsData := WritePrefsCollection(prefs, prefs_resid);
  137.     end;
  138.  
  139.     procedure ReadPrefsData;
  140.         var
  141.             nmoddate: longint;
  142.     begin
  143.         MyGetModDate(prefs_fs, nmoddate);
  144.         if nmoddate <> prefs_mdate then begin
  145.             prefs_mdate := nmoddate;
  146.             JustReadPrefsData;
  147.         end;
  148.     end;
  149.  
  150.     procedure FixPrefType;
  151.         var
  152.             fi: FInfo;
  153.             err: OSErr;
  154.     begin
  155.         err := HGetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
  156.         if (err = noErr) & (fi.fdCreator = prefs_creator) & (fi.fdType <> prefs_type) then begin
  157.             fi.fdType := prefs_type;
  158.             fi.fdFlags := BAND(fi.fdFlags, GoodBNOT(fdInited));
  159.             err := HSetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
  160.         end;
  161.     end;
  162.  
  163.     procedure SetDefaultLong (code: OSType; def: longint);
  164.     begin
  165.         if not prefs.ExistsTag(code) then begin
  166.             prefs.SetTagLong(code, def);
  167.         end;
  168.     end;
  169.     
  170.     procedure SetupPreferenceFolder;
  171.         var
  172.             oe: OSErr;
  173.             gv: longint;
  174.             sysenv: SysEnvRec;
  175.             name: Str255;
  176.             dummy: longint;
  177.             pb: CInfoPBRec;
  178.     begin
  179.         if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, the_prefs_folder_vrn, the_prefs_folder_dirID) <> noErr) then begin
  180.             oe := SysEnvirons(1, sysenv);
  181.             the_prefs_folder_vrn := sysenv.sysVRefNum;
  182.             the_prefs_folder_dirID := 0;
  183.             name := 'Preferences';
  184.             oe := DirCreate(the_prefs_folder_vrn, the_prefs_folder_dirID, name, dummy);
  185.             oe := MyGetCatInfo(the_prefs_folder_vrn, the_prefs_folder_dirID, name, 0, pb);
  186.             if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
  187.                 the_prefs_folder_vrn := pb.ioVRefNum;
  188.                 the_prefs_folder_dirID := pb.ioDirID;
  189.             end;
  190.         end;
  191.     end;
  192.     
  193.     procedure SetupOurPreferenceFolder(strhId, folderindex: integer);
  194.         var
  195.             oe: OSErr;
  196.             name: Str255;
  197.             dummy: longint;
  198.             pb: CInfoPBRec;
  199.     begin
  200.         our_prefs_folder_vrn := the_prefs_folder_vrn;
  201.         our_prefs_folder_dirID := the_prefs_folder_dirID;
  202.         if folderindex > 0 then begin
  203.             GetIndString(name, strhId, folderindex);
  204.             oe := DirCreate(our_prefs_folder_vrn, our_prefs_folder_dirID, name, dummy);
  205.             oe := MyGetCatInfo(our_prefs_folder_vrn, our_prefs_folder_dirID, name, 0, pb);
  206.             if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
  207.                 our_prefs_folder_vrn := pb.ioVRefNum;
  208.                 our_prefs_folder_dirID := pb.ioDirID;
  209.             end;
  210.         end;
  211.     end;
  212.     
  213.     procedure InitNewPreferences(strhId, folderindex, fileindex: integer; fcreator: OSType);
  214.         var
  215.             oe: OSErr;
  216.             name: Str255;
  217.     begin
  218.         prefs_creator := fcreator;
  219.         new(prefs);
  220.         prefs.Create(0, false, true);
  221.         prefs.safeget := true;
  222.  
  223.         SetupPreferenceFolder;
  224.         SetupOurPreferenceFolder( strhId, folderindex );
  225.         
  226.         GetIndString(name, strhId, fileindex);
  227.         oe := MyFSMakeFSSpec(our_prefs_folder_vrn, our_prefs_folder_dirID, name, prefs_fs);
  228.  
  229.         FixPrefType;
  230.  
  231.         MyGetModDate(prefs_fs, prefs_mdate);
  232.         JustReadPrefsData;
  233.     end;
  234.  
  235.     procedure FinishPreferences;
  236.     begin
  237.         prefs.Destroy;
  238.     end;
  239.     
  240. end.