ایجاد یک Directory Tree

[Keramatifar]

procedure MakeDir(Dir: String);
function Last(What: String; Where: String): Integer;
var
Ind : Integer;

begin
Result := 0;

for Ind := (Length(Where)-Length(What)+1) downto 1 do
if Copy(Where, Ind, Length(What)) = What then begin
Result := Ind;
Break;
end;
end;

var
PrevDir : String;
Ind : Integer;

begin
if Copy(Dir,2,1) <> ':' then
if Copy(Dir,3,1) <> '\' then
if Copy(Dir,1,1) = '\' then
Dir := 'C:'+Dir
else
Dir := 'C:\'+Dir
else
Dir := 'C:'+Dir;

if not DirectoryExists(Dir) then begin
// if directory don't exist, get name of the previous directory

Ind := Last('\', Dir); // Position of the last '\'
PrevDir := Copy(Dir, 1, Ind-1); // Previous directory

// if previous directoy don't exist,
// it's passed to this procedure - this is recursively...
if not DirectoryExists(PrevDir) then
MakeDir(PrevDir);

// In thats point, the previous directory must be exist.
// So, the actual directory (in "Dir" variable) will be created.
CreateDir(Dir);
end;
end;


Usage:
MakeDir('\data\year\2000');

or

MakeDir('D:\TEST\PROGRAMS\NOVEMBER\');