请帮忙！

一,双击我的电脑
二,双击c:
三,关闭窗口
怎么样,ok了吧,哈哈

用Delphi实现Windows文件夹管理树
摘要：本文利用Windows名空间所提供的IShellFolder接口，用Delphi实现了文件夹管理树的生成。
关键字：文件夹  接口  Delphi

    一、概述
     Windows95/98视觉感观上区别Windows3.1的一个重要方面就是大量采用了树形视图控件，资源管理器左侧的文件夹管理树便是如此，它将本地和网络上的文件夹和文件等资源以层次树的方式罗列出来，为用户集中管理计算机提供了极大便利，同时在外貌上也焕然一新。Delphi为我们提供了大量Windows标准控件，但遗憾的是在目录浏览方面却只提供了一个Windows3.1样式的DirectoryListBox（Delphi5的测试版也是如此），因此，在Delphi中实现Windows文件夹管理树对开发更“地道”的Windows程序有着重大意义。
二、实现原理
Windows文件夹管理树的实现实质上是对Windows名空间（Namespace）的遍历。名空间中每个文件夹都提供了一个IShellFolder接口，遍历名空间的方法是：
1）调用SHGetDesktopFolder函数获得桌面文件夹的IShellFolder接口，桌面文件夹是文件夹管理树的根节点。
2）再调用所获得的IShellFolder接口的EnumObjects成员函数列举出子文件夹。
3）调用IShellFolder的BindToObject成员函数获得子文件夹的IShellFolder接口。
4）重复步骤2）、3）列举出某文件夹下的所有子文件夹，只至所获得的IShellFolder接口为nil为止。
下面解释将要用到的几个主要函数，它们在ShlObj单元中定义：
1）function SHGetDesktopFolder(var ppshf: IShellFolder): HResult;
该函数通过ppshf获得桌面文件夹的IShellFolder接口。
2）function IShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD;
                                out EnumIDList: IEnumIDList): HResult;
该函数获得一个IEnumIDList接口，通过调用该接口的Next等函数可以列举出IShellFolder接口所对应的文件夹的内容，内容的类型由grfFlags来指定。我们需要列举出子文件夹来，因此grfFlags的值指定为SHCONTF_FOLDERS。HwndOwner是属主窗口的句柄。
3）function IShellFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer;
                                const riid: TIID; out ppvOut: Pointer): HResult;
该函数获得某个子文件夹的IShellFolder接口，该接口由ppvOut返回。pidl是一个指向元素标识符列表的指针，Windows95/98中用元素标识符和元素标识符列表来标识名空间中的对象，它们分别类似于文件名和路径。需要特别指出的是：pidl作为参数传递给Shell API函数时，必须是相对于桌面文件夹的绝对路径，而传递给IShellFolder接口的成员函数时，则应是相对于该接口所对应文件夹的相对路径。pbcReserved应指定为nil，riid则应指定为IID_IShellFolder。
其它函数可以查阅Delphi提供的《Win32 Programmer's Reference》。
三、程序清单
下面的源代码在Windows98中实现，并在Windows2000测试版中测试无误(程序运行结果如图1所示)，有兴趣的读者可以将其改写成Delphi组件，以备常用。
unit BrowseTreeView;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShlObj, ComCtrls;
type
  PTreeViewItem = ^TTreeViewItem;
  TTreeViewItem = record
    ParentFolder: IShellFolder;  // 接点对应的文件夹的父文件夹的IShellFolder接口
    Pidl, FullPidl: PItemIDList;  // 接点对应的文件夹的相对和绝对项目标识符列表
    HasExpanded: Boolean;   // 接点是否展开
  end;

程序运行结果

TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
  private
    FItemList: TList;
    procedure SetTreeViewImageList;
    procedure FillTreeView(Folder: IShellFolder;  FullPIDL: PItemIDList;  ParentNode: TTreeNode);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
uses
  ActiveX, ComObj, ShellAPI, CommCtrl;
// 以下是几个对项目标识符进行操作的函数
procedure DisposePIDL(ID: PItemIDList);
var
  Malloc: IMalloc;
begin
  if ID = nil then Exit;
  OLECheck(SHGetMalloc(Malloc));
  Malloc.Free(ID);
end;
function CopyItemID(ID: PItemIDList): PItemIDList;
var
  Malloc: IMalloc;
begin
  Result := nil;
  OLECheck(SHGetMalloc(Malloc));
  if Assigned(ID) then
  begin
    Result := Malloc.Alloc(ID^.mkid.cb + sizeof(ID^.mkid.cb));
    CopyMemory(Result, ID, ID^.mkid.cb + sizeof(ID^.mkid.cb));
  end;
end;
function NextPIDL(ID: PItemIDList): PItemIDList;
begin
  Result := ID;
  Inc(PChar(Result), ID^.mkid.cb);
end;
function GetPIDLSize(ID: PItemIDList): Integer;
begin
  Result := 0;
  if Assigned(ID) then
  begin
    Result := sizeof(ID^.mkid.cb);
    while ID^.mkid.cb <> 0 do
    begin
      Inc(Result, ID^.mkid.cb);
      ID := NextPIDL(ID);
    end;
  end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
var
  Malloc: IMalloc;
  HR: HResult;
begin
  Result := nil;
  HR := SHGetMalloc(Malloc);
  if Failed(HR) then Exit;
  try
    Result := Malloc.Alloc(Size);
    if Assigned(Result) then
      FillChar(Result^, Size, 0);
  finally
  end;
