DELPHI基础教程：文件管理（三）[3]

没有办法我只能再次使用FindFirst这个函数的特性在节中已进行了介绍下面是这一功能的实现代码

procedure TFMFormsearchClick（Sender: TObject）

var

SearchForm: TSearchForm;

FileAttrForm: TFileAttrForm;

FindItpath: String;

SearchRec: TSearchRec;

Return: Integer;

begin

SearchForm := TSearchFormCreate（self）

with SearchForm do

begin

SearchFiletext := ;

SearchPathtext := DirectoryOutlineDirectory;

if （ShowModal <> idCancel） and

（SearchFileText <> ） and （SearchPathtext <> ） then

begin

FindIt := SearchPathtext+\+SearchFiletext;

Return := FindFirst（FindItfaAnyFileSearchRec）

if Return <> then

FindIt :=

else

FindIt := ExpandFileName（SearchRecName）

end;

if FindIt = then

MessageDlg（Cannot find the file in current directory

mtWarning [mbOk] ）

else

begin

Path := ExtractFilePath（FindIt）

FindIt := ExtractFileName（FindIt）

FileAttrForm := TFileAttrFormCreate（self）

ShowFileAttr（FileAttrFormFindItPath）

end;

end;

end;

显示磁盘信息

当用户单击Disk View菜单项时将弹出一个TDiskViewForm类型的对话框用来显示当前磁盘的信息

磁盘信息的获取是在DiskViewForm中DriveEdit编辑框的OnChange事件处理过程中实现的

procedure TDiskViewFormdriveEditChange（Sender: TObject）

var

dr: Byte;

FreeTotal: LongInt;

begin

Free := DiskFree（）

Total := DiskSize（）

FreeSpacetext := IntToStr（Free）+ bytes;

TotalSpacetext := IntToStr（Total） + bytes;

end;

DiskFreeDiskSize带参数为表示当前驱动器读者可以很容易把它改成按用户输入显示磁盘信息的情况

DiskViewForm中的三个编辑框设计时都令ReadOnly为True

改变显示文件的类型

改变显示文件的类型事实上是设置FileList的Mask属性我们利用一个标准的InputBox输入文件的匹配字符串而后利用Update方法更新FileList

procedure TFMFormViewtypeClick（Sender: TObject）

var

FileMask: String;

begin

FileMask := InputBox（File typeInput File type For View :FileListMask）

If FileMask = then FileMask := **;

FileListMask := FileMask;

FileListUpdate;

CreateCaption;

end;

其中的CreateCaption私有过程将在（）中进行介绍

目录管理功能的实现

在子窗口的Directory菜单中提供了目录管理功能

● Create Directory :创建一个子目录

● Delete Directory :删除一个空的子目录

● Change Directory :改变当前目录

创建目录

创建目录时首先弹出一个TNewDir类型的对话框

对话框中要求用户输入目录名如果用户不输入路径则缺省认定为当前目录的子目录

Dir := ExpandFileName（DirNameText）

而后调用MkDir函数在目录创建过程中关闭了I/O错误检测出错不产生异常而是把IOResult设置为非零值通过检查IOResult是否为可以确定创建是否成功

程序清单如下

procedure TFMFormCreateDirectoryClick（Sender: TObject）

var

NewDir: TNewDir;

Dir: String;

begin

{$I}

NewDir := TNewDirCreate（self）

with NewDir do

begin

CurrentDirCaption := DirectoryOutlineDirectory;

if （ShowModal <> idCancel） and （DirNameText <> ） then

Dir := ExpandFileName（DirNametext）

end;

MkDir（Dir）

if IOResult <> then

MessageDlg（Cannot Create directory mtWarning [mbOk] ）

end;

但不幸的是目录创建后我们却无法从当前目录树中看到必须移到另一个驱动器而后再返回创建的目录才是可见的在后边我们将提供一种解决方法

删除目录

在实现目录删除过程中远不如创建目录那么顺利碰到的问题是

RmDir不允许删除当前目录但为了操作方便我们要求删除的恰恰是当前目录

目录删除后调用Refresh方法或Update方法并不能使该目录从屏幕显示中去除因而当用户试图进入该目录时会导致系统崩溃

对第一个问题我们的解决办法是把当前目录转换到其父目录假如读者记得目录也被操作系统作为一种特殊的文件对待的话那么就不会对下面的语句感到奇怪了

path := DirectoryOutlineDirectory;

DirectoryoutlinDirectory := ExpandFilePath（Path）

而后调用RmDir过程

RmDir（Path）

第二个问题的解决却颇为费神因为DirectoryOutline是Delphi提供的示例部件没有Help文件支持通过试验发现只有当DirectoryOutline的Drive属性改变时才重新从相应驱动器读取目录而且它基本上是只读的除非清除（ Clear） 它象AddDelete这些方法对它都是无效的

我曾经考虑过一个笨拙的方法那就是先改变当前驱动器而后再改回来但这种方法一方面速度无法忍受另一方面当只存在一个驱动器可用时会导致系统崩溃

正当我一筹莫展时突然想到DirectoryOutline是一个Sample部件Delphi 提供了它的源代码而当我分析了它的源代码后我知道应该做什么了那就是为DirectoryOutline增添一个Reset方法！

为部件增添一个方法

严格地说我们所做的工作属于创建一个新部件但因为我们有源代码所以不必从DirectoryOutline继承而是直接修改它这样我们可以省去与创建部件有关的许多繁琐工作对创建新部件感兴趣的读者可阅读本书第三编的有关章节

在Delphi IDE中打开DirectoryOutline的源文件后

把库单元名改为DirPlus类名改为TDirectoryOutlinePlus表明这是DirectoryOutline的增强版而后存入另一个目录中

添加一个公有方法Reset这一方法的作用是重新读取当前驱动器的目录程序清单如下

procedure TDirectoryOutlinePlusReset;

begin

ChDir（FDrive + :）

GetDir（ FDirectory）

FDirectory := ForceCase（FDirectory）

if not （csLoading in ComponentState） then BuildTree;

end;

读者也许被这段代码弄糊涂了由于篇幅所限而且涉及到许多自定义部件开发的内容我们也不准备去详细解释它假如读者想彻底搞懂它我建议先看一下本书第三编有关自定义部件开发的内容而后再对照原DirectoryOutline的源代码进行分析

编译成一个库文件DirPlustpu;

把DirPlus加入部件的Samples页中

如何添加一个部件见第三编有关章节的介绍

当增强的目录树准备好以后必须修改我们的子窗口设计但却不必亲自修改源代码

删除子窗口中的TDirectoryOutline类部件DirectoryOutline此时FileList占据了整个客户区

把FileList的Align属改为None并留出左边的空白供放部件用

在窗口左部加入TDirectoryOutlinPlus类的部件DirectoryOutline;

把DirectoryOutline的Align属性改为LeftFileList的Align属性还原为Client;

在DirectoryOutline的事件OnChange列表中选取DirectoryOutlineChange即原DirectoryOutline的处理过程

以上工作的最终目标是实现目录创建删除后屏幕的正确显示这只需要调用DirectoryOutline的Reset方法即可

[] [] [] []