Delphi多線程詳解


(整理自網絡)

Delphi多線程處理

1-1多線程的基本概念

      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.多線程的同步機制

      同步機制,實際上是事件驅動機制,意思是讓線程平時處於“休眠”狀態,除非發生某個事件才觸發。

      例如一個拷貝文件,拷貝線程完成一個程序塊后,再喚醒進程條線程做一個格的填充。

      研究多線程的同步機制的必要性在於,多線程同步工作時,如果同時調用相同的資源,就可能會出現問題,一般讀出是不會有問題的,但是,如果寫入(全局變量、數據庫),就會發生沖突,甚至產生死

鎖和競爭問題。

一、使用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也不會顯示。

      這就告訴我們,這樣的代碼是不能作為主線程的一部分的,如果與主窗體連接的線程內等待另一個線程結束,而另一個線程又要等待訪問用戶界面,就可能是程序陷於死鎖。

      這點在應用的時候要謹慎。

四、利用WindowsAPI

      Windows API函數提供了很多同步技術,下面簡要介紹。

      1. Critical Sections(臨界區),源代碼中如果有不能由兩個或兩個以上線程同時執行的部分,可以用臨界段來使這部分的代碼執行串行化。它只能在一個獨立的進程或一個獨立的應用程序中使用。使用方法如下:

   //在窗體創建中

   InitializeCriticalSection(Critical1)

   //在窗體銷毀中

   DeleteCriticalSection(Critical1)

   //在線程中

   EnterCriticalSection(Critical1)

   ……保護的代碼

   LeaveCriticalSection(Critical1)

   2. Mutex(互斥對象),是用於串行化訪問資源的全局對象。我們首先設置互斥對象,然后訪問資源,最后釋放互斥對象。在設置互斥對象時,如果另一個線程(或進程)試圖設置相同的互斥對象,該線程將會停下來,直到前一個線程(或進程)釋放該互斥對象為止。注意它可以由不同應用程序共享。使用方法如下:

   //在窗體創建中

   hMutex:=CreateMutex(nil,false,nil)

   //在窗體銷毀中

   CloseHandle(hMutex)

   //在線程中

   WaitForSingleObject(hMutex,INFINITE)

   ……保護的代碼

   ReleaseMutex(hMutex)

   3. Semaphore(信號量),它與互斥對象相似,但它可以計數。例如可以允許一個給定資源同時同時被三個線程訪問。其實Mutex就是最大計數為一的Semaphore。使用方法如下:

   //在窗體創建中

   hSemaphore:= CreateSemaphore(nil,lInitialCount,lMaximumCount,lpName)

   //在窗體銷毀中

   CloseHandle(hSemaphore)

   //在線程中

   WaitForSingleObject(hSemaphore,INFINITE)

   ……保護的代碼

   ReleaseSemaphore(hSemaphore, lReleaseCount, lpPreviousCount)

4、事件

 

delphi多線程

2017年09月30日 09:53:31 一葉青晨 閱讀數:2282更多

(推薦)

個人分類: delphi

在了解多線程之前我們先了解一下進程和線程的關系

一個程序至少有一個主進程,一個進程至少有一個線程。

為了保證線程的安全性請大家看看下面介紹 Delphi多線程同步的一些處理方案大家可以參考:http://www.cr173.com/html/16747_1.html

主線程又程為UI線程。

進程和線程的主要差別在於它們是不同的操作系統資源管理方式。進程有獨立的地址空間,一個進程崩潰后,在保護模式下不會對其它進程產生影響,而線程只是一個進程中的不同執行路徑。線程有自己的堆棧和局部變量,但線程之間沒有單獨的地址空間,一個線程死掉就等於整個進程死掉,所以多進程的程序要比多線程的程序健壯,但在進程切換時,耗費資源較大,效率要差一些。但對於一些要求同時進行並且又要共享某些變量的並發操作,只能用線程,不能用進程。如果有興趣深入的話,我建議你們看看《現代操作系統》或者《操作系統的設計與實現》。對就個問題說得比較清楚。

多線程應該是編程工作者的基礎技能, 但這個基礎我從來沒學過,所以僅僅是看上去會一些,明白了2+2的時候,其實我還不知道1+1。

 

開始本應該是一篇洋洋灑灑的文字, 不過我還是提倡先做起來, 在嘗試中去理解.

 

先試試這個:

procedure TForm1.Button1Click(Sender: TObject); 

var 

  i: Integer; 

begin 

  for i := 0 to 500000 do 

  begin 

    Canvas.TextOut(10, 10, IntToStr(i)); 

  end

end

 

上面程序運行時, 我們的窗體基本是 "死" 的, 可以在你在程序運行期間拖動窗體試試...

 

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

 

這個 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

 

細數上面程序的變化:

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

 

代碼分析:

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

 

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

 

//可簡化為: 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  with TMyThread.Create(True) do Resume; 

end

 

一、入門

㈠、CreateThread 函數

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

 

代碼注釋:

當前程序是一個進程, 進程只是一個工作環境, 線程是工作者;

每個進程都會有一個啟動線程(或叫主線程), 也就是說: 我們之前大量的編碼都是寫給這個主線程的;

上面的 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

 

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.

㈢、入口函數的參數

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.

 

這個例子還有不嚴謹的地方: 當一個線程 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.

㈣、入口函數的指針

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.

㈤、堆棧大小

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 定義變量的不同.

使用 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.

㈥、安全設置

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;

夠復雜的, 但我們在多線程編程時不需要去設置它們, 大都是使用默認設置(也就是賦值為 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; 

上面的四個系統內核對象(事件、互斥、信號、計時器)都是線程同步的手段, 從這也能看出處理線程同步的復雜性; 不過這還不是全部, 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.

在這段程序中, 有三個線程幾乎是同時建立, 向窗體中的 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.

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.

三、等待函數aitForSingleObject

一下子跳到等待函數 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, nilnilnil, False, 0, nilnil, sInfo, pInfo) then 

  begin 

    hProcess := pInfo.hProcess;                           {獲取進程句柄} 

    Text := Format('進程 %d 已啟動', [hProcess]);  

    CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID); {建立線程監視} 

  end

end

 

end.

 

Delphi TThread類詳解

我們常有工作線程和主線程之分,工作線程負責作一些后台操作,比如接收郵件;主線程負責界面上的一些顯示。工作線程的好處在某些時候是不言而喻的,你的主界面可以響應任何操作,而背后的線程卻在默默地工作。

VCL中,工作線程執行在Execute方法中,你必須從TThread繼承一個類並覆蓋Execute方法,在這個方法中,所有代碼都是在另一個 線程中執行的,除此之外,你的線程類的其他方法都在主線程執行,包括構造方法,析構方法,Resume等,很多人常常忽略了這一點。

 

最簡單的一個線程類如下:

 

TMyThread = class(TThread)

 

protected

 

procedure Execute; override;

 

end;

 

在Execute中的代碼,有一個技術要點,如果你的代碼執行時間很短,像這樣,Sleep(1000),那沒有關系;如果是這樣Sleep (10000),10秒,那么你就不能直接這樣寫了,須把這10秒拆分成10個1秒,然后判斷Terminated屬性,像下面這樣:

 

procedure TMyThread.Execute;

 

var

 

i: Integer;

 

begin

 

for i := 0 to 9 do

 

if not Terminated then

 

Sleep(1000)

 

else

 

Break;

 

end;

 

這樣寫有什么好處呢,想想你要關閉程序,在關閉的時候調用MyThread.Free,這個時候線程並沒有馬上結束,它調用WaitFor,等待 Execute執行完后才能釋放。你的程序就必須等10秒以后才能關閉,受得了嗎。如果像上面那樣寫,在程序關閉時,調用Free之后,它頂多再等一秒就 會關閉。為什么?答案得去線程類的Destroy中找,它會先調用Terminate方法,在這個方法里面它把Terminated設為True(僅此而 已,很多人以為是結束線程,其實不是)。請記住這一切是在主線程中操作的,所以和Execute是並行執行的。既然Terminated屬性已為 Ture,那么在Execute中判斷之后,當然就Break了,Execute執行完畢,線程類也正常釋放。

 

