home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyFileSystemUtils.p < prev    next >
Encoding:
Text File  |  1994-10-05  |  9.3 KB  |  381 lines  |  [TEXT/PJMM]
  1. unit MyFileSystemUtils;
  2.  
  3. interface
  4.  
  5. {$IFC undefined THINK_Pascal}
  6.     uses
  7.         Files, Types;
  8. {$ENDC}
  9.  
  10.     procedure MyResolveAliasFile (var fs: FSSpec);
  11.     function MyGetCatInfo (vrn: integer; dirID: longInt; var name: string; index: integer; var pb: CInfoPBRec): OSErr;
  12.     function FSpGetCatInfo (var fs: FSSpec; index: integer; var pb: CInfoPBRec): OSErr;
  13.     function FSpSetCatInfo (var fs: FSSpec; var pb: CInfoPBRec): OSErr;
  14.     function MyFSMakeFSSpec (vrn: integer; dirID: longInt; name: str255; var fs: FSSpec): OSErr;
  15.     procedure MyGetModDate (var fs: FSSpec; var moddate: longInt);
  16.     function DuplicateFile (var org, new: FSSpec): OSErr;
  17.     function CopyData (src, dst: integer; len: longInt): OSErr;
  18.     function TouchDir (fs: FSSpec): OSErr;
  19.     function TouchFolder (vrn: integer; dirID: longInt): OSErr;
  20.     function CreateUniqueFile (var fs: FSSpec; creator, ftype: OSType): OSErr;
  21.     function MyFSReadLineEOL (refnum: integer; ch: char; var s: str255): OSErr;
  22.     function MyFSReadLine (refnum: integer; var s: str255): OSErr;
  23.     function MyFSReadLineAt (refnum: integer; pos: longInt; var s: str255): OSErr;
  24.     function MyFSWrite (refnum: integer; len: longInt; p: ptr): OSErr;
  25.     function MyFSWriteAt (refnum: integer; mode: integer; pos, len: longInt; p: ptr): OSErr;
  26.     function MyFSReadAt (refnum: integer; pos, len: longInt; p: ptr): OSErr;
  27.     function FSSpecToFullPath (fs: FSSpec; var path: str255): OSErr;
  28.  
  29. implementation
  30.  
  31.     uses
  32. {$IFC undefined THINK_Pascal}
  33.         Errors, Packages, GestaltEqu, 
  34. {$ENDC}
  35.         Aliases, MyTypes, MyStrings;
  36.  
  37.     function FSSPecToFullPath (fs: FSSpec; var path: str255): OSErr;
  38.         var
  39.             err: OSErr;
  40.             pb: CInfoPBRec;
  41.     begin
  42.         err := FSMakeFSSpec(fs.vRefNum, fs.parID, fs.name, fs);
  43.         if err = noErr then begin
  44.             if fs.parID = 1 then begin
  45.                 path := concat(fs.name, ':');
  46.             end
  47.             else begin
  48.                 path := fs.name;
  49.                 while (err = nOErr) & (fs.parID <> 1) do begin
  50.                     err := MyGetCatInfo(fs.vRefNum, fs.parID, fs.name, -1, pb);
  51.                     path := concat(fs.name, ':', path);
  52.                     fs.parID := pb.ioFlParID;
  53.                 end;
  54.             end;
  55.         end;
  56.         FSSPecToFullPath := err;
  57.     end;
  58.  
  59.     function TouchDir (fs: FSSpec): OSErr;
  60.         var
  61.             pb: CInfoPBRec;
  62.             err: OSErr;
  63.     begin
  64.         if fs.name = '' then begin
  65.             TouchDir := TouchFolder(fs.vRefNum, fs.parID);
  66.         end
  67.         else begin
  68.             pb.ioVRefNum := fs.vRefNum;
  69.             pb.ioDirID := fs.parID;
  70.             pb.ioNamePtr := @fs.name;
  71.             pb.ioFDirIndex := 0;
  72.             err := PBGetCatInfoSync(@pb);
  73.             if err = noErr then begin
  74.                 pb.ioNamePtr := nil;
  75.                 GetDateTime(pb.ioDrMdDat);
  76.                 err := PBSetCatInfoSync(@pb);
  77.             end;
  78.             TouchDir := err;
  79.         end;
  80.     end;
  81.  
  82.     function TouchFolder (vrn: integer; dirID: longInt): OSErr;
  83.         var
  84.             pb: CInfoPBRec;
  85.             err: OSErr;
  86.     begin
  87.         pb.ioVRefNum := vrn;
  88.         pb.ioDirID := dirID;
  89.         pb.ioNamePtr := nil;
  90.         pb.ioFDirIndex := -1;
  91.         err := PBGetCatInfoSync(@pb);
  92.         if err = noErr then begin
  93.             pb.ioVRefNum := vrn;
  94.             pb.ioDirID := dirID;
  95.             pb.ioNamePtr := nil;
  96.             GetDateTime(pb.ioDrMdDat);
  97.             err := PBSetCatInfoSync(@pb);
  98.         end;
  99.         TouchFolder := err;
  100.     end;
  101.  
  102.     function CreateUniqueFile (var fs: FSSpec; creator, ftype: OSType): OSErr;
  103.         var
  104.             oname: str31;
  105.             n: str255;
  106.             i: integer;
  107.             oe: OSErr;
  108.     begin
  109.         oname := fs.name;
  110.         LimitStringLength(oname, 27, '…');
  111.         oe := HCreate(fs.vRefNum, fs.parID, fs.name, creator, ftype);
  112.         i := 1;
  113.         while oe = dupFNErr do begin
  114.             NumToString(i, n);
  115.             fs.name := concat(oname, '#', n);
  116.             oe := HCreate(fs.vRefNum, fs.parID, fs.name, creator, ftype);
  117.             i := i + 1;
  118.         end;
  119.         CreateUniqueFile := oe;
  120.     end;
  121.  
  122.     function MyFSReadAt (refnum: integer; pos, len: longInt; p: ptr): OSErr;
  123.         var
  124.             pb: ParamBlockRec;
  125.             oe: OSErr;
  126.     begin
  127.         pb.ioRefNum := refnum;
  128.         pb.ioBuffer := p;
  129.         pb.ioReqCount := len;
  130.         pb.ioPosMode := fsFromStart;
  131.         pb.ioPosOffset := pos;
  132.         oe := PBReadSync(@pb);
  133.         if (oe = noErr) & (pb.ioActCount <> len) then begin
  134.             oe := -1;
  135.         end;
  136.         MyFSReadAt := oe;
  137.     end;
  138.  
  139.     function MyFSReadLineEOL (refnum: integer; ch: char; var s: str255): OSErr;
  140.         var
  141.             pb: ParamBlockRec;
  142.             err: OSErr;
  143.     begin
  144.         pb.ioRefNum := refnum;
  145. {$PUSH}
  146. {$R-}
  147.         pb.ioBuffer := @s[1];
  148.         pb.ioReqCount := SizeOf(s) - 1;
  149.         pb.ioPosMode := fsFromMark + fsNewLine + BSL(ord(ch), 8);
  150.         pb.ioPosOffset := 0;
  151.         err := PBReadSync(@pb);
  152.         if (err = eofErr) & (pb.ioActCount > 0) then begin
  153.             err := noErr;
  154.         end;
  155.         if err = noErr then begin
  156.             if s[pb.ioActCount] = ch then begin
  157.                 pb.ioActCount := pb.ioActCount - 1;
  158.             end;
  159.             s[0] := chr(pb.ioActCount);
  160.         end;
  161. {$POP}
  162.         MyFSReadLineEOL := err;
  163.     end;
  164.  
  165.     function MyFSReadLine (refnum: integer; var s: str255): OSErr;
  166.     begin
  167.         MyFSReadLine := MyFSReadLineEOL(refnum, cr, s);
  168.     end;
  169.  
  170.     function MyFSReadLineAt (refnum: integer; pos: longInt; var s: str255): OSErr;
  171.         var
  172.             pb: ParamBlockRec;
  173.             err: OSErr;
  174.     begin
  175.         pb.ioRefNum := refnum;
  176. {$PUSH}
  177. {$R-}
  178.         pb.ioBuffer := @s[1];
  179.         pb.ioReqCount := SizeOf(s) - 1;
  180.         pb.ioPosMode := fsFromStart + fsNewLine + BSL(ord(cr), 8);
  181.         pb.ioPosOffset := pos;
  182.         err := PBReadSync(@pb);
  183.         if (err = eofErr) & (pb.ioActCount > 0) then begin
  184.             err := noErr;
  185.         end;
  186.         if err = noErr then begin
  187.             s[0] := chr(pb.ioActCount - 1);
  188.         end;
  189. {$POP}
  190.         MyFSReadLineAt := err;
  191.     end;
  192.  
  193.     function MyFSWrite (refnum: integer; len: longInt; p: ptr): OSErr;
  194.         var
  195.             oe: OSErr;
  196.             count: longInt;
  197.     begin
  198.         oe := noErr;
  199.         if len > 0 then begin
  200.             count := len;
  201.             oe := FSWrite(refnum, count, p);
  202.             if (oe = noErr) & (count <> len) then
  203.                 oe := -1;
  204.         end;
  205.         MyFSWrite := oe;
  206.     end;
  207.  
  208.     procedure MyResolveAliasFile (var fs: FSSpec);
  209.         var
  210.             isfolder, wasalias: boolean;
  211.             temp: FSSpec;
  212.             gv: longInt;
  213.             oe: OSErr;
  214.     begin
  215.         if (Gestalt(gestaltAliasMgrAttr, gv) = noErr) & (BTST(gv, gestaltAliasMgrPresent)) then begin
  216.             temp := fs;
  217.             oe := ResolveAliasFile(fs, true, isfolder, wasalias);
  218.             if oe <> noErr then
  219.                 fs := temp;
  220.         end;
  221.     end;
  222.  
  223.     function MyGetCatInfo (vrn: integer; dirID: longInt; var name: string; index: integer; var pb: CInfoPBRec): OSErr;
  224.     begin
  225.         pb.ioVRefNum := vrn;
  226.         pb.ioDirID := dirID;
  227.         pb.ioNamePtr := @name;
  228.         pb.ioFDirIndex := index;
  229.         MyGetCatInfo := PBGetCatInfoSync(@pb);
  230.     end;
  231.  
  232.     function FSpGetCatInfo (var fs: FSSpec; index: integer; var pb: CInfoPBRec): OSErr;
  233.     begin
  234.         pb.ioVRefNum := fs.vRefNum;
  235.         pb.ioDirID := fs.parID;
  236.         pb.ioNamePtr := @fs.name;
  237.         pb.ioFDirIndex := index;
  238.         FSpGetCatInfo := PBGetCatInfoSync(@pb);
  239.     end;
  240.  
  241.     function FSpSetCatInfo (var fs: FSSpec; var pb: CInfoPBRec): OSErr;
  242.     begin
  243.         pb.ioVRefNum := fs.vRefNum;
  244.         pb.ioDirID := fs.parID;
  245.         pb.ioNamePtr := @fs.name;
  246.         FSpSetCatInfo := PBSetCatInfoSync(@pb);
  247.     end;
  248.  
  249.     function MyFSMakeFSSpec (vrn: integer; dirID: longInt; name: str255; var fs: FSSpec): OSErr;
  250.         var
  251.             pb: CInfoPBRec;
  252.             oe: OSErr;
  253.             gv: longInt;
  254.     begin
  255.         if (Gestalt(gestaltFSAttr, gv) = noErr) & (BTST(gv, gestaltHasFSSpecCalls)) then begin
  256.             oe := FSMakeFSSpec(vrn, dirID, name, fs);
  257.         end
  258.         else begin
  259.             oe := MyGetCatInfo(vrn, dirID, name, 0, pb);
  260.             if (oe = noErr) then begin
  261.                 fs.vRefNum := pb.ioVRefNum;
  262.                 fs.parID := pb.ioFlParID;
  263.                 fs.name := name;
  264.             end;
  265.         end;
  266.         MyFSMakeFSSpec := oe;
  267.     end;
  268.  
  269.     procedure MyGetModDate (var fs: FSSpec; var moddate: longInt);
  270.         var
  271.             oe: OSErr;
  272.             pb: CInfoPBRec;
  273.     begin
  274.         oe := MyGetCatInfo(fs.vRefNum, fs.parID, fs.name, 0, pb);
  275.         if oe = noErr then begin
  276.             moddate := pb.ioFlMdDat
  277.         end
  278.         else begin
  279.             moddate := $80000000;
  280.         end;
  281.     end;
  282.  
  283.     function CopyData (src, dst: integer; len: longInt): OSErr;
  284.         const
  285.             buffer_len = 4096;
  286.         var
  287.             buffer: array[1..buffer_len] of signedByte;
  288.             l: longInt;
  289.             oe: OSErr;
  290.     begin
  291.         oe := noErr;
  292.         while (len > 0) & (oe = noErr) do begin
  293.             if len > SizeOf(buffer) then
  294.                 l := SizeOf(buffer)
  295.             else
  296.                 l := len;
  297.             oe := FSRead(src, l, @buffer);
  298.             if (l = 0) & (oe = noErr) then
  299.                 oe := -1;
  300.             if oe = noErr then
  301.                 oe := MyFSWrite(dst, l, @buffer);
  302.             len := len - l;
  303.         end;
  304.         CopyData := oe;
  305.     end;
  306.  
  307.     function DuplicateFile (var org, new: FSSpec): OSErr;
  308.         var
  309.             oe, ooe: OSErr;
  310.             fi: FInfo;
  311.             pb: CInfoPBRec;
  312.             orn, nrn: integer;
  313.             rlen, dlen: longInt;
  314.     begin
  315.         oe := FSpGetFInfo(org, fi);
  316.         if oe = noErr then
  317.             oe := FSpCreate(new, fi.fdCreator, fi.fdType, 0);
  318.         if oe = noErr then begin
  319.             oe := MyGetCatInfo(org.vRefNum, org.parID, org.name, 0, pb);
  320.             if oe = noErr then begin
  321.                 dlen := pb.ioFlLgLen;
  322.                 rlen := pb.ioFlRLgLen;
  323.                 pb.ioVRefNum := new.vRefNum;
  324.                 pb.ioDirID := new.parID;
  325.                 pb.ioNamePtr := @new.name;
  326.                 pb.ioFDirIndex := 0;
  327.                 oe := PBGetCatInfoSync(@pb);
  328.             end;
  329.  
  330.             if oe = noErr then begin
  331.                 oe := FSpOpenDF(org, fsRdPerm, orn);
  332.                 if oe = noErr then begin
  333.                     oe := FSpOpenDF(new, fsWrPerm, nrn);
  334.                     if oe = noErr then begin
  335.                         oe := CopyData(orn, nrn, dlen);
  336.                         ooe := FSClose(nrn);
  337.                         if oe = noErr then
  338.                             ooe := oe;
  339.                     end;
  340.                     ooe := FSClose(orn);
  341.                 end;
  342.             end;
  343.  
  344.             if oe = noErr then begin
  345.                 oe := FSpOpenRF(org, fsRdPerm, orn);
  346.                 if oe = noErr then begin
  347.                     oe := FSpOpenRF(new, fsWrPerm, nrn);
  348.                     if oe = noErr then begin
  349.                         oe := CopyData(orn, nrn, rlen);
  350.                         ooe := FSClose(nrn);
  351.                         if oe = noErr then
  352.                             ooe := oe;
  353.                     end;
  354.                     ooe := FSClose(orn);
  355.                 end;
  356.             end;
  357.  
  358.             if oe <> noErr then
  359.                 ooe := FSpDelete(new);
  360.         end;
  361.         DuplicateFile := oe;
  362.     end;
  363.  
  364.     function MyFSWriteAt (refnum: integer; mode: integer; pos, len: longInt; p: ptr): OSErr;
  365.         var
  366.             pb: ParamBlockRec;
  367.             oe: OSErr;
  368.     begin
  369.         pb.ioRefNum := refnum;
  370.         pb.ioBuffer := p;
  371.         pb.ioReqCount := len;
  372.         pb.ioPosMode := mode;
  373.         pb.ioPosOffset := pos;
  374.         oe := PBWriteSync(@pb);
  375.         if (oe = noErr) & (pb.ioActCount <> len) then begin
  376.             oe := -1;
  377.         end;
  378.         MyFSWriteAt := oe;
  379.     end;
  380.  
  381. end.