Недавно добавленные исходники

•  3D Designer  134

•  Sik Screen Capture  109

•  Patch Maker  92

•  Айболит (remote control)  113

•  ListBox Drag & Drop  85

•  Доска для игры Реверси  1 559

•  Графические эффекты  100

•  Рисование по маске  76

•  Перетаскивание изображений  79

•  Canvas Drawing  82

•  Рисование Луны  152

•  Поворот изображения  65

•  Рисование стержней  56

•  Paint on Shape  52

•  Генератор кроссвордов  60

•  Головоломка Paletto  75

•  Теорема Монжа об окружностях  113

•  Пазл Numbrix  56

•  Заборы и коммивояжеры  87

•  Игра HIP  66

•  Игра Go (Го)  51

•  Симулятор лифта  55

•  Программа укладки плитки  56

•  Генератор лабиринта  97

•  Проверка числового ввода  45

•  HEX View  101

•  Физический маятник  102

•  Задача коммивояжера  129

•  Автомобильная пробка  52

•  Квадратные сетки из слов  46

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Ищем файл рекурсивно



Встречаются двое юзеров. Один говорит:
- Я тут свежий антивирус достал, не хочешь себе установить?
- Нет, мне это не нужно.
- Почему?
- Да мой комп так глючит, что на нем ни один вирус не запустится.


procedure GetAllFiles(mask: string); 
var 
  search: TSearchRec; 
  directory: string; 
begin 
  directory := ExtractFilePath(mask); 

  // find all files 
  if FindFirst(mask, $23, search) = 0 then 
  begin 
    repeat 
      // add the files to the listbox 
      Form1.ListBox1.Items.Add(directory + search.Name); 
      Inc(Count); 
    until FindNext(search) <> 0; 
  end; 

  // Subdirectories/ Unterverzeichnisse 
  if FindFirst(directory + '*.*', faDirectory, search) = 0 then 
  begin 
    repeat 
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then 
        GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask)); 
    until FindNext(search) <> 0; 
    FindClose(search); 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  directory: string; 
  mask: string; 
begin 
  Count := 0; 
  Listbox1.Items.Clear; 

  directory := 'C:\temp\'; 
  mask := '*.*'; 

  Screen.Cursor := crHourGlass; 
  try 
    GetAllFiles(directory + mask); 
  finally 
    Screen.Cursor := crDefault; 
  end; 
  ShowMessage(IntToStr(Count) + ' Files found'); 
end; 


{**************************************} 
{ Code from P. Below: } 

// recursively scanning all drives 

  { excerpt from form declaration, form has a listbox1 for the 
    results, a label1 for progress, a button2 to start the scan, 
    an edit1 to get the search mask from, a button3 to stop 
    the scan. } 
  private 
    { Private declarations } 
    FScanAborted: Boolean; 

  public 
    { Public declarations } 
     
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 

implementation 

function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 
  function ScanDirectory(var path: string): Boolean; 
  var 
    SRec: TSearchRec; 
    pathlen: Integer; 
    res: Integer; 
  begin 
    label1.Caption := path; 
    pathlen := Length(path); 
    { first pass, files } 
    res := FindFirst(path + filemask, faAnyfile, SRec); 
    if res = 0 then 
      try 
        while res = 0 do  
        begin 
          hitlist.Add(path + SRec.Name); 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
    Application.ProcessMessages; 
    Result := not (FScanAborted or Application.Terminated); 
    if not Result then Exit; 

    {second pass, directories} 
    res := FindFirst(path + '*.*', faDirectory, SRec); 
    if res = 0 then 
      try 
        while (res = 0) and Result do  
        begin 
          if ((Srec.Attr and faDirectory) = faDirectory) and 
            (Srec.Name <> '.') and 
            (Srec.Name <> '..') then  
          begin 
            path := path + SRec.Name + '\'; 
            Result := ScanDirectory(path); 
            SetLength(path, pathlen); 
          end; 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
  end; 
begin 
  FScanAborted := False; 
  Screen.Cursor := crHourglass; 
  try 
    Result := ScanDirectory(root); 
  finally 
    Screen.Cursor := crDefault 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  ch: Char; 
  root: string; 
begin 
  root := 'C:\'; 
  for ch := 'A' to 'Z' do  
  begin 
    root[1] := ch; 
    case GetDriveType(PChar(root)) of 
      DRIVE_FIXED, DRIVE_REMOTE: 
        if not ScanDrive(root, edit1.Text, listbox1.Items) then 
          Break; 
    end; 
  end; 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
begin // aborts scan 
  FScanAborted := True; 
end;





Похожие по теме исходники

Чтение PSD файлов

Шифратор файлов

Разбиение файла на части

Поиск файлов

 

FileMan (менеджер файлов)

Поиск открытых файлов

Текст внутри файла




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter