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

📄 dcdiskscanner.pas

📁 获取硬盘相关详细信息
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    SplitSemicolons(FSearchMask, Masks);
    MultiFind := (Masks.Count > 1) or FFindAllFolders;
    ScanFolder(IncludeTrailingBackslash(FFolder));
  finally
    Masks.Free;
  end;  
end;

procedure TdcDiskScanner.SetFolder(const Value: String);
begin
  if FFolder <> Value then
   begin
    if Value = '' then
     begin
      FFolder := '';
      Exit;
     end;

{  // commented to support UNC pathes

    if Length(Value) > 3 then
      Value := ExcludeTrailingBackslash(Value);

  if (Value[2] <> ':') and (Value[3] <> '\') then
      raise Exception.Create('Disk Letter is not specified.');

    if not DirectoryExists(Value) then
      raise Exception.Create('Folder does not exists.');}

    FFolder := Value;
   end;
end;


// DiskScannerPath
constructor TDiskScannerPath.Create(const aPathMask: String; aIncludeSubfolders: Boolean);
begin
  inherited Create;
  FPathMask := aPathMask;
  FIncludeSubfolders := aIncludeSubfolders;
end;


// DiskScanList
procedure TDiskScanList.AddPath(PathMask: String; IncludeSubfolders: Boolean);
var
  DiskScannerPath: TDiskScannerPath;
begin
  DiskScannerPath := TDiskScannerPath.Create(PathMask, IncludeSubfolders);
  Add(DiskScannerPath);
end;

function TDiskScanList.LoadFromFile(const FileName: String): Boolean; // returns True if successfull
var
  I: Integer;
  St, Params: String;
  StrList: TStringList;
begin
  Result := True;
  StrList := TStringList.Create;
  try
    try
      StrList.LoadFromFile(FileName);
    except
      Result := False;
    end;
    if Result then
     begin
      I := StrList.Count;
      if I <> 0 then
       for I := 0 to I - 1 do
        begin
         St := StrList[I];
         SplitFileNameAndParams(St, Params); { splits the path and params }
         AddPath(St, Params = '/+');
        end;
     end;
  finally
    StrList.Free;
  end;  
end;

function TDiskScanList.SaveToFile(const FileName: String): Boolean; // returns True if successfull
var
  I: Integer;
  St: String;
  StrList: TStringList;
begin
  Result := True;
  StrList := TStringList.Create;
  try
    { filling the string list with items }
    if Count <> 0 then
     for I := 0 to Count - 1 do
      with TDiskScannerPath(Items[I]) do
       begin
        St := FPathMask;
        if FIncludeSubfolders then St := St + ' /+';
        StrList.Add(St);
       end;

    { saving the list to file }
    try
      StrList.SaveToFile(FileName);
    except
      Result := False;
    end;
  finally
    StrList.Free;
  end;  
end;


// TDiskScanList
function TDiskScanList.Get(Index: Integer): TDiskScannerPath;
begin
  Result := inherited Get(Index);
end;

procedure TDiskScanList.Put(Index: Integer; Item: TDiskScannerPath);
begin
  inherited Put(Index, Item);
end;


// MultiDiskScanner
constructor TdcMultiDiskScanner.Create(aOwner: TComponent);
begin
  inherited;

  FIncludeList := TDiskScanList.Create;
  FExcludeList := TDiskScanList.Create;
  FPreExcludedList := TStringList.Create;
  FExcludedWithoutPath := TStringList.Create;
end;

destructor TdcMultiDiskScanner.Destroy;
begin
  FExcludedWithoutPath.Free;
  FPreExcludedList.Free;
  FExcludeList.Free;
  FIncludeList.Free;

  inherited;
end;

procedure TdcMultiDiskScanner.ReadData(Stream: TStream);
var
  I, J: Integer;
  St: String;
  B: Boolean;
begin
  Stream.Read(I, SizeOf(I));
  if I <> 0 then
   for I := 0 to I - 1 do
    begin
     { read path }
     Stream.Read(J, SizeOf(J));
     SetLength(St, J);
     Stream.Read(St[1], J);
     { read subfolders flag }
     Stream.Read(B, SizeOf(B));     
     { add to the list }
     FIncludeList.AddPath(St, B);
    end;

  Stream.Read(I, SizeOf(I));
  if I <> 0 then
   for I := 0 to I - 1 do
    begin
     { read path }
     Stream.Read(J, SizeOf(J));
     SetLength(St, J);
     Stream.Read(St[1], J);
     { read subfolders flag }
     Stream.Read(B, SizeOf(B));
     { add to the list }
     FExcludeList.AddPath(St, B);
    end;
end;

procedure TdcMultiDiskScanner.WriteData(Stream: TStream);
var
  I, J: Integer;
begin
  I := FIncludeList.Count;
  Stream.Write(I, SizeOf(I));
  if I <> 0 then
   for I := 0 to I - 1 do
    with TDiskScannerPath(FIncludeList[I]) do
     begin
      J := Length(FPathMask);
      Stream.Write(J, SizeOf(J));
      Stream.Write(FPathMask[1], J);

      Stream.Write(FIncludeSubfolders, SizeOf(FIncludeSubfolders));
     end;

  I := FExcludeList.Count;
  Stream.Write(I, SizeOf(I));
  if I <> 0 then
   for I := 0 to I - 1 do
    with TDiskScannerPath(FExcludeList[I]) do
     begin
      J := Length(FPathMask);
      Stream.Write(J, SizeOf(J));
      Stream.Write(FPathMask[1], J);

      Stream.Write(FIncludeSubfolders, SizeOf(FIncludeSubfolders));
     end;
end;

procedure TdcMultiDiskScanner.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('ScannerLists', ReadData, WriteData, (FIncludeList.Count <> 0) or (FExcludeList.Count <> 0));
end;

procedure TdcMultiDiskScanner.ThreadExecute(Sender: TObject);

  procedure ScanFolder(const SFolder, SMask: String; IncludeSubfolders: Boolean; IsInclude: Boolean);
  var
    I: Integer;
    ExMask: String;
    FindHandle: THandle;
    FindData: TWin32FindData;

    procedure FileIsFound(QuickExclude: Boolean); {QuickExclude means exlusion for entries without path}
    var
      I: Integer;
      LCaseName: String;
    begin
      LCaseName := AnsiLowerCase(CurrentFile);
      
      if IsInclude then
       begin
        for I := 0 to FPreExcludedList.Count - 1 do
         if FPreExcludedList[I] = LCaseName then Exit;
       end;

      if IsInclude and not QuickExclude then
        ProcessFoundFile(FindData)
      else
        FPreExcludedList.Add(LCaseName);
    end;

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

    // Excluding files without path
    if IsInclude then
     begin
      I := FExcludedWithoutPath.Count;
      if I <> 0 then
       for I := 0 to I - 1 do
        begin
         if FThread.Terminated then Exit;
         
         ExMask := FExcludedWithoutPath[I];
         FindHandle := FindFirstFile(PChar(SFolder + ExMask), FindData);
         if FindHandle <> INVALID_HANDLE_VALUE then
          try
            repeat
              CurrentFile := SFolder + FindData.cFileName;
              if IsGoodFile(FindData) then FileIsFound(True);
            until not FindNextFile(FindHandle, FindData) or FThread.Terminated
          finally
            Windows.FindClose(FindHandle);
          end;
        end;  
     end;

    if FThread.Terminated then Exit;

    // Files
    FindHandle := FindFirstFile(PChar(SFolder + SMask), FindData);
    if FindHandle <> INVALID_HANDLE_VALUE then
     try
       repeat
         CurrentFile := SFolder + FindData.cFileName;
         if IsGoodFile(FindData) then FileIsFound(False);
       until not FindNextFile(FindHandle, FindData) or FThread.Terminated
     finally
       Windows.FindClose(FindHandle);
     end;

    if FThread.Terminated then Exit;

    // Scan Directories
    if IncludeSubfolders 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
             ScanFolder(CurrentFile + '\', SMask, IncludeSubfolders, IsInclude);
          until not FindNextFile(FindHandle, FindData) or FThread.Terminated
       finally
         Windows.FindClose(FindHandle);
       end;  
     end;
  end;

  procedure ProcessList(List: TList; IsInclude: Boolean);
  var
    I, J: Integer;
    ScannerPath: TDiskScannerPath;
    Path, Mask: String;
  begin
    I := List.Count;
    if I <> 0 then
     for I := 0 to I - 1 do
      begin
       ScannerPath := List[I];
       Path := ScannerPath.PathMask;
       J := Length(Path);
       if J <> 0 then
        begin
         for J := 1 to J do
          if Path[J] = '/' then Path[J] := '\';

         Mask := ExtractFileName(Path);
         Path := ExtractFilePath(Path);

         { if doesn't contain the path info }
         if not IsInclude and (Pos('\', Path) = 0) and (Pos(':', Path) = 0) then
          begin
           FExcludedWithoutPath.Add(Path + Mask);
           Continue;
          end;
         Path := GetCorrectDirName(Path); // see notes to IncludeList in the .hlp

         if IsUNCPath(Path) or DirectoryExists(Path) then
           ScanFolder(Path, Mask, ScannerPath.IncludeSubfolders, IsInclude)
         else
          begin
           CurrentFolder := Path;
           if FThread.Terminated then Exit;
           FThread.Synchronize(DoFolderNotExist);
          end;
        end;
      end;
  end;

begin
  inherited;
  FPreExcludedList.Clear;
  FExcludedWithoutPath.Clear;

  { ** Filling the ExcludeLists ** }
  if Assigned(FOnExcludingBegin) then
    FOnExcludingBegin(Self);

  ProcessList(FExcludeList, False);

  if Assigned(FOnExcludingEnd) then
    FOnExcludingEnd(Self);
  { ** Excluding done ** }

  if FThread.Terminated then Exit;

  MultiFind := FIncludeList.Count > 1;
  { searching by IncludeList }
  ProcessList(FIncludeList, True);
end;

procedure TdcMultiDiskScanner.ThreadDone(Sender: TObject);
begin
  inherited;
  FExcludedWithoutPath.Clear;
  FPreExcludedList.Clear;
end;

end.

⌨️ 快捷键说明

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