或者有人說,TThread可以設FreeOnTerminate屬性為True,線程類就能自動釋放。除非你的線程執行的任務很簡單,不然,還是不要去理會這個屬性,一切由你來操作,才能使線程更靈活強大。

 

接下來的問題是如何使工作線程和主線程很好的通信,很多時候主線程必須得到工作線程的通知,才能做出響應。比如接收郵件,工作線程向服務器收取郵件,收取完畢之后,它得通知主線程收到多少封郵件,主線程才能彈出一個窗口通知用戶。

 

在VCL中,我們可以用兩種方法,一種是向主線程中的窗體發送消息,另一種是使用異步事件。第一種方法其實沒有第二種來得方便。想想線程類中的OnTerminate事件,這個事件由線程函數的堆棧引起,卻在主線程執行。

 

事實上,真正的線程函數是這個:

 

function ThreadProc(Thread: TThread): Integer;

 

函數里面有Thread.Execute,這就是為什么Execute是在其他線程中執行,該方法執行之后,有如下句:

 

Thread.DoTerminate;

 

而線程類的DoTerminate方法里面是

 

if Assigned(FOnTerminate) then Synchronize(CallOnTerminate);

 

顯然Synchronize方法使得CallOnTerminate在主線程中執行,而CallOnTerminate里面的代碼其實就是:

 

if Assigned(FOnTerminate) then FOnTerminate(Self);

 

只要Execute方法一執行完就發生OnTerminate事件。不過有一點是必須注意,OnTerminate事件發生后,線程類不一定會釋 放,只有在FreeOnTerminate為True之后,才會Thread.Free。看一下ThreadProc函數就知道。

 

依照Onterminate事件,我們可以設計自己的異步事件。

 

Synchronize方法只能傳進一個無參數的方法類型,但我們的事件經常是要帶一些參數的,這個稍加思考就可以得到解決,即在線程類中保存參數,觸發事件前先設置參數,再調用異步事件,參數復雜的可以用記錄或者類來實現。

 

假設這樣,上面的代碼每睡一秒,線程即向外面引發一次事件,我們的類可以這樣設計:

 

TSecondEvent = procedure (Second: Integer) of object;

TMyThread = class(TThread)

private

FSecond: Integer;

FSecondEvent: TSecondEvent;

procedure CallSecondEvent;

protected

procedure Execute; override;

public

property SencondEvent: TSecondEvent read FSecondEvent

write FSecondEvent;

end;

 

{ TMyThread }

 

procedure TMyThread.CallSecondEvent;

begin

if Assigned(FSecondEvent) then

FSecondEvent(FSecond);

end;

 

procedure TMyThread.Execute;

var

i: Integer;

begin

for i := 0 to 9 do

if not Terminated then

begin

Sleep(1000);

FSecond := i;

Synchronize(CallSecondEvent);

end

else

Break;

end;

在主窗體中假設我們這樣操作線程:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

MyThread := TMyThread.Create(true);

MyThread.OnTerminate := ThreadTerminate;

MyThread.SencondEvent := SecondEvent;

MyThread.Resume;

end;

 

procedure TForm1.ThreadTerminate(Sender: TObject);

begin

ShowMessage('ok');

end;

 

procedure TForm1.SecondEvent(Second: Integer);

begin

Edit1.Text := IntToStr(Second);

end;

 

我們將每隔一秒就得到一次通知並在Edit中顯示出來。

 

現在我們已經知道如何正確使用Execute方法,以及如何在主線程與工作線程之間通信了。但問題還沒有結束,有一種情況出乎我的意料之外,即如果 線程中有一些資源,Execute正在使用這些資源,而主線程要釋放這個線程,這個線程在釋放的過程中會釋放掉資源。想想會不會有問題呢,兩個線程,一個 在使用資源,一個在釋放資源,會出現什么情況呢,

 

用下面代碼來說明:

 

type

TMyClass = class

private

FSecond: Integer;

public

procedure SleepOneSecond;

end;

 

TMyThread = class(TThread)

private

FMyClass: TMyClass;

protected

procedure Execute; override;

public

constructor MyCreate(CreateSuspended: Boolean);

destructor Destroy; override;

end;

 

implementation

 

{ TMyThread }

 

constructor TMyThread.MyCreate(CreateSuspended: Boolean);

begin

inherited Create(CreateSuspended);

FMyClass := TMyClass.Create;

end;

 

destructor TMyThread.Destroy;

begin

FMyClass.Free;

FMyClass := nil;

inherited;

end;

 

procedure TMyThread.Execute;

var

i: Integer;

begin

for i := 0 to 9 do

FMyClass.SleepOneSecond;

end;

 

{ TMyClass }

 

procedure TMyClass.SleepOneSecond;

begin

FSecond := 0;

Sleep(1000);

end;

 

end.

 

用下面的代碼來調用上面的類:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

MyThread := TMyThread.MyCreate(true);

MyThread.OnTerminate := ThreadTerminate;

MyThread.Resume;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

MyThread.Free;

end;

 

先點擊Button1創建一個線程,再點擊Button2釋放該類,出現什么情況呢,違法訪問,是的,MyThread.Free時,MyClass被釋放掉了

 

FMyClass.Free;

 

FMyClass := nil;

 

而此時Execute卻還在執行,並且調用MyClass的方法,當然就出現違法訪問。對於這種情況,有什么辦法來防止呢,我想到一種方法,即在線程類中使用一個成員,假設為FFinished,在Execute方法中有如下的形式:

 

FFinished := False;

 

try

 

//... ...

 

finally

 

FFinished := True;

 

End;

 

接着在線程類的Destroy中有如下形式:

 

While not FFinished do

 

Sleep(100);

 

MyClass.Free;

 

這樣便能保證MyClass能被正確釋放。

 

線程是一種很有用的技術。但使用不當,常使人頭痛。在CSDN論壇上看到一些人問,我的窗口在線程中調用為什么出錯,主線程怎么向其他線程發送消息等等,其實,我們在抱怨線程難用時,也要想想我們使用的方法對不對,只要遵循一些正確的使用規則,線程其實很簡單。

 

后記

 

上面有一處代碼有些奇怪:FMyClass.Free; FMyClass := nil;如果你只寫FMyClass.Free,線程類還不會出現異常,即調用FMyClass.SleepOneSecond不會出錯。我在主線程中試了下面的代碼

 

MyClass := TMyClass.Create;

 

MyClass.SleepOneSecond;

 

MyClass.Free;

 

MyClass.SleepOneSecond;

 

同樣也不會出錯,但關閉程序時就出錯了,如果是這樣:

 

MyClass := TMyClass.Create;

 

MyClass.SleepOneSecond;

 

MyClass.Free;

 

MyThread := TMyThread.MyCreate(true);

 

MyThread.OnTerminate := ThreadTerminate;

 

MyThread.Resume;

 

MyClass.SleepOneSecond;

 

馬上就出錯。所以這個和線程類無線,應該是Delphi對於堆棧空間的釋放規則,我想MyClass.Free之后,該對象在堆棧上空間還是保留 着,只是允許其他資源使用這個空間,所以接着調用下面這一句MyClass.SleepOneSecond就不會出錯,當程序退出時可能對堆棧作一些清理 導致出錯。而如果MyClass.Free之后即創建MyThread,大概MyClass的空間已經被MyThread使用,所以再調用 MyClass.SleepOneSecond就出錯了。

 

DELPHI 多線程之TThread類的實現

TThread類

先新建一個普通的工程,再新建一個線程類File>>New>>Othre>>Delphi File>Thread Object,取個名字,DELPHI會自動生成一個單元,我們只需往里簡單添加功能代碼,和在要使用的單元里實例引用即可。

