分已用尽. 帮个忙,多线程的问题,实在不知道问题出在哪里了,贴上全部源程序,
綏子 2003-07-16 03:25:59 unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls,SyncObjs;
type
TRec=record
data:array[0..19] of integer;
end;
TAThread = class(TThread)
protected
procedure Execute; override;
procedure Updata;
end;
TBThread = class(TThread)
protected
m_index: Integer;
m_data:TRec;
m_x:int64;
coun:integer;
procedure Execute; override;
procedure Draw;
procedure Updata;
procedure Updata1;
public
constructor Create(index:Integer;data:TRec);
end;
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
UpDown1: TUpDown;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ListBox1: TListBox;
Memo1: TMemo;
Button4: TButton;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
A:TAThread;
List:TList;
strList:TStringList;
ThreadNum:integer;
TaskTotalNum:integer;
CurrenPoint:integer;
ResultTotal:int64;
procedure endGetText(Sender: TObject);
procedure endTotal(Sender: TObject);
procedure Total;
function Getdata:TRec;
public
{ Public declarations }
end;
const
FileName='OutFile.txt';
var
Form1: TForm1;
implementation
{$R *.DFM}
//******************* 以下代码用来产生需要的数据 *************************
procedure TAThread.Execute;
var
i:integer;
f:TextFile;
begin
i:=0;
Randomize;
try
AssignFile(f,FileName);
if FileExists(FileName) then
if not DeleteFile(FileName) then exit;
Rewrite(f);
Reset(f);
Append(f);
while i<100000 do
begin
Write(f,Round(Random(100)));
Write(f,#13#10);
Synchronize(Updata);
inc(i);
end;
finally
CloseFile(f);
end;
end;
procedure TAThread.Updata;
begin
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+1;
Form1.Button1.Caption:='完成: '+IntToStr(Form1.ProgressBar1.Position div 1000)+'%';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
A:=TAThread.Create(true);
A.OnTerminate:=endGetText;
A.FreeOnTerminate:=true;
A.Resume;
end;
procedure TForm1.endGetText(Sender: TObject);
begin
ProgressBar1.Position:=0;
Button1.Caption:='数据已经生成';
Button1.Enabled:=false;
Button2.Enabled:=True;
end;
//******************* 以上代码用来产生需要的数据 *************************
procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(List);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
f:TextFile;
s:string;
begin
if not FileExists(FileName) then exit;
try
AssignFile(f,FileName);
strList:=TStringList.Create;
FileMode:=0;
Reset(f);
while not EOF(f) do
begin
ReadLn(f,s);
strList.Add(s);
end;
Button3.Enabled:=True;
Edit1.Enabled:=True;
Label1.Enabled:=True;
UpDown1.Enabled:=True;
Button2.Enabled:=false;
Label2.Caption:='共计有: '+IntToStr(strList.Count)+' 笔数据';
TaskTotalNum:=strList.Count;
finally
CloseFile(f);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
CurrenPoint:=0;
ThreadNum:=0;
Total;
Button3.Enabled:=false;
Edit1.Enabled:=false;
Label1.Enabled:=false;
UpDown1.Enabled:=false;
end;
function TForm1.Getdata: TRec;
var
i:integer;
datas:TRec;
begin
for i:=0 to 19 do
begin
if CurrenPoint < TaskTotalNum then
begin
datas.data[i]:=StrToInt(strList.Strings[CurrenPoint]);
inc(CurrenPoint);
end
else
begin
datas.data[i]:=0;
end;
end;
end;
procedure TForm1.Total;
var
i:integer;
B:TBThread;
begin
if TaskTotalNum > UpDown1.Position*20 then
begin
for i:=0 to UpDown1.Position-1 do
begin
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Add(Pointer(B));
inc(ThreadNum);
end;
end
else
for i:=0 to (TaskTotalNum div 20)+1 do // 总数少于 100 个数据的处理
begin
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Add(Pointer(B));
inc(ThreadNum);
end;
end;
constructor TBThread.Create(index: Integer; data: TRec);
begin
// FreeOnTerminate:=true;
inherited Create(true);
m_index:=Index;
m_data:=data;
// Coun:=5;
Resume;
end;
procedure TBThread.Draw;
begin
// 不画了,画了速度太慢了
end;
procedure TBThread.Execute;
var
i:integer;
//m_criticalsection:tcriticalsection;
begin
for i:=0 to High(m_data.data) do
begin
m_x:=m_x+m_data.data[i];
end;
//try
// m_criticalsection:=tcriticalsection.create;
// m_criticalsection.Acquire;
// Synchronize(Updata1);
Synchronize(Updata);
// finally
// m_criticalsection.Release;
//m_criticalsection.Free;
// m_criticalsection.Leave;
//end;
end;
procedure TBThread.Updata;
begin
Form1.ResultTotal:=Form1.ResultTotal+m_x;
// Form1.label4.caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
//我加上这句 经常出错,很奇怪的错误.
Form1.Caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+20;
if (Form1.ThreadNum mod 10 =0) then
Form1.Memo1.Lines.Text:=Form1.Memo1.Lines.Text+'◎';
end;
procedure TBthread.updata1;
begin
Form1.label4.caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
end;
procedure TForm1.endTotal(Sender:TObject);
var
i:integer;
B:TBThread;
begin
if CurrenPoint < TaskTotalNum then
begin
i:=TBThread(Sender).m_index;
TBThread(List.Items[i]).Free;
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Delete(i);
List.Insert(i,Pointer(B));
inc(ThreadNum);
end
else
Label3.Caption:='累计结果: '+IntToStr(ResultTotal);
end;
end.
上面是完整的源程序,程序的作用解释.
开启一个多线程的程序, 线程A随机产生10000个数据,
线程B,(开启多线程)进行统计 10000个数据的和
问题:开启5个线程程序一点错误都没有,但是程序的线程数增加,比如10个,50个,100个,程序一运行就出问题,甚至死掉.