原帖地址:http://blog.sina.com.cn/s/blog_5591c079010005pq.html
习惯了 Delphi 的 VCL 框架后, 越来越了解封装的好处. 可是一到写多线程程序的时候, 由于 VCL 并非线程安全的缘故, 必须用 Synchronize 去直接访问窗体中的内容从而实现和界面层的交互, 可是这样就完全破坏了封装的美感和代码的独立, 实在是让人感觉到难受.
;并非线程安全的缘故, 必须用 Sync
如何解决这个问题呢? 本人觉得, 著名的 Observer 模式似乎是个很好的解决方案. 以提供主题和观察者的方式, 在封装的前提下, 让线程无须知道哪个对象关心它执行中的结果, 就能把运行中的状态和结果派发出去, 从而实现了将原本线程和显示控件之间的强耦合关系脱耦, 由于观察者可允许一对多的情况存在, 所以也就实现了能同时更新数个界面显示的功能.
线程程序的时候, 由于 VCL
这里就不解释 Observer 模式了, 有兴趣的朋友, 请参见<<设计模式>>中的相关章节. 下面我们直奔主题, 来看看如何用 Observer 模式实现与主题订阅者之间的通讯吧. 那么从哪里开始呢? 就以一个最常见的文件搜索的功能来制作 Demo 吧.
当需要搜索某个目录下的文件的时候, 通常使用 FindFirstFile/FindNextFile 等 API 函数来历遍整个目录, 最常见的就是用递归的方式完成目录的深度搜索. 可是一般在执行搜索的过程中, 界面会被锁死, 即使是在循环中使用了 Application.ProcessMessages 的话, 也很难实现搜索的暂停和恢复. 看来用线程是个比较合适的选择了.
, 越来越了解封装的好处. 可是一到写多
首先我们把搜索功能封装成一个类 (TFileSearchEngine), 下面看看它有哪些属性方法:
1
TSearchFoundEvent
=
procedure
(Sender: TObject;
const
BaseDir:
string
;
2
const
FoundRec: TSearchRec)
of
Object;
3
4
TFileSearchEngine
=
class
(TComponent)
5
private
6
FRootDir:
string
;
7
FIncludeSubDir: Boolean;
8
FOnFound: TSearchFoundEvent;
9
FAborted: Boolean;
10
FWorking: Boolean;
11
procedure
SetIncludeSubDir(
const
Value: Boolean);
12
procedure
SetRootDir(
const
Value:
string
);
13
procedure
SetAborted(
const
Value: Boolean);
14
protected
15
procedure
DoFound(
const
BaseDir:
string
;
const
Found: TSearchRec);
dynamic
;
16
public
17
constructor
Create(AOwner: TComponent);
overload
;
override
;
18
constructor
Create(AOwner: TComponent;
const
ARootDir:
string
);
overload
;
19
procedure
Search;
virtual
;
20
procedure
Abort;
21
22
property
Working: Boolean
read
FWorking;
23
property
Aborted: Boolean
read
FAborted
write
SetAborted;
24
published
25
property
RootDir:
string
read
FRootDir
write
SetRootDir;
26
property
IncludeSubDir: Boolean
read
FIncludeSubDir
write
SetIncludeSubDir;
27
property
OnFound: TSearchFoundEvent
read
FOnFound
write
FOnFound;
28
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

这个类并不复杂, 主要实现了对目录的递归搜索, 其中几个属性也很简单, 通过名字就能知道它们的作用了, 这里我就不赘述了. TFileSearchEngine 可以适用于多线程和单线程模式下, 所以现在我们就来考虑如何在多线程模式下将查找到的文件实时发送给界面(也就是主题订阅者)的实现.
首先是要定义好观察者的接口, 这里我采用了 Interface 而不是 Abstract Class 的方式. 因为 Interface 更加灵活, 能让任何控件和类支持 (只要实现该接口即可), 而不像 Abstract Class 那样固定了继承树.
1
IObserverWatcher
=
interface
(IInterface)
2
[
'
{8ED26F9D-9377-4829-B305-3A825ECC231B}
'
]
3
function
Update(Dispatch: TCustomSubjectDispatcher): Boolean;
4
end
;

