关于线程问题

[flitooo]

创建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.

[flitooo]

看来无解

[ok1411]

学习了，同步下试试吧

[金卯刀]

[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

[金卯刀]

LZ貼出的代碼是否完整？
我用D7執行的你的代碼，并無問題。你是開發環境是？

[hjkto]

我用d7，sp2测试如楼主所说，确实有问题

[金卯刀]

[Quote=引用 19 楼 hjkto 的回复:]
我用d7，sp2测试如楼主所说，确实有问题
[/Quote]
我的OS是：win2003

ok，我改到xp sp3 + D5測試看看

[金卯刀]

xp sp3 + D5

也是乖乖地跑...

[flitooo]

d7 和 d2010结果都一样。

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

还有几位朋友说用同步，其实现在的程序就是同步，有用到临界区，一次其实只有一个线程在处理。

[flitooo]

还有几位朋友说是ThreadLog(Const msg: String)参数问题，我试过把参数去掉，就像这样调用ThreadLog; 但还是报错，我想可能问题不在参数

[金卯刀]

放在那run了10幾分鐘，沒出狀況...

你的os是？

[flitooo]

我是windows server 2003

[sanguomi]

[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 类型（线程不安全，至少我一直这么觉得）换成系统标准类型（线程安全）.
标准类型是不会报错的

[金卯刀]

那應該是你在線程直接操作主線程的memo導致。因為VCL為 非線程安全。
建議將線程改為delphi自帶的TThread，執行更新memo時，用Synchronize(ThreadLog)，試看看。

另外string應該是線程安全的。

[Hexpate]

VCL组件必须要进行Synchronize操作.

[Hexpate]

VCL组件必须要进行Synchronize操作.

[金卯刀]

剛剛查了資料，并且驗證了...
參考<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;

[金卯刀]

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

以上個人理解，僅供參考，不足之處，請指正...

[flitooo]

最终解决方案

IsMultiThread := TRUE;


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

[shenmepowangzhan]

delphi dll内无法使用threadvar还有threadvar对string的不释放问题就已经说明了在开发线程安全的dll时就不能为了方便使用那些高级的类型了

[zhangting241]

也碰到类似的问题，还没解决，楼主咋解决的