dcdiskscanner.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

procedure TdcCustomDiskScanner.DoFileFound;
begin
  if not FThread.Terminated and not (csDestroying in ComponentState) then
    FOnFileFound(Self, CurrentFile, FileType,
                 FileSize, FileTime, FileAttributes,
                 tmpLIcon, tmpSIcon, SysImageIndex,
                 ITotalFiles, ITotalSize);
end;

procedure TdcCustomDiskScanner.DoScanFolder;
begin
  if not FThread.Terminated and not (csDestroying in ComponentState) then
    FOnScanFolder(Self, CurrentFolder);
end;

procedure TdcCustomDiskScanner.DoFolderNotExist;
begin
  if not FThread.Terminated and not (csDestroying in ComponentState) then
    FOnFolderNotExist(Self, CurrentFolder);
end;

{ utilities }
function  TdcCustomDiskScanner.IsDirectory(Data: TWin32FindData): Boolean;
begin
  Result := (Data.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY;
end;

function  TdcCustomDiskScanner.IsHidden(Data: TWin32FindData): Boolean;
begin
  Result := (Data.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN;
end;

function  TdcCustomDiskScanner.IsGoodFileName(Data: TWin32FindData): Boolean;
begin
  with Data do
    Result := (String(cFileName) <> '.') and (String(cFileName) <> '..');
end;

function  TdcCustomDiskScanner.IsGoodAttributes(Data: TWin32FindData): Boolean;
{
  function orOK(SA: TdcScanAttribute; FA: DWord): Boolean;
  begin
    Result := (SA in FSearchAttributes) and
              ((Data.dwFileAttributes and FA) = FA);
  end;
}
  function andOK(SA: TdcScanAttribute; FA: DWord): Boolean;
  begin
    Result := not (not (SA in FSearchAttributes) and
                  ((Data.dwFileAttributes and FA) = FA));
  end;

begin
  if Data.dwFileAttributes = 0 then
    Result := (saNormal in FSearchAttributes)
  else
   Result :=
     (andOK(saDirectory, FILE_ATTRIBUTE_DIRECTORY) and
      andOK(saArchive, FILE_ATTRIBUTE_ARCHIVE) and
      andOK(saReadOnly, FILE_ATTRIBUTE_READONLY) and
      andOK(saHidden, FILE_ATTRIBUTE_HIDDEN) and
      andOK(saSystem, FILE_ATTRIBUTE_SYSTEM) and
      andOK(saNormal, FILE_ATTRIBUTE_NORMAL));

{ Result :=
    orOK(saDirectory, FILE_ATTRIBUTE_DIRECTORY) or
    orOK(saArchive, FILE_ATTRIBUTE_ARCHIVE) or
    orOK(saReadOnly, FILE_ATTRIBUTE_READONLY) or
    orOK(saHidden, FILE_ATTRIBUTE_HIDDEN) or
    orOK(saSystem, FILE_ATTRIBUTE_SYSTEM) or
    orOK(saNormal, FILE_ATTRIBUTE_NORMAL) or
    ((saNormal in FSearchAttributes) and (dwFileAttributes = 0));}
end;

function  TdcCustomDiskScanner.IsGoodSize(Data: TWin32FindData): Boolean;
var
  ExtSize: Extended;
begin
  with Data do
    ExtSize := Int2x32ToExt(nFileSizeHigh, nFileSizeLow);
  Result := FSearchSize.AnySize or
            ((ExtSize >= FSearchSize.MinSizeKB * $400) and
             (ExtSize <= FSearchSize.MaxSizeKB * $400));
end;

function  TdcCustomDiskScanner.IsGoodTime(Data: TWin32FindData): Boolean;
var
  FileTime: TDateTime;
begin
  if FSearchTime.AnyTime then Result := True
  else
   begin
    with Data do
     case FSearchTime.FindFiles of
       ffCreated: FileTime := UTCFileTimeToDateTime(ftCreationTime);
       ffModified: FileTime := UTCFileTimeToDateTime(ftLastWriteTime);
       ffAccessed: FileTime := UTCFileTimeToDateTime(ftLastAccessTime);
       else FileTime := -1;
      end;
     
    Result := (FileTime <> -1) and
              (FileTime >= FSearchTime.SinceTime) and
              (FileTime <= FSearchTime.TillTime);
   end;
end;

function  TdcCustomDiskScanner.IsNewFile(Data: TWin32FindData): Boolean;
var
  I: Integer;
begin
  Result := True;
  I := FFiles.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    if CurrentFolder + Data.cFileName = FFiles[I] then
     begin
      Result := False;
      Exit;
     end;
end;

function  TdcCustomDiskScanner.IsGoodFile(Data: TWin32FindData): Boolean;
begin
  Result := IsGoodAttributes(Data) and
            IsGoodFileName(Data) and
            IsGoodSize(Data) and
            IsGoodTime(Data) and
            (not MultiFind or IsNewFile(Data));
end;

function  TdcCustomDiskScanner.AttrToScanAttributes(Attr: Integer): TdcScanAttributes;
begin
  if Attr = 0 then Result := [saNormal]
  else
   begin
    Result := [];   
    if (Attr and FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL then
      Result := Result + [saNormal];
    if (Attr and FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE then
      Result := Result + [saArchive];
    if (Attr and FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY then
      Result := Result + [saReadOnly];
    if (Attr and FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN then
      Result := Result + [saHidden];
    if (Attr and FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM then
      Result := Result + [saSystem];
    if (Attr and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
      Result := Result + [saDirectory];

{ // ToDo ?
    if (Attr and FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY then
      Result := Result + [saTemporary];
    if (Attr and FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED then
      Result := Result + [saCompressed];
    if (Attr and FILE_ATTRIBUTE_OFFLINE) = FILE_ATTRIBUTE_OFFLINE then
      Result := Result + [saOffline];
}      
   end;
end;

procedure TdcCustomDiskScanner.ProcessFoundFile(Data: TWin32FindData);
var
  Res: Integer;
  ShInfo: TShFileInfo;
begin
  FFiles.Add(CurrentFolder + Data.cFileName);
  
  { 64-bit filesize for files over 2gb }
  with Data do
    FileSize := Int2x32ToExt(nFileSizeHigh, nFileSizeLow);

  Inc(ITotalFiles);
  ITotalSize := ITotalSize + FileSize;

  if Assigned(FOnFileFound) then
   begin
    if FUseIcons then
     begin
      ShGetFileInfo(PChar(CurrentFile), 0, ShInfo, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_LARGEICON);
      tmpLIcon.Handle := ShInfo.hIcon;
      Res := ShGetFileInfo(PChar(CurrentFile), 0, ShInfo, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_SMALLICON or SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
      tmpSIcon.Handle := ShInfo.hIcon;
     end
    else
     begin
      Res := ShGetFileInfo(PChar(CurrentFile), 0, ShInfo, SizeOf(TShFileInfo), SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
      tmpLIcon.Handle := 0;
      tmpSIcon.Handle := 0;
     end;

    if Res <> 0 then
     begin
      FileType := ShInfo.szTypeName;
      SysImageIndex := ShInfo.iIcon;
     end
    else
     { Couldn't get file info for some reason??
       Unfortunately, this problem happends if
       whe trying to scan files in the "Recycle.bin" }
     with TdcFileAssociation.Create(nil) do
      try
        EXTENSION := ExtractFileExt(Data.cFileName);
        FileType := FileDescription;
        SysImageIndex := 0;

        if FUseIcons then
         begin
          tmpLIcon.Assign(LargeIcon);
          tmpSIcon.Assign(SmallIcon);
         end;
      finally
        Free;
      end;

    FileTime := UTCFileTimeToDateTime(Data.ftLastWriteTime);
    FileAttributes := AttrToScanAttributes(Data.dwFileAttributes);

    if not FThread.Terminated then
      FThread.Synchronize(DoFileFound);
   end;

  if FMatches.FLimited and (ITotalFiles = FMatches.FMaxMatches) then Stop;
end;

{ properties }
function  TdcCustomDiskScanner.GetBusy: Boolean;
begin
  Result := FThread.Running;
end;

procedure TdcCustomDiskScanner.SetSearchAttributes(Value: TdcScanAttributes);
begin
  if FSearchAttributes <> Value then
   begin
    if not (saAny in FSearchAttributes) and (saAny in Value) then
     begin
      FSearchAttributes := [saNormal, saArchive, saReadOnly, saHidden, saSystem, saDirectory, saAny];
      Exit;
     end;

    if (saAny in FSearchAttributes) and (saAny in Value) and
       (not (saReadOnly in Value) or not (saHidden in Value) or
        not (saSystem in Value) or not (saDirectory in Value) or
        not (saArchive in Value) or not (saNormal in Value)) then
     Value := Value - [saAny]
    else
     if not (saAny in FSearchAttributes) and not (saAny in Value) and
        (saReadOnly in Value) and (saHidden in Value) and
        (saSystem in Value) and (saDirectory in Value) and
        (saDirectory in Value) and (saNormal in Value) then
      Value := Value + [saAny];

    FSearchAttributes := Value;
   end;
end;

function  TdcCustomDiskScanner.GetSuspended: Boolean;
begin
  Result := FThread.Suspended;
end;

procedure TdcCustomDiskScanner.SetSuspended(Value: Boolean);
begin
  FThread.Suspended := Value;
end;

function  TdcCustomDiskScanner.GetThreadPriority: TThreadPriority;
begin
  Result := FThread.Priority;
end;

procedure TdcCustomDiskScanner.SetThreadPriority(Value: TThreadPriority);
begin
  FThread.Priority := Value;
end;

function  TdcCustomDiskScanner.GetWaitThread: Boolean;
begin
  Result := FThread.WaitThread;
end;

procedure TdcCustomDiskScanner.SetWaitThread(Value: Boolean);
begin
  FThread.WaitThread := Value;
end;


// DiskScanner
constructor TdcDiskScanner.Create(aOwner: TComponent);
begin
  inherited;

  FFolder := C_ROOT_DIR;
  FIncludeSubfolders := True;
  FSearchMask := AST_DOT_AST;
end;

procedure TdcDiskScanner.ThreadExecute(Sender: TObject);
var
  Masks: TStringList;

  procedure ScanFolder(const SFolder: String);
  var
    I: Integer;
    FindHandle: THandle;
    FindData: TWin32FindData;

    procedure ScanMask(const SMask: String);
    begin
      FindHandle := FindFirstFile(PChar(SFolder + SMask), FindData);
      if FindHandle <> INVALID_HANDLE_VALUE then
       try
         repeat
           CurrentFile := SFolder + FindData.cFileName;
           if IsGoodFile(FindData) then ProcessFoundFile(FindData);
         until not FindNextFile(FindHandle, FindData) or FThread.Terminated
       finally
         Windows.FindClose(FindHandle);
       end;
    end;

    procedure ScanFolders;
    begin
      FindHandle := FindFirstFile(PChar(SFolder + AST_DOT_AST), FindData);
      if FindHandle <> INVALID_HANDLE_VALUE then
       try
         repeat
           CurrentFile := SFolder + FindData.cFileName;
           if IsDirectory(FindData) and
              IsGoodAttributes(FindData) and
              IsGoodFileName(FindData) then
             ProcessFoundFile(FindData);
         until not FindNextFile(FindHandle, FindData) or FThread.Terminated
       finally
         Windows.FindClose(FindHandle);
       end;
    end;

  begin
    CurrentFolder := SFolder;
      
    // Current Folder
    if Assigned(FOnScanFolder) then
     begin
      if FThread.Terminated then Exit;
      FThread.Synchronize(DoScanFolder);
     end;

    // Folders (even those which does not match to search mask)
    if FFindAllFolders and (saDirectory in FSearchAttributes) then
      ScanFolders;

    // Files
    for I := 0 to Masks.Count - 1 do
      ScanMask(Masks[I]);

    if FThread.Terminated then Exit;

    // Scan Directories
    if FIncludeSubfolders then
     begin
      FindHandle := FindFirstFile(PChar(SFolder + AST_DOT_AST), FindData);
      if FindHandle <> INVALID_HANDLE_VALUE then
       try
         repeat
           CurrentFile := SFolder + FindData.cFileName;
           if IsDirectory(FindData) and
              IsGoodFileName(FindData) then
            begin
             if IsHidden(FindData) and not FIncludeHiddenSubfolders then Continue;
             if not FThread.Terminated then
               ScanFolder(CurrentFile + '\');
            end; 
         until not FindNextFile(FindHandle, FindData) or FThread.Terminated
       finally
         Windows.FindClose(FindHandle);
       end; 
     end;
  end;

begin
  inherited;
  Masks := TStringList.Create;
  try