[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]

Program MakeChangeDir;

{ Purpose:      - Make directories where they don't exist               }
{                                                                       }
{ Useful for:   - Installation Type Programs                            }
{                                                                       }
{ Useful notes: - seems to handles even directories With extentions     }
{                 (i.e. DIRDIR.YYY)                                     }
{               - there are some defaults that have been set up :-      }
{                 change if needed                                      }
{               - doesn't check to see how legal the required directory }
{                 is (i.e. spaces, colon in the wrong place, etc.)      }
{                                                                       }
{ Legal junk:   - this has been released to the public as public domain }
{               - if you use it, give me some credit!                   }
{                                                                       }

Var
  Slash : Array[1..20] of Integer;

Procedure MkDirCDir(Target : String);
Var
  i,
  count   : Integer;
  dir,
  home,
  tempdir : String;

begin
  { sample directory below to make }
  Dir := Target;
  { add slash at end if not given }
  if Dir[Length(Dir)] <> '\' then
    Dir := Dir + '\';
  { if colon where normally is change to that drive }
  if Dir[2] = ':' then
    ChDir(Copy(Dir, 1, 2))
  else
  { assume current drive (and directory) }
  begin
    GetDir(0, Home);
    if Dir[1] <> '\' then
      Dir := Home + '\' + Dir
    else
      Dir := Home + Dir;
  end;

  Count := 0;
  { search directory For slashed and Record them }
  For i := 1 to Length(Dir) do
  begin
    if Dir[i] = '\' then
    begin
      Inc(Count);
      Slash[Count] := i;
    end;
  end;
  { For each step of the way, change to the directory }
  { if get error, assume it doesn't exist - make it }
  { then change to it }
  For i := 2 to Count do
  begin
    TempDir := Copy(Dir, 1, Slash[i] - 1);
    {$I-}
    ChDir(TempDir);
    if IOResult <> 0 then
    begin
      MkDir(TempDir);
      ChDir(TempDir);
    end;
  end;
end;

begin
  MkDirCDir('D:\HI.ZZZ\GEEKS\2JKD98');
end.

[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]