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

画出每个自画项目

这在TabSet的OnDrawTab事件处理过程中完成 这一事件处理过程的参数中包含了待画项目索引 画板 待画区域 是否被选中等 这里我们只利用了前三个参数 事实上利用最后一个参数 我们可以对被选中的标签进行一些特殊的视觉效果处理 这一工作就留给读者自己去完成

procedure TFMForm DriveTabSetDrawTab（Sender: TObjectTabCanvas: TCanvas

R: TRectIndex: IntegerSelected: Boolean）

var

Bitmap: TBitmap

begin

Bitmap := TBitmap（DriveTabSet Tabs Objects[Index]）

with TabCanvas do

begin

Draw（R Left R Top + Bitmap）

TextOut（R Left + + Bitmap Width R Top + DriveTabSet Tabs[Index]）

end

end

文件管理基本功能的实现

在子窗口的File菜单中 定义了文件管理的基本功能 它们是

● Open :打开或运行一个文件（从文件列表框双击该文件可实现同样效果）

● Move :文件在不同目录间的移动

● Copy :文件拷贝

● Delete :文件删除

● Rename :文件更名

● Properties :显示文件属性

文件打开

文件打开功能可以运行一个可执行文件 或把文件在与之相关联的应用程序中打开 文件总是与创建它的应用程序相关联 这种关联可以在Windows的文件管理器中修改 要注意的是 文件的关银简联是以后缀名为标志的 因而对一个文件关联方式的修改将影响所有相同后缀名的文件

文件打开喊搏盯功能实现的关键是利用了Windows API函数ShellExecute 由于Windows API函数的参数要求字符串类型是PChar 而Delphi中一般用的是有结束标志的String类型 因此为调用方便我们把这一函数进行了重新定义如下

function ExecuteFile（const FileName Params DefaultDir: String

ShowCmd: Integer） THandle

var

zFileName zParams zDir: array[ ] of Char

begin

Result := ShellExecute（Application MainForm Handle nil

StrPCopy（zFileName FileName） StrPCopy（zParams Params）

StrPCopy（zDir DefaultDir） ShowCmd）

end

以上函数在fmxutils单元中定义 fmxutils是一个自定义代码单元

有关ShellExecute中各参数的具体含义读者可查阅联机Help文件

StrPCopy把一个Pascal类型的字符串拷贝到一个无结郑和束符的PChar类型字符串中

在子窗口的Open Click事件处理过程中

procedure TFMForm Open Click（Sender: TObject）

begin

with FileList do

ExecuteFile（FileName Directory SW_SHOW）

end

如果FileList允许显示目录的话（即FileType属性再增加一项ftDirectory） 那么对于一个目录而言 打开的含义应该是显示它下边的子目录和文件 程序修改如下

procefure TFMForm Open Click（Sender: Tobject）

begin

With FileList do

begin

if HasAttr（FileName faDirectory） then

DirectoryOutline Directory := FileName

else

ExecuteFile（FileName Directory SW_SHOW）

end

end

其中HasAttr是一个fmxutils单元中的自定义函数 用于检测指定文件是否具有某种属性

function HasAttr（const FileName: StringAttr: Word） Boolean

begin

Result := （FileGetAttr（FileName） and Attr） = Attr

end

文件拷贝 移动 删除 更名

文件拷贝的关键是使用了以文件句柄为 *** 作对象的文件管理函数 因而提供了一种底层的I/O通道 在Object Pascal中这一点是利用无类型文件实现的

在文件拷贝中首先检查目标文件名是否是一个目录 如是则把原文件的文件名添加到目标路径后 生成目标文件全路径名 而后提取源文件的时间戳 以备拷贝完成后设置目标文件 拷贝过程中使用了返回文件句柄或以文件句柄为参数的文件管理函数FileOpen FileCreate FileRead FileWrite FileClose 为保证文件的正常关闭和内存的释放 在拷贝过程中进行异常保护

过程CopyFile实现上述功能 它定义在fmxutils单元中

