设为首页 加入收藏

TOP

TDirectory.CreateDirectory 完整、严谨的创建一个目录
2014-01-14 21:16:43 来源:互联网 作者: 【 】 浏览:521次 评论:0

描述:创建一个目录,不包含多级目录(多级目录使用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], 0);
        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], 0);
        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], 0);
                Exit;
            end;
        end;
        ShowMessage('创建成功!');
        Exit;
    end;
    MessageDlg('文件夹已存在!', mtError, [mbOK], 0);
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 [0 .. 8] of Char = ('\', '/', '*', '?', ':', '|', '>',
      '<', '"');  //特殊字符
    InvalidStrs: array [0 .. 7] 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], 0);
        Exit;
    end;
    Dir2 := Edit_Path.Text;
    for I := 0 to Length(InvalidChrs) do
    begin
        if Pos(InvalidChrs[i], Dir2) <> 0 then
        begin
            MessageDlg('无效目录(特殊字符)', mtError, [mbOK], 0);
            Exit;
        end;
    end;
    for I := 0 to Length(InvalidStrs) do
    begin
        if InvalidStrs[I] = LowerCase(Dir2) then
        begin
            MessageDlg('无效目录(特殊字符)', mtError, [mbOK], 0);
            Exit;
        end;
    end;
    if AnsiLastChar(sDir) = '\' then //判断是否根目录
        Form1.Edit_Dir.Text := sDir + Dir2
    else
        Form1.Edit_Dir.Text := sDir + '\' + Dir2;


    Close;
end;

end.
复制代码

效果演示:

 
您看到此篇文章时的感受是:
Tags:delphi 责任编辑:administrator
】【打印繁体】【投稿】【收藏】 【推荐】【举报】【评论】 【关闭】 【返回顶部
分享到QQ空间
分享到: 
上一篇Delphi 中的全局快捷键+给指定窗.. 下一篇TDirectory.GetDirectories 获取..

评论

帐  号: 密码: (新用户注册)
验 证 码:
表  情:
内  容:

相关栏目

最新文章

图片主题

热门文章

推荐文章

相关文章

广告位