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

📄 dcdiskscanner.pas

📁 DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{*******************************************************************************

  Disk Controls pack v3.5
  FILE: dcDiskScanner.pas - dcDiskScanner and dcMultiDiskScanner components

  Copyright (c) 1999-2002 UtilMind Solutions
  All rights reserved.
  E-Mail: info@appcontrols.com, info@utilmind.com
  WWW: http://www.appcontrols.com, http://www.utilmind.com

  The entire contents of this file is protected by International Copyright
Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
or any portion of the code contained in this file is strictly prohibited and
may result in severe civil and criminal penalties and will be prosecuted to
the maximum extent possible under the law.

*******************************************************************************}
{$I umDefines.inc}

unit dcDiskScanner;

interface

uses
  Windows, Classes, Controls, Forms, Graphics, SysUtils,
  dcInternal, dcThread;

type
// DiskScanner
  TDiskScannerMatches = class(TPersistent)
  private
    FLimited: Boolean;
    FMaxMatches: DWord;
  protected
  public
  published
    property Limited: Boolean read FLimited write FLimited default False;
    property MaxMatches: DWord read FMaxMatches write FMaxMatches default 0;
  end;

  TFindFilesByDateKind = (ffModified, ffCreated, ffAccessed);
  TSearchTime = class(TPersistent)
  private
    FAnyTime: Boolean;
    FFindFiles: TFindFilesByDateKind;
    FSinceTime: TDateTime;
    FTillTime: TDateTime;
  protected
  public
    constructor Create;
  published
    property AnyTime: Boolean read FAnyTime write FAnyTime default True;
    property FindFiles: TFindFilesByDateKind read FFindFiles write FFindFiles default ffModified;
    property SinceTime: TDateTime read FSinceTime write FSinceTime;
    property TillTime: TDateTime read FTillTime write FTillTime;
  end;

  TSearchSize = class(TPersistent)
  private
    FAnySize: Boolean;
    FMinSizeKB,
    FMaxSizeKB: Integer;
  protected
  public
    constructor Create;
  published
    property AnySize: Boolean read FAnySize write FAnySize default True;
    property MinSizeKB: Integer read FMinSizeKB write FMinSizeKB default 0;
    property MaxSizeKB: Integer read FMaxSizeKB write FMaxSizeKB default 0;
  end;

  TdcFileFoundEvent = procedure(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) of object;
  TdcScanFolderEvent = procedure(Sender: TObject; const Folder: String) of object;
  TdcScanDoneEvent = procedure(Sender: TObject; TotalFiles: Integer;
     const TotalSize: Extended; ElapsedTimeInSeconds: Integer) of object;