procedure CopyFile（const FileName DestName: TFileName）

var

CopyBuffer: Pointer

TimeStamp BytesCopied: Longint

Source Dest: Integer

Destination: TFileName

const

ChunkSize: Longint =

begin

Destination := ExpandFileName（DestName）

if HasAttr（Destination faDirectory） then

Destination := Destination + \ + ExtractFileName（FileName）

TimeStamp := FileAge（FileName）

GetMem（CopyBuffer ChunkSize）

try

Source := FileOpen（FileName fmShareDenyWrite）

if Source <then

raise EFOpenError Create（FmtLoadStr（SFOpenError [FileName]））

try

Dest := FileCreate（Destination）

if Dest <then

raise EFCreateError Create（FmtLoadStr（SFCreateError [Destination]））

try

repeat

BytesCopied := FileRead（Source CopyBuffer^ ChunkSize）

if BytesCopied >then

FileWrite（Dest CopyBuffer^ BytesCopied）

until BytesCopied <ChunkSize

finally

FileSetDate（Dest TimeStamp）

FileClose（Dest）

end

finally

FileClose（Source）

end

finally

FreeMem（CopyBuffer ChunkSize）

end

end

如果我们不使用FileSetDate过程 Windows自动把当前时间作为时间戳写入文件

文件移动事实上是文件拷贝与文件删除的结合 fmxutils单元中的MoveFile过程实现了这一功能

procedure MoveFile（const FileName DestName: TFileName）

var

Destination: TFileName

begin

Destination := ExpandFileName（DestName）

if not RenameFile（FileName Destination） then

begin

if HasAttr（FileName faReadOnly） then

raise EFCantMove Create（Format（SFCantMove [FileName]））

CopyFile（FileName Destination）

DeleteFile（FileName）

end

end

EFCanMove是一个自定义异常类

type

EFCanMove := Class（EStreamError）

有关自定义异常类请参阅第十二章

文件删除 文件更名直接调用Delphi文件管理过程DeleteFile RenameFile 它们都以文件名为参数 *** 作执行前应d出一个对话框进行确认 执行完毕后应调用Update方法更新FileList的显示

lishixinzhi/Article/program/Delphi/201311/25232

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

procedure TFMForm search Click（Sender: TObject）

var

SearchForm: TSearchForm

FileAttrForm: TFileAttrForm

FindIt path: String

SearchRec: TSearchRec

Return: Integer

begin

SearchForm := TSearchForm Create（self）

with SearchForm do

begin

SearchFile text :=

SearchPath text := DirectoryOutline Directory

if （ShowModal <>idCancel） and

（SearchFile Text <>） and （SearchPath text <>） then

begin

FindIt := SearchPath text+ \ +SearchFile text

Return := FindFirst（FindIt faAnyFile SearchRec）

if Return <>then

FindIt :=

else

FindIt := ExpandFileName（SearchRec Name）

end

if FindIt = then

MessageDlg（ Cannot find the file in current directory

mtWarning [mbOk] ）

else

begin

Path := ExtractFilePath（FindIt）

FindIt := ExtractFileName（FindIt）

FileAttrForm := TFileAttrForm Create（self）

ShowFileAttr（FileAttrForm FindIt Path）

end

end

end

显示磁盘信息

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

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

procedure TDiskViewForm driveEditChange（Sender: TObject）

var

dr: Byte

Free Total: LongInt

begin

Free := DiskFree（ ）

Total := DiskSize（ ）

FreeSpace text := IntToStr（Free）+ bytes

TotalSpace text := IntToStr（Total） + bytes

end

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

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

改变显示文件的类型

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

procedure TFMForm Viewtype Click（Sender: TObject）

var

FileMask: String

begin

FileMask := InputBox（ File type Input File type For View : FileList Mask）

If FileMask = then FileMask := * *

FileList Mask := FileMask

FileList Update

CreateCaption

end

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

目录管理功能的实现

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

