foldertree.pas

来自「功能强大的报表生成和管理工具」· PAS 代码 · 共 1,285 行 · 第 1/3 页

unit FolderTree;

//  Change log
//     12/14/1999 -- Moved allocation of TStringList in FindPath routine
//                   to fix a memory leak.
//     03/15/2000 -- Exposed OnDblClick.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ShlObj, ShellAPI, OLE2;

const
  WM_DIRCHANGE   = WM_USER + 0;
  WM_SHOWDESKTOP = WM_USER + 1;

 (* Events of WM_DEVICECHANGE (wParam) *)

  DBT_DEVICEARRIVAL = $8000;            (* system detected a new device *)
  DBT_DEVICEQUERYREMOVE = $8001;        (* wants to remove, may fail *)
  DBT_DEVICEQUERYREMOVEFAILED = $8002;  (* removal aborted *)
  DBT_DEVICEREMOVEPENDING = $8003;      (* about to remove, still avail *)
  DBT_DEVICEREMOVECOMPLETE = $8004;     (* device is gone *)
  DBT_DEVICETYPESPECIFIC = $8005;       (* type specific event *)
  DBT_CONFIGCHANGED = $0018;

 (* type of device in DEV_BROADCAST_HDR *)
  DBT_DEVTYP_OEM = $00000000;           (* OEM- or IHV-defined *)
  DBT_DEVTYP_DEVNODE = $00000001;       (* Devnode number *)
  DBT_DEVTYP_VOLUME = $00000002;        (* Logical volume *)
  DBT_DEVTYP_PORT = $00000003;          (* Port (serial or parallel *)
  DBT_DEVTYP_NET = $00000004;           (* Network resource *)

  (* media types in DBT_DEVTYP_VOLUME *)
  DBTF_MEDIA = $0001;
  DBTF_NET = $0002;                     (* logical volume is network volume *)

type
 PDEV_BROADCAST_HDR = ^TDEV_BROADCAST_HDR;
 TDEV_BROADCAST_HDR = packed record
   dbch_size : DWORD;
   dbch_devicetype : DWORD;
   dbch_reserved : DWORD;
  end;

  PDEV_BROADCAST_VOLUME = ^TDEV_BROADCAST_VOLUME;
  TDEV_BROADCAST_VOLUME = packed record
   dbcv_size : DWORD;
   dbcv_devicetype : DWORD;
   dbcv_reserved : DWORD;
   dbcv_unitmask : DWORD;
   dbcv_flags : WORD;
  end;

  TWMDeviceChange = record
   Msg : Cardinal;
   Event : UINT;
   dwData : Pointer;
   Result : LongInt;
  end;

  TWM_DIRCHANGE = record
    Msg    : word;         { first is the message ID }
    fill   : integer;      { unused }
    Node   : TTreeNode;    { Node whose structure changed }
    result : longint;
  end;

  TWM_SHOWDESKTOP = record
    Msg    : word;         { first is the message ID }
    fill1  : word;         { unused }
    fill2  : longint;      { unused }
    result : longint;
  end;

type
  TPathInfo = record
     Path      : string;
     Text      : string;
     IconIndex : uInt;
     SelectedIndex : uInt;
     Pid           : PItemIdList;
  end;

type
  TDisplayMode = (dmAsis,dmUppercase,dmLowercase);
  TFilePathList = record
     Normal     : string;
     ForParsing : string;
     InFolder   : string;
  end;

  TFolderType  = (ftFolder,ftNetworkNeighborhood,ftRecycleBin,ftMyComputer,ftDesktop,
                  ftNetNode,ftNone);
  SFolderTypes  = set of TFolderType;
  TFolderOption = (foNetworkNeighborhood,foRecycleBin);
  SFolderOption = set of TFolderOption;


type
  TFolderTree = class(TCustomTreeView)
  private
     DesktopNode      : TTreeNode;
     MyComputerNode   : TTreeNode;
     NetHoodNode      : TTreeNode;
     BitBucketNode    : TTreeNode;
     SysImageList     : TImageList;
     fDesktopPath     : string;
     fNetHoodPath     : string;
     fMessageHandle : hWnd;
     fDisplayMode         : TDisplayMode;
     fFolderOptions       : SFolderOption;
     AllocInterface            : IMalloc;
     function  fGetNetHood         : TPathInfo;
     function  fGetSpecialFolder(nFolder : integer) : TPathInfo;
     function  CreateFolderNode(PidList   : PItemIdList;
                          parent    : TTreeNode;
                          virtualok : boolean) : TTreeNode;
     procedure RetrieveSysImageList;
     procedure ShowDesktop;
     function  GetLongFilePath(const Pid : PItemIdList;
                                     ShellFolder : IShellFolder)
                                          : TFilePathList;
     function  GetPathName(const Pid : PItemIdList; Flags : dword;
                                 ShellFolder : IShellFolder) : string;
     function  AttachFolders(var Node : TTreeNode) : boolean;
     function  GetVol_Ser (drive : string) : longint;
     function  FindPath(path : string) : TTreeNode;
     procedure MessageProc(Var Message : TMessage);
     procedure StartChangeThread(Node : TTreeNode);
     procedure FreePidl(pidl : PItemIdList);
     procedure FreeChildren(Node : TTreeNode);
     procedure FreeNode(Node : TTreeNode);
     procedure DriveChanged(Sender: TObject; FirstDriveLetter: Char);
     procedure TFolderTreeExpanding(Sender: TObject; Node: TTreeNode;
         var AllowExpansion: Boolean);
     procedure TFolderTreeClick(Sender: TObject);
     function  GetDirectory : string;
     function  GetFirstDriveLetter(unitmask:longint):char;
     procedure WMDeviceChange(var Msg : TWMDeviceChange); dynamic;
    { Private declarations }
  protected
    { Protected declarations }
  public
    property Items;
    property Selected;
    property Directory : string read GetDirectory;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function  SetDirectory(path : string) : TTreeNode;
    function  GetPath (Node : TTreeNode) : string;
    function NodeShellFolder (Node : TTreeNode)  : IShellFolder;
    function NodeType (Node : TTreeNode)         : TFolderType;
    function NodeItemIdList (Node : TTreeNode)   : PItemIdList;
    { Public declarations }
  published
    property FolderOptions : SFolderOption read fFolderOptions
                              write fFolderOptions;
    property OnChange;
    property OnDblClick;
    property OnDragOver;
    property OnDragDrop;
    property DisplayMode : TDisplayMode read fDisplayMode write fDisplayMode
                               default dmAsis;
    property ShowButtons;
    property ShowLines;
    property ShowRoot;
    property HideSelection;
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Indent;
    property OnEnter;
    property OnExit;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
    { Published declarations }
  end;

type
  TThDirChange = class(TThread)
  private
  protected
    procedure Execute; override;
  private
    procedure DoOnChange;
  public
    Node       :  TTreeNode;
    FolderTree :  TFolderTree;
    msghandle  :  hwnd;
  end;

type
  TFolderNode = record
     FN_Path         : string;
     FN_Has_Parent   : boolean;
     FN_Change_Thread : TThDirChange;
     FN_Vol_Ser       : longint;
     FN_ShellFolder   : IShellFolder;
     FN_Type          : TFolderType;
     FN_PidLen        : word;
     FN_PidList       : PItemIdList;
end;

procedure Register;

implementation

const
   VirtualFolders = [ftNetworkNeighborhood,ftNetNode,ftRecycleBin,ftMyComputer];

constructor TFolderTree.Create(AOwner : TComponent);
begin
   inherited Create(AOwner);
   fFolderOptions := [];
   fDisplayMode   := dmAsis;
   CoGetMalloc(MEMCTX_TASK, AllocInterface);
   self.parent      := (AOwner as TForm);
   fMessageHandle := AllocateHWnd(MessageProc);
   self.OnExpanding  := TFolderTreeExpanding;
   self.OnClick     := TFolderTreeClick;
   self.ReadOnly    := true;

   // Get the system image list.
   RetrieveSysImageList;
   with SysImageList do begin
      masked   := false;
      shareimages := true;
   end;
   self.Images := SysImageList;
   PostMessage(fMessageHandle,WM_SHOWDESKTOP,0,0);
end;


// ShowDesktop is performed when Create posts a WM_SHOWDESKTOP
// message, so we see the correct value of fFolderOptions.
procedure TFolderTree.ShowDesktop;
var
   i               : byte;
   nodeptr         : ^TFolderNode;
   pathinfo        : TPathInfo;
   displayname     : string;
   drivenode       : TTreeNode;
   foldernode      : ^TFolderNode;
   path            : string;
   AllowExpansion  : boolean;
   FilePath        : TFilePathList;
   ShellFolder     : IShellFolder;

begin
   Items.BeginUpdate;

   // Establish the node for the Desktop.
   pathinfo := fGetSpecialFolder(CSIDL_DESKTOP);
   fDesktopPath := pathinfo.path;
   DesktopNode := CreateFolderNode(pathinfo.pid,nil,true);  // Create a node for the Desktop
   foldernode  := DesktopNode.data;
   FilePath := GetLongFilePath(pathinfo.pid,foldernode^.FN_ShellFolder);
   with DesktopNode do begin
        text := FilePath.Normal;

        // Set FN_Path to the path name of the desktop, and indicate
        // it is the desktop.
        foldernode := data;
        with foldernode^ do begin
             FN_Path       := fDesktopPath;
             FN_Type       := ftDesktop;
        end;
   end;

   // Add real folders on the desktop to the Desktop node, then
   // alphabetize.
   AttachFolders(DesktopNode);

   // Establish the node for the Recycle Bin, if so desired.
   if not (csDesigning in ComponentState) then begin
      if foRecycleBin in fFolderOptions then begin
         pathinfo := fGetSpecialFolder(CSIDL_BITBUCKET);
         BitBucketNode := CreateFolderNode(pathinfo.pid,DesktopNode,true);  // Create a node for the BitBucket
         foldernode := DesktopNode.data;
         FilePath := GetLongFilePath(pathinfo.pid,foldernode^.FN_ShellFolder);
         with BitBucketNode do begin
              text := FilePath.Normal;

              // Set FN_Path null, and indicate it is the BitBucket.
              foldernode := data;
              with foldernode^ do begin
                   FN_Path       := '';
                   FN_Type       := ftRecycleBin;
              end;
         end;
      end;
   end;

   // Establish the node for the NetHood if so desired.
   if not (csDesigning in ComponentState) then begin
      if foNetworkNeighborhood in fFolderOptions then begin
         pathinfo := fGetNetHood;
         fNetHoodPath := pathinfo.path;
         NetHoodNode := CreateFolderNode(pathinfo.pid,DesktopNode,true);  // Create a node for the NetHood
         with NetHoodNode do begin
              text := pathinfo.text;

              // Set FN_Path to \\, which is the root of Network
              // Neighborhood, and set FN_Type to shows it is the NetHood.
              foldernode := data;
              with foldernode^ do begin
                   FN_Path       := '\\';
                   FN_Type       := ftNetworkNeighborhood;
              end;
         end;
      end;
   end;

   // Attach the MyComputer node to the Desktop node.
   pathinfo := fGetSpecialFolder(CSIDL_DRIVES);
   MyComputerNode := CreateFolderNode(pathinfo.pid,DesktopNode,true);  // Create a node for the Desktop
   foldernode     := DesktopNode.data;
   FilePath := GetLongFilePath(pathinfo.pid, foldernode^.FN_ShellFolder);
   with MyComputerNode do begin
        text := FilePath.Normal;

        // Set FN_Path to a null string, and the type to ftMyComputer.
        foldernode := data;
        with foldernode^ do begin
             FN_Path       := '';
             FN_Type       := ftMyComputer;
        end;
   end;

   // Expand the Desktop node.
   DesktopNode.expand(false);
   Items.EndUpdate;
end;

function  TFolderTree.fGetNetHood   : TPathInfo;
var
    pi  : TPathInfo;
    FilePath : TFilePathList;
begin
    result := fGetSpecialFolder(CSIDL_NETWORK);
    FilePath := GetLongFilePath(result.pid,nil);
    result.text := FilePath.Normal;
end;

function TFolderTree.fGetSpecialFolder(nFolder : integer) : TPathInfo;
var
  aPidl: PItemIDList;
  TC     : TComponent;
  fLinkDir : string;
  FileInfo  : TSHFileInfo;
  r         : boolean;
begin
  // Get the folder location (as a PItemIDList)
  if SUCCEEDED(SHGetSpecialFolderLocation(self.parent.handle, nFolder, aPidl))
     then begin
       result.Pid := aPidl;

    // Get the actual path of the directory from the PItemIDList
       SetLength(fLinkDir, MAX_PATH); // SHGetPathFromIDList assumes MAX_PATH buffer
       SHGetPathFromIDList(aPidl, PChar(fLinkDir)); // Do it
       SetLength(fLinkDir, StrLen(PChar(fLinkDir)));
       Result.Path := fLinkDir;

       SHGetFileInfo(Pointer(aPidl),SFGAO_SHARE, FileInfo, sizeof(FileInfo),
              SHGFI_PIDL or SHGFI_SYSICONINDEX );
       Result.IconIndex:=FileInfo.iIcon;

       SHGetFileInfo(Pointer(aPidl),SFGAO_SHARE, FileInfo, sizeof(FileInfo),
              SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_OPENICON);
       Result.SelectedIndex:=FileInfo.iIcon;
  end;
end;

// CreateFolderNode creates a Folder_Node and inserts it under
// the "parent" node (if any), using the last of the path
// string as the Name, and setting the new node's text
// property to match.
function TFolderTree.CreateFolderNode(PidList   : PItemIdList;
                                parent    : TTreeNode;
                                virtualok : boolean) : TTreeNode;
var
   filename  : string;
   path      : string;
   NewNodeData : ^TFolderNode;
   ParentNodeData   : ^TFolderNode;
   DesktopNodeData  : ^TFolderNode;
   FileInfo  : TSHFileInfo;
   ImageIndex: Uint;
   SelectedIndex : Uint;
   newnode   : TTreeNode;
   pidl      : PItemIdList;
   parentfolder    : IShellFolder;
   ShellFolder     : IShellFolder;
   Attributes      : uint;
   FilePath        : TFilePathList;
   virtualfolder   : boolean;
   pidlen          : word;
   parentpidlen    : word;
   parentpidbuf    : PItemIdList;
   pidbuf          : PItemIdList;
   itemid          : TSHItemID;
begin
   result := nil;
   try
      // Get the Long File Path for the PidList passed.
      if assigned(parent)
         then begin
                ParentNodeData  := parent.data;
                FilePath := GetLongFilePath(PidList,ParentNodeData^.FN_ShellFolder);
         end
         else
             FilePath := GetLongFilePath(PidList,nil);
      filename := FilePath.InFolder;
      path     := FilePath.ForParsing;

      // Get the attributes we're interested in for this folder.
      Attributes := SFGAO_SHARE or SFGAO_FILESYSTEM