為了節省篇幅,現把TMyThread類集成主窗體單元里,在窗體單元里聲明類也是可以的。

例:用工作線程在窗體輸出0~500000的數字。

 

 1 unit Unit1;

 2

 3 interface

 4

 5 uses

 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 7   Dialogs, StdCtrls;

 8

 9 type

10   TMyThread = class(TThread)

11   private

12     { Private declarations }

13   protected

14     procedure Execute; override; {執行}

15     procedure Run; {聲明多一個過程,把功能代碼寫在這里再給Execute調用}

16   end;

17   TForm1 = class(TForm)

18     btn1: TButton;

19     procedure btn1Click(Sender: TObject);

20   private

21     { Private declarations }

22   public

23     { Public declarations }

24   end;

25

26

27

28 var

29   Form1: TForm1;

30

31

32 implementation

33

34 {$R *.dfm}

35

36 var

37   MyThread:TMyThread; {聲明一個線程類對象]

38

39 procedure TMyThread.Execute;

40 begin

41   { Place thread code here }

42   FreeOnTerminate:=True; {加上這句線程用完了會自動注釋}

43   Run;

44 end;

45

46 procedure TMyThread.Run;

47 var

48   i:integer;

49 begin

50   for i := 0 to 500000 do

51   begin

52     Form1.Canvas.Lock;

53     Form1.Canvas.TextOut(10,10,IntToStr(i));

54     Form1.Canvas.Unlock;

55   end;

56 end;

57

58 procedure TForm1.btn1Click(Sender: TObject);

59 begin

60   MyThread:=TMyThread.Create(False); {實例化這個類,為False時立即運行,為True時可加MyThread.Resume用來啟動}

61 end;

 

 

CriticalSection(臨界區)

 uses SyncObjs;用TCriticalSection類的方法處理。

例:用三個線程,按順序給ListBox添加0~99.

 

 1 unit Unit1;

 2

 3 interface

 4

 5 uses

 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 7   Dialogs, StdCtrls;

 8

 9 type

10   TMyThread = class(TThread)

11   private

12     { Private declarations }

13   protected

14     procedure Execute; override; {執行}

15     procedure Run;  {運行}

16   end;

17   TForm1 = class(TForm)

18     btn1: TButton;

19     lst1: TListBox;

20     procedure btn1Click(Sender: TObject);

21     procedure FormDestroy(Sender: TObject);

22   private

23     { Private declarations }

24   public

25     { Public declarations }

26   end;

27

28

29

30 var

31   Form1: TForm1;

32

33

34 implementation

35

36 {$R *.dfm}

37

38 uses SyncObjs;

39

40 var

41   MyThread:TMyThread;   {聲明線程}

42   CS:TCriticalSection; {聲明臨界}

43

44

45 procedure TMyThread.Execute;

46 begin

47   { Place thread code here }

48   FreeOnTerminate:=True; {加上這句線程用完了會自動注釋}

49   Run;     {運行}

50 end;

51

52 procedure TMyThread.Run;

53 var

54   i:integer;

55 begin

56   CS.Enter;  {我要用了,其它人等下}

57   for i := 0 to 100 - 1 do

58   begin

59     Form1.lst1.Items.Add(IntToStr(i));

60   end;

61   CS.Leave;  {我用完了,下一個}

62 end;

63

64 procedure TForm1.btn1Click(Sender: TObject);

65 begin

66   CS:=TCriticalSection.Create;     {實例化臨界}

67   MyThread:=TMyThread.Create(False); {實例化這個類,為False時立即運行,為True時可加MyThread.Resume用來啟動}

68   MyThread:=TMyThread.Create(False);

69   MyThread:=TMyThread.Create(False);

70 end;

71

72

73 procedure TForm1.FormDestroy(Sender: TObject);

74 begin

75   CS.Free;{釋放臨界體}

76 end;

77

78 end.

 

 

Mutex (互斥對象)

uses SyncObjs;用TMutex類的方法處理(把釋放語句放在循環內外可以決定執行順序)

例:互斥輸出三個0~2000的數字到窗體在不同位置。

 

 1 unit Unit1;

 2

 3 interface

 4

 5 uses

 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 7   Dialogs, StdCtrls;

 8

 9 type

10   TMyThread = class(TThread)

11   private

12     { Private declarations }

13   protected

14     procedure Execute; override; {執行}

15     procedure Run;  {運行}

16   end;

17   TForm1 = class(TForm)

18     btn1: TButton;

19     procedure FormDestroy(Sender: TObject);

20     procedure btn1Click(Sender: TObject);

21   private

22     { Private declarations }

23   public

24     { Public declarations }

25   end;

26

27

28

29 var

30   Form1: TForm1;

31

32

33 implementation

34

35 {$R *.dfm}

36

37 uses SyncObjs;

38

39 var

40   MyThread:TMyThread;   {聲明線程}

41   Mutex:TMutex; {聲明互斥體}

42   f:integer;

43

44

45 procedure TMyThread.Execute;

46 begin

47   { Place thread code here }

48   FreeOnTerminate:=True; {加上這句線程用完了會自動注釋}

49   Run;     {運行}

50 end;

51

52 procedure TMyThread.Run;

53 var

54   i,y:integer;

55 begin

56   Inc(f);

57   y:=20*f;

58   for i := 0 to 2000  do

59   begin

60     if Mutex.WaitFor(INFINITE)=wrSignaled then   {判斷函數,能用時就用}

61     begin

62       Form1.Canvas.Lock;

63       Form1.Canvas.TextOut(10,y,IntToStr(i));

64       Form1.Canvas.Unlock;

65       Sleep(1);

66       Mutex.Release; {釋放,誰來接下去用}

67     end;

68   end;

69 end;

70

71 procedure TForm1.btn1Click(Sender: TObject);

72 begin

73   f:=0;

74   Repaint;

75   Mutex:=TMutex.Create(False);  {參數為是否讓創建者擁有該互斥體,一般為False}

76   MyThread:=TMyThread.Create(False);

77   MyThread:=TMyThread.Create(False);

78   MyThread:=TMyThread.Create(False);

79 end;

80

81 procedure TForm1.FormDestroy(Sender: TObject);

82 begin

83   Mutex.Free;{釋放互斥體}

84 end;

85

86 end.

 

 

Semaphore(信號或叫信號量)

 {DELPHI2007不支持信號量,DELPHI2009才開始支持}

 

 1 unit Unit1;

 2

 3 interface

 4

 5 uses

 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 7   Dialogs, StdCtrls;

 8

 9 type

10   TForm1 = class(TForm)

11     Button1: TButton;

12     Edit1: TEdit;

13     procedure Button1Click(Sender: TObject);

14     procedure FormCreate(Sender: TObject);

15     procedure FormDestroy(Sender: TObject);

16     procedure Edit1KeyPress(Sender: TObject; var Key: Char);

17   end;

18

19 var

20   Form1: TForm1;

21

22 implementation

23

24 {$R *.dfm}

25

26 uses SyncObjs;

27 var

28   f: Integer;

29   MySemaphore: TSemaphore;

30

31 function MyThreadFun(p: Pointer): DWORD; stdcall;

32 var

33   i,y: Integer;

34 begin

35   Inc(f);

36   y := 20 * f;

37   if MySemaphore.WaitFor(INFINITE) = wrSignaled then

38   begin

39     for i := 0 to 1000 do

40     begin

41       Form1.Canvas.Lock;

42       Form1.Canvas.TextOut(20, y, IntToStr(i));

43       Form1.Canvas.Unlock;

44       Sleep(1);

45     end;

46   end;

47   MySemaphore.Release;

48   Result := 0;

49 end;

50

51 procedure TForm1.Button1Click(Sender: TObject);

52 var

53   ThreadID: DWORD;

54 begin

55   if Assigned(MySemaphore) then MySemaphore.Free;

56   MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, ''); {創建,參數一為安全默認為nil,參數2可以填寫運行多少線程,參數3是運行總數,參數4可命名用於多進程}

