TDirectory.CreateDirectory 完整、严谨的创建一个目录

描述：创建一个目录，不包含多级目录(多级目录使用System.SysUtils.ForceDirectories，Vcl.FileCtrl.ForceDirectories已过时)

procedure CreateDirectory(Path: string);

参数一：给定的路径如D:\aa，非完整路径如aa则在程序当前目录下创建

完整代码

unit Unit1;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.IOUtils,
    Vcl.FileCtrl;

type
    TForm1 = class(TForm)
        GroupBox1: TGroupBox;
        Button_Create: TButton;
        Label1: TLabel;
        Button_Browser: TButton;
        Edit_Dir: TEdit;
        procedure Button_CreateClick(Sender: TObject);
        procedure Button_BrowserClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    Form1: TForm1;

implementation

Uses Unit2;
{$R *.dfm}

procedure TForm1.Button_BrowserClick(Sender: TObject);
var
    Dir: string;
    Flag: Integer;
begin
    if Edit_Dir.Text <> '' then // 为空先选择目录
    begin
        Flag := MessageDlg('Yes修改名称，No选择目录，Cancel无作为', mtInformation,
          [mbYes, mbNo, mbCancel], );
        if Flag = IDYES then
        begin
            Form2.ShowModal;
            Exit;
        end
        else if Flag = IDNO then
        begin
            if not selectDirectory('', '', Dir) then
                Exit;
            Form2.setDir(Dir);
            Form2.ShowModal;
            Exit;
        end;
        Exit;  //为IDCancel直接退出
    end;
    if not selectDirectory('', '', Dir) then
        Exit;
    Form2.setDir(Dir);
    Form2.ShowModal;
    Exit;
end;

procedure TForm1.Button_CreateClick(Sender: TObject);
begin
    if Trim(Edit_Dir.Text) = '' then
    begin
        MessageDlg('请先选择目录', mtInformation, [mbOK], );
        Exit;
    end;
    if not TDirectory.Exists(Edit_Dir.Text) then
    begin
        try
            TDirectory.CreateDirectory(Edit_Dir.Text);
        except
            on E: Exception do
            begin
                MessageDlg('创建失败!' + E.Message, mtError, [mbOK], );
                Exit;
            end;
        end;
        ShowMessage('创建成功！');
        Exit;
    end;
    MessageDlg('文件夹已存在！', mtError, [mbOK], );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Edit_Dir.ReadOnly := True;
end;

end.

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    Edit_Path: TEdit;
    Button_OK: TButton;
    procedure Button_OKClick(Sender: TObject);
    procedure setDir(Dir: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation
 uses Unit1;
{$R *.dfm}
var
    sDir: string;
procedure TForm2.setDir(Dir: String);
begin
    sDir := Dir;
end;
procedure TForm2.Button_OKClick(Sender: TObject);
const
    InvalidChrs: array [ .. ] of Char = ('\', '/', '*', '?', ':', '|', '>',
      '<', '"');  //特殊字符
    InvalidStrs: array [ .. ] of string = ('con', 'aux', 'lpt1', 'lpt2',
      'com1', 'com2', 'prn', 'nul'); // windows预留名称，此处省略万把个
var
     Dir2: string;
     I: Integer;
begin
    if Trim(Edit_Path.Text) = '' then
    begin
        MessageDlg('请输入目录名称！', mtError, [mbOK], );
        Exit;
    end;
    Dir2 := Edit_Path.Text;
    for I :=  to Length(InvalidChrs) do
    begin
        if Pos(InvalidChrs[i], Dir2) <>  then
        begin
            MessageDlg('无效目录(特殊字符)', mtError, [mbOK], );
            Exit;
        end;
    end;
    for I :=  to Length(InvalidStrs) do
    begin
        if InvalidStrs[I] = LowerCase(Dir2) then
        begin
            MessageDlg('无效目录(特殊字符)', mtError, [mbOK], );
            Exit;
        end;
    end;
    if AnsiLastChar(sDir) = '\' then //判断是否根目录
        Form1.Edit_Dir.Text := sDir + Dir2
    else
        Form1.Edit_Dir.Text := sDir + '\' + Dir2;

    Close;
end;

end.

效果演示：