返回
生活百科
delphi开发安卓步骤（web开发桌面应用程序）
2022-11-05 16:13

当你有两个或者两个以上的线程同时运行，并且他们共同操作的同一块数据时，我们必须要对其进行保护，否则因为时间切片或者一些其他原因造成的延时都会让你的程序产生错误的计算结果。即使做两个线程访问共享整数变量这样简单的事情也可能导致完全的灾难

线程之间共享什么数据

首先，值得确切知道每个进程和每个线程存储的状态。每个线程都有自己的程序计数器和处理器状态。这意味着线程通过代码独立进行。每个线程也有自己的堆栈，因此局部变量本身就是每个线程的本地变量，并且这些变量不存在同步问题。

程序中的全局数据可以在线程之间自由共享，因此这些变量可能存在同步问题。当然，如果变量是全局可访问的，但只有一个线程使用它，则没有问题。

Delphi提供了threadvar关键字。这允许声明全局变量，其中为每个线程创建变量的副本。此功能使用不多，因为将这些变量放在TThread类中通常更方便，因此为每个创建的TThread后代创建一个变量实例。

共享数据的原子性

为了理解如何使线程协同工作，有必要理解原子性的概念。

所谓的原子性是指某一组动作是一个整体，它不可分割，要么一起成功，要么一起失败。就好比银行转账，转账这个东西由两步完成取出、存入，必须两个都成功才可以算成功，不允许出现一半成功一半失败

当线程执行原子操作时，这意味着所有其他线程将操作视为尚未启动或已完成。一个线程不可能在“行为”中捕获另一个线程。如果线程之间没有执行同步，那么几乎所有操作都是非原子的。我们举一个简单的例子。考虑 这段代码

var
  a: integer;

begin
  a := a + 1;
end;

如果两个单独的线程使用它来递增共享变量A，即使是这些微不足道的代码也会导致问题。这个单个pascal语句在汇编程序级别分解为三个操作。

  • 从存储器读取A到处理器寄存器。
  • 将1添加到处理器寄存器。
  • 将处理器寄存器的内容写入内存中的A.

即使在单个处理器机器上，多个线程执行此代码也可能导致问题。之所以这样做是因为调度操作。当只存在一个处理器时，实际上只有一个线程 一次执行，但Win32调度程序在它们之间以每秒约18次的速度切换。

调度程序可以在任何时候停止一个线程运行并启动另一个线程调度是先发制人的。在挂起一个线程并启动另一个线程之前，操作系统不会等待权限交换机可能随时发生。由于切换可以在任何两个处理器指令之间发生，因此它可能发生在函数中间的临界点，甚至是执行一个特定程序语句的一半。

让我们假设两个线程正在单处理器机器（X和Y）上执行示例代码。在一个很好的情况下，程序可能正在运行，并且调度操作可能会错过这个临界点，给出预期结果：A增加2。但是，这绝不是保证，而是盲目的机会如果共享变量碰巧是一个指针，那结果可能会让人崩溃。

说了一大堆理论，下面以代码的方式来看看上述的情况会不会出现，为了便于观查我没有使用视频中案例，而是采用了控制台应用


uses
    System.SysUtils, System.Classes;

type
    TWorkThread = class(TThread)

    protected
        procedure Execute; override;
    end;

var
    // 定义全局变量，充当共享数据
    Num: Integer = 0;

    { TWorkThread }

procedure TWorkThread.Execute;
begin
    // 循环的方式自增Num

    while True do begin
        //为了效果更为明显加入了延时
        TThread.Sleep(100);
        // 当Num的值大于10则终止线程
        if (Num > 10) then
            Exit;
        Writeln(Num);
        Inc(Num);
    end;
end;

begin
    //启动3个线程
    TWorkThread.Create(False);
    TWorkThread.Create(False);
    TWorkThread.Create(False);
    Readln;

end.

执行结果如下

篇幅的原因，我截取其中的一段结果，但是已经足以说明问题所在

解决方案

对于我们自己来说解决起来好像确实很麻烦，好在我们的前辈已经提供了解决方案。不学不知道，一学吓一跳，Delphi针对线程安全问题提供了不止一种解决方案。

临界区

临界区是一种最直接的线程同步方式。所谓临界区，简单的说就是有一块区域，而在该区域内的代码只能有一个线程在执行。针对临界区的使用Delphi中有两种方式使用EnterCriticalSection( ) 和LeaveCriticalSection( ) API 函数，另外一种是使用 TCriticalSection 类，我个人推荐使用TCriticalSection 因为该类对API进行了封装使用更为便捷。所在的单元为“SyncObjs”

在理清临界区的概念之后我们改组上述代码

program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
    SyncObjs, System.SysUtils, System.Classes;

type
    TWorkThread = class(TThread)

    protected
        procedure Execute; override;

    public

    end;

var
    // 定义全局变量，充当共享数据
    Num: Integer = 0;
var
    { 声明临界 }
    CS: TCriticalSection;
    { TWorkThread }
procedure TWorkThread.Execute;
begin

    // 循环的方式自增Num
    while True do begin
        TThread.Sleep(100);
        // 临界区开始
        CS.Enter;
        // 当Num的值大于10则终止线程
        if (Num > 10) then
            Exit;
        Writeln(TThread.CurrentThread.ThreadID.ToString + '：' + Num.ToString);
        Inc(Num);
        // 临界区结束
        CS.Leave;
    end;

end;

begin
    //初始化临界区
    CS := TCriticalSection.Create;

    TWorkThread.Create(False);
    TWorkThread.Create(False);
    TWorkThread.Create(False);
    Readln;
end.

互斥对象