2

3

4

1
TCustomSubjectDispatcher
=
class
(TObject)
2
private
3
FObserverList: TSafedObjectList;
4
FMultipleDispatch: Boolean;
5
procedure
SetMultipleDispatch(
const
Value: Boolean);
6
protected
7
function
ObserverSupportDispatch(AObserver: TComponent): Boolean;
virtual
;
8
function
DoObserverUpdate(AObserver: TComponent): Boolean;
virtual
;
9
public
10
constructor
Create(AMultipleDispatch: Boolean);
11
destructor
Destroy;
override
;
12
procedure
NotifyObservers;
13
function
Attach(AObserver: TComponent): Integer;
14
procedure
Detach(AObserver: TComponent);
15
property
MultipleDispatch: Boolean
read
FMultipleDispatch
write
SetMultipleDispatch;
16
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

1
procedure
TCustomSubjectDispatcher.NotifyObservers;
2
var
3
I: Integer;
4
begin
5
FObserverList.Enter;
6
try
7
for
I :
=
FObserverList.Count
-
1
downto
0
do
8
try
9
if
(DoObserverUpdate((FObserverList[I]
as
TComponent)))
and
10
(
not
FMultipleDispatch)
11
then
Break;
12
except
13
Continue;
14
end
;
15
finally
16
FObserverList.Leave;
17
end
;
18
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

1
function
TCustomSubjectDispatcher.DoObserverUpdate(AObserver: TComponent): Boolean;
2
begin
3
Result :
=
(AObserver
as
IObserverWatcher).Update(Self);
4
end
;

2

3

4

这两个方法也很简单, NotifyObservers 首先进入 FObserverList, 然后把每个对象取出来, 传给 DoObserverUpdate 方法来执行 IObserverWatcher.Update 接口. 这样做的好处是, 子类可以覆盖 DoObserverUpdate, 用别的观察者接口来调用 Observer, 使得这个架构更加灵活. 线程程序的时候, 由于 VCL
1
type
2
TSearchFoundInfo
=
record
3
Directory:
string
;
4
Name:
string
;
5
Name_
8
_
3
:
string
;
6
FullPathName:
string
;
7
Size: Int64;
8
Attributes: Integer;
9
CreationTime,
10
LastAccessTime,
11
LastWriteTime: TDateTime;
12
{
$IFDEF VCL10ORABOVE
}
13
class
operator Implicit(ASearchRec:TSearchRec): TSearchFoundInfo;
14
class
operator Explicit(ASearchRec: TSearchRec): TSearchFoundInfo;
15
{
$ENDIF
}
16
end
;
17
18
TFileFoundSubjectStatus
=
(fdsBeforeSearch, fdsSearching, fdsSearchDone, fdsSearchAborted);
19
20
TFileFoundSubjectDispatcher
=
class
(TCustomSubjectDispatcher)
21
private
22
FSearchFoundInfo: TSearchFoundInfo;
23
FStatus: TFileFoundSubjectStatus;
24
public
25
property
SearchFoundInfo: TSearchFoundInfo
read
FSearchFoundInfo
write
FSearchFoundInfo;
26
property
Stauts: TFileFoundSubjectStatus
read
FStatus
write
FStatus;
27
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

