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
     Ind     := Last('\', Dir);
     PrevDir := Copy(Dir, 1, Ind-1);
     if not DirectoryExists(PrevDir) then
        MakeDir(PrevDir);
     CreateDir(Dir);
end;
end;