● Create Directory :创建一个子目录

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

● Change Directory :改变当前目录

创建目录

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

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

Dir := ExpandFileName（DirName Text）

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

程序清单如下

procedure TFMForm CreateDirectory Click（Sender: TObject）

var

NewDir: TNewDir

Dir: String

begin

{$I }

NewDir := TNewDir Create（self）

with NewDir do

begin

CurrentDir Caption := DirectoryOutline Directory

if （ShowModal <>idCancel） and （DirName Text <>） then

Dir := ExpandFileName（DirName text）

end

MkDir（Dir）

if IOResult <>then

MessageDlg（ Cannot Create directory mtWarning [mbOk] ）

end

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

删除目录

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

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

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

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

path := DirectoryOutline Directory

Directoryoutlin Directory := ExpandFilePath（Path）

而后调用RmDir过程

RmDir（Path）

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

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

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

为部件增添一个方法

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

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

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

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

procedure TDirectoryOutlinePlus Reset

begin

ChDir（FDrive + : ）

GetDir（ FDirectory）

FDirectory := ForceCase（FDirectory）

if not （csLoading in ComponentState） then BuildTree

end

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

编译成一个库文件DirPlus tpu

把DirPlus加入部件的Samples页中

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

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

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

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

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

把DirectoryOutline的Align属性改为Left FileList的Align属性还原为Client

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

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

lishixinzhi/Article/program/Delphi/201311/25234

函数NotInList用于判断待添加的字符串是否已存在于一个TStrings对象中 函数返回一个布尔型运枝变量

NotInList的具体实现如下

Function TFileCtrForm NotInList（FileName: StringItems: TStrings） Boolean

var

i: Integer

begin

for I := to Items Count do

if Items[i] = FileName then

begin

NotInList := False

Exit

end

NotInList := True

end

按指定匹配字符串显示当前目录中的文件

当在FileEdit中输入一个匹配字符串 并回车 文件列表框将显示匹配结果 这一功能在FileEdit的OnKeyPress事件中实现

procedure TFileCtrForm FileEditKeyPress（Sender: TObjectvar Key: Char）

begin

if Key = # then

begin

FileListBox ApplyFilePath（FileEdit Text）

Key := #

end

end

文件列表框提供的ApplyFilePath方法是解决这一问题的关键所在

　如仔　 按指定匹配字符串查找当前目录中的文件

为了进行比较 我们用另一种方法来实现文件的查找功能 即利用标准旁橡敏过程FindFirst FindNext FileList 与ListBox 中的内容完全一致

当用户单击 查找 按钮时 与FileEdit 中字符串相匹配的文件将显示在ListBox 中 下面是实现代码

procedure TFileCtrForm Button Click（Sender: TObject）

var

i: Integer

SearchRec: TSearchRec

begin

Searched := True

Label Caption := Search Result

ListBox Items Clear

FindFirst（FileEdit text faAnyFile SearchRec）

ListBox Items Add（SearchRec Name）

Repeat

i := FindNext（SearchRec）

If i = then

ListBox Items Add（SearchRec Name）

until i <>

end

SearchRec是一个TSearchRec类型的记录 TSearchRec的定义如下

TSearchRec = record

Fill: array[ ] of Byte

Attr: Byte

Time: Longint

Size: Longint

Name: string[ ]

end

在这一结构中提供了很多信息 灵活应用将给编程带来很大方便 下面我们举几个例子

检测给定文件的大小

function GetFileSize（const FileName: String） LongInt

var

SearchRec: TSearchRec

begin

if FindFirst（ExpandFileName（FileName） faAnyFile SearchRec） = then

Result := SearchRec Size

else

Result :=

end

这一程序将在下一节中应用

获取给定文件的时间戳 事实上等价于FileAge函数

function GetFileTime（const FileName: String） Longint

var

SearchRec: TSearchRec

begin

if FindFirst（ExpandFileName（FileName） faAnyFile SearchRec） = then

Result := SearchRec Time

else

Result :=

