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方法即可

[]  []  []  []  

From:http://tw.wingwit.com/Article/program/Delphi/201311/25234.html