57

58   Self.Repaint;

59   f := 0;

60   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);

61   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);

62   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);

63   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);

64   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);

65 end;

66

67 {讓 Edit 只接受 1 2 3 4 5 五個數}

68 procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

69 begin

70   if not CharInSet(Key, ['1'..'5']) then Key := #0;

71 end;

72

73 procedure TForm1.FormCreate(Sender: TObject);

74 begin

75   Edit1.Text := '1';

76 end;

77

78 procedure TForm1.FormDestroy(Sender: TObject);

79 begin

80   if Assigned(MySemaphore) then MySemaphore.Free;

81 end;

82

83 end.

 

 

 

 Event (事件對象)

注:相比API的處理方式,此類沒有啟動步進一次后暫停的方法。

 

  1 unit Unit1;

  2

  3 interface

  4

  5 uses

  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  7   Dialogs, StdCtrls;

  8

  9 type

 10   TMyThread = class(TThread)

 11   private

 12     { Private declarations }

 13   protected

 14     procedure Execute; override;

 15     procedure Run;

 16   end;

 17

 18   TForm1 = class(TForm)

 19     btn1: TButton;

 20     btn2: TButton;

 21     btn3: TButton;

 22     btn4: TButton;

 23     procedure btn1Click(Sender: TObject);

 24     procedure FormDestroy(Sender: TObject);

 25     procedure btn2Click(Sender: TObject);

 26     procedure btn3Click(Sender: TObject);

 27     procedure btn4Click(Sender: TObject);

 28     procedure FormCreate(Sender: TObject);

 29   private

 30     { Private declarations }

 31   public

 32     { Public declarations }

 33   end;

 34

 35 var

 36   Form1: TForm1;

 37

 38 implementation

 39

 40 {$R *.dfm}

 41

 42 uses SyncObjs;

 43

 44 var

 45   f:integer;

 46   MyEvent:TEvent;

 47   MyThread:TMyThread;

 48

 49 { TMyThread }

 50

 51

 52 procedure TMyThread.Execute;

 53 begin

 54   inherited;

 55   FreeOnTerminate:=True; {線程使用完自己注銷}

 56   Run;

 57 end;

 58

 59 procedure TMyThread.Run;

 60 var

 61   i,y:integer;

 62 begin

 63   Inc(f);

 64   y:=20*f;

 65

 66   for i := 0 to 20000 do

 67   begin

 68     if MyEvent.WaitFor(INFINITE)=wrSignaled then    {判斷事件在用沒,配合事件的啟動和暫停,對事件相關線程起統一控制}

 69     begin

 70       Form1.Canvas.lock;

 71       Form1.Canvas.TextOut(10,y,IntToStr(i));

 72       Form1.Canvas.Unlock;

 73       Sleep(1);

 74     end;

 75

 76   end;

 77

 78 end;

 79

 80 procedure TForm1.btn1Click(Sender: TObject);

 81 begin

 82   Repaint;

 83   f:=0;

 84   if Assigned(MyEvent) then MyEvent.Free;    {如果有,就先銷毀}

 85

 86   {參數1安全設置,一般為空;參數2為True時可手動控制暫停,為Flase時對象控制一次后立即暫停

 87   參數3為True時對象建立后即可運行,為false時對象建立后控制為暫停狀態,參數4為對象名稱,用於跨進程,不用時默認''}

 88   MyEvent:=TEvent.Create(nil,True,True,'');   {創建事件}

 89

 90 end;

 91

 92 procedure TForm1.btn2Click(Sender: TObject);

 93 var

 94   ID:DWORD;

 95 begin

 96   MyThread:=TMyThread.Create(False);      {創建線程}

 97 end;

 98

 99 procedure TForm1.btn3Click(Sender: TObject);

100 begin

101   MyEvent.SetEvent;    {啟動}  {事件類沒有PulseEvent啟動一次后輕描談寫}

102 end;

103

104 procedure TForm1.btn4Click(Sender: TObject);

105 begin

106   MyEvent.ResetEvent;  {暫停}

107 end;

108

109 procedure TForm1.FormCreate(Sender: TObject);

110 begin

111    btn1.Caption:='創建事件';

112    btn2.Caption:='創建線程';

113    btn3.Caption:='啟動';

114    btn4.Caption:='暫停';

115 end;

116

117 procedure TForm1.FormDestroy(Sender: TObject);

118 begin

119   MyEvent.Free;        {釋放}

120 end;

121

122 end.

 

總結

多線程用TThread類以及Uses syncobjs后使用的 TCriticalSection (臨界區),TMutex(互斥體),TSemaphore (信號對象,D2009才開始有),TEvent (事件對象)很多都是引用了API的方法進行了一定的簡化,不過也有部分功能的缺失,如Event (事件對象)缺少了啟動步進一次后暫停的功能,不過基本在同步上已經夠用了,另外在TThread類聲明的Execute過程里,加上FreeOnTerminate := True;這句會讓線程執行完后自動釋放,還可以把功能代碼的方法套在Synchronize()里,用於同步一些非線程安全的控件對象,避免多個線程同時對一個對象操作引發的問題。

 

 

 

Delphi 線程同步技術

(轉)

上次跟大家分享了線程的標准代碼,其實在線程的使用中最重要的是線程的同步問題,如果你在使用線程后,發現你的界面經常被卡死,或者無法顯示出來,顯示混亂,你的使用的變量值老是不按預想的變化,結果往往出乎意料,那么你很有可能是忽略了線程同步的問題。

當有多個線程的時候,經常需要去同步這些線程以訪問同一個數據或資源。例如,假設有一個程序,其中一個線程用於把文件讀到內存,而另一個線程用於統計文件中的字符數。當然,在把整個文件調入內存之前,統計它的計數是沒有意義的。但是,由於每個操作都有自己的線程,操作系統會把兩個線程當作是互不相干的任務分別執行,這樣就可能在沒有把整個文件裝入內存時統計字數。為解決此問題,你必須使兩個線程同步工作。存在一些線程同步地址的問題,Windows 提供了許多線程同步的方式。在本節您將看到使用臨界區、互斥、信號量、事件、全局原子和Synchronize 函數來解決線程同步的問題。

下面的同步技術一般均有兩種使用方式,一種是直接使用Windows API 函數,一種是使用

由Delphi 對API 函數進行封裝的類。

以下函數以Delphi 2009 中的函數格式為准。

1. Critical Sections 臨界區

臨界區是一種最直接的線程同步方式。所謂臨界區,就是一次只能由一個線程來執行的一段

代碼。例如把初始化數組的代碼放在臨界區內,另一個線程在第一個線程處理完之前是不會

被執行的。臨界區非常適合於序列化對一個進程中的數據的訪問,因為它們的速度很快。

(1). 使用EnterCriticalSection( ) 和LeaveCriticalSection( ) API 函數

在使用臨界區之前, 必須定義一個TRTLCriticalSection 類型的記錄變量並使用

InitializeCriticalSection( ) 過程來初始化臨界區。該過程多半在窗體創建時或在程序初始化時

執行。

其聲明如下:

procedure InitializeCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall;

lpCriticalSection 參數是一個TRTLCriticalSection 類型的記錄, 並且是變參。至於

TRTLCriticalSection 是如何定義的,這並不重要,因為很少需要查看這個記錄中的具體內容。

只需要在lpCriticalSection 中傳遞未初始化的記錄, InitializeCriticalSection( ) 過程就會填充這個記錄。

注意:Microsoft 故意隱瞞了TRTLCriticalSection 的細節。因為,其內容在不同的硬件平台上是不同的。在基於Intel 的平台上,TRTLCriticalSection 包含一個計數器、一個指示當前線程句柄的域和一個系統事件的句柄。在Alpha 平台上,計數器被替換為一種Alpha-CPU數據結構,稱為spinlock 。

