vlistview.pas

用delphi编成的文件管理器

  begin
    ID := ShellItem(ListView.Selected.Index).ID;
    if not IsFolder(FIShellFolder, ID) then Exit;
    RootPIDL := ConcatPIDLs(FPIDL, ID);
    SetPath(RootPIDL);
  end;
end;

function TForm1.ShellItem(Index: Integer): PShellItem;
begin
  Result := PShellItem(FIDList[Index]);
end;

procedure TForm1.ListViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      ListViewDblClick(Sender);
    VK_BACK:
      btnBackClick(Sender);  
  end;
end;

//SHELL-RELATED ROUTINES.

procedure TForm1.ClearIDList;
var
  I: Integer;
begin
  for I := 0 to FIDList.Count-1 do
  begin
    DisposePIDL(ShellItem(I).ID);
    Dispose(ShellItem(I));
  end;
  FIDList.Clear;
end;

procedure TForm1.PopulateIDList(ShellFolder: IShellFolder);
const
  Flags = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN;
var
  ID: PItemIDList;
  EnumList: IEnumIDList;
  NumIDs: LongWord;
  SaveCursor: TCursor;
  ShellItem: PShellItem;
begin
  SaveCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourglass;
    OleCheck(
      ShellFolder.EnumObjects(
        Application.Handle,
        Flags,
        EnumList)
    );

    FIShellFolder := ShellFolder;
    ClearIDList;
    while EnumList.Next(1, ID, NumIDs) = S_OK do
    begin
      ShellItem := New(PShellItem);
      ShellItem.ID := ID;
      ShellItem.DisplayName := GetDisplayName(FIShellFolder, ID, False);
      ShellItem.Empty := True;
      FIDList.Add(ShellItem);
    end;

    FIDList.Sort(ListSortFunc);

    //We need to tell the ListView how many items it has.
    ListView.Items.Count := FIDList.Count;

    ListView.Repaint;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

procedure TForm1.SetPath(const Value: string);
var
  P: PWideChar;
  NewPIDL: PItemIDList;
  Flags,
  NumChars: LongWord;
begin
  NumChars := Length(Value);
  Flags := 0;
  P := StringToOleStr(Value);

  OLECheck(
    FIDesktopFolder.ParseDisplayName(
      Application.Handle,
      nil,
      P,
      NumChars,
      NewPIDL,
      Flags)
   );
  SetPath(NewPIDL);
end;

procedure TForm1.SetPath(ID: PItemIDList);
var
  Index: Integer;
  NewShellFolder: IShellFolder;
begin
   OLECheck(
     FIDesktopFolder.BindToObject(
            ID,
            nil,
            IID_IShellFolder,
            Pointer(NewShellFolder))
   );

  ListView.Items.BeginUpdate;
  try
    PopulateIDList(NewShellFolder);
    FPIDL := ID;
    FPath := GetDisplayName(FIDesktopFolder, FPIDL, True);
    {Index := cbPath.Items.IndexOf(FPath);
    if (Index < 0) then
    begin
      cbPath.Items.InsertObject(0, FPath, Pointer(FPIDL));
      cbPath.Text := cbPath.Items[0];
    end
    else begin
      cbPath.ItemIndex := Index;
      cbPath.Text := cbPath.Items[cbPath.ItemIndex];
    end;}

    if ListView.Items.Count > 0 then
    begin
      ListView.Selected := ListView.Items[0];
      ListView.Selected.Focused := True;
      ListView.Selected.MakeVisible(False);
    end;
  finally
    ListView.Items.EndUpdate;
  end;
end;

//ROUTINES FOR MANAGING VIRTUAL DATA

procedure TForm1.CheckShellItems(StartIndex, EndIndex: Integer);

 function ValidFileTime(FileTime: TFileTime): Boolean;
 begin
   Result := (FileTime.dwLowDateTime <> 0) or (FileTime.dwHighDateTime <> 0);
 end;

var
  FileData: TWin32FindData;
  FileInfo: TSHFileInfo;
  SysTime: TSystemTime;
  I: Integer;
  LocalFileTime: TFILETIME;
