DELPHI 创建文件目录

Question

DELPHI 如何创建文件目录

Answer 1

function CreateDir(const Dir: string): Boolean;

Answer 2

unit UFileAttr;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;type
  TFileAttrForm = class(TForm)
    GroupBox1: TGroupBox;
    ReadOnlyCheckBox: TCheckBox;
    ArchiveCheckBox: TCheckBox;
    SystemCheckBox: TCheckBox;
    HiddenCheckBox: TCheckBox;
    OpenDlg_File: TOpenDialog;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    OpenFileBtn: TSpeedButton;
    SetFileBtn: TSpeedButton;
    ExitBtn: TSpeedButton;
    FileNameLabel: TLabel;
    Panel4: TPanel;
    CreateBtn: TSpeedButton;
    Panel5: TPanel;
    RemoveBtn: TSpeedButton;
    procedure OpenFileBtnClick(Sender: TObject);
    procedure SetFileBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CreateBtnClick(Sender: TObject);
    procedure RemoveBtnClick(Sender: TObject);
    function RemoveDirectoryEx(Dir:string):Boolean;
  private
  public
  end;var
  FileAttrForm: TFileAttrForm;implementation{$R *.dfm}function TFileAttrForm.RemoveDirectoryEx(Dir:string):Boolean;
var
  SR:TSearchRec;
  SearchArgument:String;
begin
  //如果路径后不带反斜杠，则需加上
  if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\';
  //对目录下的所有文件进行查询
  SearchArgument:=Dir+'*.*';
  //faAayFile决定了文件类型为任意类型,判断是否存在文件或文件夹
  //如果存在则将其中的第一个赋给SR
  if FindFirst(SearchArgument,faAnyFile,SR)=0 then
     begin
       repeat
         begin
           if (SR.Name='.') or (SR.Name='..') then continue;
           if SR.Attr and faDirectory<>0 then
           //删除文件夹
               begin
                 if not RemoveDirectoryEx(Dir+SR.Name) then
                    result:=false;
               end
           else
             DeleteFile(Dir+SR.Name);
         end
       //查找下一个，直到查找完毕
       until FindNext(SR)<>0;
       //关闭当前查询
       FindClose(SR);
       if RemoveDir(Dir) then result:=true
       else result:=false;
     end;
end;procedure TFileAttrForm.OpenFileBtnClick(Sender: TObject);
var
  SaveFile:String;//用于保存需更改属性文件的文件名
  Attrs:Integer;
begin
  try
    if OpenDlg_File.Execute then
       begin
         SaveFile:=OpenDlg_File.FileName;
         if not FileExists(SaveFile) then
            MessageBox(Handle,PChar(SaveFile+'指定的文件不存在!'),PChar('警告'),MB_OK+MB_ICONWARNING)
         else
           begin
             FileNameLabel.Caption:='文件名为:['+ExtractFileName(SaveFile)+']';
             Attrs:=FileGetAttr(SaveFile);
             ReadOnlyCheckBox.Checked:=(Attrs and FaReadOnly)=FaReadOnly;
             ArchiveCheckBox.Checked:=(Attrs and FaArchive)=FaArchive;
             SystemCheckBox.Checked:=(Attrs and FaSysFile)=FaSysFile;
             HiddenCheckBox.Checked:=(Attrs and FaHidden)=FaHidden;
           end;
       end;
    except
      MessageBox(Handle,PChar('系统内部调用错误!'),PChar('警告'),MB_OK+MB_ICONWARNING)
    end;
end;procedure TFileAttrForm.SetFileBtnClick(Sender: TObject);
var
  SaveFile:String;//用于保存需更改属性文件的文件名
  Attrs:Integer;
begin
  SaveFile:=OpenDlg_File.FileName;
       if not FileExists(SaveFile) then
          begin
            MessageBox(Handle,PChar('指定的文件不存在!'),PChar('警告'),MB_OK+MB_ICONWARNING);
            ReadOnlyCheckBox.Checked:=False;
            ArchiveCheckBox.Checked:=False;
            SystemCheckBox.Checked:=False;
            HiddenCheckBox.Checked:=False;
          end
       else
         begin
           Attrs:=0;
           if ReadOnlyCheckBox.Checked then Attrs:=Attrs+FaReadOnly;
           if ArchiveCheckBox.Checked then Attrs:=Attrs+FaArchive;
           if SystemCheckBox.Checked then Attrs:=Attrs+FaSysFile;
           if HiddenCheckBox.Checked then Attrs:=Attrs+FaHidden;
              MessageBox(Handle,'文件属性设置成功!',PChar('信息提示'),MB_OK+MB_ICONINFORMATION);
           if FileSetAttr(SaveFile,Attrs)<>0 then
              MessageBox(Handle,'文件属性设置失败!',PChar('信息提示'),MB_OK+MB_ICONINFORMATION);
         end;
end;procedure TFileAttrForm.ExitBtnClick(Sender: TObject);
begin
  Close;
end;procedure TFileAttrForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;procedure TFileAttrForm.CreateBtnClick(Sender: TObject);
var
  MyDir:String;
begin
  MyDir:=Trim(InputBox('信息提示','请输入要创建的文件夹名称:',''));
  if not DirectoryExists(MyDir) then
     if not CreateDir(MyDir) then
        showmessage('无效的路径名称')
     else
       showmessage('sucessful');
end;procedure TFileAttrForm.RemoveBtnClick(Sender: TObject);
var
  RemoveDir:string;
begin
  //判断用户输入的路径是否存在
  RemoveDir:=Trim(InputBox('信息提示','请输入要删除文件夹或文件路径:',''));
  if MessageBox(Handle,PChar('所指定的文件夹及文件将被删除!'),PChar('警告信息'),MB_OKCANCEL+MB_ICONWARNING)<>IDOK then
  Exit;
  if RemoveDir<>'' then
     if not DirectoryExists(RemoveDir) then
        Showmessage('不能找到该路径!')
     else if not RemoveDirectoryEx(RemoveDir) then
  //如果删除不成功，则给出提示
          showmessage('Error')
          else
            Showmessage('指定文件夹及文件已被删除!')
  else
    Showmessage('无效的路径名称');
end;end.