关于线程问题

flitooo 2009-12-23 04:53:13
创建6个线程,6个Memo,每个线程固定对应一个Memo,运行时线程过程ThreadJob调用ThreadLog将日志写到memo中(一个线程写一个memo,固定的)。

问题是当我把临界区放在ThreadJob中时,程序正常运行,比如像下面这样:
procedure ThreadLog(Const msg: String);
begin
TMemo(
List.Objects[List.IndexOf(IntToStr(GetCurrentThreadId()))]
).Lines.Add(FormatDateTime('[yyyy-mm-dd hh:nn:ss.zzz]: ', Now) + IntToStr(GetCurrentThreadId()));
end;

function ThreadJob(): DWORD; stdcall;
begin
while APPRUN do begin

EnterCriticalSection(CS);
ThreadLog('');
LeaveCriticalSection(CS);

end;
Result := 0;
end;

当我把临界区放在ThreadLog里时,程序运行一会就报错:
procedure ThreadLog(Const msg: String);
begin

EnterCriticalSection(CS);
TMemo(
List.Objects[List.IndexOf(IntToStr(GetCurrentThreadId()))]
).Lines.Add(FormatDateTime('[yyyy-mm-dd hh:nn:ss.zzz]: ', Now) + IntToStr(GetCurrentThreadId()));
LeaveCriticalSection(CS);

end;

function ThreadJob(): DWORD; stdcall;
begin
while APPRUN do begin
ThreadLog('');
end;
Result := 0;
end;

请问这是为什么???





源码:

unit U1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
mLog: TMemo;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
Memo6: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}



var
APPRUN: Boolean = False;
hThread,
hThread2,
hThread3,
hThread4,
hThread5,
hThread6: THandle;
CS: TRTLCriticalSection; //临界区对象
List: TStringList;


procedure ThreadLog(Const msg: String);
begin
EnterCriticalSection(CS);
TMemo(
List.Objects[List.IndexOf(IntToStr(GetCurrentThreadId()))]
).Lines.Add(FormatDateTime('[yyyy-mm-dd hh:nn:ss.zzz]: ', Now) + IntToStr(GetCurrentThreadId()));
LeaveCriticalSection(CS);
end;



function ThreadJob(): DWORD; stdcall;
begin
while APPRUN do begin
ThreadLog('');
end;
Result := 0;
end;


//开始运行或停止程序
procedure TForm1.Button1Click(Sender: TObject);
var
ID: DWORD;
begin
if APPRUN then begin
Button1.Caption := '开始';
APPRUN := False;
CloseHandle(hThread);
CloseHandle(hThread2);
CloseHandle(hThread3);
CloseHandle(hThread4);
CloseHandle(hThread5);
CloseHandle(hThread6);
end
else begin
APPRUN := True;
Button1.Caption := '停止';

List.Clear;

hThread := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo1);

hThread2 := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo2);

hThread3 := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo3);

hThread4 := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo4);

hThread5 := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo5);

hThread6 := CreateThread(nil, 0, @ThreadJob, nil, CREATE_SUSPENDED, ID);
List.AddObject(IntToStr(ID), Memo6);

ResumeThread(hThread);
ResumeThread(hThread2);
ResumeThread(hThread3);
ResumeThread(hThread4);
ResumeThread(hThread5);
ResumeThread(hThread6);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CS);
List := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CS);
List.Free;
end;

end.
...全文
307 33 打赏 收藏 举报
写回复
33 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
zhangting241 2011-02-25
  • 打赏
  • 举报
回复
也碰到类似的问题,还没解决,楼主咋解决的
shenmepowangzhan 2010-12-24
  • 打赏
  • 举报
回复
delphi dll内无法使用threadvar还有threadvar对string的不释放问题就已经说明了在开发线程安全的dll时就不能为了方便使用那些高级的类型了
flitooo 2010-01-04
  • 打赏
  • 举报
回复
最终解决方案

IsMultiThread := TRUE;


查下了delphi help , IsMultiThread设置为true,表示内存管理器应该支持多线程。




金卯刀 2009-12-25
  • 打赏
  • 举报
回复
修改字串之所以會出錯,原因應該是:
線程1在修改字串時,還沒結束,此時中斷,由線程2執行,線程2可正常訪問到 字串所在地址。cpu時間片一到,又切換到線程1,線程1繼續執行while內的動作。此時,線程1訪問字串的地址還是它本身上一次處理的。
由于之前線程2對字串修改,產生寫復制,因為地址空間發生變化,原先線程1上下文環境所記錄的字串的地址已經是無效的了,所以產生地址訪問非法的錯誤...

以上個人理解,僅供參考,不足之處,請指正...
金卯刀 2009-12-25
  • 打赏
  • 举报
