System.IOUtils.TDirectory.CreateDirectory complete, rigorous create a directory

Recommended for you: Get network issues from WhatsUp Gold. Not end users.

Description: create a directory, multi-level directory (not including multi-level directory using the System.SysUtils.ForceDirectories, the Vcl.FileCtrl.ForceDirectories is out of date)

procedure CreateDirectory(Path: string);

Parameters: such as a D:\aa path given, nonholonomic path such as AA are created during program under the current directory

The complete code

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 // Select the directory is empty
    begin
        Flag := MessageDlg('Yes modification of name, No directory, Cancel not as', 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 directly from the
    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('Please select a directory', 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('Creation failed!' + E.Message, mtError, [mbOK], 0);
                Exit;
            end;
        end;
        ShowMessage('Successfully created!');
        Exit;
    end;
    MessageDlg('A folder already exists!', 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 = ('\', '/', '*', '?', ':', '|', '>',
      '<', '"');  //Special characters
    InvalidStrs: array [0 .. 7] of string = ('con', 'aux', 'lpt1', 'lpt2',
      'com1', 'com2', 'prn', 'nul'); // Windows reserved name, omitted here million to
var
     Dir2: string;
     I: Integer;
begin
    if Trim(Edit_Path.Text) = '' then
    begin
        MessageDlg('Please enter the directory name!', 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('Invalid directory (special character)', mtError, [mbOK], 0);
            Exit;
        end;
    end;
    for I := 0 to Length(InvalidStrs) do
    begin
        if InvalidStrs[I] = LowerCase(Dir2) then
        begin
            MessageDlg('Invalid directory (special character)', mtError, [mbOK], 0);
            Exit;
        end;
    end;
    if AnsiLastChar(sDir) = '\' then //Determine whether the root directory
        Form1.Edit_Dir.Text := sDir + Dir2
    else
        Form1.Edit_Dir.Text := sDir + '\' + Dir2;


    Close;
end;

end.

The effect of presentation

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download

Posted by Borg at December 30, 2013 - 1:36 PM