uses SyncObjs;用TMutex类的方法处理(把释放语句放在循环内外可以决定执行顺序)

例：互斥输出三个0~2000的数字到窗体在不同位置。

unit Unit1;

interface

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

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override; {执行}
    procedure Run;  {运行}
  end;
  TForm1 = class(TForm)
    btn1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;


implementation

{$R *.dfm}

uses SyncObjs;

var
  MyThread:TMyThread;   {声明线程}
  Mutex:TMutex; {声明互斥体}
  f:integer;


procedure TMyThread.Execute;
begin
  { Place thread code here }
  FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
  Run;     {运行}
end;

procedure TMyThread.Run;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;
  for i := 0 to 2000  do
  begin
    if Mutex.WaitFor(INFINITE)=wrSignaled then   {判断函数，能用时就用}
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(10,y,IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
      Mutex.Release; {释放，谁来接下去用}
    end;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  f:=0;
  Repaint;
  Mutex:=TMutex.Create(False);  {参数为是否让创建者拥有该互斥体，一般为False}
  MyThread:=TMyThread.Create(False);
  MyThread:=TMyThread.Create(False);
  MyThread:=TMyThread.Create(False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Mutex.Free;{释放互斥体}
end;

end.

Semaphore(信号或叫信号量)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;
var
  f: Integer;
  MySemaphore: TSemaphore;

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i,y: Integer;
begin
  Inc(f);
  y := 20 * f;
  if MySemaphore.WaitFor(INFINITE) = wrSignaled then
  begin
    for i := 0 to 1000 do
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(20, y, IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;
  end;
  MySemaphore.Release;
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadID: DWORD;
begin
  if Assigned(MySemaphore) then MySemaphore.Free;
  MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, ''); {创建，参数一为安全默认为nil，参数2可以填写运行多少线程，参数3是运行总数，参数4可命名用于多进程}

  Self.Repaint;
  f := 0;
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;

{让 Edit 只接受 1 2 3 4 5 五个数}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not CharInSet(Key, ['1'..'5']) then Key := #0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '1';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(MySemaphore) then MySemaphore.Free;
end;

end.

Event (事件对象)

注：相比API的处理方式，此类没有启动步进一次后暂停的方法。

unit Unit1;

interface

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

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure Run;
  end;

  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;

var
  f:integer;
  MyEvent:TEvent;
  MyThread:TMyThread;

{ TMyThread }


procedure TMyThread.Execute;
begin
  inherited;
  FreeOnTerminate:=True; {线程使用完自己注销}
  Run;
end;

procedure TMyThread.Run;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;

  for i := 0 to 20000 do
  begin
    if MyEvent.WaitFor(INFINITE)=wrSignaled then    {判断事件在用没，配合事件的启动和暂停，对事件相关线程起统一控制}
    begin
      Form1.Canvas.lock;
      Form1.Canvas.TextOut(10,y,IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;

  end;

end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  Repaint;
  f:=0;
  if Assigned(MyEvent) then MyEvent.Free;    {如果有，就先销毁}

  {参数1安全设置，一般为空；参数2为True时可手动控制暂停，为Flase时对象控制一次后立即暂停
  参数3为True时对象建立后即可运行，为false时对象建立后控制为暂停状态，参数4为对象名称，用于跨进程，不用时默认''}
  MyEvent:=TEvent.Create(nil,True,True,'');   {创建事件}

end;

procedure TForm1.btn2Click(Sender: TObject);
var
  ID:DWORD;
begin
  MyThread:=TMyThread.Create(False);      {创建线程}
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  MyEvent.SetEvent;    {启动}  {事件类没有PulseEvent启动一次后轻描谈写}
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  MyEvent.ResetEvent;  {暂停}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   btn1.Caption:='创建事件';
   btn2.Caption:='创建线程';
   btn3.Caption:='启动';
   btn4.Caption:='暂停';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyEvent.Free;        {释放}
end;

end.

Synchronize

最后来聊聊这个 Synchronize 函数，至于原因是将该线程的代码放到主线程中运行，并非实际意义的线程同步。RAD Studio VCL Reference 中也有描述

Executes a method call within the main thread，Synchronize causes the call specified by AMethod() to be executed using the main thread,，thereby avoiding multi-thread conflicts。

谷歌译文：在主线程中执行方法调用，同步导致指定的呼叫用于使用主线程执行的可用于执行的次数，从而避免多线程冲突

另外一个原因是个人感觉它不够灵活，比如我只需要同步核心运算部分的代码，其他部分并不需要同步的情况，所以我不太推荐。可能是我的姿势不对，在控制台应用下无法使用，只能回到VCL中

//开启控制台的指令
{$APPTYPE CONSOLE}

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
    TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

type
    TSyncThread = class(TTHread)

        procedure Execute; override;

    public
        procedure Work();
    end;

var
    Num: Integer = 0;

var
    Form1: TForm1;

implementation

{$R *.dfm}
{ TSyncThread }

procedure TSyncThread.Execute;
begin
    inherited;
    Synchronize(Work);
end;

procedure TSyncThread.Work;
begin
    // 循环的方式自增Num
    while True do begin
        TTHread.Sleep(100);
        // 当Num的值大于10则终止线程
        if (Num > 10) then
            Exit;
        Writeln(TTHread.CurrentThread.ThreadID.ToString + '：' + Num.ToString);
        Inc(Num);

    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    TSyncThread.Create(false);
end;

end.

至此Delphi多线程已知的同步方案结束了。通常Delphi中会提供两种方案一是原生API方式二是Delphi本身封装的

这篇文章也是Delphi图文版的最后一篇文章了，至此第一季相关的内容全部更新完成

发表评论
0评