// TdcCustomDiskScanner
  TdcCustomDiskScanner = class(TumdcComponent)
  private
    FFiles: TStringList;
    FFindAllFolders: Boolean;
    FMatches: TDiskScannerMatches;
    FSearchAttributes: TdcScanAttributes;
    FSearchTime: TSearchTime;
    FSearchSize: TSearchSize;
    FUseIcons: Boolean;

    FThread: TdcCustomThread;

    { for internal use }
    MultiFind: Boolean;
    tmpLIcon, tmpSIcon: TIcon;
    CurrentFile, CurrentFolder: String;
    FileType: String;
    FileSize: Extended;
    FileTime: TDateTime;
    FileAttributes: TdcScanAttributes;
    SysImageIndex: Integer;

    ITotalFiles: DWord;
    ITotalSize: Extended;
    IElapsedTime: TDateTime;
    { ---------------- }

    FOnFileFound: TdcFileFoundEvent;
    FOnScanFolder: TdcScanFolderEvent;
    FOnScanDone: TdcScanDoneEvent;
    FOnStopped: TNotifyEvent;
    FOnFolderNotExist: TdcScanFolderEvent;

    function  GetBusy: Boolean;
    procedure SetSearchAttributes(Value: TdcScanAttributes);
    function  GetSuspended: Boolean;
    procedure SetSuspended(Value: Boolean);
    function  GetThreadPriority: TThreadPriority;
    procedure SetThreadPriority(Value: TThreadPriority);
    function  GetWaitThread: Boolean;
    procedure SetWaitThread(Value: Boolean);

    { utilities }
    function  IsDirectory(Data: TWin32FindData): Boolean;
    function  IsHidden(Data: TWin32FindData): Boolean;
    function  IsGoodFileName(Data: TWin32FindData): Boolean;
    function  IsGoodAttributes(Data: TWin32FindData): Boolean;    
    function  IsGoodSize(Data: TWin32FindData): Boolean;
    function  IsGoodTime(Data: TWin32FindData): Boolean;
    function  IsNewFile(Data: TWin32FindData): Boolean;    
    function  IsGoodFile(Data: TWin32FindData): Boolean;

    function  AttrToScanAttributes(Attr: Integer): TdcScanAttributes;
    procedure ProcessFoundFile(Data: TWin32FindData);
  protected
    procedure ThreadExecute(Sender: TObject); virtual;
    procedure ThreadException(Sender: TObject); virtual;
    procedure ThreadDone(Sender: TObject); virtual;

    procedure DoFileFound; virtual;
    procedure DoScanFolder; virtual;
    procedure DoFolderNotExist; virtual;

    property FindAllFolders: Boolean read FFindAllFolders write FFindAllFolders default False;
    property Matches: TDiskScannerMatches read FMatches write FMatches;
    property SearchAttributes: TdcScanAttributes read FSearchAttributes write SetSearchAttributes default [saNormal, saArchive, saReadOnly, saSystem, saHidden];
    property SearchTime: TSearchTime read FSearchTime write FSearchTime;
    property SearchSize: TSearchSize read FSearchSize write FSearchSize;
    property Suspended: Boolean read GetSuspended write SetSuspended default True;    
    property ThreadPriority: TThreadPriority read GetThreadPriority write SetThreadPriority default tpNormal;
    property WaitThread: Boolean read GetWaitThread write SetWaitThread default False;
    property UseIcons: Boolean read FUseIcons write FUseIcons default False;
    property OnFileFound: TdcFileFoundEvent read FOnFileFound write FOnFileFound;
    property OnScanFolder: TdcScanFolderEvent read FOnScanFolder write FOnScanFolder;
    property OnScanDone: TdcScanDoneEvent read FOnScanDone write FOnScanDone;
    property OnStopped: TNotifyEvent read FOnStopped write FOnStopped;
    property OnFolderNotExist: TdcScanFolderEvent read FOnFolderNotExist write FOnFolderNotExist;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    function  Execute: Boolean; virtual;
    procedure Stop; virtual;

    property Files: TStringList read FFiles;
    property Busy: Boolean read GetBusy;
    property Thread: TdcCustomThread read FThread;
  end;

// TdcDiskScanner  
  TdcDiskScanner = class(TdcCustomDiskScanner)
  private
    FFolder: String;
    FSearchMask: String;
    FIncludeSubfolders: Boolean;
    FIncludeHiddenSubfolders: Boolean;

    procedure SetFolder(const Value: String);
  protected
    procedure ThreadExecute(Sender: TObject); override;  
  public
    constructor Create(aOwner: TComponent); override;
  published
    property About;

    property Folder: String read FFolder write SetFolder;
    property SearchMask: String read FSearchMask write FSearchMask;
    property IncludeSubfolders: Boolean read FIncludeSubfolders write FIncludeSubfolders default True;
    property IncludeHiddenSubfolders: Boolean read FIncludeHiddenSubfolders write FIncludeHiddenSubfolders default False;

    property FindAllFolders;
    property Matches;
    property SearchAttributes;
    property SearchTime;
    property SearchSize;
    property Suspended;
    property ThreadPriority;
    property WaitThread;
    property UseIcons;
    property OnFileFound;
    property OnScanFolder;
    property OnScanDone;
    property OnStopped;    
  end;

// TDiskScannerPath
  TDiskScannerPath = class(TPersistent)
  private
    FPathMask: String;
    FIncludeSubfolders: Boolean;
  protected
  public
    constructor Create(const aPathMask: String; aIncludeSubfolders: Boolean);
  published
    property PathMask: String read FPathMask write FPathMask;
    property IncludeSubfolders: Boolean read FIncludeSubfolders write FIncludeSubfolders;
  end;

// TDiskScanList
  TDiskScanList = class(TdcObjectList)
  private
    function  Get(Index: Integer): TDiskScannerPath;
    procedure Put(Index: Integer; Item: TDiskScannerPath);
  public
    procedure AddPath(PathMask: String; IncludeSubfolders: Boolean);

    function LoadFromFile(const FileName: String): Boolean; // returns True if successfull
    function SaveToFile(const FileName: String): Boolean; // returns True if successfull

    property Items[Index: Integer]: TDiskScannerPath read Get write Put; default;    
  end;

