|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
||||
|
||||
Cheater, какие свойства и методы должны быть (хочется иметь, указано в задании, приказано реализовать) у компонента?
Пишу программы за еду. __________________ |
#17
|
|||
|
|||
Цитата:
Путь по которому производить поиск И имя файла, в который сохранять результат поиска Сомневаюсь на счет маски, так что думаю *.* пойдет. А метод Execute |
#18
|
||||
|
||||
что-то типа этого:
Код:
unit Finder; interface uses SysUtils, Classes; type TFinder = class(TComponent) private FMask: String; FDirectory: String; FAttr: Integer; FIncludeParentPath: Boolean; FFindList: TStringList; procedure SetMask(const Value: String); procedure SetDirectory(const Value: String); procedure SetAttr(const Value: Integer); public property FindList: TStringList read FFindList; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Execute; published property Mask: String read FMask write SetMask; property Directory: String read FDirectory write SetDirectory; property Attr: Integer read FAttr write SetAttr; property IncludeParentPath: Boolean read FIncludeParentPath write FIncludeParentPath; end; procedure Register; implementation procedure Register; begin RegisterComponents('Internet', [TFinder]); end; constructor TFinder.Create(AOwner: TComponent); begin inherited Create(AOwner); FMask:='*.*'; FDirectory:=''; FAttr:=faAnyFile; FIncludeParentPath:=True; FFindList:=TStringList.Create; end; destructor TFinder.Destroy; begin FFindList.Free; inherited Destroy; end; procedure TFinder.SetMask(const Value: String); begin if Value='' then FMask:='*.*' else FMask:=Value; end; procedure TFinder.SetDirectory(const Value: String); begin if Value='' then FDirectory:='' else FDirectory:=IncludeTrailingPathDelimiter(Value); end; procedure TFinder.SetAttr(const Value: Integer); begin if Value<=0 then FAttr:=faAnyFile else FAttr:=Value; end; procedure TFinder.Execute; var ASearchRec: TSearchRec; ADirList: TStringList; AFileList: TStringList; begin FFindList.Clear; ADirList:=TStringList.Create; AFileList:=TStringList.Create; try if FindFirst(FDirectory+FMask, FAttr, ASearchRec)=0 then begin repeat if (ASearchRec.Attr and faDirectory)=faDirectory then begin if (ASearchRec.Name<>'.') and (ASearchRec.Name<>'..') then if FIncludeParentPath then ADirList.Add(FDirectory+IncludeTrailingPathDelimiter(ASearchRec.Name)) else ADirList.Add(IncludeTrailingPathDelimiter(ASearchRec.Name)); end else begin if (ASearchRec.Name<>'.') and (ASearchRec.Name<>'..') then if FIncludeParentPath then AFileList.Add(FDirectory+ASearchRec.Name) else AFileList.Add(ASearchRec.Name); end; until FindNext(ASearchRec)<>0; end; ADirList.Sort; FFindList.AddStrings(ADirList); AFileList.Sort; FFindList.AddStrings(AFileList); finally AFileList.Free; ADirList.Free; end; end; end. Пишу программы за еду. __________________ |
#19
|
||||
|
||||
свойства:
property FindList: TStringList - результирующий список property Mask: String - маска (*.* *.txt и т.д.) property Directory: String - путь (c:\WINDOWS) property Attr: Integer - аттрибуты (faAnyFile, faReadOnly or faHidden or faDirectory и т.д.) property IncludeParentPath: Boolean - включать родительский путь (Японский мотив.bmp или c:\WINDOWS\Японский мотив.bmp) метод: Execute сохранять в файл: Код:
type TForm1 = class(TForm) Finder1: TFinder; Finder1.FindList.SaveToFile('c:\Downloads\Новая папка.txt'); Пишу программы за еду. __________________ Последний раз редактировалось NumLock, 18.05.2011 в 14:41. |
#20
|
|||
|
|||
Спасибо огромное!!!
Проинсталлировал компонент. Но после создания такой формы, файл создается, но пустой... А ошибок не пишет... Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Finder; type TForm1 = class(TForm) Finder1: TFinder; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Finder1.FindList.SaveToFile('Z:\fff.txt'); end; end. Последний раз редактировалось Admin, 18.05.2011 в 17:41. |
#21
|
||||
|
||||
для получения списка нужно сначала Execute вызвать, а уж потом...
Пишу программы за еду. __________________ |
#22
|
|||
|
|||
Цитата:
Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Finder; type TExecute = procedure of object; TForm1 = class(TForm) Finder1: TFinder; Button1: TButton; procedure Button1Click(Sender: TObject); private procedure ExecuteFinder1(Instance: TObject); end; var Form1: TForm1; Execute: TExecute; implementation procedure TForm1.ExecuteFinder1(Instance: TObject); begin Execute := TExecute(Finder1); Execute; end; procedure TForm1.Button1Click(Sender: TObject); begin ExecuteFinder1(Instance: TObject); Finder1.FindList.SaveToFile('Z:\fff.txt'); end; end. Последний раз редактировалось Cheater, 18.05.2011 в 19:03. |
#23
|
||||
|
||||
Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Finder; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Finder1: TFinder; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Finder1.Directory:='c:\Windows'; // можно задать в design-time Finder1.Mask:='*.*'; // можно задать в design-time Finder1.Execute; Memo1.Lines.Assign(Finder1.FindList); Finder1.FindList.SaveToFile('g:\__Apps\__\Finder.txt'); end; end. Пишу программы за еду. __________________ |
#24
|
|||
|
|||
ООО, УРА!!!
Заработало!!! Спасибо огромное! Даже и не знаю как Вас благодарить! |
#25
|
|||
|
|||
Упс, а как добавить чтобы оно еще и во вложенных директориях искало файлы и каталоги?
|
#26
|
||||
|
||||
добавил просмотр подкаталогов, ну и кое-что изменил для несовместимости с пред. версией (сейчас все так делают )
метод Find вместо Execute свойства: property Mask: String - без изменений property Directory: String - без изменений property Attr: TFileAttributes - сделал набором значений property IncludeParentPath: Boolean - без изменений property IncludeSubDirectory: Boolean - просмотр подкаталогов property IncludeDirectoryName: Boolean - включать в список имена папок (имена папок оканчиваются "\") или только файлы Пишу программы за еду. __________________ |
#27
|
|||
|
|||
Спасибо.
Все сделал и сдал!
|