Форум программистов [Powered by Invision Power Board]

Код



procedure ScanDir(Dir: string);
var
  SearchRec: TSearchRec;
  ras: string;
  sum: Dword;
begin
 if Dir <> '' then if Dir[length(Dir)] <> '\' then Dir := Dir + '\';
  // Осуществляем поиск по всем вложенным папкам
  if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
    //Ищем файлы с любым расширением
    repeat // пошел цикл
      //если имеет название "." или "..", тогда продолжаем
      if (SearchRec.name = '.') or (SearchRec.name = '..') then Continue;
      // если найден каталог то...
      if (SearchRec.Attr and faDirectory) <> 0 then
        ScanDir(Dir + SearchRec.name) //то проверим и его
      Else // иначе мы поймали файл
      begin
        Form1.label3.caption := dir + SearchRec.Name;//ПОЛНЫЙ ПУть файла
      // Можно в переменную забить а не в лабел
        ras := AnsiLowerCase(ExtractFileExt(dir + SearchRec.name));
        // Узнаем расширение найденного файла
        if (ras = '.txt')  then
        // И если оно  *.txt то...
        begin
        
       //АРХИВИРОВНИЕ!!!
  
           
        end;
      end;
      Application.ProcessMessages;
      if stopScan then // если stopScan=true , то ...
      begin
        Exit; // останавливаем поиск
      end;
    until FindNext(SearchRec) <> 0; 
   //Продолжаем поиск до тех пор, пока результат работы функции не равен нулю
  FindClose(SearchRec);
// завершаем поиск, освобождаем память, выделенный системой под него
end;  

...
procedure GetHDD;
var
  Drive: Char; //Буква диска
  n: byte; // счетчик дисков
  lst: TStringList; // переменная в которой будут храниться список дисков
const
  pref = ':\';
begin
  lst := TStringList.Create;
  lst.Clear;
  for Drive := 'A' to 'Z' do // перебираем буквы дисков
    if GetDriveType(PChar(Drive + pref)) = DRIVE_FIXED then 
    // и если диск не съемный то...
      lst.Add(Drive + pref); 
   //добавим в список дисков, которые нужно сканировать
  for n := 0 to (lst.Count - 1) do // по очереди начинаем сканировать
    ScanDir(lst.Strings[n]); // ScanDir – наша процедуру поиска файлов
  lst.Free;
end;