end

检测文件的属性 如果文件具有某种属性 则

SearchRec Attr And GivenAttr >

属性常量对应的值与意义如下表

表 属性常量对应的值与意义

━━━━━━━━━━━━━━━━━━━━

常量 值 描述

─────────────────────

faReadOnly $ 只读文件

faHidden $ 隐藏文件

faSysFile $ 系统文件

faVolumeID $ 卷标文件

faDirectory $ 目录文件

faArchive $ 档案文件

faAnyFile $ F 任何文件

━━━━━━━━━━━━━━━━━━━━

文件管理综合举例 文件管理器的实现

在本章的最后 我们利用Delphi提供的文件控件和文件管理函数开发一个简单的文件管理器 虽然这一文件管理器还无法和Windows提供的文件管理器相比拟 但它也为一般的文件 *** 作提供了足够多的功能 而且如果读者感兴趣 还可以对它做进一步的扩充 在后边的拖放 *** 作一章中 我们就为它提供了拖放支持 使它看起来更象一个 文件管理器

设计基本思路

窗口设计

文件管理器的主窗口是一个多文档界面（MDI） 有关文件 目录的显示和文件管理功能的实现都放在子窗口中 在程序执行过程中将根据需要d出一些完成不同 *** 作的对话框 这些对话框都是在需要时动态生成的 表 给出了本程序所设计窗体的清单

表 FileManger窗体清单

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

窗体类 功能 用于创建该类窗体的菜单项

──────────────────────────────────────

TFileManager 主窗口

TFMForm 子窗口 Windows|New Window

TFileAttrForm 显示文件属性 File|PropertiesFunction|Search

TChangeForm 文件移动 拷贝 改名 改变 File|Move Cope Rename 当前目录等 *** 作的输入对话框 Directory|change Directory

TSearchForm 输入待查找文件的名称和路径 Function|Search

TDiskViewForm 显示磁盘信息 Function|Disk View

TViewDir 输入待创建的子目录 Directory|CreateDirectory

TAboutBox 显示版权信息 Help|About

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

界面设计

主窗口界面主要是主菜单和用于表示当前目录 当前文件的状态条

表 主窗口界面设计

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

部件 属性 功能

─────────────────────────────

FileManager Style=fsMDI 主窗口

WindowMenu=Windows

Position=poDefault

MainMenu 主菜单

FilePanel Align=alBottom 显示当前选中文件

BevelInner=bvLowered

BevelWidth=

DirectoryPanel Align=alBottom 显示当前选中目录

Alignment=taLeftJustify

BevelInner=bvLowered

BevelWidth=

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

主窗口主菜单包括File WIndows Help三项 File菜单项在子窗口生成时被子窗口同名菜单项所取代 设置Windows Help的GroupIndex = 可以使子窗口生成时这两个菜单项仍存在

子窗口界面包括主菜单 目录树（DirectoryOutline） 文件列表框 用于显示驱动器的标签集（TabSet）以及三个用于显示驱动器类型的TImage部件

表 子窗口界面设计

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

部件 属性 功能

───────────────────────────────────────

FMForm ActiveControl=DirectoryOutline 子窗口

Position=poDefault

Style=fsMDIChild

MainMenu 主菜单

DriveTabSet Align=alTop 显示驱动器

style=tsOwnerDraw

DirectoryOutline Align=alLeft 显示当前驱动器的目录树

options=[ooDrawTreeRoot

ooDrawFocusRect ooStretchBitmaps]

FileList Align=alClient 显示当前目录中的文件

FileType=[ftReadOnly

ftHidden ftSystem ftArchive ftNormal]

ShowGlyphs=True

Neork（Image） Picture（Neork bmp） 标志网络驱动器

Vsible=False

Floppy（Image） Picture（Floppy bmp） 标志软驱

Visible=False

Fixed（Image） Picture（Fixed bmp） 标志硬驱

Visible=False

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

lishixinzhi/Article/program/Delphi/201311/25238

---