Delphi多线程问题

Posted 2023-05-06

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
// procedure FormCreate(Sender: TObject);
private
Private declarations
public
Public declarations
end;

var
Form1: TForm1;
hloopHandle:Thandle ; //线程 句柄
dloopThreadID:DWORD ; //线程 id
//================
lpHandles:Thandle;
lpTheradID:DWORD;
function doloop(P:pointer):Longint;stdcall;
Function StartEvent(S:pointer):Longint;stdcall;
implementation

$R *.dfm

//按钮一
procedure TForm1.Button1Click(Sender: TObject);
begin
hloopHandle:= CreateThread(nil,0,@doloop,nil,0,dloopThreadID);
if hloopHandle=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

//按钮二
procedure TForm1.Button2Click(Sender: TObject);
begin
lpHandles:= CreateThread(nil,0,@StartEvent,nil,0,lpTheradID);
if lpHandles=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

//线程处理函数一
function doloop(P:pointer):integer;stdcall;
var
i:integer;
begin
for i:=0 to 100000 do
begin
form1.Edit1.Text:=inttostr(i);
end;
end;

//==================================
//线程处理函数二
Function StartEvent(S:pointer):integer;stdcall;
var
c:integer;
begin
for c:=0 to 100000 do
begin
form1.Edit2.Text:=inttostr(c);
end;
end;

end.

求教大虾们，程序能顺利编译，但是在运行的时候 点击按钮一启动线程之后在线程一还没结束的时候点击按钮二，不到几秒程序就会无情的出现应用程序错误，内存XXX不能为XXX的错误。
求教大虾们如何解决，小弟我刚学习Delphi，谢谢
一楼的，按照你的代码我运行了下点击按钮没反应哦，不知道是哪里出错，麻烦你在帮调试调试，谢谢了。

注意哦，你的两个线程用的同一个变量装它们的句柄，这样是不对地,出错地原因是因为循环操作可视控件的时候，如果不排队，会出现同时访问的情况,最好是可以使用类的方式来使用线程
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
// procedure FormCreate(Sender: TObject);
private
Private declarations
public
Public declarations
end;

var
Form1: TForm1;
hloopHandle:Thandle ; //线程 句柄
dloopThreadID:DWORD ; //线程 id
//================
lpHandles:Thandle;
lpTheradID:DWORD;
function doloop(P:pointer):Longint;stdcall;
Function StartEvent(S:pointer):Longint;stdcall;
implementation

$R *.dfm

//按钮一
procedure TForm1.Button1Click(Sender: TObject);
begin
hloopHandle:= CreateThread(nil,0,@doloop,nil,0,dloopThreadID);
if hloopHandle=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

//按钮二
procedure TForm1.Button2Click(Sender: TObject);
begin
lpHandles:= CreateThread(nil,0,@StartEvent,nil,0,lpTheradID);
if lpHandles=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

//线程处理函数一
function doloop(P:pointer):integer;stdcall;
var
i:integer;
begin
for i:=0 to 100000 do
begin
form1.Edit1.Text:=inttostr(i);
sleep(100);
end;
end;

//==================================
//线程处理函数二
Function StartEvent(S:pointer):integer;stdcall;
var
c:integer;
begin
for c:=0 to 100000 do
begin
form1.Edit2.Text:=inttostr(c);
sleep(100);
end;
end;

end. 参考技术A 稍微修改了一下,不过还是不完善,线程最主要的就是同步,一定要处理好才行

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
// procedure FormCreate(Sender: TObject);
private
Private declarations
public
Public declarations
end;

var
Form1: TForm1;
hloopHandle:Thandle ; //线程 句柄
dloopThreadID:DWORD ; //线程 id
CS:TRTLCriticalSection;
lpHandles:Thandle;
lpTheradID:DWORD;

implementation

$R *.dfm

//线程处理函数一
procedure doloop(P:pointer);stdcall;
var
i:integer;
begin
for i:=0 to 100000 do
begin
EnterCriticalSection(CS);
try
form1.Edit1.Text:=inttostr(i);
Sleep(15);
finally
LeaveCriticalSection(CS);
end;
end;
end;

//==================================
//线程处理函数二
procedure StartEvent(S:pointer);stdcall;
var
c:integer;
begin
for c:=0 to 100000 do
begin
EnterCriticalSection(CS);
try
form1.Edit2.Text:=inttostr(c);
Sleep(15);
finally
LeaveCriticalSection(CS);
end;
end;
end;