------------------------------------------------------------------------------------------------------
先来看看这个模式的UML图:
上次介绍完了文件搜索和观察者模式的相关代码, 现在轮到线程类粉末登场了.
1
type
2
TThreadFileSearch
=
class
(TThread)
3
private
4
FFileSearch: TFileSearchEngine;
5
FIncludeSubDir: Boolean;
6
FSearchRootDir:
string
;
7
FUpdateSubjectDispatcher: TFileFoundSubjectDispatcher;
8
procedure
SetIncludeSubDir(
const
Value: Boolean);
9
procedure
SetSearchRootDir(
const
Value:
string
);
10
procedure
OnSearch(Sender: TObject;
const
BaseDir:
string
;
11
const
FoundRec: TSearchRec);
12
procedure
SetUpdateSubjectDispatcher(
const
Value: TFileFoundSubjectDispatcher);
13
procedure
BeforeSearch;
14
procedure
SearchDone;
15
procedure
SearchAborted;
16
procedure
DispatchNotification(NotifyStates: TFileFoundSubjectStatus);
17
public
18
constructor
Create(CreateSuspended: Boolean; ASubjectDispatcher: TFileFoundSubjectDispatcher;
19
const
ASearchRoot:
string
; AIncludeSubDir: Boolean);
reintroduce
;
overload
;
virtual
;
20
destructor
Destroy;
override
;
21
procedure
Execute;
override
;
22
property
SearchRootDir:
string
read
FSearchRootDir
write
SetSearchRootDir;
23
property
IncludeSubDir: Boolean
read
FIncludeSubDir
write
SetIncludeSubDir;
24
property
UpdateSubjectDispatcher: TFileFoundSubjectDispatcher
25
read
FUpdateSubjectDispatcher
write
SetUpdateSubjectDispatcher;
26
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

1
procedure
TThreadFileSearch.DispatchNotification(
2
NotifyStates: TFileFoundSubjectStatus);
3
var
4
DoDispatch: TFileFoundSubjectDispatcher;
5
begin
6
DoDispatch :
=
FUpdateSubjectDispatcher;
7
if
DoDispatch
<>
nil
then
8
begin
9
DoDispatch.Stauts :
=
NotifyStates;
10
Synchronize(DoDispatch.NotifyObservers);
11
end
;
12
end
;
13
14
procedure
TThreadFileSearch.Execute;
15
begin
16
BeforeSearch;
17
try
18
FFileSearch.Search;
19
finally
20
if
not
FFileSearch.Aborted
then
21
SearchDone
22
else
23
SearchAborted;
24
end
;
25
end
;
26
27
procedure
TThreadFileSearch.OnSearch(Sender: TObject;
const
BaseDir:
string
;
28
const
FoundRec: TSearchRec);
29
var
30
DoDispatch: TFileFoundSubjectDispatcher;
31
begin
32
if
not
Terminated
then
33
begin
34
DoDispatch :
=
FUpdateSubjectDispatcher;
35
if
DoDispatch
<>
nil
then
36
begin
37
{
$IFDEF VCL10ORABOVE
}
38
DoDispatch.SearchFoundInfo :
=
FoundRec;
39
{
$ELSE
}
40
DoDispatch.SearchFoundInfo :
=
SearchRec2SearchFoundInfo(FoundRec);
41
{
$ENDIF
}
42
with
DoDispatch.SearchFoundInfo
do
43
begin
44
Directory :
=
BaseDir;
45
FullPathName :
=
BaseDir
+
FoundRec.Name;
46
end
;
47
DispatchNotification(fdsSearching);
48
end
;
49
end
50
else
51
FFileSearch.Abort;
52
end
;

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