// TdcMultiDiskScanner
  TdcMultiDiskScanner = class(TdcCustomDiskScanner)
  private
    FIncludeList: TDiskScanList;
    FExcludeList: TDiskScanList;

    FPreExcludedList, FExcludedWithoutPath: TStringList;
    FOnExcludingBegin, FOnExcludingEnd: TNotifyEvent;
  protected
    procedure ReadData(Stream: TStream); virtual;
    procedure WriteData(Stream: TStream); virtual;
    procedure DefineProperties(Filer: TFiler); override;

    procedure ThreadExecute(Sender: TObject); override;
    procedure ThreadDone(Sender: TObject); override;        
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About;

    property IncludeList: TDiskScanList read FIncludeList write FIncludeList;
    property ExcludeList: TDiskScanList read FExcludeList write FExcludeList;

    property OnExcludingBegin: TNotifyEvent read FOnExcludingBegin write FOnExcludingBegin;
    property OnExcludingEnd: TNotifyEvent read FOnExcludingEnd write FOnExcludingEnd;

    property Matches;
    property SearchAttributes;
    property SearchTime;
    property SearchSize;
    property Suspended;
    property ThreadPriority;
    property WaitThread;
    property UseIcons;
    property OnFileFound;
    property OnScanFolder;
    property OnScanDone;
    property OnStopped;
    property OnFolderNotExist;
  end;

implementation

uses ShellAPI, dcUtils, dcFileAssociation;

// SearchTime
constructor TSearchTime.Create;
begin
  inherited;
  FAnyTime := True;
end;

// SearchSize
constructor TSearchSize.Create;
begin
  inherited;
  FAnySize := True;
end;

// CustomDiskScanner
constructor TdcCustomDiskScanner.Create(aOwner: TComponent);
begin
  inherited;
  FThread := TdcCustomThread.Create(Self);
  FThread.OnExecute := ThreadExecute;
  FThread.OnException := ThreadException;
  FThread.OnTerminate := ThreadDone;

  FSearchAttributes := [saNormal, saArchive, saReadOnly, saSystem, saHidden];

  FSearchTime := TSearchTime.Create;
  FSearchSize := TSearchSize.Create;
  FMatches := TDiskScannerMatches.Create;

  tmpLIcon := TIcon.Create;
  tmpSIcon := TIcon.Create;
  FFiles := TStringList.Create;
end;

destructor TdcCustomDiskScanner.Destroy;
begin
  Stop;

  FFiles.Free;
  tmpSIcon.Free;
  tmpLIcon.Free;

  FMatches.Free;
  FSearchSize.Free;
  FSearchTime.Free;
  FThread.Free;  

  inherited;
end;

{ public methods }
function TdcCustomDiskScanner.Execute: Boolean;
begin
  Result := Busy;
  if not Result then
   begin
    ITotalFiles := 0;
    ITotalSize := 0;
    IElapsedTime := Now;
    FThread.Execute;
   end
end;

procedure TdcCustomDiskScanner.Stop;
begin
  if Busy then
   begin
    FThread.Terminate(False);
    
    if Assigned(FOnStopped) and not (csDestroying in ComponentState) then
      FOnStopped(Self);
   end;
end;

{ virtual thread methods }
procedure TdcCustomDiskScanner.ThreadExecute(Sender: TObject);
begin
  FFiles.Clear;
end;

procedure TdcCustomDiskScanner.ThreadException(Sender: TObject);
begin
end;

procedure TdcCustomDiskScanner.ThreadDone(Sender: TObject);

  function GetSeconds: LongInt;
  var
    TimeDif: TDateTime;
  begin
    Result := 0;
    TimeDif := Now - IElapsedTime;
    if TimeDif <> 0 then
     try
       Result := Trunc(MSecsPerDay * TimeDif / 1000);
     except
     end;
  end;
  
begin
  if not (csDestroying in ComponentState) and
    Assigned(FOnScanDone) then
    FOnScanDone(Self, ITotalFiles, ITotalSize, GetSeconds);
end;

⌨️ 快捷键说明

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