|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу. Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста". Название темы слишком короткое или не отражает сути вашего вопроса. Тема исчерпала себя, помните, один вопрос - одна тема Прочитайте правила и заново правильно создайте тему. |
|
Опции темы | Поиск в этой теме |
21.04.2014, 15:54 | #11 | |
Белик Виталий :)
Старожил
Регистрация: 23.07.2007
Сообщений: 57,097
|
Цитата:
I'm learning to live...
|
|
21.04.2014, 17:08 | #12 |
Пользователь
Регистрация: 21.04.2014
Сообщений: 11
|
Если программу поместить в папку windows и нет прав админа, то программа не работает
|
22.04.2014, 10:51 | #13 |
Пользователь
Регистрация: 21.04.2014
Сообщений: 11
|
В чем ошибка, люди?
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(aPath:String); var SearchRec: TSearchRec; // информация о файле или каталоге begin 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(aPath+'.*', 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; 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_PA TH*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; // кол-во найденных файлов Find(Edit2.Text); 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. |
22.04.2014, 11:30 | #14 |
Пользователь
Регистрация: 21.04.2014
Сообщений: 11
|
Все. Нашел. Работает
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
команда 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 |