好了, 一切顺利, 离大功告成仅有一步之遥. 接下来实现界面上的 Observer, 并调用 TThreadFileSearch 即可.
1
procedure TTThreadFileSearchDemo.FormCreate(Sender: TObject);
2
begin
3
FThreadFileSearch := nil;
4
FFIleFoundSubjectDispatcher := TFileFoundSubjectDispatcher.Create(False);
5
FFIleFoundSubjectDispatcher.Attach(Self);
6
end;
1
procedure TTThreadFileSearchDemo.btnSearchClick(Sender: TObject);
2
3
procedure AppendInComboBox(const S: string; AComboBox: TComboBox); {$IFDEF VCL10ORABOVE}inline;{$ENDIF}
4
var
5
Index: Integer;
6
begin
7
if (S <> '') and (Trim(S) <> '') then
8
begin
9
Index := AComboBox.Items.IndexOf(S);
10
if Index = -1 then
11
AComboBox.Items.Insert(0, S)
12
else
13
AComboBox.Items.Move(index, 0);
14
end;
15
end;
16
17
begin
18
if (Trim(cbbSearchDir.Text) = '') or (Length(cbbSearchDir.Text) < 3) then
19
begin
20
MessageBox(Handle, '请输入您需要搜索的目录.', '警告',
21
MB_ICONWARNING);
22
cbbSearchDir.SetFocus;
23
cbbSearchDir.SelectAll;
24
Exit;
25
end
26
else if (cbbSearchDir.Text[2] <> ':') or (cbbSearchDir.Text[3] <> '\') then
27
begin
28
MessageBox(Handle, '请输入一个有效的路径.', '错误', MB_ICONERROR);
29
cbbSearchDir.SetFocus;
30
cbbSearchDir.SelectAll;
31
Exit;
32
end
33
else if not DirectoryExists(cbbSearchDir.Text) then
34
begin
35
MessageBox(Handle, '请输入一个存在的目录.', '警告', MB_ICONWARNING);
36
cbbSearchDir.SetFocus;
37
cbbSearchDir.SelectAll;
38
Exit;
39
end;
40
AppendInComboBox(cbbSearchDir.Text, cbbSearchDir);
41
if FThreadFileSearch = nil then
42
begin
43
SearchFileCount := 0;
44
SearchSpace := 0;
45
LockUIComponents;
46
FThreadFileSearch := TThreadFileSearch.Create(True, FFIleFoundSubjectDispatcher,
47
cbbSearchDir.Text, True);
48
FThreadFileSearch.Priority := FPriority;
49
FThreadFileSearch.OnTerminate := ThreadOnTerminate;
50
FThreadFileSearch.FreeOnTerminate := True;
51
FThreadFileSearch.Resume;
52
end
53
else
54
MessageBox(Handle, '请首先停止当前的搜索工作, 然后再点击"搜索"按钮.',
55
'错误', MB_ICONERROR);
56
end;
1
procedure TTThreadFileSearchDemo.OnSearching(const ASearchFoundInfo: TSearchFoundInfo);
2
begin
3
if lblStatus.Caption <> '正在搜索
' then
4
lblStatus.Caption := '正在搜索
';
5
SearchFileCount := SearchFileCount + 1;
6
SearchSpace := SearchSpace + ASearchFoundInfo.Size;
7
edtPath.Text := ASearchFoundInfo.Directory;
8
edtName.Text := ASearchFoundInfo.Name;
9
lblSize.Caption := Format('大小: %s', [FormatFileSize(ASearchFoundInfo.Size,
10
stT, True)]);
11
lblAttr.Caption := Format('属性: %d', [ASearchFoundInfo.Attributes]);
12
lblCreateTime.Caption := '创建时间: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',
13
ASearchFoundInfo.CreationTime);
14
lblLastAccessTime.Caption := '最后访问时间: ' + FormatDateTime('yyyy-mm-dd',
15
ASearchFoundInfo.LastAccessTime);
16
lblLastWriteTime.Caption := '最后写入时间: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',
17
ASearchFoundInfo.LastWriteTime);
18
lbl8_3Name.Caption := Format('8.3文件名: %s', [ASearchFoundInfo.Name_8_3]);
19
end;
20
21
function TTThreadFileSearchDemo.ProcessUpdate(
22
ACustomSubjectDispatcher: TCustomSubjectDispatcher): Boolean;
23
var
24
Dsp: TFileFoundSubjectDispatcher;
25
begin
26
Result := False;
27
if ACustomSubjectDispatcher is TFileFoundSubjectDispatcher then
28
begin
29
Dsp := ACustomSubjectDispatcher as TFileFoundSubjectDispatcher;
30
case Dsp.Stauts of
31
fdsBeforeSearch: OnBeginSearch;
32
fdsSearching: OnSearching(Dsp.SearchFoundInfo);
33
fdsSearchDone: OnSearchDone;
34
fdsSearchAborted: OnSearchAborted;
35
end;
36
Result := True;
37
end;
38
end;
按下 F9, 点击 Search 按钮, 试试看, 呵呵非常成功!
,
先来看看这个模式的U
上次介绍完了文件搜索和观察者模式的相关代
om.cnu5591c079010005