在記錄被填充后,我們就可以開始創建臨界區了。這時我們需要用EnterCriticalSection( ) 和LeaveCriticalSection( ) 來封裝代碼塊,這兩個函數分別代表進入和離開臨界區,將要同步的代碼塊放在這兩個函數中間。在第一個線程調用了EnterCriticalSection( ) 之后,所有別的線程就不能再進入代碼塊並掛起等待第一個線程離開臨界區。下一個線程要等第一個線程調用LeaveCriticalSection( ) 后才能被喚醒。這兩個過程的聲明如下:

procedure EnterCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall; //進入臨界區

procedure LeaveCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall; //離開臨界

正如你所想的,參數lpCriticalSection 就是由InitializeCriticalSection( ) 填充的記錄。如果在某個子線程執行EnterCriticalSection( ) 前,已經有另一個線程進入臨界區且還未離開臨界區,則該子線程將掛起並無限期等待另一個線程離開臨界區,要想不掛起且0 時間等待,必須使用TryEnterCriticalSection( ) 。該過程聲明如下:

function TryEnterCriticalSection(var lpCriticalSection: TRTLCriticalSection): BOOL; stdcall;

TryEnterCriticalSection( ) 不同於EnterCriticalSection( ) 的聲明在於多出一個布爾型的返回值,如果返回True 代表成功進入臨界區,如果返回False 代表臨界區已占用且不進入臨界區。運用這個函數,線程能夠迅速查看它是否可以訪問某個共享資源,如果不能訪問,那么它可以繼續執行某些其他操作,而不必進行等待。

使用TryEnterCriticalSection( ) ,必須判斷其返回值。

當你不需要臨界區時,應當調用DeleteCriticalSection( ) 過程刪除臨界區,該函數多半在窗

體銷毀時或程序終止前執行。下面是它的聲明:

procedure DeleteCriticalSection(var lpCriticalSection : TRTLCriticalSection); stdcall;

例:

 

type

TMyThread = class(TThread)

protected

procedure Execute; override;

public

constructor Create; virtual;

end;

var

Form1 : TForm1;

CriticalSection : TRTLCriticalSection;//定義臨界區

implementation

{$R *.dfm}

var

tick: Integer = 1;

procedure TMyThread.Execute;

begin

EnterCriticalSection(CriticalSection);//進入臨界區

try

Form1.Edit1.Text := IntToStr(tick);

Inc(tick);

Sleep(10);

finally

LeaveCriticalSection(CriticalSection); //離開臨界區

end;

end;

constructor TMyThread.Create;

begin

inherited Create(False);

FreeOnTerminate := True;

end;

procedure TForm1.RzButton1Click(Sender : TObject);

var

index: Integer;

begin

for index := 0 to 15 do

TMyThread.Create;

end;

procedure TForm1.FormCreate(Sender : TObject);

begin

InitializeCriticalSection(CriticalSection); //初始化臨界區

end;

procedure TForm1.FormDestroy(Sender : TObject);

begin

DeleteCriticalSection(CriticalSection); //刪除臨界區

end;

 

 

(2). 使用TcriticalSection 類

TcriticalSection 是在SyncObjs 單元中定義的類,要使用它需要先uses SyncObjs 。它對上面的那些臨界區操作API 函數進行了封裝,簡化並方便了在Delphi 中的使用。例如TcriticalSection.Enter 其實是調用了TRTLCriticalSection.Enter 。

使用TcriticalSection 類和一般類差不多,首先實例化TcriticalSection 類。使用的時候只要

在主線程當中創建這個臨界對象(注意一定要在需要同步的子線程之外建立這個對象)。

Tcriticalsection 類的構造函數比較簡單,沒有帶參數。

TcriticalSection.Enter 等效於EnterCriticalSection( ) 。

TcriticalSection.TryEnter 等效於TryEnterCriticalSection( ) 。

TcriticalSection.Leave 等效於LeaveCriticalSection( ) 。

例:

 

//在主線程中定義

var criticalsection : TCriticalsection;

criticalsection := TCriticalsection.Create;

//在子線程中使用

criticalsection.Enter;

try

...

finally

criticalsection.Leave;

end;

 

警告:臨界區只有在所有的線程都使用它來訪問全局內存時才起作用,如果有線程直接調用

內存,而不通過臨界區,也會造成同時訪問的問題。

注意:臨界區主要是為實現線程之間同步的,但是使用的時候要注意,一定要在使用臨界區

同步的線程之外建立該臨界區(一般在主線程中定義臨界區並初始化臨界區)。臨界區是一

個進程里的所有線程同步的最好辦法,它不是系統級的,只是進程級的,也就是說它可能利

用進程內的一些標志來保證該進程內的線程同步,據Richter 說是一個記數循環。臨界區只

能在同一進程內使用。

 

2. Mutex 互斥

 

互斥是在序列化訪問資源時使用操作系統內核對象的一種方式。我們首先設置一個互斥對

象,然后訪問資源,最后釋放互斥對象。在設置互斥時,如果另一個線程(或進程)試圖設

置相同的互斥對象,該線程將會停下來,直到前一個線程(或進程)釋放該互斥對象為止。

注意它可以由不同應用程序共享。互斥的效果非常類似於臨界區,除了兩個關鍵的區別:首

先,互斥可用於跨進程的線程同步。其次,互斥對象能被賦予一個字符串名字,並且通過引

用此名字創建現有內核對象的附加句柄。線程同步使用臨界區,進程同步使用互斥。

當一個互斥對象不再被一個線程所擁有, 它就處於發信號狀態。此時首先調用

WaitForSingleObject( ) 函數(實現WaitFor 功能的API 還有幾個,這是最簡單的一個)的線

程就成為該互斥對象的擁有者,將互斥對象設為不發信號狀態。當線程調用ReleaseMutex( )

函數並傳遞一個互斥對象的句柄作為參數時,這種擁有關系就被解除,互斥對象重新進入發

信號狀態。

提示:臨界區和互斥的作用類似,都是用來進行同步的,但它們間有以下一點差別。臨界區

只能在進程內使用,也就是說只能是進程內的線程間的同步;而互斥則還可用在進程之間的;

臨界區隨着進程的終止而終止,而互斥,如果你不用CloseHandle( ) 的話,在進程終止后

仍然在系統內存在,也就是說它是操作系統全局內核對象;臨界區與互斥最大的區別是在性

能上,臨界區在沒有線程沖突時,要用10 ~ 15 個時間片,而互斥由於涉及到系統內核要用

400 ~ 600 個時間片;臨界區不是內核對象,它不由操作系統的低級部件管理,而且不能使

用句柄來操縱,而互斥屬於操作系統內核對象。

 

(1). 使用CreateMutex( ) API 函數

調用函數CreateMutex( ) 來創建一個互斥。下面是函數的聲明:

function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName:

PWideChar): THandle; stdcall;

lpMutexAttributes 參數為一個指向TsecurityAttributtes 記錄的指針。此參數通常設為nil ,

表示默認的安全屬性。bInitalOwner 參數表示創建互斥的線程是否要成為此互斥對象的初始

擁有者,當此參數為False 時,表示互斥對象沒有擁有者。lpName 參數指定互斥對象的名

稱,該名稱是大小寫區分的,設為nil 表示無命名,如果參數不是設為nil ,函數會搜索

是否有同名的互斥對象存在,如果有,函數就會返回同名互斥對象的句柄。否則,就新創建

一個互斥對象並返回其句柄。

當使用完互斥時,應當調用CloseHandle( ) 來關閉它。

WaitForSingleObject( ) 函數的使用:

在線程中使用WaitForSingleObject( ) 來防止其他線程進入同步區域的代碼。第一個調用

WaitForSingleObject( ) 函數的線程會將事件對象(不限於互斥對象)設為無信號狀態,其它線

程調用WaitForSingleObject( ) 函數時會檢查事件對象是否處於發信號狀態,這時狀態處於

無信號狀態,所以其它線程會掛起等待而不執行同步區域中的代碼。當第一個線程執行完同

