home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyResources.p < prev    next >
Encoding:
Text File  |  1993-10-15  |  2.4 KB  |  112 lines  |  [TEXT/PJMM]
  1. unit MyResources;
  2.  
  3. interface
  4.  
  5.     const
  6.         res_by_id = 0;
  7.         res_by_name = -1;
  8.  
  9.     type
  10.         ResourceObject = record
  11.                 data: handle;
  12.                 fs: FSSpec;
  13.                 typ: ResType;
  14.                 id: integer;
  15.                 name: str255;
  16.                 attributes: integer;
  17.                 readonly: boolean;
  18.             end;
  19.  
  20.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  21.     function PutResourceObject (var res: ResourceObject): OSErr;
  22.     procedure DestroyResourceObject (var res: ResourceObject);
  23.  
  24. implementation
  25.  
  26.     procedure DestroyResourceObject (var res: ResourceObject);
  27.     begin
  28.         DisposeHandle(res.data);
  29.         res.data := nil;
  30.     end;
  31.  
  32.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  33.         var
  34.             h: handle;
  35.             err: OSErr;
  36.             resfile: integer;
  37.     begin
  38.         res.data := nil;
  39.         res.readonly := false;
  40.         SetResLoad(false);
  41.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  42.         err := ResError;
  43.         if err <> noErr then begin
  44.             res.readonly := true;
  45.             resfile := FSpOpenResFile(res.fs, fsRdPerm);
  46.             err := ResError;
  47.         end;
  48.         if err = noErr then begin
  49.             if index = res_by_id then begin
  50.                 h := Get1Resource(res.typ, res.id);
  51.             end
  52.             else if index = res_by_name then begin
  53.                 h := Get1NamedResource(res.typ, res.name);
  54.             end
  55.             else begin
  56.                 h := Get1IndResource(res.typ, index);
  57.             end;
  58.             if h = nil then begin
  59.                 if index > 0 then begin
  60.                     err := resNotFound;
  61.                 end
  62.                 else if res.readonly then begin
  63.                     err := wrPermErr;
  64.                 end;
  65.                 res.attributes := 0;
  66.             end
  67.             else begin
  68.                 GetResInfo(h, res.id, res.typ, res.name);
  69.                 res.attributes := GetResAttrs(h);
  70.                 SetResAttrs(h, 0);
  71.                 SetResLoad(true);
  72.                 h := Get1Resource(res.typ, res.id);
  73.                 SetResAttrs(h, res.attributes);
  74.                 DetachResource(h);
  75.                 res.data := h;
  76.             end;
  77.             CloseResFile(resfile);
  78.         end;
  79.         SetResLoad(true);
  80.         GetResourceObject := err;
  81.     end;
  82.  
  83.     function PutResourceObject (var res: ResourceObject): OSErr;
  84.         var
  85.             h: handle;
  86.             err: OSErr;
  87.             resfile: integer;
  88.     begin
  89.         SetResLoad(false);
  90.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  91.         err := ResError;
  92.         if err = noErr then begin
  93.             h := Get1Resource(res.typ, res.id);
  94.             if h <> nil then begin
  95. {    SetResInfo(h, -1, 'Backup');}
  96.                 RmveResource(h);
  97.             end;
  98.             AddResource(res.data, res.typ, res.id, res.name);
  99.             err := ResError;
  100.             if err = noErr then begin
  101.                 WriteResource(res.data);
  102.                 SetResAttrs(res.data, res.attributes);
  103.                 err := ResError;
  104.                 DetachResource(res.data);
  105.             end;
  106.             CloseResFile(resfile);
  107.         end;
  108.         SetResLoad(true);
  109.         PutResourceObject := err;
  110.     end;
  111.  
  112. end.