DELPHI 创建文件目录

[sundoc]

DELPHI 如何创建文件目录

[allyer]

function CreateDir(const Dir: string): Boolean;

[tjff2000]

CreateDir()

[yckxzjj]

unit UFileAttr;

interface

uses
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.