⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dcfolderview.pas

📁 获取硬盘相关详细信息
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  FullFolderName := FindUnusedFolderName(IncludeTrailingBackslash(Folder) + FolderName);
  FolderName := ExtractFileName(FullFolderName);
  if CreateDirectory(PChar(FullFolderName), nil) then
   begin
    { checking the created folder to retrieve information }
    FindHandle := FindFirstFile(PChar(FullFolderName), FindData);
    if FindHandle <> INVALID_HANDLE_VALUE then
     with FindData do
      begin
       Windows.FindClose(FindHandle);

       { retrieving the folder information and adding to internal list }
       ShGetFileInfo(PChar(FullFolderName), 0, ShInfo, SizeOf(TShFileInfo), SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
       ShObject := TdcShellObject.Create(FullFolderName, ShInfo.szTypeName,
          0, UTCFileTimeToDateTime(FindData.ftLastWriteTime),
          [saDirectory], ShInfo.iIcon);
       FFiles.Add(ShObject);

       { adding list item}
       if Edit then
         TListItem(ShObject.ApplyToListView(Self)).EditCaption;
      end;
   end;
end;

procedure TdcFolderListView.CreateShortcut;
begin
  try
    WinExec(PChar('rundll32 appwiz.cpl,NewLinkHere ' + Folder), SW_SHOWNORMAL);
  except
  end;
end;

{$IFDEF D3}
procedure TdcFolderListView.ShowFolderProperties;
begin
  FShellProperties.ShowPropertiesByFile(Folder);
end;

procedure TdcFolderListView.ShowItemProperties;
begin
  if Selected <> nil then
    FShellProperties.ShowPropertiesByFile(FileNameByListItem(Selected));
end;
{$ENDIF}

procedure TdcFolderListView.Refresh;
begin
  if not (csLoading in ComponentState) and
     not (csReading in ComponentState) and
     not FDiskScanner.Busy and not Busy then
   begin
    Busy := True;
    ListUpdated := True;
    if Columns.Count = 0 then InitColumns;

    if Assigned(FOnBeginUpdate) then
      FOnBeginUpdate(Self);

    if Assigned(FFolderMonitor) then
     begin
      FFolderMonitor.Active := False;
      FFolderMonitor.Folder := Folder;
     end;

    if not (csDesigning in ComponentState) then
     begin
      OldControlCursor := Cursor;
      Cursor := crHourglass;
     end; 

    Items.BeginUpdate;
    FFiles.Clear;
    Items.Clear;
    Items.EndUpdate;

    FDiskScanner.Execute;
   end;
end;


{ event handlers }
procedure TdcFolderListView.ScanDone(Sender: TObject; TotalFiles: Integer;
  const TotalSize: Extended; ElapsedTimeInSeconds: Integer);
begin
  UpdateListItems;
  if not (csDesigning in ComponentState) then
    Cursor := OldControlCursor;

  if Assigned(FFolderMonitor) then
    FFolderMonitor.Active := True;

  if Assigned(FOnEndUpdate) then
    FOnEndUpdate(Self);
  Busy := False;  
end;

procedure TdcFolderListView.FileFound(Sender: TObject;
  const FileName, FileType: String;
  const FileSize: Extended; const FileTime: TDateTime;
  const FileAttributes: TdcScanAttributes;
  const LargeIcon, SmallIcon: TIcon; SysImageIndex: Integer;
  TotalFiles: Integer; const TotalSize: Extended);
var
  ShellObject: TdcShellObject;
begin
  ShellObject := TdcShellObject.Create(FileName, FileType,
       FileSize, FileTime, FileAttributes, SysImageIndex);
  FFiles.Add(ShellObject);
end;

procedure TdcFolderListView.FolderMonitorOnChange(Sender: TObject);
begin
  Refresh;
end;

procedure TdcFolderListView.ContextMenuOnDelete(Sender: TObject; const FileName: String);
var
  ShellObject: TdcShellObject;
begin
  if Selected <> nil then
   begin
    { delete record from list }
    try
      ShellObject := Selected.Data;
      FFiles.Remove(ShellObject);
    except
    end;  

    { delete list item }
    Items.Delete(Selected.Index);
   end;
end;

procedure TdcFolderListView.ContextMenuOnRename(Sender: TObject; const FileName: String);
begin
  if Selected <> nil then Selected.EditCaption;
end;


{ public methods }
function  TdcFolderListView.FileNameByListItem(ListItem: TListItem): String;
begin
  Result := '';
  if ListItem <> nil then
   try
     Result := TdcShellObject(ListItem.Data).FileName;
   except
   end
end;

function TdcFolderListView.FileSizeByListItem(ListItem: TListItem): Extended;
begin
  Result := -1;
  if ListItem <> nil then
   try
     Result := TdcShellObject(ListItem.Data).FileSize;
   except
   end
end;

function TdcFolderListView.FileTypeByListItem(ListItem: TListItem): String;
begin
  Result := '';
  if ListItem <> nil then
   try
     Result := TdcShellObject(ListItem.Data).FileType;
   except
   end
end;

function TdcFolderListView.FileTimeByListItem(ListItem: TListItem): TDateTime;
begin
  Result := -1;
  if ListItem <> nil then
   try
     Result := TdcShellObject(ListItem.Data).FileTime;
   except
   end
end;

function TdcFolderListView.FileAttributesByListItem(ListItem: TListItem): TdcScanAttributes;
begin
  Result := [];
  if ListItem <> nil then
   try
     Result := TdcShellObject(ListItem.Data).Attributes;
   except
   end
end;

function  TdcFolderListView.ListItemByFileName(FileName: String): TListItem;
var
  I: Integer;
begin
  Result := nil;
  I := FFiles.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    if TdcShellObject(FFiles[I]).FileName = FileName then
     begin
      Result := TdcShellObject(FFiles[I]).ListItem; 
      Exit;
     end;
end;

function  TdcFolderListView.DeleteSelectedFiles: Boolean;
var
  I: Integer;
  St: String;
  Lst: TList;  
  ShellObject: TdcShellObject;
  FileOperations: TdcFileOperations;
begin
  Result := False;
  I := Items.Count;
  if I = 0 then Exit;

  Lst := TList.Create;
  FileOperations := TdcFileOperations.Create(Self);
  with FileOperations do
   try
     try
       for I := 0 to I - 1 do
        if Items[I].Selected then
         begin
          St := FileNameByListItem(Items[I]);
          FileList.Add('"' + St + '"');
          Lst.Add(Items[I]);
         end;
       ListUpdated := False;  
       Result := FileOperations.Delete;
       { if command confirmed }
       if Result and not ListUpdated and (Lst.Count <> 0) then
        begin
         Items.BeginUpdate;
         for I := Lst.Count - 1 downto 0 do
          begin
           try
             ShellObject := TListItem(Lst[I]).Data;
             FFiles.Remove(ShellObject);
           except
           end;
           { delete list item }
           Items.Delete(TListItem(Lst[I]).Index);
          end;
         Items.EndUpdate;
        end;  
     except
     end;
   finally
     Free;
   end;
  Lst.Free; 
end;


{ properties }
function  TdcFolderListView.GetFolder: String;
begin
  Result := FDiskScanner.Folder;
end;

procedure TdcFolderListView.SetFolder(const Value: String);
begin
  if LowerCase(IncludeTrailingBackslash(FDiskScanner.Folder)) <> LowerCase(IncludeTrailingBackslash(Value)) then
   begin
    FDiskScanner.Folder := Value;
    Refresh;
   end;
end;

function  TdcFolderListView.GetFileMask: String;
begin
  Result := FDiskScanner.SearchMask;
end;

procedure TdcFolderListView.SetFileMask(const Value: String);
begin
  if LowerCase(FDiskScanner.SearchMask) <> LowerCase(Value) then
   begin
    FDiskScanner.SearchMask := Value;
    Refresh;
   end;
end;

procedure TdcFolderListView.SetFolderMonitor(Value: TdcFolderMonitor);
begin
  if FFolderMonitor <> Value then
   begin
    FFolderMonitor := Value;
    if Value <> nil then
     begin
      FFolderMonitor.Active := True;
      FFolderMonitor.Folder := Folder;
      FFolderMonitor.OnChange := FolderMonitorOnChange;
      Value.FreeNotification(Self);
     end;
   end;
end;

function  TdcFolderListView.GetFileAttributes: TdcScanAttributes;
begin
  Result := FDiskScanner.SearchAttributes;
end;

procedure TdcFolderListView.SetFileAttributes(Value: TdcScanAttributes);
begin
  if FDiskScanner.SearchAttributes <> Value then
   begin
    FDiskScanner.SearchAttributes := Value;
    Refresh;
   end;
end;

function  TdcFolderListView.GetReadOnly: Boolean;
begin
  Result := inherited ReadOnly;
end;

procedure TdcFolderListView.SetReadOnly(Value: Boolean);
begin
  inherited ReadOnly := Value;

{$IFDEF D3}
  with FShellProperties do
   if Value then
     MenuOptions := MenuOptions - [moCanRename]
   else
     MenuOptions := MenuOptions + [moCanRename];
{$ENDIF}
end;

function  TdcFolderListView.GetShowAllFolders: Boolean;
begin
  Result := FDiskScanner.FindAllFolders;
end;

procedure TdcFolderListView.SetShowAllFolders(Value: Boolean);
begin
  FDiskScanner.FindAllFolders := Value;
  if HandleAllocated then Refresh;
end;

procedure TdcFolderListView.SetShowFileExtensions(Value: Boolean);
begin
  if FShowFileExtensions <> Value then
   begin
    FShowFileExtensions := Value;
    UpdateListItems;
   end;
end;

procedure TdcFolderListView.SetKBStr(Value: String);
begin
  if FKBStr <> Value then
   begin
    FKBStr := Value;
    UpdateListItems;
   end;
end;


{ misc functions }
procedure TdcFolderListView.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
begin
  inherited;
  ExecuteListItem(GetItemAt(Msg.XPos, Msg.YPos));
end;

procedure TdcFolderListView.WMRButtonDown(var Msg: TWMRButtonDown);
var
  ListItem: TListItem;
begin
  ListItem := GetItemAt(Msg.XPos, Msg.YPos);
  if (ListItem <> nil) and (floShowContextMenu in FOptions) then
   begin
    SetFocus;
    if MultiSelect then UnselectAll;
    ListItem.Selected := True;

{$IFDEF D3}
    with FShellProperties do
     begin
      if floAllowDelete in FOptions then
       MenuOptions := MenuOptions + [moAllowDelete]
      else
       MenuOptions := MenuOptions - [moAllowDelete];

      ShowContextMenuByFile(FileNameByListItem(ListItem));
     end;
{$ENDIF}      
   end
  else inherited;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -