Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > БД в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 21.04.2014, 10:08   #1
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию Избавиться от chdir

Программа поиска файлов, нужно обойтись без chdir. Подскажите как модернизировать код.
Код:
unit FindFile_;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  FileCtrl;

type
  TForm1 = class(TForm)
    Edit1: TEdit;       // что искать
    Edit2: TEdit;       // где искать
    Memo1: TMemo;       // результат поиска
    Button1: TButton;   // кнопка Поиск
    Button2: TButton;   // кнопка Папка
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
   FileName: string;  // имя или маска искомого файла
   cDir: string;
   n: integer;       // кол-во файлов, удовлетворяющих запросу

// поиск файла в текущем каталоге
procedure Find;
var
   SearchRec: TSearchRec; // информация о файле или каталоге
begin
   GetDir(0,cDir); // получить имя текущего каталога
   if cDir[length(cDir)] <> '\' then cDir := cDir+'\';

   if FindFirst(FileName, faArchive,SearchRec) = 0 then
       repeat
          if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
             begin
               Form1.Memo1.Lines.Add(cDir +  SearchRec.Name);
               n := n + 1;
             end;
        until FindNext(SearchRec) <> 0;

       // обработка подкаталогов текущего каталога
       if FindFirst('*', faDirectory, SearchRec) = 0 then
          repeat
              if (SearchRec.Attr and faDirectory) = SearchRec.Attr then
                  begin
                    // каталоги .. и . тоже каталоги,
                    // но в них входить не надо !!!
                    if SearchRec.Name[1] <> '.' then
                       begin
                         ChDir(SearchRec.Name);// войти в каталог
                         Find; // выполнить поиск в подкаталоге
                         ChDir('..');// выйти из каталога
                       end;
                  end;
          until FindNext(SearchRec) <> 0;
end;

// возвращает каталог, выбранный пользователем
function GetPath(mes: string):string;
var
  Root: string;      // корневой каталог
  pwRoot : PWideChar;
  Dir: string;
begin
  Root := ''; // корневой каталог - папка Рабочий стол
  GetMem(pwRoot, (Length(Root)+1) * 2);
  pwRoot := StringToWideChar(Root,pwRoot,MAX_PATH*2);
  if SelectDirectory(mes, pwRoot, Dir)
     then
          if length(Dir) = 2  // пользователь выбрал корневой каталог
              then GetPath := Dir+'\'
              else GetPath := Dir
     else
          GetPath := '';
end;

// щелчок на кнопке Поиск
procedure TForm1.Button1Click(Sender: TObject);
begin
        Memo1.Clear;             // очистить поле Memo1
        Label4.Caption := '';
        FileName := Edit1.Text;  // что искать
        cDir := Edit2.Text;      // где искать
        n:=0;                    // кол-во найденных файлов
        ChDir(cDir);             // войти в каталог начала поиска
        Find;                    // начать поиск
        if n = 0 then
           ShowMessage('Файлов, удовлетворяющих критерию поиска нет.')
        else Label4.Caption := 'Найдено файлов:' + IntToStr(n);
end;

// щелчок на кнопке Папка
procedure TForm1.Button2Click(Sender: TObject);
var
  Path: string;
begin
  Path := GetPath('Выберите папку');
  if Path <> ''
     then Edit2.Text := Path;
end;

end.

Последний раз редактировалось Stilet; 21.04.2014 в 10:28.
flyingbudda вне форума
Старый 21.04.2014, 10:32   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Код:
procedure Find(aPath:String);
...
if FindFirst(aPath+FileName, faArchive,SearchRec) = 0 then
...
                    if SearchRec.Name[1] <> '.' then
                       begin
                         Find(aPath+SearchRec.Name); // выполнить поиск в подкаталоге
                       end;
...
В качестве примера: http://www.programmersforum.ru/showthread.php?t=6639
I'm learning to live...
Stilet вне форума
Старый 21.04.2014, 10:45   #3
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию

Поменял, теперь выдает ошибку в строке 102, а именно
[Pascal Error] FindFile_.pas(102): E2035 Not enough actual parameters

Последний раз редактировалось flyingbudda; 21.04.2014 в 11:02.
flyingbudda вне форума
Старый 21.04.2014, 11:16   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Догадываться что в 102-й строке мне нужно?
Ладно. Телепатирую: Find вызываешь изначально по клику кнопки без передачи ему пути. Передай ему в параметр Edit2.Text.
I'm learning to live...
Stilet вне форума
Старый 21.04.2014, 11:24   #5
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию

Прошу прощения, спасибо за помощь!
flyingbudda вне форума
Старый 21.04.2014, 11:55   #6
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию

я правильно понял?
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
        Memo1.Clear;             // очистить поле Memo1
        Label4.Caption := '';
        FileName := Edit1.Text;  // что искать
        cDir := Edit2.Text;      // где искать
        n:=0;                    // кол-во найденных файлов
        ChDir(cDir);             // войти в каталог начала поиска
        Find(Edit2.Text)            // начать поиск
        if n = 0 then
           ShowMessage('Файлов, удовлетворяющих критерию поиска нет.')
        else Label4.Caption := 'Найдено файлов:' + IntToStr(n);
end;
flyingbudda вне форума
Старый 21.04.2014, 11:58   #7
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

ChDir(cDir); уже не нужен. Можешь его убирать.
Еще раз внимательно посмотри пример по ссылке что я дал. Проанализируй его.
I'm learning to live...
Stilet вне форума
Старый 21.04.2014, 12:06   #8
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию

Да я сижу, разбираю его. Стараюсь перенести его на мой пример.
Функция поиска правильно построена?
procedure Find(aPath:String);
var
SearchRec: TSearchRec; // информация о файле или каталоге
begin
GetDir(0,cDir); // получить имя текущего каталога
if cDir[length(cDir)] <> '\' then cDir := cDir+'\';

if FindFirst(aPath+FileName, faArchive,SearchRec) = 0 then
repeat
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
begin
Form1.Memo1.Lines.Add(cDir + SearchRec.Name);
n := n + 1;
end;
until FindNext(SearchRec) <> 0;

// обработка подкаталогов текущего каталога
if FindFirst('*', faDirectory, SearchRec) = 0 then
repeat
if (SearchRec.Attr and faDirectory) = SearchRec.Attr then
begin
// каталоги .. и . тоже каталоги,
// но в них входить не надо !!!
if SearchRec.Name[1] <> '.' then
begin
Find(aPath+Searchrec.Name);//выполнить поиск в подкаталоге
end;
end;
until FindNext(SearchRec) <> 0;
flyingbudda вне форума
Старый 21.04.2014, 12:51   #9
northener
ПШП
Участник клуба
 
Регистрация: 15.07.2013
Сообщений: 1,859
По умолчанию

Код:
if (SearchRec.Attr and faХХХ) = SearchRec.Attr then
В любом случае такое сравнение в корне неверное. Потеряется куча файлов и папок.
northener вне форума
Старый 21.04.2014, 15:50   #10
flyingbudda
Пользователь
 
Регистрация: 21.04.2014
Сообщений: 11
По умолчанию

я делал поиск для файлов dbf, с chdir все прекрасно работало. Но от chdir надо уйти.
flyingbudda вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
команда cd, смена текущего каталога в cmd через chdir.exe crosby87 Общие вопросы C/C++ 3 27.11.2013 00:05
Избавиться от BlueScreen Анастасия2013 Windows 5 30.01.2013 09:59
Как избавиться от #Н/Д? kachorro Microsoft Office Excel 10 26.04.2012 06:38
Избавиться от нагромождения IF fezilk25 Общие вопросы Delphi 9 17.11.2010 20:30