回复
剛剛查了資料,并且驗證了...
參考<Delphi in a Nut Shell>第四章--P103 有關線程安全說明如下:
reading long strings and dynamic arrays is thread-safe, but writting is not.
Refering to a string or dynamic array might change the reference count, but
delphi protects the reference count to ensure thread safety. when changing a
string or dynamic array, though, you should use a critical section, just as you
would when changing any other variable.

GS : string;
implementation

{$R *.dfm}

function ThreadProc(p: Pointer): LongInt ; stdcall;
begin
while GS<>'' do //這樣沖突的機會較大
begin
GS := GS + 'sss';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
id : Cardinal;
i,count: Integer;
begin
count := 2;
GS := '111';
for i:=1 to count do
begin
CreateThread(nil,SizeOf(Pointer),@ThreadProc,nil,0,id);
end;
end;


以上測試,若是有修改則會沖突,地址訪問非法。若是僅僅是讀出,則不會有問題
如改為:

function ThreadProc(p: Pointer): LongInt ; stdcall;
var
s : string;
begin
while GS<>'' do
begin
s := s + GS ;
end;
end;

Hexpate 2009-12-24
  • 打赏
  • 举报
回复
VCL组件必须要进行Synchronize操作.
Hexpate 2009-12-24
  • 打赏
  • 举报
回复
VCL组件必须要进行Synchronize操作.
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
那應該是你在線程直接操作主線程的memo導致。因為VCL為 非線程安全。
建議將線程改為delphi自帶的TThread,執行更新memo時,用Synchronize(ThreadLog),試看看。

另外string應該是線程安全的。
sanguomi 2009-12-24
  • 打赏
  • 举报
回复
[Quote=引用 26 楼 avan_lau 的回复:]
那應該是你在線程直接操作主線程的memo導致。因為VCL為 非線程安全。
建議將線程改為delphi自帶的TThread,執行更新memo時,用Synchronize(ThreadLog),試看看。

另外string應該是線程安全的。
[/Quote]

function ThreadFun(p:Pointer): LongInt; stdcall;
var
Test: String;
I: integer;
begin
for I :=0 to 1000 do
begin
Test := 'Test!';
Test := Test + 'Test!';
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
H: THandle;
ThreadID: DWORD;
I: Integer;
begin
for i:=1 to 10 do // 测试一个和十个
H := CreateThread(nil, 0, @ThreadFun, nil, 0, ThreadID);
end;


你也可以把string 类型(线程不安全,至少我一直这么觉得)换成系统标准类型(线程安全).
标准类型是不会报错的


flitooo 2009-12-24
  • 打赏
  • 举报
回复
我是windows server 2003
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
放在那run了10幾分鐘,沒出狀況...

你的os是?
flitooo 2009-12-24
  • 打赏
  • 举报
回复
还有几位朋友说是ThreadLog(Const msg: String)参数问题,我试过把参数去掉,就像这样调用ThreadLog; 但还是报错,我想可能问题不在参数
flitooo 2009-12-24
  • 打赏
  • 举报
回复
d7 和 d2010结果都一样。

楼上几位说正常可能是运行的时间不够久,有时要几分钟后才出错。

还有几位朋友说用同步,其实现在的程序就是同步,有用到临界区,一次其实只有一个线程在处理。
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
xp sp3 + D5

也是乖乖地跑...
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
[Quote=引用 19 楼 hjkto 的回复:]
我用d7,sp2测试如楼主所说,确实有问题
[/Quote]
我的OS是:win2003

ok,我改到xp sp3 + D5測試看看
hjkto 2009-12-24
  • 打赏
  • 举报
回复
我用d7,sp2测试如楼主所说,确实有问题
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
LZ貼出的代碼是否完整?
我用D7執行的你的代碼,并無問題。你是開發環境是?
金卯刀 2009-12-24
  • 打赏
  • 举报
回复
[Quote=引用 9 楼 sanguomi 的回复:]
肯定要到外部锁
procedure ThreadLog(Const msg: String);
参数为string 是线程不安全的

对String的大多数操作,都涉及到全局堆栈的操作。相对单线程的系统
来讲,使用String类型绝对不会出错,而多线程,则存在潜在的冲突的机会。特别是
大量的String类型运算,一般会引起系统堆竞争操作,则及有可能发生严重的存储冲
突,而导致系统崩溃。
[/Quote]
Starting in D5 referring to strings and dynamic arrays will be thread-safe.
In D5, access to the reference count is protected. This makes strings
work correctly in multithreaded applications.

Reference counting for Long Strings is not thread safe on multi-processor machines.
The Bug was fixed in Delphi 5.

http://www.efg2.com/Lab/Library/UseNet/1999/1119c.txt

ok1411 2009-12-24
  • 打赏
  • 举报
回复
学习了,同步下试试吧
flitooo 2009-12-24
  • 打赏
  • 举报
回复
看来无解
加载更多回复(13)
相关推荐
发帖
Windows SDK/API

1177

社区成员

Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
帖子事件
创建了帖子
2009-12-23 04:53
社区公告
暂无公告