精华内容
下载资源
问答
  • delphi多线程编程

    2010-12-01 20:51:19
    delphi多线程编程详解。 不错的资源。
  • Delphi 多线程编程

    2019-10-15 07:48:06
    原文地址:Delphi多线程编程作者:liwenchao828 多线程的基本概念 WIN 98/NT/2000/XP 是个多任务操作系统,也就是:一个进程可以划分为多个线程,每个线程轮流占用CPU 运行时间和资源,或者说,把CPU 时间划成片,...

    原文地址:Delphi 多线程编程作者:liwenchao828

    多线程的基本概念

         WIN 98/NT/2000/XP 是个多任务操作系统,也就是:一个进程可以划分为多个线程,每个线程轮流占用CPU 运行时间和资源,或者说,把CPU 时间划成片,每个片分给不同的线程,这样,每个线程轮流的“挂起”和“唤醒”,由于时间片很小,给人的感觉是同时运行的。
         多线程带来如下好处:(自己阅读)
         1)避免瓶颈;
         2)并行操作;
         3)提高效率;
         在多线程中,通过优先级管理,可以使重要的程序优先操作,提高了任务管理的灵活性。
         另一方面,在多CPU 系统中,可以把不同的线程在不同的CPU 中执行,真正做到同时处理多任务(Win 98 只是模拟的,而Win/NT/2000是真正的多CPU同时操作)。

         多线程的两个概念:

         1) 进程:也称任务,程序载入内存,并分配资源,称为“一个进程”。
        注意:进程本身并不一定要正在执行。进程由以下几部分组成:
         a>一个私有的地址空间,它是进程可以使用的一组虚拟内存地址空间;
         b>程序的相关代码、数据源;
         c>系统资源,比如操作系统同步对象等;
         d>至少包含一个线程(主线程);

         2) 线程:是程序的执行单位(线程本身并不包括程序代码,真正拥有代码的是进程),每个进程至少包括一个线程,称为主线程,一个进程如果有多个线程,就可以共享同一进程的资源,并可以并发执行。
         线程是进程的一个执行单元,是操作系统分配CPU 时间的基本实体,线程主要由如下两部分组成:
         a>数据结构;
         b>CPU 寄存器和堆栈;
         一个进程中的线程,可以独立运行,也可以控制另一个线程的运行。

         请注意:
         多线程不能滥用,书上提到了多线程的几个缺点(自阅)。

         1-2 Tthread 对象

         虽然Windows 提供了比较多的多线程设计的API 函数,但是直接使用API 函数一方面极其不方便,而且使用不当还容易出错。为解决这个问题,Borland 公司率先推出了一种Tthread 对象,来解决多线程设计上的困难,简化了多线程问题的处理。
         应该注意,Tthread 对象是没有实例的,它和界面的交流,主要依靠主窗体(主VCL线程),这和其他对象使用上有些区别。

        一、Tthread 对象的主要方法

         构造线程:

         constructor Create(CreateSuspended:boolean)

         其中:CreateSuspended=true   构造但不唤醒
                                                  false 构造的同时即唤醒

         也可以用如下方法

         inheried Create(CreateSuspended:boolean)


         挂起线程:

         suspend
       
         (把线程挂起的次数加一)

         唤醒线程:

         resume

         (注意:注意这个属性是把线程挂起的次数减一,当次数为0 时,即唤醒。也就是说,线程挂起多少次,唤醒也需要多少次。同时挂起的时候将保持线程的地址指针不变,所以线程挂起后再唤醒,将从挂起的地方开始运行)

         析构(清除线程所占用的内存):

         destroy

         终止线程(后面会具体讨论):

         Terminate

         二、线程应用的简单例子:

         下面通过一个例子说明上述方法的应用。我们知道,循环是独占性最强的运行方式之一,现在希望建立两个线程对象,实现循环的并行运行。具体方法如下:

         File---New---Thread Object

         这就自动在主Form中建立了一个线程单元(在对话框里写上线程名字),默认的名字是Unit2。同样方法建立第二个线程单元Unit3。
       
         要注意的是:Unit2和Unit3中有一个给定的过程:

         procedure Object.Execute;
         begin

         end;

         其中的程序是线程唤醒后自动执行的程序,也可以在里面调用其他自定义的过程和函数。这个过程的结束,意味着线程程序的结束。
         为了构造线程,在interface的Type区,定义一个构造过程:

         type
           Object = class(TThread)   //自动给出的,也可以直接改

           private
        
           protected

              procedure Execute; override;
         
           public
           constructor create;       //自己写的

          并且在implementation区域写上:

          constructor Object.create;
          begin
            inherited create(true);
          end
       
         其中Object 为线程对象的名字。所以这么写,是希望在主Form中调用这个构造过程。
         Create()的参数用True,表明构造出的线程为挂起状态。
         注意一下,在同一个线程对象里,如果两次构造,将产生两个独立的线程,不但运行是独立的,而且使用线程的局部变量也是独立的。但这里为了简化问题,还是建立了两个独立的线程对象,而且两个循环数
    是不同的,在并行运算时容易判断出是两个不同的程序在运行。  

         假定我们给两个线程对象起的名字是:

         mymath1
         mymath2

         这样在Unit1,应该作如下声明:
     
         implementation

         {$R *.DFM}

         uses unit2,unit3;

         var thread1:mymath1;
             thread2:mymath2;

         这样在主线程,将可以通过这两个线程变量调用对应的线程方法。

         在主线程区构造线程的方法是:

         thread1:=mymath1.create;
         thread2:=mymath2.create;

         挂起:

         thread1.suspend;
         thread2.suspend;

         唤醒:

         thread1.resume;
         thread2.resume;

         析构:

          thread1.destroy;
          thread2.destroy;    

         这里需要说明的是,由于线程单元需要调用Form的Edit控件(对象),可以采用两种方法:

         1) 在线程单元定义一个TEdit对象,例如

         edit4:Tedit; 

         在Execute过程内直接引用

         但在Unit1中一定要在FormCreate过程里作一个赋值:

         procedure TForm1.FormCreate(Sender: TObject);
         begin
           thread1.edit4:=edit1;
         end;
       
         这样,就把第一线程的edit4与Form上的edit1联系来。

         2)在第二个线程中首先声明调用Unti1,也就是要加上
         Uses Unit1;

         这样就可以在该线程单元直接调用主Form的控件了,比如在Unit3中可以写:

         form1.edit2.text:=inttostr(i)

         了解了这些基本规则,就可以写出比较复杂的多线程程序了。
         还有一点要说明的,默认生成的线程单元,调用的单元只有一个:

         Uses Classes;

         这样,往往很多函数和对象在线程单元里不能使用,所以在必要时,应该根据需要User相应的单元,这个例程为了简单,把大部分常用的单元都拷过去了,这并不是推荐的办法,因为这样一来会使程序的垃圾过
    多,所以,一般要用什么拷什么。

         三、常用的API 函数

         在处理多线程问题的时候,也经常用到Windows提供的API 函数,需要说明的是,Tthread 对象内部封装的方法,其实主要也是调用API 函数,但是,考虑更全面,更安全。而直接调用API 函数,往往会因为运用不当,出现一些不应有的错误。所以,我个人以为,只要用Tthread 对象的方法能解决的,就不要直接调用API 函数,API 函数只应该在用在Tthread 对象方法解决不了的时候。
         例如Tthread 对象方法内部调用API 函数的时候,一般使用推荐的默认值,但需要更精细的控制时,就可以直接使用API 函数。
         其实,Tthread 对象方法已经受到了大多数程序设计者的认可,比如,原来VB是不具备直接处理多线程的能力的,但是,现在VB.Net就宣称,它具备了简单处理多线程问题的能力,这就很说明问题。
         下面简单介绍几种API 函数,为了清晰方便,这里着重在于说明,函数正确的描述可以自己阅读书上的例子和手册:
         构建线程:
      
         CreateThread(参数1,--安全属性(一般=Nil,默认安全属性)

                      参数2,--线程堆栈尺寸(一般=0,与主线程相同长度,而且可以根据需要自动变化)
                      参数3,--指向函数名指针,@函数名,这个参数十分重要,不正确将无法调用成功。
                      参数4,--用户需要向线程传递的参数,是一个指向结构的指针,不需传递参数时,为Nil。
                      参数5)--传入与线程有关的一些参数,例如:
                              CREATE_SUSPENDED   创建一个挂起的线程;
                              0 创建后立即激活。

         书上有这个函数应用的十分清晰的例子,可以自己阅读。
         一般并不推荐使用   CreateTheard函数,而推荐使用RTL 库里的System单元中定义的 BeginTheard函数,因为这除了能创建一个线程和一个入口函数以外,还增加了几项保护措施,具体的请参阅书上的第10页说明。

         对应suspend(挂起)和resume(唤醒)的两个API 函数为:
       
         Function SuspendThread(hThread:Thandle):DWORD;

         Function ResumeThread(hThread:Thandle):DWORD;

         其中,Thandle被要求控制线程的句柄,函数调用成功,返回挂起的次数,调用不成功。则返回0xFFFFFFFF。

         四、线程的终止和退出:

         1)自动退出:

         一个线程从Execute()过程中退出,即意味着线程的终止,此时将调用Windows的ExitThread()函数来清除线程所占用的堆栈。
         如果线程对象的 FreeOnTerminate 属性设为True,则线程对象将自动删除,并释放线程所占用的资源。
         这是消除线程对象最简单的办法。

         2)受控退出:

         利用线程对象的Terminate属性,可以由进程或者由其他线程控制线程的退出。只需要简单的调用该线程的Terminate方法,并设直线程对象的Terminate属性为True。
         在线程中,应该不断监视Terminate的值,一旦发现为True,则退出,例如在Execute()过程中可以这样写:

          While not Terminate do
            begin
               ........
            end;       

          3)退出的API 函数:

          关于线程退出的API 函数声明如下:code

          Function TerminateThread(hThread:Thandle;dwExitCode:DWORD);

          不过,这个函数会使代码立刻终止,而不管程序中有没有
          
                try....finally

          机制,可能会导致错误,不到万不得已,最好不要使用。

         4) 利用挂起线程的方法(suspend)

         利用挂起线程的suspend方法,后面跟个Free,也可以释放线程,
    例如:
       
         thread1.suspend;   //挂起
         thread2.free;      //释放

         书上有相应的例子。


         五、 线程的优先级:

         在多线程的情况下,一般要根据线程执行任务的重要性,给线程适当的优先级,一般如果量的线程同时申请CPU 时间,优先级高的线程优先。

         在Windows下,给线程的优先级分为30级,而Delphi中Tthread 对象相对简单的把优先级分为七级。也就是在Tthread中声明了一个枚举类型TTthreadPriority:

         type

         TTthreadPriority(tpidle,tpLowest,tpLower,tpNormal,
                          tpHight,tpHighest,tpTimecrital)

         分别对应的是最低(系统空闲时有效,-15),较低(-2),低(-1),正常(普通0),高(1),较高(2),最高(15)。

         其中tpidle和tpTimecrital有些特殊,具体情况请阅读书上有关内容。

         设置优先级可使用thread对象的priority属性:
       
         threadObject.priority:=Tthreadpriority(级别);

         这里给出了一个演示多线程优先级的实例:


        1-3   在数据库中使用多线程

        一)使用ADO模式

         由于Delphi 6.0的ADO 数据源控件内置了多线程能力,所以,在ADO模式下,使用多线程不需要做更多的工作。用两个ADOTable控件,分别连到两个数据库,并且分别通过DataSource控件,与数据帮定控件联系就可以了,这样就可以实现前后台处理数据库问题。


        二)使用BDE模式和Tseeion对象

         如果需要使用BDE 模式,那么多线程使用数据库,就要考虑Session的问题。在单线程时,每个数据源的建立就自动生成一个Session, 这是这个数据源私有的关于数据库信息的文件。但多线程时,必须统一管理,所以在BDE 中专门提供了一个Tsession对象,它可以同时管理不同的Databas数据源对象。
         Databas数据源可以接受来自不同数据平台的数据库。

         数据库1---databas(2)----table(Qurey)(3)---datasource
                      |              |
                      |              |
                      |---------   Tsession(1)
                      |              |
                      |              |
         数据库2---databas(2)----table(Qurey)(3)---datasource


         方法:
         1)Tsession
            属性:SessionName=名(自起)
                  Active=true    (激活)
         2)Database(可以有多个)
            属性:SessionName=Tsession名
                  Dataname=名(自起,作为Table的标识)
                  AliasName=数据库别名
                  Connected=True (激活)
         3)Table或Qurey
            属性:SessionName=Tsession名(不要用默认值)
                  DatabaseName=如果前面起了名,这里就会出现Database
                               的名字。
                  Tablename=表名
                  Active=true (激活)
          以后比如加入Datasoucre和其他一样,这样就可以构造两个前后台处理的数据库管理系统了。           

        2-4 多线程的同步机制

         同步机制,实际上是事件驱动机制,意思是让线程平时处于“休眠”状态,除非发生某个事件才触发。
         例如一个拷贝文件,拷贝线程完成一个程序块后,再唤醒进程条线程做一个格的填充。
         研究多线程的同步机制的必要性在于,多线程同步工作时,如果同时调用相同的资源,就可能会出现问题,一般读出是不会有问题的,但是,如果写入(全局变量、数据库),就会发生冲突,甚至产生死
    锁和竞争问题。

    一、使用Synchronize方法

         这个方法用于访问VCL 主线程所管理的资源,其方法的应用是:
         第一步:把访问主窗口(或主窗口控件资源)的代码放到线程的一个方法中;
         第二步:是在线程对象的Execute方法中,通过Synchronize方法使用该方法。
         实例:
         procedure Theater.Execute;
         begin
           Synchronize(update);     
         end;   

         procedure Theater.update;
         begin
           .........    
         end;     

         这里通过 Synchronize使线程方法update同步。


    二、使用VCL类的Look方法

         在Delphi的IDE提供的构件中,有一些对象内部提供了线程的同步机制,工作线程可以直接使用这些控件,比如:Tfont,Tpen,TBitmap,TMetafile,Ticon等。另外,一个很重要的控件对象叫TCanvas,提供了一个Lock方法用于线程的同步,当一个线程使用此控件对象的时候,首先调用这个对象的Lock方法,然后对这个控件进行操作,完毕后再调用Unlock方法,释放对控间的控制权。
         例如:
         CanversObject.look;
              try
                画图
              finally
                CanversObject.unlock;
              end;
         {使用这个保护机制,保证不论有没有异常,unlock都会被执行否则很可能会发生死锁。在多线程设计的时候,应该很注意发生死锁的问题}
        
       

    三、Waitfor方法
         当一个线程应该等待另一个线程结束时,可以调用Waitfor方法。这个方法属于等待线程对象,Waitfor方法的原型如下:

         Function Waitfor(Const Astring:string):string;
       
         比如在前面最基本的线程的例子中,唤醒线程的语句中加上

         thread1.resume;
         thread1.waitfor;
         thread2.resume;

         那么所有的线程都必须等待thread1运行完毕后才能运行,其中包括主线程,可以预想,由于thread1调用了主窗体的Edit控件,那么,在thread1运行中间,Edie1也不会显示。
         这就告诉我们,这样的代码是不能作为主线程的一部分的,如果与主窗体连接的线程内等待另一个线程结束,而另一个线程又要等待访问用户界面,就可能是程序陷于死锁。
         这点在应用的时候要谨慎。


    四、利用Windows的API 实现同步

         Windows API函数提供了很多同步技术,下面简要介绍。

    1)临界区
      
        使用线程的时候,遇到的一个基本的问题,就是多个线程访问同一个对象,比如访问相同的文件、DLL、相同的通讯资源,特别是数据库的访问,当多个线程对同一数据库字段写入的时候,其结果会出
    现不确定性。
         临界区用于解决这个问题,它可以保证线程使用敏感数据的时候,阻赛其他的线程访问名干数据,使用时首先要初始化,其声明一个TRTLCriticalSection类型的变量:

    var
       CS:TRTLCriticalSection;

    初始化:

         initializeCriticalSection(cs);

    独占  

    EnterCriticalSection(cs);

    解除独占

    LeaveCriticalSection(CS);

         使用临界区是比较方便而且概念比较清晰的的线程同步机制,应用比较广泛。
         请注意,临界区只能在一个进程内使用,首先要标记出把数据作为临界区操作的那些代码,在这部分代码执行前,计算机首先要查看一下全局记录,已确定是否有其它线程在临界区中,同时也要查看这个临界区是否和第一个临界区相关,也就是说同一个程序中可能会有几个不同的临界区,然后计算机再决定运行策略。

    展开全文
  • Delphi多线程编程

    2010-07-14 14:41:50
    从“万一的Delphi博客”上抓取并制作的CHM版Delphi多线程编程教程。 内容详实,由浅入深,代码带上色,带有图例
  • delphi 多线程编程

    2019-09-23 01:25:57
    Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单. function MyFun(p: Pointer): Integer; stdcall ; var i: Integer; begin for i := 0 to 500000 do ...

    开始本应该是一篇洋洋洒洒的文字, 不过我还是提倡先做起来, 在尝试中去理解.
    先试试这个:

    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    i: Integer; 
    begin 
    for i := 0 to 500000 do 
    begin 
    Canvas.TextOut(10, 10, IntToStr(i)); 
    end; 
    end;
    View Code

    上面程序运行时, 我们的窗体基本是 "死" 的, 可以在你在程序运行期间拖动窗体试试...

    Delphi 为我们提供了一个简单的办法(Application.ProcessMessages)来解决这个问题:

    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    i: Integer; 
    begin 
    for i := 0 to 500000 do 
    begin 
    Canvas.TextOut(10, 10, IntToStr(i)); 
    Application.ProcessMessages; 
    end; 
    end;
    View Code

    这个 Application.ProcessMessages; 一般用在比较费时的循环中, 它会检查并先处理消息队列中的其他消息.

    但这算不上多线程, 譬如: 运行中你拖动窗体, 循环会暂停下来...

    在使用多线程以前, 让我们先简单修改一下程序:

    function MyFun: Integer; 
    var 
    i: Integer; 
    begin 
    for i := 0 to 500000 do 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(10, 10, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    begin 
    MyFun; 
    end;
    View Code

    细数上面程序的变化:
    1、首先这还不是多线程的, 也会让窗体假 "死" 一会;
    2、把执行代码写在了一个函数里, 但这个函数不属于 TForm1 的方法, 所以使用 Canvas 是必须冠以名称(Form1);
    3、既然是个函数, (不管是否必要)都应该有返回值;
    4、使用了 500001 次 Lock 和 Unlock.

    Canvas.Lock 好比在说: Canvas(绘图表面)正忙着呢, 其他想用 Canvas 的等会;
    Canvas.Unlock : 用完了, 解锁!

    在 Canvas 中使用 Lock 和 Unlock 是个好习惯, 在不使用多线程的情况下这无所谓, 但保不准哪天程序会扩展为多线程的; 我们现在学习多线程, 当然应该用.

    在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.

    function MyFun(p: Pointer): Integer; stdcall; 
    var 
    i: Integer; 
    begin 
    for i := 0 to 500000 do 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(10, 10, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: THandle; 
    begin 
    CreateThread(nil, 0, @MyFun, nil, 0, ID); 
    end;
    View Code

    代码分析:
    CreateThread 一个线程后, 算上原来的主线程, 这样程序就有两个线程、是标准的多线程了;
    CreateThread 第三个参数是函数指针, 新线程建立后将立即执行该函数, 函数执行完毕, 系统将销毁此线程从而结束多线程的故事.

    CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;
    因为是系统级调用, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这里只有一个参数没有顺序可言, 但这是使用系统函数的惯例.

    CreateThread 还需要一个 var 参数来接受新建线程的 ID, 尽管暂时没用, 但这也是格式; 其他参数以后再说吧.

    这样一个最简单的多线程程序就出来了, 咱们再用 TThread 类实现一次

    type 
    TMyThread = class(TThread) 
    protected 
    procedure Execute; override; 
    end; 
    
    procedure TMyThread.Execute; 
    var 
    i: Integer; 
    begin 
    FreeOnTerminate := True; {这可以让线程执行完毕后随即释放} 
    for i := 0 to 500000 do 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(10, 10, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    end; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    begin 
    TMyThread.Create(False); 
    end; 
    View Code

    TThread 类有一个抽象方法(Execute), 因而是个抽象类, 抽象类只能继承使用, 上面是继承为 TMyThread.

    继承 TThread 主要就是实现抽象方法 Execute(把我们的代码写在里面), 等我们的 TMyThread 实例化后, 首先就会执行 Execute 方法中的代码.

    按常规我们一般这样去实例化:

    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    MyThread: TMyThread; 
    begin 
    MyThread := TMyThread.Create(False); 
    end; 
    因为 MyThread 变量在这里毫无用处(并且编译器还有提示), 所以不如直接写做 TMyThread.Create(False);
    
    我们还可以轻松解决一个问题, 如果: TMyThread.Create(True) ?
    这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程, 譬如:
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    MyThread: TMyThread; 
    begin 
    MyThread := TMyThread.Create(True); 
    MyThread.Resume; 
    end; 
    View Code

    //可简化为:

    procedure TForm1.Button1Click(Sender: TObject); 
    begin 
    with TMyThread.Create(True) do Resume; 
    end;
    View Code

    一、入门
    ㈠、
    function CreateThread(
    lpThreadAttributes: Pointer; {安全设置}
    dwStackSize: DWORD; {堆栈大小}
    lpStartAddress: TFNThreadStartRoutine; {入口函数}
    lpParameter: Pointer; {函数参数}
    dwCreationFlags: DWORD; {启动选项}
    var lpThreadId: DWORD {输出线程 ID }
    ): THandle; stdcall; {返回线程句柄}

    在 Windows 上建立一个线程, 离不开 CreateThread 函数;
    TThread.Create 就是先调用了 BeginThread (Delphi 自定义的), BeginThread 又调用的 CreateThread.
    既然有建立, 就该有释放, CreateThread 对应的释放函数是: ExitThread, 譬如下面代码:

    procedure TForm1.Button1Click(Sender: TObject); 
    begin 
    ExitThread(0); {此句即可退出当前程序, 但不建议这样使用} 
    end;
    View Code

    代码注释:
    当前程序是一个进程, 进程只是一个工作环境, 线程是工作者;
    每个进程都会有一个启动线程(或叫主线程), 也就是说: 我们之前大量的编码都是写给这个主线程的;
    上面的 ExitThread(0); 就是退出这个主线程;
    系统不允许一个没有线程的进程存在, 所以程序就退出了.
    另外: ExitThread 函数的参数是一个退出码, 这个退出码是给之后的其他函数用的, 这里随便给个无符号整数即可.

    或许你会说: 这个 ExitThread 挺好用的; 其实不管是用 API 还是用 TThread 类写多线程, 我们很少用到它; 因为:
    1、假如直接使用 API 的 CreateThread, 它执行完入口函数后会自动退出, 无需 ExitThread;
    2、用 TThread 类建立的线程又绝不能使用 ExitThread 退出; 因为使用 TThread 建立线程时会同时分配更多资源(譬如你自定义的成员、还有它的祖先类(TObject)分配的资源等等), 如果用 ExitThread 给草草退出了, 这些资源将得不到释放而导致内存泄露. 尽管 Delphi 提供了 EndThread(其内部调用 ExitThread), 这也不需要我们手动操作(假如非要手动操作也是件很麻烦的事情, 因为很多时候你不知道线程是什么时候执行完毕的).
    除了 CreateThread, 还有一个 CreateRemoteThread, 可在其他进程中建立线程, 这不应该是现在学习的重点;
    现在先集中精力把 CreateThread 的参数搞彻底.

    倒着来吧, 先谈谈 CreateThread 将要返回的 "线程句柄".

    "句柄" 类似指针, 但通过指针可读写对象, 通过句柄只是使用对象;
    有句柄的对象一般都是系统级别的对象(或叫内核对象); 之所以给我们的是句柄而不是指针, 目的只有一个: "安全";
    貌似通过句柄能做很多事情, 但一般把句柄提交到某个函数(一般是系统函数)后, 我们也就到此为止很难了解更多了; 事实上是系统并不相信我们.

    不管是指针还是句柄, 都不过是内存中的一小块数据(一般用结构描述), 微软并没有公开句柄的结构细节, 猜一下它应该包括: 真实的指针地址、访问权限设置、引用计数等等.

    既然 CreateThread 可以返回一个句柄, 说明线程属于 "内核对象".
    实际上不管线程属于哪个进程, 它们在系统的怀抱中是平等的; 在优先级(后面详谈)相同的情况下, 系统会在相同的时间间隔内来运行一下每个线程, 不过这个间隔很小很小, 以至于让我们误以为程序是在不间断地运行.

    这时你应该有一个疑问: 系统在去执行其他线程的时候, 是怎么记住前一个线程的数据状态的?
    有这样一个结构 TContext, 它基本上是一个 CPU 寄存器的集合, 线程是数据就是通过这个结构切换的, 我们也可以通过 GetThreadContext 函数读取寄存器看看.

    附上这个结构 TContext(或叫: CONTEXT、_CONTEXT) 的定义:

    PContext = ^TContext; 
    _CONTEXT = record 
    ContextFlags: DWORD; 
    Dr0: DWORD; 
    Dr1: DWORD; 
    Dr2: DWORD; 
    Dr3: DWORD; 
    Dr6: DWORD; 
    Dr7: DWORD; 
    FloatSave: TFloatingSaveArea; 
    SegGs: DWORD; 
    SegFs: DWORD; 
    SegEs: DWORD; 
    SegDs: DWORD; 
    Edi: DWORD; 
    Esi: DWORD; 
    Ebx: DWORD; 
    Edx: DWORD; 
    Ecx: DWORD; 
    Eax: DWORD; 
    Ebp: DWORD; 
    Eip: DWORD; 
    SegCs: DWORD; 
    EFlags: DWORD; 
    Esp: DWORD; 
    SegSs: DWORD; 
    end;
    View Code

    CreateThread 的最后一个参数是 "线程的 ID";
    既然可以返回句柄, 为什么还要输出这个 ID? 现在我知道的是:
    1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.
    2、ID 比句柄更轻便.

    在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 获取的都是主线程的 ID.
    ㈡、启动选项
    function CreateThread(
    lpThreadAttributes: Pointer;
    dwStackSize: DWORD;
    lpStartAddress: TFNThreadStartRoutine;
    lpParameter: Pointer;
    dwCreationFlags: DWORD; {启动选项}
    var lpThreadId: DWORD
    ): THandle; stdcall;
    CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
    0: 线程建立后立即执行入口函数;
    CREATE_SUSPENDED: 线程建立后会挂起等待.

    可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
    这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.

    什么是挂起计数?
    SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
    当这个数 = 0 时, 线程会运行; > 0 时会挂起.
    如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.

    在下面的例子中, 有新线程不断给一个全局变量赋随机值;
    同时窗体上的 Timer 控件每隔 1/10 秒就把这个变量写在窗体标题;
    在这个过程中演示了 ResumeThread、SuspendThread 两个函数.

    //上面图片中演示的代码。

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, ExtCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Timer1: TTimer; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    hThread: THandle; {线程句柄} 
    num: Integer; {全局变量, 用于记录随机数} 
    
    {线程入口函数} 
    function MyThreadFun(p: Pointer): Integer; stdcall; 
    begin 
    while True do {假如线程不挂起, 这个循环将一直循环下去} 
    begin 
    num := Random(100); 
    end; 
    Result := 0; 
    end; 
    
    {建立并挂起线程} 
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    hThread := CreateThread(nil, 0, @MyThreadFun, nil, CREATE_SUSPENDED, ID); 
    Button1.Enabled := False; 
    end; 
    
    {唤醒并继续线程} 
    procedure TForm1.Button2Click(Sender: TObject); 
    begin 
    ResumeThread(hThread); 
    end; 
    
    {挂起线程} 
    procedure TForm1.Button3Click(Sender: TObject); 
    begin 
    SuspendThread(hThread); 
    end; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    Timer1.Interval := 100; 
    end; 
    
    procedure TForm1.Timer1Timer(Sender: TObject); 
    begin 
    Text := IntToStr(num); 
    end; 
    
    end.
    View Code

    ㈢、入口函数的参数
    function CreateThread(
    lpThreadAttributes: Pointer;
    dwStackSize: DWORD;
    lpStartAddress: TFNThreadStartRoutine;
    lpParameter: Pointer; {入口函数的参数}
    dwCreationFlags: DWORD;
    var lpThreadId: DWORD
    ): THandle; stdcall;
    线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据; 本例是把鼠标点击窗体的坐标传递给线程的入口函数, 每次点击窗体都会创建一个线程.

    运行效果图:

    //上面演示的代码 
    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs; 
    
    type 
    TForm1 = class(TForm) 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    pt: TPoint; {这个坐标点将会已指针的方式传递给线程, 它应该是全局的} 
    
    function MyThreadFun(p: Pointer): Integer; stdcall; 
    var 
    i: Integer; 
    pt2: TPoint; {因为指针参数给的点随时都在变, 需用线程的局部变量存起来} 
    begin 
    pt2 := PPoint(p)^; {转换} 
    for i := 0 to 1000000 do 
    begin 
    with Form1.Canvas do begin 
    Lock; 
    TextOut(pt2.X, pt2.Y, IntToStr(i)); 
    Unlock; 
    end; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    var 
    ID: DWORD; 
    begin 
    pt := Point(X, Y); 
    CreateThread(nil, 0, @MyThreadFun, @pt, 0, ID); 
    {下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的} 
    //CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID); 
    end; 
    
    end.
    View Code

     

    这个例子还有不严谨的地方: 当一个线程 Lock 窗体的 Canvas 时, 其他线程在等待; 线程在等待时, 其中的计数也还在增加. 这也就是说: 现在并没有去处理线程的同步; 同步是多线程中最重要的课题, 快到了.

    另外有个小技巧: 线程函数的参数是个 32 位(4个字节)的指针, 仅就本例来讲, 可以让它的 "高16位" 和 "低16位" 分别携带 X 和 Y; 这样就不需要哪个全局的 pt 变量了.
    其实在 Windows 的消息中就是这样传递坐标的, 在 Windows 的消息中一般高字节是 Y、低字节是 X; 咱们这么来吧, 这样还可以使用给消息准备的一些方便的函数.

    重写本例代码(当然运行效果和窗体文件都是一样的):

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs; 
    
    type 
    TForm1 = class(TForm) 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    function MyThreadFun(p: Pointer): Integer; stdcall; 
    var 
    i: Integer; 
    x,y: Word; 
    begin 
    x := LoWord(Integer(p)); 
    y := HiWord(Integer(p)); 
    {如果不使用 LoWord、HiWord 函数可以像下面这样: } 
    //x := Integer(p); 
    //y := Integer(p) shr 16; 
    for i := 0 to 1000000 do 
    begin 
    with Form1.Canvas do begin 
    Lock; 
    TextOut(x, y, IntToStr(i)); 
    Unlock; 
    end; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
    var 
    ID: DWORD; 
    num: Integer; 
    begin 
    num := MakeLong(X, Y); 
    {如果不使用 MekeLong、MakeWParam、MakeLParam、MakeResult 等函数, 可以像下面这样: } 
    //num := Y shl 16 + X; 
    CreateThread(nil, 0, @MyThreadFun, Ptr(num), 0, ID); 
    {上面的 Ptr 是专门将一个数字转换为指针的函数, 当然也可以这样: } 
    //CreateThread(nil, 0, @MyThreadFun, Pointer(num), 0, ID); 
    end; 
    
    end.
    View Code

    ㈣、入口函数的指针
    function CreateThread(
    lpThreadAttributes: Pointer;
    dwStackSize: DWORD;
    lpStartAddress: TFNThreadStartRoutine; {入口函数的指针}
    lpParameter: Pointer;
    dwCreationFlags: DWORD;
    var lpThreadId: DWORD
    ): THandle; stdcall;


    到了入口函数了, 学到这个地方, 我查了一个入口函数的标准定义, 这个函数的标准返回值应该是 DWORD, 不过这函数在 Delphi 的 System 单元定义的是: TThreadFunc = function(Parameter: Pointer): Integer; 我以后会尽量使用 DWORD 做入口函数的返回值.

    这个返回值有什么用呢?
    等线程退出后, 我们用 GetExitCodeThread 函数获取的退出码就是这个返回值!

    如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出.

    还有一个问题: 前面也提到过, 线程函数不能是某个类的方法! 假如我们非要线程去执行类中的一个方法能否实现呢?
    尽管可以用 Addr(类名.方法名) 或 MethodAddress('published 区的方法名') 获取类中方法的地址, 但都不能当做线程的入口函数, 原因可能是因为类中的方法的地址是在实例化为对象时动态分配的.
    后来换了个思路, 其实很简单: 在线程函数中再调用方法不就得了, 估计 TThread 也应该是这样.

    下面的例子就尝试了用线程调用 TForm1 类中的方法, 并测试了退出码的相关问题.

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    private 
    procedure FormProc; {准备给线程使用的方法} 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    hThread: THandle; 
    
    {线程入口函数} 
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    begin 
    Form1.FormProc; {调用 TForm1 类的方法} 
    Result := 99; {这个返回值将成为线程的退出代码, 99 是我随意给的数字} 
    end; 
    
    {TForm1 的方法, 本例中是给线程的入口函数调用的} 
    procedure TForm1.FormProc; 
    var 
    i: Integer; 
    begin 
    for i := 0 to 200000 do 
    begin 
    with Form1.Canvas do begin 
    Lock; 
    TextOut(10, 10, IntToStr(i)); 
    Unlock; 
    end; 
    end; 
    end; 
    
    {建立并执行线程} 
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    hThread := CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    end; 
    
    {获取线程的退出代码, 并判断线程是否退出} 
    procedure TForm1.Button2Click(Sender: TObject); 
    var 
    ExitCode: DWORD; 
    begin 
    GetExitCodeThread(hThread, ExitCode); 
    
    if hThread = 0 then 
    begin 
    Text := '线程还未启动'; 
    Exit; 
    end; 
    
    if ExitCode = STILL_ACTIVE then 
    Text := Format('线程退出代码是: %d, 表示线程还未退出', [ExitCode]) 
    else 
    Text := Format('线程已退出, 退出代码是: %d', [ExitCode]); 
    end; 
    
    end.
    View Code

    ㈤、堆栈大小
    function CreateThread(
    lpThreadAttributes: Pointer;
    dwStackSize: DWORD; {堆栈大小}
    lpStartAddress: TFNThreadStartRoutine;
    lpParameter: Pointer;
    dwCreationFlags: DWORD;
    var lpThreadId: DWORD
    ): THandle; stdcall;


    CreateThread 的第二个参数是分配给线程的堆栈大小.
    这首先这可以让我们知道: 每个线程都有自己独立的堆栈(也拥有自己的消息队列).

    什么是堆栈? 其实堆是堆、栈是栈, 有时 "栈" 也被叫做 "堆栈".
    它们都是进程中的内存区域, 主要是存取方式不同(栈:先进后出; 堆:先进先出);
    "栈"(或叫堆栈)适合存取临时而轻便的变量, 主要用来储存局部变量; 譬如 for i := 0 to 99 do 中的 i 就只能存于栈中, 你把一个全局的变量用于 for 循环计数是不可以的.

    现在我们知道了线程有自己的 "栈", 并且在建立线程时可以分配栈的大小.

    前面所有的例子中, 这个值都是 0, 这表示使用系统默认的大小, 默认和主线程栈的大小一样, 如果不够用会自动增长;
    那主线程的栈有多大? 这个值是可以设定的: Project -> Options -> linker -> memory size(如图)

    栈是私有的但堆是公用的, 如果不同的线程都来使用一个全局变量有点乱套;
    为解决这个问题 Delphi 为我们提供了一个类似 var 的 ThreadVar 关键字, 线程在使用 ThreadVar 声明的全局变量时会在各自的栈中留一个副本, 这样就解决了冲突. 不过还是尽量使用局部变量, 或者在继承 TThread 时使用类的成员变量, 因为 ThreadVar 的效率不好, 据说比局部变量能慢 10 倍.

    在下面的例子就测试了用 var 和 ThreadVar 定义变量的不同.

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    //var num: Integer; {全局变量} 
    threadvar num: Integer; {支持多线程的全局变量} 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    py: Integer; 
    begin 
    py := Integer(p); 
    while True do 
    begin 
    Inc(num); 
    with Form1.Canvas do begin 
    Lock; 
    TextOut(20, py, IntToStr(num)); 
    Unlock; 
    end; 
    Sleep(1000); {然线程挂起 1 秒钟再继续} 
    end; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    {借入口函数的参数传递了一个坐标点中的 Y 值, 以让各线程把结果输出在不同位置} 
    CreateThread(nil, 0, @MyThreadFun, Ptr(20), 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, Ptr(40), 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, Ptr(60), 0, ID); 
    end; 
    
    end.
    View Code

    ㈥、安全设置

    function CreateThread( 
    lpThreadAttributes: Pointer; {安全设置} 
    dwStackSize: DWORD; 
    lpStartAddress: TFNThreadStartRoutine; 
    lpParameter: Pointer; 
    dwCreationFlags: DWORD; 
    var lpThreadId: DWORD 
    ): THandle; stdcall;
    CreateThread 的第一个参数 lpThreadAttributes 是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制; 该结构的定义是:
    //TSecurityAttributes(又名: SECURITY_ATTRIBUTES、_SECURITY_ATTRIBUTES) 
    _SECURITY_ATTRIBUTES = record 
    nLength: DWORD; {结构大小} 
    lpSecurityDescriptor: Pointer; {默认 nil; 这是另一个结构 TSecurityDescriptor 的指针} 
    bInheritHandle: BOOL; {默认 False, 表示不可继承} 
    end; 
    
    //TSecurityDescriptor(又名: SECURITY_DESCRIPTOR、_SECURITY_DESCRIPTOR) 
    _SECURITY_DESCRIPTOR = record 
    Revision: Byte; 
    Sbz1: Byte; 
    Control: SECURITY_DESCRIPTOR_CONTROL; 
    Owner: PSID; 
    Group: PSID; 
    Sacl: PACL; 
    Dacl: PACL; 
    end;
    View Code

    够复杂的, 但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil).

    我觉得有必要在此刻了解的是: 建立系统内核对象时一般都有这个属性(TSecurityAttributes);
    在接下来多线程的课题中要使用一些内核对象, 不如先盘点一下, 到时碰到这个属性时给个 nil 即可, 不必再费神.

    {建立事件} 
    function CreateEvent( 
    lpEventAttributes: PSecurityAttributes; {!} 
    bManualReset: BOOL; 
    bInitialState: BOOL; 
    lpName: PWideChar 
    ): THandle; stdcall; 
    
    {建立互斥} 
    function CreateMutex( 
    lpMutexAttributes: PSecurityAttributes; {!} 
    bInitialOwner: BOOL; 
    lpName: PWideChar 
    ): THandle; stdcall; 
    
    {建立信号} 
    function CreateSemaphore( 
    lpSemaphoreAttributes: PSecurityAttributes; {!} 
    lInitialCount: Longint; 
    lMaximumCount: Longint; 
    lpName: PWideChar 
    ): THandle; stdcall; 
    
    {建立等待计时器} 
    function CreateWaitableTimer( 
    lpTimerAttributes: PSecurityAttributes; {!} 
    bManualReset: BOOL; 
    lpTimerName: PWideChar 
    ): THandle; stdcall; 
    View Code

    上面的四个系统内核对象(事件、互斥、信号、计时器)都是线程同步的手段, 从这也能看出处理线程同步的复杂性; 不过这还不是全部, Windows Vista 开始又增加了 Condition variables(条件变量)、Slim Reader-Writer Locks(读写锁)等同步手段.

    不过最简单、最轻便(速度最快)的同步手段还是 CriticalSection(临界区), 但它不属于系统内核对象, 当然也就没有句柄、没有 TSecurityAttributes 这个安全属性, 这也导致它不能跨进程使用; 不过写多线程时一般不用跨进程, 所以 CriticalSection 应该是最常用的同步手段.

    二、临界区。
    先看一段程序, 代码文件:

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i: Integer; 
    begin 
    for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i)); 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    end; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    ListBox1.Align := alLeft; 
    end; 
    
    end.
    View Code

    在这段程序中, 有三个线程几乎是同时建立, 向窗体中的 ListBox1 中写数据, 最后写出的结果是这样的:

    能不能让它们别打架, 一个完了另一个再来? 这就要用到多线程的同步技术.
    前面说过, 最简单的同步手段就是 "临界区".

    先说这个 "同步"(Synchronize), 首先这个名字起的不好, 我们好像需要的是 "异步"; 其实异步也不准确...
    管它叫什么名字呢, 它的目的就是保证不冲突、有次序、都发生.

    "临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:
    var CS: TRTLCriticalSection; {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的}
    InitializeCriticalSection(CS); {初始化}
    EnterCriticalSection(CS); {开始: 轮到我了其他线程走开}
    LeaveCriticalSection(CS); {结束: 其他线程可以来了}
    DeleteCriticalSection(CS); {删除: 注意不能过早删除}

    //也可用 TryEnterCriticalSection 替代 EnterCriticalSection.
    用上临界区, 重写上面的代码, 运行效果图:

    //用临界区重写后的代码文件: 
    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    CS: TRTLCriticalSection; 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i: Integer; 
    begin 
    EnterCriticalSection(CS); 
    for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i)); 
    LeaveCriticalSection(CS); 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    end; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    ListBox1.Align := alLeft; 
    InitializeCriticalSection(CS); 
    end; 
    
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    DeleteCriticalSection(CS); 
    end; 
    
    end.
    View Code

    Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    uses SyncObjs; 
    
    var 
    CS: TCriticalSection; 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i: Integer; 
    begin 
    CS.Enter; 
    for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i)); 
    CS.Leave; 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ID: DWORD; 
    begin 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
    end; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    ListBox1.Align := alLeft; 
    CS := TCriticalSection.Create; 
    end; 
    
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    CS.Free; 
    end; 
    
    end.
    View Code

    三、等待函数 WaitForSingleObject
    一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数; 不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.
    function WaitForSingleObject(
    hHandle: THandle; {要等待的对象句柄}
    dwMilliseconds: DWORD {等待的时间, 单位是毫秒}
    ): DWORD; stdcall; {返回值如下:}
    WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}
    WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
    WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}
    //WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.

    WaitForSingleObject 等待什么? 在多线程里就是等待另一个线程的结束, 快来执行自己的代码; 不过它可以等待的对象可不止线程; 这里先来一个等待另一个进程结束的例子, 运行效果图:
    //WaitForSingleObject的示例代码文件:

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    hProcess: THandle; {进程句柄} 
    
    {等待一个指定句柄的进程什么时候结束} 
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    begin 
    if WaitForSingleObject(hProcess, INFINITE) = WAIT_OBJECT_0 then 
    Form1.Text := Format('进程 %d 已关闭', [hProcess]); 
    Result := 0; 
    end; 
    
    {启动一个进程, 并建立新线程等待它的结束} 
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    pInfo: TProcessInformation; 
    sInfo: TStartupInfo; 
    Path: array[0..MAX_PATH-1] of Char; 
    ThreadID: DWORD; 
    begin 
    {先获取记事本的路径} 
    GetSystemDirectory(Path, MAX_PATH); 
    StrCat(Path, '\notepad.exe'); 
    
    {用 CreateProcess 打开记事本并获取其进程句柄, 然后建立线程监视} 
    FillChar(sInfo, SizeOf(sInfo), 0); 
    if CreateProcess(Path, nil, nil, nil, False, 0, nil, nil, sInfo, pInfo) then 
    begin 
    hProcess := pInfo.hProcess; {获取进程句柄} 
    Text := Format('进程 %d 已启动', [hProcess]); 
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID); {建立线程监视} 
    end; 
    end; 
    
    end.
    View Code

    四、多线程同步之 Mutex (互斥对象)
    原理分析:
    互斥对象是系统内核对象, 各线程都可以拥有它, 谁拥有谁就能执行;
    执行完毕, 用 ReleaseMutex 函数释放拥有权, 以让其他等待的线程使用.
    其他线程可用 WaitForSingleObject 函数排队等候(等候也可以理解为排队申请).

    使用过程:


    var hMutex: THandle; {应该先声明一个全局的互斥句柄}
    CreateMutex {建立一个互斥对象}
    WaitForSingleObject {用等待函数排队等候}
    ReleaseMutex {释放拥有权}
    CloseHandle {最后释放互斥对象}


    ReleaseMutex、CloseHandle 的参数都是 CreateMutex 返回的句柄, 关键是 CreateMutex 函数:

    function CreateMutex(
    lpMutexAttributes: PSecurityAttributes;
    bInitialOwner: BOOL; {是否让创建者(此例中是主线程)拥有该互斥对象}
    lpName: PWideChar {可以给此互斥对象取个名字, 如果不要名字可赋值为 nil}
    ): THandle;
    {
    1、第一个参数前面说过.
    2、第二个参数在这里一定要是 False, 如果让主线程拥有互斥, 从理论上讲, 得等程序退出后其他线程才有机会;
    取值 False 时, 第一个执行的线程将会最先拥有互斥对象, 一旦拥有其他线程就得先等等.
    3、第三个参数, 如果给个名字, 函数将从系统中寻找是否有重名的互斥对象, 如果有则返回同名对象的存在的句柄;
    如果赋值为 nil 将直接创建一个新的互斥对象; 下个例子将会有名字. }

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    f: Integer; {用这个变量协调一下各线程输出的位置} 
    hMutex: THandle; {互斥对象的句柄} 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i,y: Integer; 
    begin 
    Inc(f); 
    y := 20 * f; 
    for i := 0 to 50000 do 
    begin 
    if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(20, y, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    Sleep(0); {稍稍耽搁一点, 不然有时 Canvas 会协调不过来} 
    ReleaseMutex(hMutex); 
    end; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ThreadID: DWORD; 
    begin 
    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; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    hMutex := CreateMutex(nil, False, nil); 
    end; 
    
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    CloseHandle(hMutex); 
    end; 
    
    end.
    View Code

    SyncObjs 单元下有封装好的 TMutex 类, 好像不如 Api 快, 内部机制也稍有区别, 但使用方法差不多:

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 
    
    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    uses SyncObjs; 
    var 
    f: Integer; 
    MyMutex: TMutex; 
    
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i,y: Integer; 
    begin 
    Inc(f); 
    y := 20 * f; 
    for i := 0 to 50000 do 
    begin 
    if MyMutex.WaitFor(INFINITE) = wrSignaled then 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(20, y, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    MyMutex.Release; 
    end; 
    end; 
    Result := 0; 
    end; 
    
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ThreadID: DWORD; 
    begin 
    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; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    MyMutex := TMutex.Create(False); 
    end; 
    
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    MyMutex.Free; 
    end; 
    
    end.
    View Code

    Mutex 作为系统核心对象是可以跨进程的(临界区就不行), 我们可以利用互斥对象禁止程序重复启动.

    工作思路:
    先用 OpenMutex 尝试打开一个自定义名称的 Mutex 对象, 如果打开失败说明之前没有这个对象存在;
    如果之前没有这个对象, 马上用 CreateMutex 建立一个, 此时的程序应该是第一次启动;
    再重复启动时, 那个 OpenMutex 就有结果了, 然后强制退出.
    最后在程序结束时用 CloseHandle 释放 Mutex 对象.


    function OpenMutex(
    dwDesiredAccess: DWORD; {打开权限}
    bInheritHandle: BOOL; {能否被当前程序创建的进程继承}
    pName: PWideChar {Mutex 对象的名称}
    ): THandle; stdcall; {成功返回 Mutex 的句柄; 失败返回 0}

    注意, 这里的 CreateMutex 函数应该有个名了, 因为 OpenMutex 要用到;
    另外, CreateMutex 的第二个参数已经不重要了(也就是 True 和 False 都行), 因为这里是用其名称来判断的.

    程序可以这样写:

    unit Unit1; 
    
    interface 
    
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs; 
    
    type 
    TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    end; 
    
    var 
    Form1: TForm1; 
    
    implementation 
    
    {$R *.dfm} 
    
    var 
    hMutex: THandle; 
    const 
    NameMutex = 'MyMutex'; 
    
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    if OpenMutex(MUTEX_ALL_ACCESS, False, NameMutex) <> 0 then 
    begin 
    ShowMessage('该程序已启动'); 
    Application.Terminate; 
    end; 
    hMutex := CreateMutex(nil, False, NameMutex); 
    end; 
    
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    CloseHandle(hMutex); 
    end; 
    
    end.
    View Code

    这一般都是写在 dpr 主程序里, 省得让后启动的程序执行些无用的代码:

    program Project1; 
    
    uses 
    Forms, Windows, 
    Unit1 in 'Unit1.pas' {Form1}; 
    
    {$R *.res} 
    
    var 
    hMutex: THandle; 
    const 
    NameMutex = 'MyMutex'; 
    
    begin 
    {主线程入口} 
    if OpenMutex(MUTEX_ALL_ACCESS, False, NameMutex) <> 0 then 
    begin 
    MessageBox(0, '该程序已启动', '提示', MB_OK); 
    Application.Terminate; 
    end; 
    hMutex := CreateMutex(nil, False, NameMutex); 
    
    Application.Initialize; 
    Application.MainFormOnTaskbar := True; 
    Application.CreateForm(TForm1, Form1); 
    Application.Run; 
    
    CloseHandle(hMutex); 
    {主线程出口} 
    end. 
    View Code

    五、多线程同步之 Semaphore (信号对象)
    之前已经有了两种多线程的同步方法:
    CriticalSection(临界区) 和 Mutex(互斥), 这两种同步方法差不多, 只是作用域不同;
    CriticalSection(临界区) 类似于只有一个蹲位的公共厕所, 只能一个个地进;
    Mutex(互斥) 对象类似于接力赛中的接力棒, 某一时刻只能一个人持有, 谁拿着谁跑.

    什么是 Semaphore(信号或叫信号量)呢?
    譬如到银行办业务、或者到车站买票, 原来只有一个服务员, 不管有多少人排队等候, 业务只能一个个地来.
    假如增加了业务窗口, 可以同时受理几个业务呢?
    这就类似与 Semaphore 对象, Semaphore 可以同时处理等待函数(如: WaitForSingleObject)申请的几个线程.

    Semaphore 的工作思路如下:
    1、首先要通过 CreateSemaphore(安全设置, 初始信号数, 信号总数, 信号名称) 建立信号对象;
    参数四: 和 Mutex 一样, 它可以有个名称, 也可以没有, 本例就没有要名称(nil); 有名称的一般用于跨进程.
    参数三: 信号总数, 是 Semaphore 最大处理能力, 就像银行一共有多少个业务窗口一样;
    参数二: 初始信号数, 这就像银行的业务窗口很多, 但打开了几个可不一定, 如果没打开和没有一样;
    参数一: 安全设置和前面一样, 使用默认(nil)即可.

    2、要接受 Semaphore 服务(或叫协调)的线程, 同样需要用等待函数(如: WaitForSingleObject)排队等候;

    3、当一个线程使用完一个信号, 应该用 ReleaseSemaphore(信号句柄, 1, nil) 让出可用信号给其他线程;
    参数三: 一般是 nil, 如果给个数字指针, 可以接受到此时(之前)总共闲置多少个信号;
    参数二: 一般是 1, 表示增加一个可用信号;
    如果要增加 CreateSemaphore 时的初始信号, 也可以通过 ReleaseSemaphore.

    4、最后, 作为系统内核对象, 要用 CloseHandle 关闭.

    另外, 在 Semaphore 的总数是 1 的情况下, 就和 Mutex(互斥) 一样了.

    在本例中, 每点击按钮, 将建立一个信号总数为 5 的信号对象, 初始信号来自 Edit1; 同时有 5 个线程去排队.
    本例也附上了 Delphi 中 TSemaphore 类的例子, 但没有过多地纠缠于细节, 是为了尽快理出多线程的整体思路.

    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); 
    end; 
    var 
    Form1: TForm1; 
    implementation 
    {$R *.dfm} 
    var 
    f: Integer; {用这个变量协调一下各线程输出的位置} 
    hSemaphore: THandle; {信号对象的句柄} 
    function MyThreadFun(p: Pointer): DWORD; stdcall; 
    var 
    i,y: Integer; 
    begin 
    Inc(f); 
    y := 20 * f; 
    if WaitForSingleObject(hSemaphore, INFINITE) = WAIT_OBJECT_0 then 
    begin 
    for i := 0 to 100 do 
    begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(20, y, IntToStr(i)); 
    Form1.Canvas.Unlock; 
    Sleep(1); {以免 Canvas 忙不过来} 
    end; 
    end; 
    ReleaseSemaphore(hSemaphore, 1, nil); 
    Result := 0; 
    end; 
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
    ThreadID: DWORD; 
    begin 
    {不知是不是之前创建过 Semaphore 对象, 假如有先关闭} 
    CloseHandle(hSemaphore); 
    {创建 Semaphore 对象} 
    hSemaphore := CreateSemaphore(nil, StrToInt(Edit1.Text), 5, nil); 
    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; 
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    Edit1.Text := '1'; 
    end; 
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    CloseHandle(hSemaphore); 
    end; 
    end.
    View Code

    再用 SyncObjs 单元下的 TSemaphore 类实现一次, 使用方法差不多, 运行效果也一样:

    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, ''); 
    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; 
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    Edit1.Text := '1'; 
    end; 
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    if Assigned(MySemaphore) then MySemaphore.Free; 
    end; 
    end.
    View Code

     

    转载于:https://www.cnblogs.com/blogpro/p/11345243.html

    展开全文
  • delphi多线程编程详解,里面对delphi多线程的应用做了详细的说明
  • delphi多线程编程学习

    2012-07-16 11:08:20
    学习delphi多线程编程,从实例学习delphi
  • Delphi多线程编程中的技巧
  • 实验一 Linux多线程编程I 实验目的 熟悉GNU GCC编译器能够用Pthreads线程库熟练编写多线程程序 二实验内容 1设一个double型的一维数组数组长度是1,000,000计算全数组部元素的和 要求 1) 编制一个串行程序仅有一个...
  • Delphi多线程编程之四 线程安全和VCL ◆(乌龙哈里2008-10-12) (调试环境:Delphi2007+WinXPsp3 例程:Tst_Thread4.dpr) 由于Delphi VCL在设计成大部分在主线程访问,因而,当多个线程同时访问VCL时,就非安全...
    1. ◆Delphi多线程编程之四 线程安全和VCL ◆(乌龙哈里2008-10-12)
    2. (调试环境:Delphi2007+WinXPsp3 例程:Tst_Thread4.dpr)
    3.     由于Delphi VCL在设计成大部分在主线程访问,因而,当多个线程同时访问VCL时,就非安全。
    4. 其实线程的安全性如上面那个读全局变量来说,那个全局变量是非线程安全的,因为当另外一个线程访问它的时候,它的数值还在被前一个线程改动中。这在非线程安全的对象中就会造成很严重的后果,比如一个对象的创立时的初始值被另一个线程改变了,后果相当地严重。
    5. VCL中,连很基础的Tlist都是非线程安全,要多个线程操纵List时,用TThreadList来替代。
    6. unit Tst_Thread4U;
    7. interface
    8. uses
    9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    10.   Dialogs, StdCtrls;
    11. type
    12.   TForm1 = class(TForm)
    13.     Button1: TButton;
    14.     Memo1: TMemo;
    15. procedure Button1Click(Sender: TObject);
    16. procedure Button2Click(Sender: TObject);
    17. private
    18. { Private declarations }
    19. public
    20. { Public declarations }
    21. end;
    22.   TMyThread=class(TThread)
    23. protected
    24. procedure Execute;override;
    25. procedure ShowInMemo;
    26. end;
    27. var
    28.   Form1: TForm1;
    29. implementation
    30. {$R *.dfm}
    31. const
    32.   MaxSize=1000;
    33. var
    34.   NextNumber:Integer=0;
    35.   GlobalNum:Integer;
    36. function GetNextNumber:Integer;
    37. begin
    38.   Result:=NextNumber;
    39.   inc(NextNumber);
    40. end;
    41. { TMyThread }
    42. procedure TMyThread.Execute;
    43. var
    44.   i:Integer;
    45. begin
    46.   FreeOnTerminate:=True; //终止后自动free
    47. for i := 1 to MaxSize do
    48. begin
    49.     GlobalNum:=GetNextNumber;
    50.     Sleep(5);
    51.     Synchronize(ShowInMemo);
    52. //  ShowInMemo;
    53. end;
    54. end;
    55. procedure TMyThread.ShowInMemo;
    56. begin
    57.     Form1.Memo1.Lines.Add(inttostr(GlobalNum));
    58. end;
    59. procedure TForm1.Button1Click(Sender: TObject);
    60. begin
    61.   TMyThread.Create(False);
    62.   TMyThread.Create(False);
    63. end;
    64. end.
    65. 上面这个例程,把输出到Memo1放在线程里了,所以要在Execute()内用到Synchronize()函数,这样才是线程安全。
    66. 一、Synchronize()函数。
    67.     是个重载函数,有两种引用形式:
    68. class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;
    69. procedure Synchronize(AMethod: TThreadMethod); overload;
    70. Amethod是线程的一个自定义不带参数过程(!!太烦了,不能带参数,好不方便)。
    71. Synchronize()调用了Windows的SendMessage()向主线程发一消息。主线程必须已建立消息队列,并且不断地从消息队类中检索消息。一旦主线程检索到消息,就执行Synchronize()所指定的代码。(ps:我查了Vcl源程序,发现也是调用临界区,这个太不方便了,还是使用临界区好)。

    转载于:https://www.cnblogs.com/94YY/archive/2011/10/05/2199345.html

    展开全文
  • Delphi多线程编程基础入门

    千次阅读 2018-03-26 01:06:41
    Delphi是一门古老而优秀的编程语言,它对多线程的处理有一些特殊的地方,本文尝试做一些简单的讲解,可以当作Delphi多线程基础入门知识来阅读。如无特殊说明,所有例子都在XP操作系统中和Delphi7中调试通过。2. 一...

    1. 概述

             对于开发人员来说,多线程是必备的知识,但相对来说,也是比较难的知识点。Delphi是一门古老而优秀的编程语言,它对多线程的处理有一些特殊的地方,本文尝试做一些简单的讲解,可以当作Delphi的多线程基础入门知识来阅读。如无特殊说明,所有例子都在XP操作系统中和Delphi7中调试通过。

    2. 一个简单的例子

              在这一节中,我们将建立一个极为简单的例子,阐述Delphi中多线程的用法。

    2.1 实现步骤

              第一步:在Delphi7 IDE中新建一个Application,如下图所示。


    图1

              第二步:打开工程文件,输入{$APPTYPE CONSOLE},以便打开控制台,新建的线程在控制台输出一些文本。操作过程如下所示。


    图2

    图3

              第三步:新建一个单元文件Unit2,如下图所示。
    图4

    图5

              第四步:在新建的Unit2单元中输入如下代码:


    图6

              在Unit1单元中输入如下代码:
    图7

              第五步:点击“Save All”,保存相关文件,如下图所示:
    图8

    图9

              第六步:按F9运行程序,如下图所示:
    图10

              在上图中,可以见到新的线程在运行了,输出了“I am a new thread”。

    2.2 线程基础知识

    2.2.1 新的线程与主线程的关系

              主线程也叫界面线程,就是窗体应用程序启动时,对应进程创建的第一条线程,该线程负责:
              1. 创建窗体、创建窗体上的控件。
              2. 响应键盘消息、鼠标消息等Windows消息。
              3. 负责创建新线程和其他事情。

              主线程以外的新线程也叫作工作线程,负责处理具体的事务。主线程创建新线程后,可以让新线程立即运行,也可以让它稍后运行。
              在下面的代码中:

    myThread := TMyThread.Create(False);
    

              参数False表示,新线程myThread在创建后,将立即运行。如果想不立即运行,而是在另一个适当的时刻运行,则可以使用如下代码:

    myThread := TMyThread.Create(True); 
    ……
    myThread.Resume;  //适当的时刻启动该线程
    

    2.2.2 新的线程在哪里工作

              在Delphi中,创建新线程时,通常的做法是从系统线程类TThread进行继承,该类有一个虚方法:

    procedure Execute; virtual;
    

              在上文的TMyThread类中,重写了这个方法,如下所示:

    TMyThread = class(TThread)
    protected
        procedure Execute; override;
    public
    end;
    

              安排新线程做的工作任务,应该在这个方法中完成。

    2.2.3 新的线程何时退出

              当方法Execute退出时,新线程就结束了。在下面的Execute方法中,它只是向屏幕打印了一个语句“I am a new thread”,新线程就结束了。

    procedure TMyThread.Execute;
    begin
        Writeln('I am a new thread');
    end;
    

              这是新线程的正常退出方法。除此之外,Delphi没有提供立即终止新线程的方法,如Kill、Abort等其他语言提供的方法。若要立即杀死线程,则需要调用Win32 API方法TerminateThread(myThread.Handle, 0)。这是一种暴力退出方法,可能导致系统不稳定,因此严重不推荐。
              在TThread中,与线程暂停、退出有关的方法和属性有:

    • property Terminated: Boolean;
              Delphi解释:The thread's Execute method and any methods that Execute calls should check Terminated periodically and exit when it's true. The Terminate method sets the Terminated property to true。
              中文翻译:Execute方法以及它调用的任何方法都应该周期性地查看Terminated的值,一旦发现Terminated为True,就应该退出。Terminate方法将属性Terminated设为True。
              上述说法表明,将Terminated设为True,并不能退出线程,它只是告诉Execute方法,“有人让你们尽快完事,你们快点干”,但Execute可以不理会Terminated的值,仍然自顾自地运行。

    • property Suspended: Boolean;
              Delphi解释:Set Suspended to true to suspend a thread; set it to false to resume it. Suspended threads do not continue execution until they are resumed.
              中文翻译:设置Suspended为True以挂起(暂停)一个线程;设置它为False以唤醒(继续)一个线程。挂起的线程不会继续执行,直到它被唤醒为止。

    • procedure Terminate;
              Delphi解释:Terminate sets the thread’s Terminated property to true, signaling that the thread should be terminated as soon as possible.
              中文翻译:Terminate方法设置线程的Terminated属性为True,该信号表明线程应该尽快结束。
              上述文字表明,Terminate方法只是想Execute方法喊话,“喂,哥们,快点啊,时间不多了,快点干完”,Execute如果懂礼貌的话,它会时不时地注意是否有人让它停止干活,一旦收到停工的消息,它就会尽快收拾停当,如果它不懂礼貌的话,则会把停工的消息当作耳边风。

    • procedure Resume;
              Delphi解释:Call Resume to cause a suspended thread to start running again. Calls to Suspend can be nested; Resume must be called the same number of times Suspend was called before the thread will resume execution.
              中文翻译:调用Resume方法以让一个挂起(暂停)的线程重新开始运行。对Suspend方法的调用可以嵌套;在线程继续运行之前,调用Resume方法的次数必须与调用Suspend方法的次数相同。

    • procedure Suspend;
              Delphi解释:Call Suspend to temporarily halt execution of the thread. To resume execution after a call to Suspend, call Resume. Calls to Suspend can be nested; Resume must be called the same number of times Suspend was called before the thread will resume execution.
              中文翻译:调用Suspend方法临时中止线程的执行。若要在调用Suspend方法后继续执行,请调用Resume方法。对Suspend方法的调用可以嵌套;在线程继续运行之前,调用Resume方法的次数必须与调用Suspend方法的次数相同。

    2.2.4 新线程如何销毁

              有两种方法:
              1. 在创建线程时,设置FreeOnTerminate为True,那么当Execute执行完毕时,系统自动销毁新线程。有如下几个地方,设置FreeOnTerminate为True。

    • 第一个地方——Create方法内部

        //为TMyThread提供Create方法,在Create方法中设置
        constructor TMyThread.Create;
        begin
            FreeOnTerminate := True;   //线程工作完毕后要自行销毁
            inherited Create(False);     //线程创建后立即启动
        end;
        //调用TMyThread.Create的地方,需要修改为
        procedure TForm1.FormCreate(Sender: TObject);
        begin
            myThread := TMyThread.Create;
        end;
      
    • 第二个方法——在Execute方法内部,执行工作任务之前

        procedure TMyThread.Execute;
        begin
            FreeOnTerminate := True;
            Writeln('I am a new thread');
        end;
      
    • 第三个方法——在类TMyThread的外部

        constructor TMyThread.Create;
        Begin 
            inherited     Create(True);     //线程创建后不立即启动
        end;
        //在TForm1内部,创建TMyThread线程后,设置FreeOnTerminate 为True
        procedure TForm1.FormCreate(Sender: TObject);
        begin
            myThread := TMyThread.Create;
            myThread.FreeOnTerminate := True;
        end;
      
        //在合适的地方,执行如下语句
        myThread.Resume;
      

    由此可见,只需要在Execute退出前,设置FreeOnTerminate为True即可。

            2. 如果没有设置FreeOnTerminate为True,则需要在Execute执行完毕后,开发人员人为地销毁它,代码如下:

    //主线程在适当的地方执行下述语句
    FreeAndNil(myThread);
    

    3. 可持续工作的线程

    3.1 使用循环实现持续工作

            上文创建的线程,只做了一件事情(即向控制台输出一行文本),就退出了。显然,这种做法没有挖掘线程的价值。为了改变这种现象,需要在Execute方法写入一个循环。该循环通常是一个永真循环,即死循环;当某些条件为真(比如Terminated为True)时,退出死循环。循环的形式可以是while、for、repeat-until语句,退出循环的形式可以是break或Exit。这里以while和Exit为例,说明用法。
            第一步:在上文的项目中,将unitMyThread单元的代码改为:

    unit unitMyThread;
    interface
    uses Windows, Classes, SysUtils;
    type
        TMyThread = class(TThread)
        protected
            procedure Execute; override;
            procedure DoMyWorkByWhile;
        
        public
            constructor Create;
        end;
    
    implementation
    
    { TMyThread }
    
    constructor TMyThread.Create;
    begin
        inherited Create(True);
    end;
    
    procedure TMyThread.DoMyWorkByWhile;
    var totalCount: Integer;
    begin
        totalCount := 0;
        while(True) do
        begin
            Inc(totalCount);
            Writeln('第' + IntToStr(totalCount) + '次循环 @' + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
            Sleep(500);
        
            if(Terminated) then
            begin
              Exit;
            end;
        end;
    
        //上述循环也可以改为
        while(not Terminated) do
        begin
            Inc(totalCount);
            Writeln('第' + IntToStr(totalCount) + '次循环 @' + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
            Sleep(500);
        end;
    end;
    
    procedure TMyThread.Execute;
    begin 
        FreeOnTerminate := True;
        DoMyWorkByWhile;
    end;
    
    end.
    

            第二步:在TForm1主窗体上添加两个按钮,分别是btnStart(启动)和btnExit(退出),主窗体单元代码为:

    unit unitMainForm;
    
    interface
    
    uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, unitMyThread, StdCtrls;
    
    type
        TForm1 = class(TForm)
            btnStart: TButton;
            btnExit: TButton;
            procedure btnStartClick(Sender: TObject);
            procedure btnExitClick(Sender: TObject);
        private
                { Private declarations }
                myThread: TMyThread;
          public
                { Public declarations }
        end;
    
        var
                Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.btnStartClick(Sender: TObject);
    begin
        myThread := TMyThread.Create;
        Writeln('亲亲的主人,谢谢您给了我以生命 @' +         FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
        //这里可以做很多其他工作
        myThread.Resume;
    end;
    
    procedure TForm1.btnExitClick(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            myThread.Terminate;  //不可以写作myThread.Terminated := True,因为Terminated不是public的
            Writeln('');
            Writeln('亲,永别了,来生再会 @' + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
        end;
    end;
    
    end.
    

            第三步:点击启动,一会儿后,点击退出,运行结果如下:


    图11

    3.2 可暂停的线程

            第一步:在TForm1主窗体上添加一个按钮btnPause(暂停)和btnResume(继续),双击它增加一个事件处理方法,如下所示:

    procedure TForm1.btnPauseClick(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            myThread.Suspend;
            Writeln('亲,你把我暂停了 @'  + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
        end;
    end;
    
    procedure TForm1.btnResumeClick(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            myThread.Resume;
            Writeln('');
            Writeln('亲,你把我唤醒了,我还没睡够呢 @'  + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
        end;
    end;
    

            第二步:点击启动,一会儿,点击暂停,一会儿,点击继续,一会儿,点击退出,运行结果如下:


    图12

    3.3 可空转/继续工作的线程

            在3.2节中,我们让线程实现了挂起(暂停)和唤醒(继续)两个操作,对某些场合来说很有用,但仍然无法某些场景的需求,举例如下:
            令狐冲因为跟魔教有勾结,被师傅岳不群罚去洗碗,包一日三餐,早上5:00开始上班,晚上11:00休息,中间不允许休息。令狐冲起床后,就要站在洗碗流水线上,他要做3件事情:1)观察是不是有碗筷要洗;2)如果有碗筷要洗,则刷洗碗筷;3)观察是不是洗完了。
            上述场景,用Suspend和Resume是解决不了的。为什么这么说呢?表面上,正在洗碗的动作,表示的是Resumed状态,这没错,而没有洗碗动作的时候,貌似是Suspended状态,这就错了,其实这也是Resumed状态。原因在于,若一个线程处于Suspended状态,就相当于令狐冲在睡觉,在睡眠中他是无法观察任何外界现象的。因此,实际上,上述三件事情,线程都必须在Resumed状态。
            第一步:在unitMyThread单元的类TMyThread中增加一个public字段:

    Working: Boolean;
    

            第二步:在TMyThread.Create中初始化:

    Working := True;
    

            第三步:增加洗碗方法TMyThread.WashDishes,如下所示:

    procedure TMyThread.WashDishes;
    var totalCount: Integer;
    begin
        totalCount := 0;
    
        while(not Terminated) do
        begin
            while(Working) do  //观察是否洗完了,Working为True说明还没洗完
            begin
                Inc(totalCount);
                Writeln('老板,我洗了第' + IntToStr(totalCount) + '个碗 @' + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
                Sleep(500);  //洗一个碗,歇500毫秒
            end;
            //洗完了
            Sleep(2000);  //每隔2秒钟,观察是否有新的一波碗要洗
        end;
    end;
    

            第四步:修改TMyThread.Execute方法,如下所示:

    procedure TMyThread.Execute;
    begin
        FreeOnTerminate := True;
        //DoMyWorkByWhile;
        WashDishes;
    end;
    

            第五步:在TForm1主窗体上增加按钮btnStartWash(洗碗)和btnSleepAwhile(歇会儿),增加两个事件方法,如下所示:

    procedure TForm1.btnStartWashClick(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            Writeln('老板,从哪儿弄来这么多碗,生意不错啊,我要开洗了 @'  + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
            myThread.Working := True;
        end;
    end;
    
    procedure TForm1.btnSleepAwhileClick(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin                                                                                 
            myThread.Working := False;
            Writeln('老板,我洗完了,歇会儿啊 @'  + FormatDateTime('yyyy-MM-dd HH:mm:ss', Now));
        end;
    end;
    
    &#160; &#160;&#160; &#160;&#160; 第六步:点击启动→洗碗→歇会儿,结果如下:
    
    图13

    4 与主线程通信

            在上文中,工作线程只是自顾自地干活(即向控制台输出文本),它并没有将工作进度实时报告给主线程。
    线程通信有很多实现方式,有些复杂,有些简单。这里主要提供两种思路和实现。

    4.1 主线程循环查询

            在主线程中增加一个时钟Timer1和OnTimer事件的处理方法Timer1Timer(Sender: TObject),在这个方法中,主线程循环查询工作线程的内部状态。
            第一步:在TMyThread中增加一个public字段:

    DishNumber: Integer;   //表示总共洗了多少个碗
    

            第二步:在TMyThread.Create方法中增加一个语句:

    DishNumber := 0;
    

            第三步:在TMyThread.WashDishes方法中的Writeln上方增加一条语句:

    DishNumber := totalCount;
    

            第四步:在TForm1主窗体上增加一个标签lblDishNumber(洗碗个数)和文本框edtDishNumber。
            第五步:在Timer1Timer方法中增加语句:

    edtDishNumber.Text := IntToStr(myThread.DishNumber);
    

            第六步:运行程序,点击启动→洗碗→歇会儿,结果如下:


    图14

    4.2 工作线程回调

            第一步:在TMyThread中增加一个public字段:

    Callback: TNotifyEvent;
    

            第二步:在TMyThread.WashDishes中的Writeln上方增加一条语句:

    Callback(Self);
    

            第三步:在TForm1中增加一个方法TForm1.callbackByMyThread(Sender: TObject),如下所示:

    procedure TForm1.callbackByMyThread(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            edtDishNumber.Text := IntToStr(myThread.DishNumber);
        end;
    end;
    

            第四步:在TForm1.btnStartClick(Sender: TObject)中的Writeln上方增加一个语句:

    myThread.Callback := callbackByMyThread;   //设置回调方法
    

            第五步:在TForm1.btnStartClick(Sender: TObject)中的Writeln上方增加一个语句:

    Timer1.Enabled := False;                   //禁止时钟
    

            第六步:运行程序,点击启动→洗碗→歇会儿,结果如下:


    图15

    4.3 两种通信方法的缺点

            如下所示:

    优缺点主线程循环查询工作线程回调
    优点可以方便访问窗体控件,无需线程切换实时性有保证
    缺点实时性难以保证需要切换线程,在访问窗体控件时需要线程同步

            在实时性方面,举一个比喻来说明问题。

            岳不群派遣令狐冲带小师妹岳灵珊攻占黑木崖,但岳不群又不放心,为保险起见,他决定采取打电话循环查询的方式,他这么做:

    第一个夜晚:岳不群打电话:“冲儿,攻占黑木崖了吗?”
    令狐冲回道:“师傅,没呢,还在路上。”
    
    第二个夜晚:岳不群打电话:“冲儿,攻占黑木崖了吗?”
    令狐冲回道:“师傅,没呢,还在路上。”
    ……
    
    第1000个夜晚:岳不群打电话:“冲儿,攻占黑木崖了吗?”
    令狐冲回道:“师傅,没呢,还在路上。”
    
    第1000 + 1个夜晚:岳不群打电话:“冲儿,攻占黑木崖了吗?”
    令狐冲回道:“师傅,攻占了,但是师妹被东方不败抢走了。”
    岳不群:“完了,完了,给我立即追击,要是找不到姗儿,你就别回来了。”
    

            在这1001个夜晚,岳不群茶饭不思、心神不灵,干啥啥不成,睡啥啥不香,还不如亲自带着自己的小师妹宁中则攻占黑木崖呢。令狐冲也过得不爽,每天晚上都要接一次电话,简直没法跟小师妹说悄悄话了和做其他事情了。特别是,要是早上9:00攻占了黑木崖,还不能立即告诉师傅好消息,只能等到晚上师傅打电话过来。

            由于师妹被东方不败抢走了,据说带到扶桑岛去了,令狐冲决定趁胜追击,但是路途遥远,路上信号又不好,关键是手机用了将近三年,电池不行啊,撑不住每天一个电话,于是,第1002个夜晚,令狐冲突发奇想,给师傅打了个电话,说道:“师傅,东方不败虏着师妹逃到扶桑去了,我要去追她,但手机电池不行了,路上充电不方便,所以,以后您就别打电话问我了,一旦有情况,我给您打电话。”
            岳不群:“好的,冲儿,如此甚好,能省不少电话费。”

            一路上,令狐冲为了省电,将手机关机。岳不群不用打电话问令狐冲了,每天带着宁中则用心训练其他徒弟,以便随时增援令狐冲。

    第1100个夜晚,岳不群收到令狐冲来电:“师傅,我到了山东半岛入海口,已经雇佣好了民船。”
    岳不群:“冲儿,别坐民船了,到青岛机场坐飞机过去。”
    令狐冲:“师傅,我没钱了。”
    岳不群:“叫你师娘给你微信转账10万块。”
    

            第1101个夜晚,令狐冲在扶桑下了飞机,恰巧看到东方不败也带着小师妹下了飞机,令狐冲赶紧给师傅打电话:“师傅,我看到东方不败和小师妹了,我立即去收拾他。”
            岳不群:“好,小心点,一定要把姗儿救回来。”

            从两个例子看出,回调的方法,其实时性要好于循环查询。

            但是,回调方法有一个缺点,就是不能直接在回调方法中访问窗体控件,其原因为:窗体控件都是由主线程创建的(其他线程也可以创建窗体,但这里假设只有主窗体创建了窗体),Delphi运行时库为了安全性,不允许主线程以外的线程访问和修改窗体控件,否则会引发一些隐患,很难跟踪调试。
            不过,由于Delphi7的运行时库并不是很严谨,因此有时候工作线程也能修改窗体控件,Delphi7不报错,例如上述TForm1.callbackByMyThread方法就在线程myThread中允许,它修改了edtDishNumber.Text。尽管如此,但Delphi7对这种操作的可靠性、稳定性不予以任何保证。
            那怎么办呢?采用线程同步的方法。线程同步有很多方式,这里采用较为简单的一种,即线程切换。具体做法是:
            第一步:在TForm1中增加一个无参数方法,如下所示:

    procedure TForm1.dealAfterCallbackByMyThread;
    begin
        edtDishNumber.Text := IntToStr(myThread.DishNumber);
    end;
    

            第二步:将TForm1.callbackByMyThread修改为:

    procedure TForm1.callbackByMyThread(Sender: TObject);
    begin
        if Assigned(myThread) then
        begin
            TThread.Synchronize(nil, dealAfterCallbackByMyThread);
        end;
    end;
    

            在上述代码中,调用类TThread的静态方法,就可以从线程myThread切换到主线程。具体地说,方法TForm1.callbackByMyThread运行在线程myThread上,线程myThread通过调用方法TThread.Synchronize,将方法放到主线程上,并立即切换到主线程,主线程且立即执行dealAfterCallbackByMyThread。

            第三步:运行程序,点击启动→洗碗→歇会儿,结果如下:


    图16

    4.4 回调方法可能存在的固有缺陷

            细心的童鞋们,肯定发现了一个问题,那就是上图中的时间有问题,不再是按照500毫秒的间隔更新,而是隔了好几秒,实时性更差了。这是为什么呢?
            这个现象也让我百思不得其解,我用了以下方法去寻找原因:
            1)死锁:找了半天,也没有找到死锁的地方。
            2)Synchronize用法不对:找了很多地方,发现大家都是这么用的。
            3)到国外网站查看:没有搜索到相同问题的描述
            4)将程序拷贝到Win10,运行良好,如下所示:


    图17

            我冥思苦想,手脚晃荡,无意中,我发现了一个问题,那就是在XP系统中,当我鼠标在TForm1窗体上晃动时,程序马上有输出。
            这是什么原因呢?我分析如下,不知对错,请大家指正:
            1)方法TForm1.callbackByMyThread运行在线程myThread上,在该方法内部,线程myThread通过调用方法TThread.Synchronize,先是给主线程发一个空的PostMessage消息,激活主线程。
            2)myThread然后给主线程发送一个SendMessage,消息告诉主线程调用dealAfterCallbackByMyThread。
            3)然后myThread挂起线程myThread,等待主线程回复。
            4)主线程在适当的时候执行dealAfterCallbackByMyThread。
            5)主线程执行dealAfterCallbackByMyThread完毕后,告诉线程myThread,线程myThread继续运行。

            上述过程的一个关键地方就是“主线程在适当的时候”,什么时候才算是适当的呢?互联网上很多文章说,主线程在空闲的时候会执行dealAfterCallbackByMyThread。这就麻烦了,主线程有时候很忙的,日理万机,不知道什么时候能闲下来,没空理会myThread,这就会导致myThread发生阻塞,从而没法好好干活。

            经过我的研究发现,“主线程在空闲的时候”是不准确的,至少在XP系统中是这样。上面我提到过,在XP系统中,程序实时输出内容到控制台,但只要鼠标在TForm1窗体上晃动,程序就会马上更新输出,因此,这说明恰恰是“主线程在忙的时候(处理鼠标晃动消息)”才会理会线程myThread的消息。照着这个思路,我再说一下上述过程:

            1)方法TForm1.callbackByMyThread运行在线程myThread上,在该方法内部,线程myThread通过调用方法TThread.Synchronize,先是给主线程发一个空的PostMessage消息(WM_NULL),试图激活主线程。但是,由于PostMessage发的是空消息,所以主线程没有处理,即使此时主线程很空闲,它也懒得处理空消息。也可以简单理解为,主线程实际上没有激活。
            2)myThread然后给主线程发送一个SendMessage,消息告诉主线程调用dealAfterCallbackByMyThread。此时,主线程收到了SendMessage发来的消息,但是因为主线程没有理会myThread通过PostMessage发送的消息,自然也就不会理会SendMessage的消息。凡事总有一个先来后到,前面的还没处理呢,后面的咋处理呢?
            3)然后myThread挂起线程myThread,等待主线程回复。主线程这个时候正闲着呢,才懒得回复呢。
            4)上帝移动了一下鼠标,主线程收到了上帝的命令,立即开始干活,先是处理上帝的命令(注意,Windows消息有优先级别,来自用户也就是上帝的消息,通常有较高的优先级),完毕后,发现角落里还藏着myThread发来的消息,于是顺便处理,马上执行dealAfterCallbackByMyThread。
            5)主线程执行dealAfterCallbackByMyThread完毕后,告诉线程myThread,事情处理完了,线程myThread继续运行。

            上述说辞似乎解决了问题,用的是时钟方法。但是,上帝总不能时时刻刻去移动鼠标啊,那还不如让岳不群每天打一个电话呢。
            上帝总是万能的,于是上帝在TForm1.Create方法中,又启动了时钟,且为了及时处理myThread的消息,时钟的间隔得比myThread.Execute中的休息间隔500毫秒还短。为了保证较好的实时性,将时钟间隔设为100毫秒。于是,每隔100毫秒,主线程收到了一条必须马上处理的时钟消息,处理完后往角落里看两眼,若是有myThread的消息,就马上处理,若是没有,则继续睡100毫秒小憩。
            更改代码后,在XP中重新运行,结果如下:


    图18

            可见,上述结果是正常的。
            对于这个问题,我不知道这算不算Delphi7的缺陷或是XP系统的缺陷,也不知道我上面的解释是否正确,请大家指正。

    4.5 回调方法就没有用了吗?

            在4.4节中,我们在使用回调方法进行线程通信时,出现了问题,为了解决问题,又使用了基于时钟的查询方法。这是否说明回调方法不但毫无用处呢,还更费事呢?
            也不能这么说,我举一个例子,说明一下。还是以岳不群、令狐冲为例。

            令狐冲带着小师妹去攻打黑木崖,临行前,岳不群嘱咐道:“冲儿,你独孤九剑已经达到炉火纯青的地步,远超为师了,你就放心地去收拾东方不败吧,有啥事你打个电话,没啥事我就跟你师娘唱唱歌、吟吟诗。”令狐冲答应照办。
            (也就是说,两人商量以回调的方式来通信。)

            走到半路上,令狐冲和小师妹突然遇到东方不败派来的四大护法,四大护法练就了一个天罡北斗阵,令狐冲苦战得脱,幸好小师妹毫发无损。
            (也就是说,工作线程完成了一个任务。)

            作战毕,令狐冲给岳不群打了个电话,但岳不群忙着呢,没接着,于是令狐冲只好发了微信,然后就抱着小师妹在路边歇着,等着师傅下一个指示。
            (也就是是,工作线程给主线程发了一个消息,然后把自己挂起来,等待主线程的回复。)

            但是,岳不群的微信好友太多,消息太多,没有把令狐冲的消息当回事,也就没有处理令狐冲的消息。
            (也就是说,主线程没有理会工作线程发来的空消息和其他消息。)

            幸好,岳不群有一个抽烟的习惯,他一般是10分钟抽一根,一根烟抽10分钟,然后干别的事情。在抽烟的过程中,岳不群啥事不干,就是把所有的未读微信消息看个遍,很快就看到了令狐冲的消息,于是顺便回复了一句:“冲儿,干得漂亮,天罡北斗阵还是蛮霸道的,上次差点让为师和师娘回不来了。”
            (抽烟的事件相当于时钟消息。)

            在上述岳不群和令狐冲的例子中,如果只有基于抽烟的循环查询,那么岳不群每抽一根烟,都要打电话问一下令狐冲,“冲儿,现在走到哪里了?情况如何?”可以想象,岳不群这个烟抽得肯定不爽。
            但是,若在抽烟的同时,看看有没有令狐冲的回调消息,如果有令狐冲的消息,就处理一下,没有的话,就看看左冷禅等群友最近在哪里发财,然后问问能不能带上自己。可以想象,这种情调下的抽烟,那才叫吞云吐雾般的享受。

            另外,再说明一下,如果只有基于时钟消息的循环查询,那么若工作线程没有更新,则每次查询时都得到同样的工作状态,这是正常现象。但是,如果规定,对于工作线程的每次状态,主线程只能用一次,那么基于时钟消息的循环查询,在工作线程没有更新状态的时候,就完全无法遵守规定。
    为了好理解,这里举例说明。

            令狐冲是打牌高手,岳不群要给岳灵珊和令狐冲准备嫁妆,但没钱,于是派令狐冲去澳门赌坊弄点钱。两人约定,令狐冲每天生活费要1000元,出发前岳不群只给令狐冲一天的生活费,令狐冲每局从牌桌上能赢得至少0元,赢来的钱马上存到银行卡里,岳不群知道令狐冲的银行卡号,他每隔30分钟从令狐冲的卡里划1000元到自己的卡里。令狐冲由于要集中精力打牌,因此不管输赢,都不会打电话告诉岳不群。

            大家想想,岳不群有没有可能把令狐冲的生活费划走?
            有些人觉得不会,有些觉得会。注意上面的约定,并未包括“岳不群在划账之前要检测一下令狐冲银行卡里面的钱够不够”。为什么不包括呢?因为令狐冲有自己的隐私,不愿意让岳不群检查自己的钱包(也就是说,对象的封装性,决定了对象必须封装一些内部状态,不让外部读取。)因此,如果令狐冲手气不好,有好几局没赢到钱,岳不群肯定会把他的生活费划走的。
            如果两人加一条约定,就可以解决上述问题。

            令狐冲:“师傅,每次赢了超过1000块钱,我就给您发条微信,告诉您赢了多少,您有空的时候就处理一下。”(注意:最开始的时候,令狐冲有1000块钱,在赌博开始前,他是不会给岳不群发消息的。)
            岳不群:“此计甚好。不过,我也有自己的事情,半个小时处理一下(相当于时钟消息),若正好在看微信(相当于在窗体上移动鼠标),我就马上处理。”

            可见,令狐冲每次有更新的时候,就把更新的状态(新赢到的钱)通过回调(微信消息)告诉岳不群,岳不群在主线程中通过微信把新赢到的钱转走,但对于令狐冲那1000块钱生活费,因为它不是新的变化,岳不群即使看到了也不会去处理。

            再举一个例子,电脑通过COM口连接了一个扫码枪,扫码枪收到一个条形码(比如“69123432432”)后,就存在内部,然后通过回调告诉电脑,电脑在回调里处理这个码。电脑同时运行一个时钟,假设周期是1秒。如果没有回调方法,则电脑只能在时钟事件里去处理条形码“69123432432”,算出当前总价,处理完后,下一个1秒钟,电脑又看到了条形码“69123432432”,此时就有了疑问,这是上一个处理过的商品,还是顾客又扫了同一个商品?这时就很难区分了。
            对于这种情况,有些童鞋会说,电脑可以在用完“69123432432”之后,电脑让扫码枪删除内部保存的“69123432432”。在下一个1秒钟,如果顾客没有扫描商品,则码是空的,如果顾客扫描了商品,即使仍然是同一个“69123432432”,电脑也能够安全地使用它。
            但是,不要忘了,电脑和扫码枪是两个独立的线程,电脑线程让扫码枪删除“69123432432”,但扫码枪线程可能同时新收到顾客扫描的“69123432432”,那么,此时就会产生资源争用问题。
            如果在扫码枪的回调方法里处理条形码“69123432432”,问题就好办了。由于扫码枪仅仅在收到新的条形码后才会进行回调,因此能确保每个条形码能被处理一次,且仅被处理一次。

    5 结论

            本文简单地讨论了Delphi中的多线程编程,内容基础、详实,但是,限于作者水平不高,可能有诸多错误的地方,请大家批评指正。

    6 做点广告

            各位Delphi码农朋友们,作为一个Delphi码农,我与大家一样,码砖赚钱不容易,所以我业余还做点副业,讨个生活,就是做竹妃纸的个人营销,请大家支持。凡是给出实际行动支持的,我都发源代码。
            竹妃纸,是目前很火的一种天然环保用纸,据说是可以吃的原浆纸,健康无毒环保,特别适合家庭有小孩的朋友们。若想了解实际情况,请大家使用以下二维码,照着以下步骤操作。
            1. 第一步,我的竹妃二维码,请大家下载到微信里。


    图19

            2. 第二步,点击图片以便让其满屏,然后单指按住它达到3秒钟,弹出如下图所示的快捷菜单。


    图20

            3. 第三步,点击上图中的“识别图中二维码”,稍等一会儿,就会弹出如下界面。如果网速慢,则要多等一会儿。
    图21

            4. 第四步,再次单指按住上图达到3秒钟,弹出如下图所示的快捷菜单。
    图22

            5. 第五步,点击上图中的“识别图中二维码”,进入如下界面。


    图23

            6. 第六步,在上图中点击“关注”,进入如下界面:
    图24

            7. 第七步,点击上图左下角的“进入商城”,如下所示:
    图25

            选择您最需要的一款产品,点击“立即购买”,然后按照指示操作,直到付款成功。其余的操作,都是大家熟悉的界面,我就不再赘述了。如果有不会的,可以加我的微信好友,既可以交流技术问题,也可以交流竹妃纸的使用心得。

            我的微信二维码是:


    图26

            感谢各位Delphi朋友,Delphi码农日子不容易啊,期待各位同行支持一下我,万分感谢!

    展开全文
  • 以下是一篇很值得看的关于Delphi多线程编程的文章,内容很全面,建议收藏。 一、入门 ㈠、 functionCreateThread( lpThreadAttributes:Pointer;{安全设置} dwStackSize:DWORD;{堆栈大小} lpStartAddress:...
  • Delphi中有一个线程类TThread是用来实现多线程编程的,这个绝大多数Delphi书藉都有说到,但基本上都是对 TThread类的几个成员作一简单介绍,再说明一下Execute的实现和Synchronize的用法就完了。然而这并不是多线程...
  • delphi多线程编程之二

    2019-10-08 19:46:21
    一、线程的局部变量threadvar type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } public ...
  • 最近Ken在比较系统地学习Delphi多线程编程方面的知识,在网络上查阅了很多资料。现在Ken将对这些资料进行整理和修改,以便收藏和分享。内容基本上是复制粘贴,拼拼凑凑,再加上一些修改而来。各个素材的来源已经很难...
  • delphi 多线程编程参考

    2009-04-03 14:49:04
    Threads should not alter the semantics of a program. They simply change the timing of operations. As a result, they are almost always used as an elegant solution to performance related problems....
  • Google搜到线程的例子都是那个画图的,猛禽那个多线程又太过高深(对于我这一滴水来说),万一老师开线程的博还是要等。只有自己看着《Delphi5开发人员指南》中文版PDF一步一步来弄懂些初步的东西,到时候可以跟上...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 457
精华内容 182
关键字:

delphi多线程编程