end;
function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList;
var
  cb1, cb2: Integer;
begin
  if Assigned(ID1) then
    cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb)
  else
    cb1 := 0;
  cb2 := GetPIDLSize(ID2);
  Result := CreatePIDL(cb1 + cb2);
  if Assigned(Result) then
  begin
    if Assigned(ID1) then
      CopyMemory(Result, ID1, cb1);

    CopyMemory(PChar(Result) + cb1, ID2, cb2);
  end;
end;
// 将二进制表示的项目标识符列表转换成有可识的项目名
function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList;
                        ForParsing: Boolean): String;
var
  StrRet: TStrRet;
  P: PChar;
  Flags: Integer;
begin
  Result := '';
  if ForParsing then
    Flags := SHGDN_FORPARSING
  else
    Flags := SHGDN_NORMAL;
  Folder.GetDisplayNameOf(PIDL, Flags, StrRet);
  case StrRet.uType of
    STRRET_CSTR:
      SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
    STRRET_OFFSET:
    begin
      P := @PIDL.mkid.abID[StrRet.uOffset - sizeof(PIDL.mkid.cb)];
      SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
    end;
    STRRET_WSTR:
      Result := StrRet.pOleStr;
  end;
end;
function GetIcon(PIDL: PItemIDList; Open: Boolean): Integer;
const
  IconFlag = SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  if Open then
    Flags := IconFlag or SHGFI_OPENICON
  else
    Flags := IconFlag;

  SHGetFileInfo(PChar(PIDL), 0, FileInfo, sizeof(TSHFileInfo), Flags);
  Result := FileInfo.iIcon;
end;
// 获得每个文件夹在系统中的图标
procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
begin
  with TreeNode do
  begin
    ImageIndex := GetIcon(FullPIDL, False);
    SelectedIndex := GetIcon(FullPIDL, True);
  end;
end;
// 获得系统的图标列表
procedure TForm1.SetTreeViewImageList;
var
  ImageList: THandle;
  FileInfo: TSHFileInfo;
begin
  ImageList := SHGetFileInfo(PChar('C:\'), 0, FileInfo,
                 sizeof(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  if ImageList <> 0 then
    TreeView_SetImageList(TreeView1.Handle, ImageList, 0);
end;
// 生成文件夹管理树
procedure TForm1.FillTreeView(Folder: IShellFolder;
                           FullPIDL: PItemIDList;  ParentNode: TTreeNode);
var
  TreeViewItem: PTreeViewItem;
  EnumIDList: IEnumIDList;
  PIDLs, FullItemPIDL: PItemIDList;
  NumID: LongWord;
  ChildNode: TTreeNode;
  Attr: Cardinal;
begin
  try
    OLECheck(Folder.EnumObjects(Handle, SHCONTF_FOLDERS, EnumIDList));
    while EnumIDList.Next(1, PIDLs, NumID) = S_OK do
    begin
      FullItemPIDL := ConcatPIDLs(FullPIDL, PIDLs);
      TreeViewItem := New(PTreeViewItem);
      TreeViewItem.ParentFolder := Folder;
      TreeViewItem.Pidl := CopyItemID(PIDLs);
      TreeViewItem.FullPidl := FullItemPIDL;
      TreeViewItem.HasExpanded := False;
      FItemList.Add(TreeViewItem);
      ChildNode := TreeView1.Items.AddChildObject(ParentNode,
                        GetDisplayName(Folder, PIDLs, False), TreeViewItem);
      GetItemIcons(FullItemPIDL, ChildNode);
      Attr := SFGAO_HASSUBFOLDER or SFGAO_FOLDER;
      Folder.GetAttributesOf(1, PIDLs, Attr);
      if Bool(Attr and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) then
        if Bool(Attr and SFGAO_FOLDER) then
          if Bool(Attr and SFGAO_HASSUBFOLDER) then
          ChildNode.HasChildren := True;
    end;
  except
    // 你可在此处对异常进行处理
  end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  try
    for I := 0 to FItemList.Count-1 do
    begin
      DisposePIDL(PTreeViewItem(FItemList[i]).PIDL);
      DisposePIDL(PTreeViewItem(FItemList[i]).FullPIDL);
    end;
  FItemList.Clear;
  FItemList.Free;
  except
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  Folder: IShellFolder;
begin
  SetTreeViewImageList;
  OLECheck(SHGetDesktopFolder(Folder));
  FItemList := TList.Create;
  FillTreeView(Folder, nil, nil);
end;
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  TVItem: PTreeViewItem;
  SHFolder: IShellFolder;
begin
  TVItem := PTreeViewItem(Node.Data);
  if TVItem.HasExpanded then Exit;
  OLECheck(TVItem.ParentFolder.BindToObject(TVItem^.Pidl,
                   nil, IID_IShellFolder, Pointer(SHFolder)));
  FillTreeView(SHFolder, TVItem^.FullPidl, Node);
  Node.AlphaSort;
  TVItem^.HasExpanded := True;
end;
end.

好的，你既然说清楚了，我也不胡说了。
WinExec('Explorer.exe c:\',sw_show)

谢谢你，fim，你帮了我一个忙，还有一个问题：就是我如何在程序中让光驱弹出呀？

http://expert.csdn.net/Expert/topic/2463/2463284.xml?temp=.592724

解决方案 »