Форум: "Основная";
Текущий архив: 2006.05.28;
Скачать: [xml.tar.bz2];

Вниз

Поиск в потоке   Найти похожие ветки 

← →
13   (2006-04-22 18:16) [0]

Написал программу для поиска файлов на диске, однако при поиске  
 программа загружает процессор на 100% и становится подвисшей. У меня вопрос как можно реализовать поиск в отдельном потоке.

---

← →
antonn ©   (2006-04-22 18:33) [1]

примерно также, как и основном потоке...

---

← →
13   (2006-04-22 18:40) [2]

а можно пример или поподробней

---

← →
Мефисто   (2006-04-22 18:48) [3]

\Delphi\Demos\Threads

---

← →
antonn ©   (2006-04-22 18:52) [4]

unit FildSkin;

interface

uses
 Windows, Messages, Classes, SysUtils;

type
 TFindSkinThread = class(TThread)
 private
   _FindList:Tstrings;
   Path:string;
   Old:boolean;
   function adddir(Path: string; Recursive: Bool; dd:Tstrings): integer;
 protected
   procedure Execute; override;
   destructor Destroy; override;
   procedure BackList;
 public
   constructor Create(CreateSuspennded: Boolean; const _Path: string);
 end;

implementation

uses Skin_file;

constructor TFindSkinThread.Create(CreateSuspennded: Boolean; const _Path:string);
begin
 inherited Create(true);
 Path:=_Path;
 resume;
end;

function NormalDir(const DirName: string): string;
begin
 Result := DirName;
 if (Result <> "") and
{$IFDEF RX_D3}
 not (AnsiLastChar(Result)^ in [":", "\"]) then
{$ELSE}
 not (Result[Length(Result)] in [":", "\"]) then
{$ENDIF}
 begin
   if (Length(Result) = 1) and (UpCase(Result[1]) in ["A".."Z"]) then
     Result := Result + ":\"
   else Result := Result + "\";
 end;
end;

function TFindSkinThread.adddir(Path: string; Recursive: Bool; dd:Tstrings): integer;
var Dirs: TSearchRec; Res,Ver: integer;
begin
   Result := -1;
    Res := FindFirst(NormalDir(Path) + "*.*", faReadOnly + faHidden + faArchive + faDirectory, Dirs);
        while Res = 0 do
        begin
   if ((Dirs.Attr and faDirectory) <> 0) and (Recursive)
     then begin
     if not ((Dirs.Name = ".") or (Dirs.Name = ".."))
        then begin
       if Result < 0
         then Result := adddir(NormalDir(Path) + Dirs.Name, True,dd)
       else
         adddir(NormalDir(Path) + Dirs.Name, True,dd);
     end
   end
   else begin
       if lowercase(extractfileext(Dirs.Name))=".sdc" then  begin
        dd.Add( NormalDir(Path)+Dirs.Name);
       end;
   end;
   Res := FindNext(Dirs);
 end;
 FindClose(Dirs);
end;

procedure TFindSkinThread.Execute;
begin
 FreeOnTerminate:=True;
 _FindList:=TstringList.Create;
 try
 adddir(path,true,_FindList);
 Synchronize(BackList);
 finally
 _FindList.Free;
 end;
end;

destructor TFindSkinThread.Destroy;
begin
Terminate;
inherited;
end;

procedure TFindSkinThread.BackList;
begin
 Skin_file.Build_skin_stringsThread(_FindList);
//короче тут передача "потокового" списка с найденым в основной поток (к Tform1, например)
end;

end.

использование в программе:
var FindSkinThread:TFindSkinThread;
begin
FindSkinThread:=TFindSkinThread.Create(false,path1);
end;

ЗЫ где то мог чего переудалить, т.ч. это только для примера:)

---

← →
begin...end ©   (2006-04-22 20:04) [5]

> antonn ©   (22.04.06 18:52) [4]

Деструктор можно убрать.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2006.05.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.01 c