begin
  //Here all the data that wasn't initialized in PopulateIDList is
  //filled in.
  for I := StartIndex to EndIndex do
  begin
    if ShellItem(I)^.Empty then
    with ShellItem(I)^ do
    begin
      FullID := ConcatPIDLs(FPIDL, ID);
      ImageIndex := GetShellImage(FullID, ListView.ViewStyle = vsIcon, False);

      //File Type
      SHGetFileInfo(
        PChar(FullID),
        0,
        FileInfo,
        SizeOf(FileInfo),
        SHGFI_TYPENAME or SHGFI_PIDL
      );
      TypeName := FileInfo.szTypeName;

      //Get File info from Windows
      FillChar(FileData, SizeOf(FileData), #0);
      SHGetDataFromIDList(
        FIShellFolder,
        ID,
        SHGDFIL_FINDDATA,
        @FileData,
        SizeOf(FileData)
      );

      //File Size, in KB
      Size := (FileData.nFileSizeLow + 1023 ) div 1024;
      if Size = 0 then Size := 1;

      //Modified Date
      FillChar(LocalFileTime, SizeOf(TFileTime), #0);
      with FileData do
        if ValidFileTime(ftLastWriteTime)
        and FileTimeToLocalFileTime(ftLastWriteTime, LocalFileTime)
        and FileTimeToSystemTime(LocalFileTime, SysTime) then
        try
          ModDate := DateTimeToStr(SystemTimeToDateTime(SysTime))
        except
          on EConvertError do ModDate := '';
        end
        else
          ModDate := '';

      //Attributes
      Attributes := FileData.dwFileAttributes;

      //Flag this record as complete.
      Empty := False;
    end;
  end;
end;

procedure TForm1.ListViewDataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
begin
  //OnDataHint is called before OnData. This gives you a chance to
  //initialize only the data structures that need to be drawn.
  //You should keep track of which items have been initialized so no
  //extra work is done.
  if (StartIndex > FIDList.Count) or (EndIndex > FIDList.Count) then Exit;
  CheckShellItems(StartIndex, EndIndex);
end;

procedure TForm1.ListViewData(Sender: TObject; Item: TListItem);
var
  Attrs: string;
begin
  //OnData gets called once for each item for which the ListView needs
  //data. If the ListView is in Report View, be sure to add the subitems.
  //Item is a "dummy" item whose only valid data is it's index which
  //is used to index into the underlying data.
  if (Item.Index > FIDList.Count) then Exit;
  with ShellItem(Item.Index)^ do
  begin
    Item.Caption := DisplayName;
    Item.ImageIndex := ImageIndex;

    if ListView.ViewStyle <> vsReport then Exit;

    if not IsFolder(FIShellFolder, ID) then
      Item.SubItems.Add(Format('%dKB', [Size]))
    else
      Item.SubItems.Add('');
    Item.SubItems.Add(TypeName);
    try
      Item.SubItems.Add(ModDate);
    except
    end;

    if Bool(Attributes and FILE_ATTRIBUTE_READONLY) then Attrs := Attrs + 'R';
    if Bool(Attributes and FILE_ATTRIBUTE_HIDDEN) then Attrs := Attrs + 'H';
    if Bool(Attributes and FILE_ATTRIBUTE_SYSTEM) then Attrs := Attrs + 'S';
    if Bool(Attributes and FILE_ATTRIBUTE_ARCHIVE) then Attrs := Attrs + 'A';
  end;
  Item.SubItems.Add(Attrs);
end;

procedure TForm1.ListViewDataFind(Sender: TObject; Find: TItemFind;
  const FindString: String; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
  var Index: Integer);
//OnDataFind gets called in response to calls to FindCaption, FindData,
//GetNearestItem, etc. It also gets called for each keystroke sent to the
//ListView (for incremental searching)
var
  I: Integer;
  Found: Boolean;
begin
  I := StartIndex;
  if (Find = ifExactString) or (Find = ifPartialString) then
  begin
    repeat
      if (I = FIDList.Count-1) then
        if Wrap then I := 0 else Exit;
      Found := Pos(UpperCase(FindString), UpperCase(ShellItem(I)^.DisplayName)) = 1;
      Inc(I);
    until Found or (I = StartIndex);
    if Found then Index := I-1;
  end;
end;

procedure TForm1.ListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  Attrs: Integer;
begin
  if Item = nil then Exit;
  Attrs := ShellItem(Item.Index).Attributes;
  if Bool(Attrs and FILE_ATTRIBUTE_READONLY) then
    ListView.Canvas.Font.Color := clGrayText;
  if Bool(Attrs and FILE_ATTRIBUTE_HIDDEN) then
    ListView.Canvas.Font.Style :=
       ListView.Canvas.Font.Style + [fsStrikeOut];
  if Bool(Attrs and FILE_ATTRIBUTE_SYSTEM) then
    Listview.Canvas.Font.Color := clHighlight;
end;

procedure TForm1.ListViewCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  if SubItem = 0 then Exit;
  ListView.Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
  //workaround for Win98 bug.
end;

procedure TForm1.btnBackClick(Sender: TObject);
var
  Temp: PItemIDList;
begin
  Temp := CopyPIDL(FPIDL);
  if Assigned(Temp) then
    StripLastID(Temp);
  if Temp.mkid.cb <> 0 then
    SetPath(Temp)
  else
    Beep;
end;

procedure TForm1.Form1Close(Sender: TObject; var Action: TCloseAction);
begin
  ClearIDList;
  FIDList.Free;
end;

procedure TForm1.O1Click(Sender: TObject);
begin
     with Listview do
  begin
    if HasAttr(FileName, faDirectory) then
      DirectoryOutline.Directory := FileName
    else ExecuteFile(FileName, '', Directory, SW_SHOW);
  end;

end;

end.