dcfolderview.pas

获取硬盘相关详细信息

   end;
  FSize := TdcListColumn.Create(aFolderListView, False);
  with FSize do
   begin
    FCaption := 'Size';
    FWidth := 60;
    FAlignment := taRightJustify;
   end;
  FType := TdcListColumn.Create(aFolderListView, False);
  with FType do
   begin
    FCaption := 'Type';
    FWidth := 100;
   end;
  FModified := TdcListColumn.Create(aFolderListView, False);
  with FModified do
   begin
    FCaption := 'Modified';
    FWidth := 120;
   end;
  FAttributes := TdcListColumn.Create(aFolderListView, False);
  with FAttributes do
   begin
    FCaption := 'Attributes';
    FWidth := 50;
    FAlignment := taRightJustify;
    FVisible := False;
   end;
end;

destructor TdcListColumns.Destroy;
begin
  FAttributes.Free;
  FModified.Free;
  FType.Free;
  FSize.Free;
  FName.Free;
  inherited Destroy;
end;


{ Default sorting for FolderListView }
function DCFolderListViewSort(Item1, Item2: TListItem;
  lParam: Integer): Integer; stdcall;

  function IsFolder(ShObj: TdcShellObject): Boolean;
  begin
    Result := saDirectory in ShObj.Attributes
  end;

  function MyCompareStr(Str1, Str2: String): Integer;
  begin
    if (Str1 <> '') and (Str2 = '') then Result := -1
    else
     if (Str2 <> '') and (Str1 = '') then Result := 1
     else
       Result := AnsiCompareStr(Str1, Str2);
  end;

var
  Column: Integer;
  Str1, Str2: String;
  ShObj1, ShObj2: TdcShellObject;
begin
  with Item1 do
   if Assigned(TListView(ListView).OnCompare) then
     TListView(ListView).OnCompare(ListView, Item1, Item2, lParam, Result)
   else
    begin
     Result := 0;
     ShObj1 := Item1.Data;
     ShObj2 := Item2.Data;
     if (ShObj1 = nil) or (ShObj2 = nil) then Exit;

     Column := TdcFolderListView(ListView).ColumnOrders[LoWord(lParam)];
     case Column of
       { by size }
       1: if ShObj1.FileSize < ShObj2.FileSize then Result := -1
          else
           if ShObj1.FileSize > ShObj2.FileSize then Result := 1
           else Result := 0;

       { by type or attributes (by caption) }
       2, 4: begin
              Column := LoWord(lParam) - 1;

              if Item1.SubItems.Count > Column then
                Str1 := Item1.SubItems[Column]
              else
                Str1 := '';

              if Item2.SubItems.Count > Column then
                Str2 := Item2.SubItems[Column]
              else
                Str2 := '';

              Result := MyCompareStr(Str1, Str2);
             end;

       { by time }
       3: if ShObj1.FileTime < ShObj2.FileTime then Result := -1
          else
           if ShObj1.FileTime > ShObj2.FileTime then Result := 1
           else Result := 0;

       { by name }
       else
        { directory is top-priority thing }
        if IsFolder(ShObj1) and not IsFolder(ShObj2) then Result := -1
        else
         if not IsFolder(ShObj1) and IsFolder(ShObj2) then Result := 1
         else
          { now by name }
          Result := MyCompareStr(ShObj1.FileName, ShObj2.FileName);
      end;

     Result := Result * ShortInt(HiWord(lParam));
    end;
end;

{ TdcFolderListView }
constructor TdcFolderListView.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  inherited ViewStyle := vsIcon;
  DefaultSortProc := @DCFolderListViewSort;

  FFiles := TList.Create;
  FReportColumns := TdcListColumns.Create(Self);
  FDiskScanner := TdcDiskScanner.Create(Self);
  with FDiskScanner do
   begin
    SearchAttributes := [saNormal, saArchive, saReadOnly, saSystem, saHidden, saDirectory, saAny];
    ThreadPriority := tpTimeCritical;
    IncludeSubfolders := False;
    OnFileFound := FileFound;
    OnScanDone := ScanDone;
   end;

{$IFDEF D3}
  FShellProperties := TdcShellProperties.Create(Self);
  with FShellProperties do
   begin
    OnDelete := ContextMenuOnDelete;
    OnRename := ContextMenuOnRename;
   end;
{$ENDIF}   
   
  FFileAssociation := TdcFileAssociation.Create(Self);

  FLargeImages := GetSystemImageList(32);
  FSmallImages := GetSystemImageList(16);

  ShowAllFolders := True;
  FOptions := [floOpenFiles, floExploreFolders, floShowContextMenu, floAllowDelete];
  FKBStr := 'KB';
  IconOptions.AutoArrange := True;
end;

destructor TdcFolderListView.Destroy;
begin
  FFileAssociation.Free;
{$IFDEF D3}
  FShellProperties.Free;
{$ENDIF}  
  FDiskScanner.Free;
  FReportColumns.Free;
  FFiles.Free;
  inherited Destroy;
end;

procedure TdcFolderListView.Loaded;
begin
  inherited Loaded;

{$IFDEF D3}
  { can rename files? }
  with FShellProperties do
   if ReadOnly then
     MenuOptions := MenuOptions - [moCanRename]
   else
     MenuOptions := MenuOptions + [moCanRename];
{$ENDIF}     

  Refresh;
