Greshnick
24-09-2011, 10:48
У меня возник следующий вопрос когда я делаю остановку поиска файлов, функция поиска выполняется в отдельном потоке. И запускаю снова то что сканировалось раньше почему то и памяти не выкидывается, почему?
Вот скин диспетчера задач до запуска поиска:
http://forum.oszone.net/attachment.php?attachmentid=70258&stc=1&d=1316846739
И после того как я несколько раз нажму кнопку остановки и запуска поиска:
http://forum.oszone.net/attachment.php?attachmentid=70259&stc=1&d=1316846819
То же самое происходит и если я не делаю остановок а подряд ищу файлы. Может я что то делаю не так?
Вот исходный код формы и потока:
Форма:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Label2: TLabel;
ComboBox1: TComboBox;
XPManifest1: TXPManifest;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
ComboBox2: TComboBox;
Label3: TLabel;
DateTimePicker1: TDateTimePicker;
Edit2: TEdit;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Vidim;
procedure ComboBox2Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
Stop : boolean;
end;
var
Form1: TForm1;
NewThread : TThread;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
If (ComboBox2.ItemIndex<>-1) and
(Edit1.Text<>'') or
(Edit2.Text<>'') or
(ComboBox1.ItemIndex<>-1) then
Begin
ListBox1.Clear; // î÷èñòêà ñïèñêà ôàéëîâ
Stop:=False;
Button1.Enabled:=False;
Form1.Label5.Visible:=True;
Form1.Label6.Visible:=True;
Form1.Label6.Caption:='Ñêàíèðîâàíèå íà÷àòî:';
NewThread:=Thread.Create(True);
NewThread.FreeOnTerminate:=True;
NewThread.Resume;
NewThread.Priority:=tpNormal;
end;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
if (ComboBox2.ItemIndex=0) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Âûáåðèòå èëè ââåäèòå ìàñêó ââîäà:';
ComboBox1.Visible:=True;
Label2.Visible:=True;
end;
if (ComboBox2.ItemIndex=1) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Óêàæèòå âðåìÿ ñîçäàíèÿ:';
DateTimePicker1.Visible:=True;
Label2.Visible:=True;
end;
if (ComboBox2.ItemIndex=2) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Óêàæèòå èìÿ ôàéëà:';
Edit2.Visible:=True;
Label2.Visible:=True;
end;
Edit1.Visible:=True;
Label1.Visible:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Vidim;
end;
procedure TForm1.Vidim;
begin
Label1.Visible:=False;
Label2.Visible:=False;
ComboBox1.Visible:=False;
Edit1.Visible:=False;
DateTimePicker1.Visible:=False;
Edit2.Visible:=False;
end;
procedure TForm1.ComboBox2Click(Sender: TObject);
begin
Form1.Vidim;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Stop:=True;
Button1.Enabled:=True;
end;
end.
Поток с функцией поиска:
unit Unit2;
interface
uses
Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF},SysUtils,Masks;
type
Thread = class(TThread)
private
Dir : string;
fff : string;
lll : string;
procedure SetName;
protected
procedure Execute; override;
public
I : integer;
A : boolean;
procedure FindFile(Dir : string; Name : string);
procedure Plus;
procedure Menys;
procedure Stoped;
end;
implementation
uses Unit1;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure Thread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF}
{ Thread }
procedure Thread.SetName;
{$IFDEF MSWINDOWS}
var
ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'NewThread';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
except
end;
{$ENDIF}
end;
procedure Thread.Execute;
begin
SetName;
A:=False;
FindFile(Form1.Edit1.Text, Form1.Edit2.Text);
Form1.Label5.Caption:='Âñåãî: '+IntToStr(I);
Form1.Label6.Caption:='Óäîâëåòâîðÿþùèõ: '+IntToStr(Form1.ListBox1.Items.Count);
Form1.Button1.Enabled:=True;
NewThread.WaitFor;
if terminated then exit;
end;
procedure Thread.FindFile(Dir : String; Name : String);
Var SR:TSearchRec;
FindRes:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
begin
if ((SR.Attr and faDirectory)=faDirectory) and
((SR.Name='.')or(SR.Name='..')) then
begin
FindRes:=FindNext(SR);
Continue;
end;
// åñëè íàéäåí êàòàëîã, òî
if ((SR.Attr and faDirectory)=faDirectory) then
begin
// âõîäèì â ïðîöåäóðó ïîèñêà ñ ïàðàìåòðàìè òåêóùåãî +
// êàòàëîã, ÷òî ìû íàøëè
FindFile(Dir+SR.Name+'\',Name);
FindRes:=FindNext(SR);
// ïîñëå îñìîòðà âëîæåííîãî êàòàëîãà ìû ïðîäîëæàåì ïîèñê
// â ýòîì êàòàëîãå
Continue; // ïðîäîëæèòü öèêë
end;
Stoped;
if (A=True) then exit;
lll:=SR.Name;
Synchronize(Menys);
case (Form1.ComboBox2.ItemIndex) of
2 :
Begin
if ((Form1.ComboBox2.ItemIndex=2) and (pos(Name,SR.Name)<>0)) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
1 :
Begin
if (FileDateToDateTime(SR.Time)>=Form1.DateTimePicker1.Date) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
0 :
Begin
if ((Form1.ComboBox1.Text='*.*') or (ExtractFileExt(SR.Name)=Form1.ComboBox1.Items.Strings[Form1.ComboBox1.ItemIndex])) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
end;
FindRes:=FindNext(SR);
end;
FindClose(SR);
end;
procedure Thread.Plus;
begin
Form1.ListBox1.Items.Add(fff);
end;
procedure Thread.Menys;
begin
Form1.Label5.Caption:='Ïîñëåäíèé íàéäåííûé :'+lll;
inc(I);
end;
procedure Thread.Stoped;
begin
A:=Form1.Stop;
end;
end.
Вот скин диспетчера задач до запуска поиска:
http://forum.oszone.net/attachment.php?attachmentid=70258&stc=1&d=1316846739
И после того как я несколько раз нажму кнопку остановки и запуска поиска:
http://forum.oszone.net/attachment.php?attachmentid=70259&stc=1&d=1316846819
То же самое происходит и если я не делаю остановок а подряд ищу файлы. Может я что то делаю не так?
Вот исходный код формы и потока:
Форма:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Label2: TLabel;
ComboBox1: TComboBox;
XPManifest1: TXPManifest;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
ComboBox2: TComboBox;
Label3: TLabel;
DateTimePicker1: TDateTimePicker;
Edit2: TEdit;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Vidim;
procedure ComboBox2Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
Stop : boolean;
end;
var
Form1: TForm1;
NewThread : TThread;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
If (ComboBox2.ItemIndex<>-1) and
(Edit1.Text<>'') or
(Edit2.Text<>'') or
(ComboBox1.ItemIndex<>-1) then
Begin
ListBox1.Clear; // î÷èñòêà ñïèñêà ôàéëîâ
Stop:=False;
Button1.Enabled:=False;
Form1.Label5.Visible:=True;
Form1.Label6.Visible:=True;
Form1.Label6.Caption:='Ñêàíèðîâàíèå íà÷àòî:';
NewThread:=Thread.Create(True);
NewThread.FreeOnTerminate:=True;
NewThread.Resume;
NewThread.Priority:=tpNormal;
end;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
if (ComboBox2.ItemIndex=0) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Âûáåðèòå èëè ââåäèòå ìàñêó ââîäà:';
ComboBox1.Visible:=True;
Label2.Visible:=True;
end;
if (ComboBox2.ItemIndex=1) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Óêàæèòå âðåìÿ ñîçäàíèÿ:';
DateTimePicker1.Visible:=True;
Label2.Visible:=True;
end;
if (ComboBox2.ItemIndex=2) then
Begin
Label1.Caption:='Óêàæèòå íà÷àëüíûé êàòàëîã:';
Label2.Caption:='Óêàæèòå èìÿ ôàéëà:';
Edit2.Visible:=True;
Label2.Visible:=True;
end;
Edit1.Visible:=True;
Label1.Visible:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Vidim;
end;
procedure TForm1.Vidim;
begin
Label1.Visible:=False;
Label2.Visible:=False;
ComboBox1.Visible:=False;
Edit1.Visible:=False;
DateTimePicker1.Visible:=False;
Edit2.Visible:=False;
end;
procedure TForm1.ComboBox2Click(Sender: TObject);
begin
Form1.Vidim;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Stop:=True;
Button1.Enabled:=True;
end;
end.
Поток с функцией поиска:
unit Unit2;
interface
uses
Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF},SysUtils,Masks;
type
Thread = class(TThread)
private
Dir : string;
fff : string;
lll : string;
procedure SetName;
protected
procedure Execute; override;
public
I : integer;
A : boolean;
procedure FindFile(Dir : string; Name : string);
procedure Plus;
procedure Menys;
procedure Stoped;
end;
implementation
uses Unit1;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure Thread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF}
{ Thread }
procedure Thread.SetName;
{$IFDEF MSWINDOWS}
var
ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'NewThread';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
except
end;
{$ENDIF}
end;
procedure Thread.Execute;
begin
SetName;
A:=False;
FindFile(Form1.Edit1.Text, Form1.Edit2.Text);
Form1.Label5.Caption:='Âñåãî: '+IntToStr(I);
Form1.Label6.Caption:='Óäîâëåòâîðÿþùèõ: '+IntToStr(Form1.ListBox1.Items.Count);
Form1.Button1.Enabled:=True;
NewThread.WaitFor;
if terminated then exit;
end;
procedure Thread.FindFile(Dir : String; Name : String);
Var SR:TSearchRec;
FindRes:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
begin
if ((SR.Attr and faDirectory)=faDirectory) and
((SR.Name='.')or(SR.Name='..')) then
begin
FindRes:=FindNext(SR);
Continue;
end;
// åñëè íàéäåí êàòàëîã, òî
if ((SR.Attr and faDirectory)=faDirectory) then
begin
// âõîäèì â ïðîöåäóðó ïîèñêà ñ ïàðàìåòðàìè òåêóùåãî +
// êàòàëîã, ÷òî ìû íàøëè
FindFile(Dir+SR.Name+'\',Name);
FindRes:=FindNext(SR);
// ïîñëå îñìîòðà âëîæåííîãî êàòàëîãà ìû ïðîäîëæàåì ïîèñê
// â ýòîì êàòàëîãå
Continue; // ïðîäîëæèòü öèêë
end;
Stoped;
if (A=True) then exit;
lll:=SR.Name;
Synchronize(Menys);
case (Form1.ComboBox2.ItemIndex) of
2 :
Begin
if ((Form1.ComboBox2.ItemIndex=2) and (pos(Name,SR.Name)<>0)) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
1 :
Begin
if (FileDateToDateTime(SR.Time)>=Form1.DateTimePicker1.Date) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
0 :
Begin
if ((Form1.ComboBox1.Text='*.*') or (ExtractFileExt(SR.Name)=Form1.ComboBox1.Items.Strings[Form1.ComboBox1.ItemIndex])) then
Begin
fff:=SR.Name;
Synchronize(Plus);
end;
end;
end;
FindRes:=FindNext(SR);
end;
FindClose(SR);
end;
procedure Thread.Plus;
begin
Form1.ListBox1.Items.Add(fff);
end;
procedure Thread.Menys;
begin
Form1.Label5.Caption:='Ïîñëåäíèé íàéäåííûé :'+lll;
inc(I);
end;
procedure Thread.Stoped;
begin
A:=Form1.Stop;
end;
end.