//按钮一
procedure TForm1.Button1Click(Sender: TObject);
begin
hloopHandle:= CreateThread(nil,0,@doloop,nil,0,dloopThreadID);
if hloopHandle=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

//按钮二
procedure TForm1.Button2Click(Sender: TObject);
begin
lpHandles:= CreateThread(nil,0,@StartEvent,nil,0,lpTheradID);
if lpHandles=0 then
begin
messagebox(Handle,'Didn’t Create a Thread',nil,MB_OK);
abort;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CS);
end;

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

end.

多线程 Delphi 7 App - 应用程序终止问题

【中文标题】多线程 Delphi 7 App - 应用程序终止问题

【英文标题】：Multithreaded Delphi 7 App - a problem with app termination

【发布时间】：2010-12-17 20:25:58

【问题描述】：

我有一个 TThread 的后代和一个对象列表，每个对象都有自己的此类线程的副本，以及使用 CreateEvent() API 创建的 Event 对象。

不同的对象通过事件触发相互交互。 IE。每个线程必须等到某个其他线程触发其事件。当然，有一个“主”线程，它永久工作，因此永远不会发生自阻塞。这个系统在每个对象的 Execute 方法结束前都可以正常工作。

当我尝试中断所有线程时出现问题，例如通过应用关闭。在这种情况下，我需要一些调用每个线程的 Terminate 方法的外部函数：

  for i := 0 to FLayers.Count - 1 do
  begin
    FLayers.Layer[i].FTerminating := true;
    f := true;
    while f do
    begin
      f := FLayers.Layer[i].IsActive;
      if f then
      begin
        Sleep(100);
        Application.ProcessMessages;
      end;
    end;
    FLayers.Layer[i].FTerminating := false;
  end;

此函数位于 Form.OnClose() 事件中。

问题是大约有两个线程正常终止，但其他所有线程都在 WaitForSingleObject() 调用中停止：

procedure TLayerThread.Execute;
begin
FLayer.FIsActive := true;
...............
repeat
 //
 if Terminated or
   FLayer.FTerminating or
   (FLayer.FEvent = INVALID_HANDLE_VALUE) then
   begin
     break;
   end;
 //
 Fres := WaitForSingleObject(FLayer.FEvent, 100); <<<<<<<<<<<<<<<<<<<<<<<<
until Fres <> WAIT_TIMEOUT;
...........
FLayer.FIsActive := false;
end;

所有线程都只是停止（挂起）在线。上面标记，尽管设置了超时值。

有什么想法吗？

我正在使用 Delphi 7 和 Win XP。

提前致谢。

跟进--

我发现问题在 Execute() 方法中的 Synchronize() 调用中得到解决。我不明白这里有什么问题。 Synchronize() 调用通常的东西，比如视觉控件更新等等。

正如调试器所示，我的线程中没有一个挂在某个 WaitForSingleObject() 调用上，但这不是我在 Execute() 方法中用来协调不同线程的方法，而是另一个调用。我可以假设它在这里：

class procedure TThread.Synchronize(ASyncRec: PSynchronizeRecord);
.................
        LeaveCriticalSection(ThreadLock);
        try
          WaitForSingleObject(SyncProc.Signal, INFINITE);<<<<<<<<<<<<<<<<<<<<<<
        finally
          EnterCriticalSection(ThreadLock);
        end;
..................

有没有人可以告诉我我的代码有什么问题？我从来没有听说过不允许在 Execute() 方法中调用 Synchronize()...

【参考方案1】：

您应该使用 WaitForMultipleObjects 而不是 WaitForSingleObject 无限超时并等待两个事件，您的 FLayer.FEvent 和第二个终止事件。

AFAIR 你必须为每个进程创建一个终止事件。 如果 WaitForMultipleObjects 返回终止事件的 ID，则退出循环。

在 OnClose() 方法中，您必须简单地通知所有终止事件。

【讨论】：

很抱歉，您是关于进程终止事件的吗？请注意，我不是要终止进程。让我们将其视为一个中断所有线程的过程。例如。我有“停止处理”菜单项，它不会关闭应用程序，而只是中断所有线程，就像上面显示的那样。而且我不能无限等待事件，因为通常每个线程都必须可以单独中断。简而言之，我的问题是“为什么一个线程终止会导致另一个线程挂起？”谢谢。

在 OnClose() 或其他方法中调用它并不重要。通过为每个线程使用一个关闭事件，您还可以单独结束每个线程。