步代碼后會釋放事件對象,事件對象重新進入發信號狀態並喚醒等待線程,其它線程會再次

將事件對象設為無信號狀態,防止另外的線程執行同步代碼。這就實現了線程同步。

此函數聲明如下:

function WaitForSingleObject(hHandle : THandle; dwMilliseconds : DWORD): DWORD; stdcall;

這個函數可以使當前線程在dwMilliseconds 參數指定的時間內等待事件對象信號,直到

hHandle 參數指定的事件對象進入發信號狀態為止。當一個事件對象不再被線程擁有時,它

就進入發信號狀態。當一個進程要終止時,它就進入發信號狀態。dwMilliseconds 參數設為

0 ,這意味着只檢查hHandle 參數指定的事件對象是否處於發信號狀態,而后立即返回該

信號狀態。dwMilliseconds 參數設為INFINITE ,表示如果信號不出現將一直等下去。

WaitForSingleObject( ) 在一個指定時間(dwMilliseconds)內等待一個事件對象變為有信號,

在此時間內,若等待的事件對象一直是無信號的,則調用線程將處於掛起狀態,否則繼續執

行。超過此時間后,線程繼續運行。

WaitForSingleObject( ) 函數返回值及含義:

WAIT_ABANDONED 指定的對象是一個事件對象,該對象沒有被擁有線程在線程結束前釋

放。此時就稱事件對象被拋棄。互斥對象的所有權被同意授予調用該函數的線程。互斥對象

被設置成為無信號狀態

WAIT_OBJECT_0 指定的對象處於發信號狀態

WAIT_TIMEOUT 等待的時間已過,對象仍然是非發信號狀態

WAIT_FAILED 語句出錯

WaitForMultipleObjects( ) 函數的使用:

WaitForMultipleObjects( ) 與WaitForSingleObject( ) 類似,只是它要么等待指定列表(由

lpHandles 指定)中若干個互斥對象(由nCount 決定)都變為有信號,要么等待一個列表

(由lpHandles 指定)中的一個對象變為有信號(由bWaitAll 決定)。該函數聲明如下:

function WaitForMultipleObjects(nCount: DWORD; lpHandles: PWOHandleArray; bWaitAll:

BOOL; dwMilliseconds: DWORD): DWORD; stdcall;

nCount 參數表示句柄的數量,最大值為MAXIMUM_WAIT_OBJECTS(64),lpHandles 參數

是指向句柄數組的指針,lpHandles 類型可以為(Event,Mutex,Process,Thread,Semaphore)

數組,bWaitAll 參數表示等待的類型,如果為True 則等待所有信號量有效再往下執行,設

為False 則當有其中一個信號量有效時就向下執行,dwMilliseconds 參數表示超時時間,超

時后向下繼續執行。

注意: 除WaitForSingleObject( ) 和WaitForMultipleObjects( ) 外, 你還可以使用

MsgWaitForMultipleObjects( ) 函數。該函數的詳細情況請看Win32 API 聯機文檔。

WaitForSingleObject( ) 不僅僅用於互斥,也用於信號量或事件,因此這里用詞為“事件對象”

而非互斥對象。在互斥例中,可以用互斥對象代替事件對象,同樣,在信號量例中,也能以

信號量對象代替事件對象。

再次提示,當一個互斥對象不再被一個線程所擁有,它就處於發信號狀態。此時首先調用

WaitForSingleObject( ) 函數的線程就成為該互斥對象的擁有者,此互斥對象設為無信號狀

態。當線程調用ReleaseMutex( ) 函數並傳遞一個互斥對象的句柄作為參數時,這種擁有關

系就被解除,互斥對象重新進入發信號狀態。ReleaseMutex( ) 聲明如下:

function ReleaseMutex(hMutex: THandle): BOOL; stdcall;

進程間需要同步時,只需要執行CreateMutex( ) 建立一個互斥對象,需要同步的時候只需

要WaitForSingleObject(mutexhandle, INFINITE) ,釋放時只需要ReleaseMutex(mutexhandle)

即可。

 

例:

//先在主線程中創建互斥對象

var

hMutex : THandle = 0;//定義一個句柄

...

hMutex := CreateMutex(nil, False, nil);//創建互斥對象,並返回其句柄

//在子線程的Execute 方法中加入以下代碼

WaitForSingleObject(hMutex, INFINITE);//互斥對象處於發信號狀態時進入同步區,否則等待

...

ReleaseMutex(hMutex);

//最后記得要在主線程中釋放互斥對象

CloseHandle(hMutex);//關閉句柄

 

(2). 使用TMutex 類

TMutex 是在SyncObjs 單元中定義的類,其是ThandleObject 類的子類,要使用它需要先

uses SyncObjs 。它對上面的那些互斥操作API 函數進行了封裝,簡化並方便了在Delphi

中的使用。

使用前先實例化TMutex 類,其有多個重載的構造函數。聲明如下:

 

constructor Create(UseCOMWait: Boolean = False); overload;

constructor Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name:

string; UseCOMWait: Boolean = False); overload;

constructor Create(DesiredAccess: LongWord; InheritHandle: Boolean; const Name: string;

UseCOMWait: Boolean = False); overload;

 

其實簡單的直接調用TMutex.Create 就可以返回一個TMutex 對象。

第一個版本將創建一個無名的、使用默認安全屬性、創建其的線程非互斥對象的初始擁有者

的TMutex 對象,其中的參數UseCOMWait 設為True 時表示當某個線程阻塞且等待互斥

對象時,任何單線程單元( STA ) COM 組件調用可以發回到該線程,其默認為False 。

第二個版本的MutexAttributes 參數通常設為nil 表示使用默認的安全屬性。InitialOwner 參

數表示創建線程是否是互斥對象的初始擁有者。Name 參數表示互斥對象的名字,大小寫區

分。

第三個版本的DesiredAccess 參數表示訪問互斥的方式,如果傳遞的訪問方式沒有被允許那

么構造函數會失敗,其參數可以是下面幾個常量的任意組合:

MUTEX_ALL_ACCESS MUTEX_MODIFY_STATE SYNCHRONIZE _DELETE

READ_CONTROL  WRITE_DAC  WRITE_OWNER 。但任何組合必須包含

SYNCHRONIZE 訪問權。InheritHandle 參數表示子進程是否可繼承該互斥對象句柄。

TMutex.Acquire 等效於WaitForSingleObject(mutexhandle, INFINITE) ,其實際上就是執行

THandleObject.WaitFor(INFINITE)。

TMutex.Release 實際上就是執行ReleaseMutex(mutexhandle)。

TMutex.Acquire 只能無限期等待一個互斥對象,要設置等待時間或等待多個互斥對象要使

用TMutex.WaitFor( ) 或TMutex.WaitForMultiple( )。

WaitFor( ) 是定義在TMutex 的父類ThandleObject 中的虛函數,聲明如下:

function WaitFor(Timeout: LongWord): TWaitResult; virtual;

其中返回值枚舉型TWaitResult 可以指示操作結果,wrSignaled 代表信號已set ,

wrTimeOut 代表超時且信號未set ,wrAbandoned 代表超時前事件對象被銷毀,wrError 代

表等待時出錯。

WaitForMultiple( ) 是定義在TMutex 的父類ThandleObject 中的類函數,聲明如下:

class function WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: LongWord;

AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer =

0): TWaitResult;

其中HandleObjs 參數是包含了要等待的一系列事件對象的數組,AAll 參數設為True 時,

當所有事件對象都進入發信號狀態后該函數調用才會完成,當返回值為wrSignaled 且

AAll 參數設為False 時,第一個發信號的事件對象會被傳給SignaledObj 參數,Len 參數

設置監視事件對象的數量。

注意:WaitFor( ) 和WaitForMultiple( ) 均定義在ThandleObject 類中,而ThandleObject 類

是TMutex 、TSemaphore 、TEvent 類的父類,所以在描述WaitFor( ) 和WaitForMultiple( )