end;

procedure TdcFolderListView.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FFolderMonitor) then
    FFolderMonitor := nil;
end;

procedure TdcFolderListView.CreateWnd;
begin
  inherited CreateWnd;
  if FLargeImages <> 0 then
    SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, FLargeImages);
  if FSmallImages <> 0 then
    SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_SMALL, FSmallImages);
  Refresh;
end;

procedure TdcFolderListView.Edit(const Item: TLVItem);
var
  ShellObject: TdcShellObject;
  OldName, NewName, NewFileName: String;
begin
  if Selected = nil then Exit;
  ShellObject := Selected.Data;

  OldName := Selected.Caption;
  inherited Edit(Item);
  NewName := Selected.Caption;

  if NewName = '' then
   begin
    Selected.Caption := OldName;
    Exit;
   end;

  { rename file or directory }
  with ShellObject do
   try
     NewFileName := IncludeTrailingBackslash(ExtractFilePath(FileName)) +
                    NewName + ExtractFileExt(FileName);
     if MoveFile(PChar(FileName), PChar(NewFileName)) then
       FileName := NewFileName
     else
       Selected.Caption := OldName;
     AlphaSort;  
   except
   end;
end;

procedure TdcFolderListView.KeyDown(var Key: Word; Shift: TShiftState);
var
  ListItem: TListItem;
begin
  case Key of
    VK_RETURN: begin
                ListItem := Selected;
                if ListItem = nil then Exit;
{$IFDEF D3}
                if ssAlt in Shift then
                 begin
                  if not (floShowContextMenu in FOptions) then Exit;
                  FShellProperties.ShowPropertiesByFile(FileNameByListItem(ListItem));
                  Key := 0;
                 end
                else
{$ENDIF}
                  ExecuteListItem(ListItem);
               end;
    VK_BACK: if not IsEditing then Back;
    VK_DELETE: if (floAllowDelete in FOptions) and not IsEditing then DeleteSelectedFiles;
    VK_F5: Refresh;
   end;
end;

procedure TdcFolderListView.UpdateListItems;
var
  I: Integer;
  OldCursor: TCursor;
begin
  inherited;

  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;

  Items.BeginUpdate;
  Items.Clear;

  { filling the listview } 
  I := FFiles.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    TdcShellObject(FFiles[I]).ApplyToListView(Self);

  AlphaSort;
  Items.EndUpdate;
  Invalidate;

  Screen.Cursor := OldCursor;
end;

procedure TdcFolderListView.InitColumns;
begin
  with Columns, FReportColumns do
   begin
    BeginUpdate;
    try
      Clear;
      CurrentOrder := 0;
      FName.CreateColumn(Columns, 0);
      FSize.CreateColumn(Columns, 1);
      FType.CreateColumn(Columns, 2);
      FModified.CreateColumn(Columns, 3);
      FAttributes.CreateColumn(Columns, 4);

      UpdateListItems;
    finally
      EndUpdate;
    end;
    Invalidate;
   end;
end;

procedure TdcFolderListView.ExecuteListItem(ListItem: TListItem);
var
  FileName: String;
begin
  if ListItem = nil then Exit;

  FileName := FileNameByListItem(ListItem);
  if FileName = '' then Exit;
  
  if (floExploreFolders in FOptions) and
     (saDirectory in FileAttributesByListItem(ListItem)) then
   begin
    Folder := FileName;
    if Assigned(FOnFolderChanged) then
      FOnFolderChanged(Self, Folder);
    Exit; 
   end;
  if floOpenFiles in FOptions then
   try
     ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOWNORMAL);
   except
   end;
end;

function TdcFolderListView.IsBackPossible: Boolean;
begin
  Result := Length(Folder) > 3;
end;

procedure TdcFolderListView.Back;
begin
  if IsBackPossible then
   begin
    Folder := ExtractFilePath(ExcludeTrailingBackslash(Folder));
    if Assigned(FOnFolderChanged) then
      FOnFolderChanged(Self, Folder);
   end;
end;

procedure TdcFolderListView.SelectAll;
var
  I: Integer;
begin
  SetFocus;
  Items.BeginUpdate;
  try
    for I := 0 to Items.Count - 1 do
      Items[I].Selected := True;
  except
  end;
  Items.EndUpdate;
end;

procedure TdcFolderListView.UnselectAll;
var
  I: Integer;
begin
//  Items.BeginUpdate;
  try
    for I := 0 to Items.Count - 1 do
      Items[I].Selected := False;
  except
  end;
//  Items.EndUpdate;
end;

procedure TdcFolderListView.CreateFolder(FolderName: String; Edit: Boolean);
var
  FullFolderName: String;
  ShObject: TdcShellObject;
  ShInfo: TShFileInfo;
  FindHandle: THandle;
  FindData: TWin32FindData;

  function FindUnusedFolderName(FullFolderName: String): String;
  var iTry: Integer;
  begin
    if ObjectExists(FullFolderName) then
     begin
      iTry := 1;
      repeat
       Inc(iTry);
       Result := FullFolderName + ' (' + IntToStr(iTry) + ')';
      until not ObjectExists(Result) or (iTry = MaxInt);
     end
    else Result := FullFolderName;
  end;

begin
  if FolderName = '' then FolderName := 'New Folder';