home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / m / msh_ut11.zip / MYMKDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-30  |  2KB  |  67 lines
  1. PROGRAM MyMkdir;
  2. { Create a directory, and all non-existent father-direc-
  3.   tories as well. Not much of error-checking, so cross
  4.   your fingers...
  5.   J.P. 92 for the Mi-Shell }
  6.  
  7. uses dos;
  8.  
  9. {$i-}
  10.  
  11.   PROCEDURE nope;
  12.   begin
  13.     writeLn('Could not create directory');
  14.     halt;
  15.   end;
  16.  
  17.   PROCEDURE MkIt(dir : string);
  18.   var i, j  : byte;
  19.       exist : boolean;
  20.       srec  : SearchRec;
  21.       subdir: string;
  22.   begin
  23.     subdir := dir;
  24.     { Which part of dir is already existing ? }
  25.     REPEAT
  26.       If subdir[Length(subdir)]='\' then
  27.         DEC(subdir[0]);  { kill it }
  28.       FindFirst(subdir, AnyFile, srec);
  29.       exist := doserror = 0;
  30.       if exist then
  31.       begin
  32.         if srec.attr and directory = 0 then
  33.         begin
  34.           nope; { Oops, there is a normal file with that name }
  35.         end;
  36.       end
  37.       else
  38.       begin
  39.         j := Length(subdir);
  40.         WHILE (j>0) and (subdir[j]<>'\') AND (subdir[j]<>':') DO
  41.           DEC(j);
  42.         subdir[0] := chr(j);
  43.         if subdir[j] = ':' then
  44.           exist := true;            { Only Drive-spec remaining }
  45.       end;
  46.     UNTIL exist OR (subdir='');
  47.     { So what remains in subdir is the existing directory }
  48.     { from this on we have to create all sub-directories  }
  49.     subdir := subdir + '\';
  50.     i := Length(subdir); { From this we start on }
  51.     REPEAT
  52.       if dir[i]='\' then inc(i);
  53.       while (i<Length(dir)) and (dir[i]<>'\') do
  54.         inc(i);
  55.       subdir := Copy(dir, 1, i);
  56.       if subdir[length(subdir)] = '\' then
  57.         dec(subdir[0]);
  58.       mkdir(subdir);
  59.       if ioresult<>0 then nope;
  60.     UNTIL i>=Length(Dir);
  61.   end;
  62.  
  63. BEGIN
  64.   IF ParamCount>0 THEN
  65.     MkIt(ParamStr(1));
  66. END.
  67.