時使用的是事件對象而非互斥對象或信號量對象。

 

3. Semaphore 信號量

另一種使線程同步的技術是使用信號量對象。它是在互斥的基礎上建立的,它與互斥相似,

但它可以計數。信號量增加了資源計數的功能,預定數目的線程允許同時進入要同步的代碼。

例如可以允許一個給定資源同時被三個線程訪問。其實互斥就是最大計數為1 的信號量。

信號量的使用和互斥差不多。

(1). 使用CreateSemaphore( ) API 函數

可以用CreateSemaphore( ) 來創建一個信號量對象,其聲明如下:

function CreateSemaphore(lpSemaphoreAttributes: PSecurityAttributes;

lInitialCount, lMaximumCount: Longint; lpName: PWideChar): THandle; stdcall;

和CreateMutex( ) 函數一樣, CreateSemaphore( ) 的第一個參數也是一個指向

TSecurityAttributes 記錄的指針,此參數的缺省值可以設為nil 。

lInitialCount 參數用來指定一個信號量的初始計數值,這個值必須在0 和lMaximumCount

之間。此參數大於0 ,就表示信號量處於發信號狀態。參數lMaximumCount 指定計數值

的最大值。如果這個信號量代表某種資源,那么這個值代表可用資源總數。

參數lpName 用於給出信號量對象的名稱,它類似於CreateMutex( ) 函數的lpName 參數。

在程序中使用WaitForSingleObject( ) 來防止其他線程進入同步區域的代碼。當調用

WaitForSingleObject( ) 函數( 或其他WaitFor 函數) 時, 此計數值就減1 。當調用

ReleaseSemaphore( ) 時,此計數值加1 ,此時同步區域代碼可以被其它線程訪問。其聲明

如下:

function ReleaseSemaphore(hSemaphore: THandle; lReleaseCount: Longint;

lpPreviousCount: Pointer): BOOL; stdcall;

其中hSemaphore 參數是創建的信號量句柄,lReleaseCount 參數是釋放時要增加的信號量

計數,lpPreviousCount 參數是通過該指針參數來獲得釋放前的信號量計數,如果不用設為

nil 。

當使用完信號量時,應當調用CloseHandle( ) 來關閉它。

注意:一般的同步使用互斥,是因為其有一個特別之處,當一個持有互斥的線程DOWN 掉

的時候,互斥可以自動讓其它等待這個對象的線程接受,而其它的內核對象則不具體這個功

能。之所以要使用信號量則是因為其可以提供一個活動線程的上限,即lMaximumCount 參

數,這才是它的真正有用之處。

例:

 

var

Form1 : TForm1;

HSem : THandle = 0;//定義一個信號量

implementation

var

tick : Integer = 0;

procedure TMyThread.Execute;

var

WaitReturn : DWord ;

begin

WaitReturn := WaitForSingleObject(HSem, INFINITE);//使用信號量對象,信號量減1

Form1.Edit1.Text := IntToStr(tick);

Inc(tick);

Sleep(10);

ReleaseSemaphore(HSem, 1, Nil);//釋放信號量對象,信號量加1

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

HSem := CreateSemaphore(Nil, 1, 1, Nil);//創建信號量對象

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

CloseHandle(HSem);//銷毀信號量

end;

procedure TForm1.Button1Click(Sender: TObject);

var

index : Integer;

begin

for index := 0 to 10 do

TMyThread.Create;

end;

 

 

(2). 使用TSemaphore 類

TSemaphore 是在SyncObjs 單元中定義的類,其是ThandleObject 類的子類,要使用它需

要先uses SyncObjs 。它對上面的API 函數進行了封裝,簡化並方便了在Delphi 中的使

用。

其有三個版本的構造器,簡單執行TSemaphore.Create 就可實例化一個對象:

 

constructor Create(UseCOMWait: Boolean = False); overload;

constructor Create(SemaphoreAttributes: PSecurityAttributes; AInitialCount: Integer;

AMaximumCount: Integer; const Name: string; UseCOMWait: Boolean = False); overload;

constructor Create(DesiredAccess: LongWord; InheritHandle: Boolean;

const Name: string; UseCOMWait: Boolean = False); overload;

 

參數參見上面介紹。

TSemaphore.Acquire 等效於WaitForSingleObject(semaphorehandle, INFINITE) ,其實際上就

是執行THandleObject.WaitFor(INFINITE)。或者使用WaitFor( ) 和WaitForMultiple( ) 函數,

這兩個函數可以設置等待的時間或等待多個事件對象。

TSemaphore.Release 有兩個版本,聲明如下:

procedure Release; override; overload;

function Release(AReleaseCount: Integer): Integer; overload; reintroduce;

第一個版本實際執行ReleaseSemaphore(FHandle, 1, nil)

第二個版本AReleaseCount 參數表示釋放時增加的信號量計數值,返回值是釋放前的信號

量計數值。實際執行ReleaseSemaphore(FHandle, AReleaseCount, @Result),其中@Result 是

指向Release 函數返回值Integer 類型的指針。如果要指定增加計數值應使用第二個版本。

4. Event 事件

事件( Event )與Delphi 中的事件有所不同。從本質上說,Event 其實相當於一個全局的布

爾變量。它有兩個賦值操作: SetEvent 和ResetEvent ,相當於把它設置為True 或False 。

而檢查它的值是通過WaitForSingleObject( ) (或其它WaitFor 函數)操作進行。SetEvent 和

ResetEvent 操作是原語操作,所以Event 可以實現一般布爾變量不能實現的在多線程中的

應用。

當Event 從Reset 狀態向Set 狀態轉換時,喚醒其它掛起的線程,這就是它為什么叫

Event 的原因。所謂“事件”就是指“狀態的轉換”。通過Event 可以在線程間傳遞這種“狀

態轉換”信息。所以其本質是用來通知某事已經發生的信號,在這里可用來表示共享資源已

經在使用或已經使用完的信號。

(1). 使用CreateEvent( ) API 函數

使用CreateEvent( ) 創建一個事件,聲明如下:

function CreateEvent(lpEventAttributes: PSecurityAttributes;

bManualReset, bInitialState: BOOL; lpName: PWideChar): THandle; stdcall;

其中bManualReset 參數代表創建的Event 是自動復位還是人工復位,如果設為True 表示

人工復位,一旦該Event 被設置為有信號,則它一直會等到手動執行ResetEvent( ) 時才會

變為無信號,設為False 表示自動復位,Event 被設置為有信號時,則當有一個線程執行

WaitForSingleObject( ) 時該Event 就會自動復位,變成無信號。bInitialState 參數代表事件

的初始狀態,設為True,事件創建后為有信號,設為False 則為無信號。

不同於互斥或信號量,Event 不使用Release 相關函數設置相關對象進入發信號狀態,而使

用SetEvent( ) 函數,當線程執行完同步代碼要從同步區域中離開時應執行該函數,聲明如

下:

function SetEvent(hEvent: THandle): BOOL; stdcall;

當事件創建為人工復位時,在線程進入同步區域執行同步代碼前應執行ResetEvent( ) 函數,

將Event 設為無信號。聲明如下:

function ResetEvent(hEvent: THandle): BOOL; stdcall;

PulseEvent( ) 是一個比較有意思的方法,正如名字,它使一個Event 對象的狀態發生一次

脈沖變化,將無信號設為有信號,喚醒等待的線程,再設為無信號,而整個操作是原子的。

對自動復位的Event 對象,它僅喚醒第一個等到該事件的線程(如果有的話),而對於人工復

位的Event 對象,它喚醒所有等待的線程。聲明如下:

function PulseEvent(hEvent: THandle): BOOL; stdcall;

當使用完事件時,應當調用CloseHandle( ) 來關閉它。

(2). 使用TEvent 類

TEvent 是在SyncObjs 單元中定義的類,其是ThandleObject 類的子類,要使用它需要先

uses SyncObjs 。它對上面的API 函數進行了封裝,簡化並方便了在Delphi 中的使用。

TEvent 若在多線程環境中可用於與其它線程同步;若在單線程環境中可用於調整響應不同

異步事件(如系統消息或用戶動作)的代碼段。構造函數如下:

constructor Create(EventAttributes: PSecurityAttributes; ManualReset: Boolean;

InitialState: Boolean; const Name: string; UseCOMWait: Boolean = False); overload;

constructor Create(UseCOMWait: Boolean = False); overload;

ManualReset 參數為是否手工復位,InitialState 參數為初始狀態。

TEvent.SetEvent( ) 和TEvent.ResetEvent( ) 均無參數。

TEvent 類中沒有定義與PulseEvent 功能一樣的方法。

TEvent 類同樣可以使用WaitFor( ) 和WaitForMultiple( ) 函數。

但要注意的是,TEvent 類並沒有實現Acquire 函數,該函數是定義在TSynchroObject 類

中僅作為接口、沒有執行代碼的虛函數。TSynchroObject 是ThandleObject 類的父類。其實

自己實現Acquire 函數也不難,它實際上是執行THandleObject.WaitFor(INFINITE) 函數,

仿照上面的TMutex 類寫就可以。

另外,Delphi 中定義了一個更簡單的事件類,TSimpleEvent 類,但從源代碼上看,該類僅

有TSimpleEvent = class(TEvent); 一句,並未定義任何屬於TSimpleEvent 的成員。估計是

作為向后兼容而存在。

5. Global Atom 全局原子

Windows 系統中,為了實現信息共享,系統維護了一張全局原子表( Global Atom Table ),

用於保存字符串與之對應的標志符(原子)的組合,系統能保證其中的每個原子都是唯一的,

管理其引用計數,並且當該全局原子的引用計數為0 時,從內存中清除。應用程序在原子表

中可以放置字符串,並接收一個16 位整數值(叫做原子,即Atom ),它可以用來提取該字

符串。放在原子表中的字符串叫做原子的名字。系統提供了許多原子表。每個表有不同的目

的。例如,動態數據交換( DDE )應用程序使用全局原子表與其他應用程序共享項目名稱和

主題名稱字符串,不傳遞實際的字符串,一個DDE 應用程序傳遞全局原子給它的父進程,

父進程使用原子提取原子表中的字符串,這就是利用全局原子進行進程或線程間的數據交

換;使用全局原子也可防止多次啟動某個程序。

應用程序可以使用本地原子表來有效地管理大量只用於程序內部的字符串。這些字符串,以

及相關聯的原子,只對創建該原子表的應用程序可用。一個在許多數據結構中需要相同字符

串的應用程序,可以通過使用本地原子表來減少內存使用。程序可以把字符串放入原子表,

把相關的原子放入結構,而無需把字符串拷到每個結構中。這樣,一個字符串在內存中只出

現一次,但可以在程序中多次使用。應用程序也可以使用本地原子表來快速搜索特定的字符

串。要實現這樣的搜索,程序只需把要搜索的字符串放入原子表中,然后把結果原子與相關

數據結構中的原子相比較。通常情況下,比較原子要比比較字符串要快得多。原子表是用哈

希表實現的。默認時,一個本地原子表使用37 個bucket 的哈希表。不過,你可以通過調

用InitAtomTable 函數來改變bucket 數量。如果程序准備調用InitAtomTable ,那它必須

在調用任何其他原子管理函數前調用它。這里只簡單介紹本地原子表。它有多個相關的函數,

 

function InitAtomTable(nSize: DWORD): BOOL; stdcall;

function DeleteAtom(nAtom: ATOM): ATOM; stdcall;

function AddAtom(lpString: PWideChar): ATOM; stdcall;

function FindAtom(lpString: PWideChar): ATOM; stdcall;

function GetAtomName(nAtom: ATOM; lpBuffer: PWideChar; nSize: Integer): UINT; stdcall;

 

以下介紹全局原子表相關函數。

function GlobalAddAtom(lpString: PWideChar): ATOM; stdcall;

增加一個字符串到全局原子表中,並返回一個唯一標識值。

lpString 參數為要添加到全局原子表中的字符串。

如果成功返回新增加的全局原子,失敗則返回0 。ATOM 類型等於Word 類型。

function GlobalDeleteAtom(nAtom: ATOM): ATOM; stdcall;

減少對指定全局原子的引用計數,引用計數減1 ,如果引用計數為零,系統會在全局原子

表中刪除此原子。

此函數一直返回0 。

只要全局原子的引用計數大於0 ,其原子名稱將保留在全局原子表中,即使把它放入表中

的應用程序終結了。一個本地的原子表在應用程序終結時被銷毀,而不管其中原子的引用計

數是多少。

function GlobalFindAtom(lpString: PWideChar): ATOM; stdcall;

在全局原子表中查找是否存在指定字符串。

lpString 參數為要查找的字符串。

如果在全局原子表中存在要查找的字符串,則返回此字符串對應的原子,沒有找到則返回0。

function GlobalGetAtomName(nAtom: ATOM;

lpBuffer: PWideChar; nSize: Integer): UINT; stdcall;

返回指定原子所對應的字符串。

nAtom 參數為指定查找的原子,lpBuffer 參數為要存放字符串的緩沖區,nSize 參數為緩沖

區大小。

若操作成功返回緩沖區接受長度,若失敗返回0 。UINT 類型等於LongWord 類型。

例:

 

//在程序的program 文件中

...

if GlobalFindAtom(iAtom) = 0 then

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

end

else

MessageBox(0, '已經有一個程序在運行', ' ', mb_OK);

...

6. Synchronize 同步

Synchronize( ) 是定義在TThread 類中的函數,它可以讓要執行的代碼實現線程同步,但這

種同步其實是偽同步,其原理是將子線程要執行的代碼通過消息傳遞給主線程,由主線程來

執行,主線程將代碼放在一個隱蔽的窗口里運行,而子線程會等待主線程將執行結果發給它,

這樣的話,這段代碼就不是子線程代碼,而是一般的主線程代碼。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。

這里有一個問題,如果Synchronize( ) 執行的代碼很繁忙,例如執行的代碼運算過於復雜、

龐大或者從數據庫中取出大量數據,數據庫不會立即返回數據時或者使用ADO 組件連接

數據庫,而這時數據庫無法連接,ADO 組件需要超時才會終止運行,這些都會導致主窗口

會阻塞掉,看似死機一般。因此,通常對用戶界面類VCL 組件的訪問才使用Synchronize( )

函數,一般用戶界面類VCL 組件都由主線程創建、存在於主窗口中,而且對VCL 組件的

訪問或修改的執行效率都比較高,不會過多的影響性能。絕對不能在主線程中執行

Synchronize( ) 函數,這會導致無限循環。

Synchronize( ) 函數一般在線程的Execute 函數中調用。其有四個版本,兩個是類函數,兩

個是靜態函數,聲明如下:

 

class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;

class procedure Synchronize(AThread: TThread; AThreadProc: TThreadProcedure); overload;

procedure Synchronize(AMethod: TThreadMethod); overload;

procedure Synchronize(AThreadProc: TThreadProcedure); overload;

 

AThread 參數是當前線程,TThreadMethod 是對象的函數指針類型,TThreadProcedure 是匿

名函數類型。

注意:Synchronize( ) 的AMethod 或AThreadProc 參數必須是一個無參數的procedure ,

故在此procedure 中無法傳遞參數值,通常的解決方法是在線程類中增加額外的成員,用其

代替參數來傳遞信息。

例:

 

type

TMyThread = class(TThread)

str : string;//額外的域,代替參數將字符串寫入Memo

...

procedure TMyThread.WriteMemo;

begin

Memo.Lines.Add(str);

end;

...

procedure TMyThread.Execute;

begin

str := 'Hello';

synchronize(WriteMemo);

end;

 

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM