Delphi 线程

米米吖 發表於 2019-11-5 16:13:00

不是原创，只是看到好的内容复制了保存下来，留着学习。
 
CreadteThred参考，同步参考，WaitForSingleObject参考，互斥参考，
 
一、在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.
1、调用 API:CreateThread()
<div>
<div class="cnblogs_code">
<pre><code class="delphi hljs">function CreateThread(   lpThreadAttributes: Pointer;     {安全设置}   dwStackSize: DWORD;         {堆栈大小}   lpStartAddress: TFNThreadStartRoutine; {入口函数}   lpParameter: Pointer;        {函数参数}   dwCreationFlags: DWORD;       {启动选项}   var lpThreadId: DWORD        {输出线程 ID } ): THandle; stdcall;          {返回线程句柄}
</code></pre>
</div>
 CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;</div>
<div>{函数参数} 因为是系统级调用, 函数参数还要缀上 stdcall；还需要一个 var 参数来接受新建线程的 ID。</div>
<div>{安全设置} ：</div>
<div>CreateThread 的第一个参数  是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制;</div>
<div>但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil).  </div>
<div>{堆栈大小} ：</div>
<div>CreateThread 的第二个参数是分配给线程的堆栈大小. 
这首先这可以让我们知道: 每个线程都有自己独立的堆栈(也拥有自己的消息队列)</div>
<div> </div>
<div>这个值都是 0, 这表示使用系统默认的大小, 默认和主线程栈的大小一样, 如果不够用会自动增长; 
那主线程的栈有多大? 这个值是可以设定的: Project -> Options -> linker -> memory size</div>
<div> </div>
<div>Delphi 为我们提供了一个类似 var 的 ThreadVar 关键字, 线程在使用 ThreadVar 声明的全局变量时会在各自的栈中留一个副本, 这样就解决了线程冲突. 不过还是尽量使用局部变量, 或者在继承 TThread 时使用类的成员变量, 因为 ThreadVar 的效率不好, 据说比局部变量能慢 10 倍.</div>
<div> </div>
<div>{入口函数} ：</div>
<div>线程执行的函数 </div>
<div>该函数返回的值可以判断线程是否退出，用GetExitCodeThread 函数获取的退出码就是这个返回值!</div>
<div>如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出</div>
<div> </div>
<div>{函数参数} ：线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据;</div>
<div>{启动选项} ：有两个可选值: 
0: 线程建立后立即执行入口函数; 
CREATE_SUSPENDED: 线程建立后会挂起等待. 
可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程. 
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数. 
什么是挂起计数? 
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0. 
当这个数 = 0 时, 线程会运行; > 0 时会挂起. 
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.</div>
<div>{输出线程ID} ：</div>
<div style="margin-left: 30px"> 1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.  2、ID 比句柄更轻便.</div>
 
<div class="cnblogs_code">
<pre>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);
procedure Button2Click(Sender: TObject);

end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
pt: TPoint; {这个坐标点将会已指针的方式传递给线程, 它应该是全局的}
hThread : THandlde;{生成的线程}

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);
hThread := CreateThread(nil, 0, @MyThreadFun, @pt, 0, ID);
{下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的}
//CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 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, 表示线程还未退出', )
else
Text := Format('线程已退出, 退出代码是: %d', );
end;

end.</pre>
</div>
 
<div>2、使用TTHread类</div>
<div>如果Create里面的参数是True，这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程。</div>
<div class="cnblogs_code">
<pre> procedure TForm1.Button1Click(Sender: TObject);
var
 MyThread: TMyThread;
begin
 MyThread := TMyThread.Create(False);
end;
</pre>
</div>
OnTerminate属性：表示在线程执行完Execute之后，还没有被释放之前，要紧接着执行的方法。
<div class="cnblogs_code">
<pre>procedure TTestThread.Execute;
var
i: Integer;
begin
OnTerminate:= Form1.ThreadDone; //在这里设置OnTerminate属性的值为Form1的ThreadDone方法，
 //表示在线程执行完Execute之后，还没有被释放之前，要紧接着执行Form1的ThreadDone方法。
EnterCriticalSection(CS);
for i:= 1 to MaxSize do
begin
GlobalArray:= GetNextNumber;
Sleep(5);
end;
LeaveCriticalSection(CS);
end;</pre>
</div>
 
 
二、同步
1、临界区
"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等;
<div class="cnblogs_code">
<pre>var CS: TRTLCriticalSection; {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的}
InitializeCriticalSection(CS); {初始化}
EnterCriticalSection(CS); {开始: 轮到我了其他线程走开}
LeaveCriticalSection(CS); {结束: 其他线程可以来了}
DeleteCriticalSection(CS); {删除: 注意不能过早删除}

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;</pre>
</div>
 
Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:
<div class="cnblogs_code">
<pre>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;</pre>
</div>
2、互斥
 
互斥量（原文链接）是系统内核对象，谁拥有就谁执行。它与临界区工作很类似。不同处在于：1、互斥量可以跨进程边界同步线程。2、可以给互斥量取个名字，通过引用互斥量的名字来使用一个已知的互斥量对象。
 
     使用互斥量之类的对象需要反复调用系统内核，期间需要进行进程上下文转换和控制级别转换，大概需要耗费400到600个时间周期。
 
      又是图书馆的比喻，现在是搞一个锁，把钥匙（互斥量句柄）交给管理员（操作系统），每一个人（线程）想要借书的时候，都要向管理员拿钥匙。当有人在使用的时候，另一人必须等待，等到钥匙有空的时候（互斥量进入信号状态），才能拿到钥匙（拥有了句柄）办理借书业务（此时互斥量进入非信号状态直到办完业务）。
 
   使用互斥量的步骤：
 
1、声明一个全局的互斥量句柄变量（var hMutex: THandle;）；
 
2、创建互斥量：CreateMutex(                           lpMutexAttributes: PSecurityAttributes;                           bInitialOwner: BOOL;                            lpName: PWideChar   ): THandle;
 
  （lpMutexAttributes参数：指向TSecurityAttributes的指针，安全属性，一般用缺省安全属性nil；
 
    bInitialOwer参数：表示创建的互斥量线程是否是互斥量的属主，如果该参数为False互斥量就没属主，一般来讲应设为False，否则如果设为True的话，要当主线程结束其他线程才成为它的属主才能运行；
 
   lpName参数：是互斥量的名字，若打算取名的话，则传入nil。）<code class="delphi plain"> </code>
<div class="cnblogs_code">
<pre>hMutex:= CreateMutex(nil, False, nil);</pre>
</div>
 
3、用等待函数控制线程进入同步代码块：<code class="delphi spaces"></code>
<div class="cnblogs_code">
<pre>if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
begin
//执行语句
end;</pre>
</div>
 
4、执行线程运行代码。
 
5、线程运行完后释放互斥量的拥有权：ReleaseMutex(hMutex: THandle);
 
6、最后关闭互斥量：CloseHandle(hMutex: THandle);
3、信号量 
信号量（原文链接）是建立在互斥量的基础之上，同时加入重要特性：提供了资源计数功能，因此预定义数量的线程同时可以进入同步的代码块中。
      信号量是维护0到指定最大值之间的计数器的同步对象，当线程完成一次信号量的等待时，计数器自减1，当线程释放信号量对象时，计数器自增1。
      借用上面的图书馆例子，信号量好像是多设几把管理钥匙。每次可以设定N把钥匙同时工作，那就有N个人员可以同时办理业务。
     信号量使用的一般步骤：
1、声明一个全局的信号量名柄，如：hSem:THandle;
2、创建信号量：CreateSemphore(
                              lpSemaphoreAttributes:PSecurityAttributes;
                              lInitialCount,lMaximumCount:LongInt;
                              lpName:PChar):THandle;stdcall;
  （lpSemaphoreAttributes参数，指向TSecurityAttributes记录的指针，一般可以缺省填入nil值；
    lInitialCount参数，是信号量对象的初始计数，是0~lMaximumCount之间的数。当它大于0时，信号量就进入了信号状态，当WaiForSingleObject函数释放了一个线程，信号量计数就减1。使用ReleaseSemphore函数可以增加信号量计数；
   lMaximumCount参数，是信号量对象计数的最大值；
   lpName参数，指定信号量的名字。）
<div class="cnblogs_code">
<pre>hSem:=CreateSemaphore(nil,2,3,nil);</pre>
</div>
3、用等待函数WaiForSingleObject协调线程。
4、当一个线程用完一个信号，释放。使用ReleaseSemphore(
                                                          hSemaphore:THandle;
                                                          lReleaseCount:LongInt;
                                                          lpPreviousCount:Pointer):BOOL;StdCall;
（hSemphore参数，是信号量对象句柄；
   lReleaseCount参数，要增加的信号量计数的数量；
  lpPreviousCount参数，当前资源数量的原始值，一般为nil。）
<div class="cnblogs_code">
<pre>ReleaseSemaphore(hSem,1,nil); </pre>
</div>
5、最后关闭信号量句柄，CloseHandle(hSem)。
<div class="cnblogs_code">
<pre>CloseHandle(hSem);</pre>
</div>
如果最大信号量计数为1，那么就相当于Mutex。
 三、WaitForSingleObject
 DWORD WaitForSingleObject( HANDLE hHandle, DWORDdwMilliseconds); 有两个参数，分别是THandle和Timeout(毫秒单位)。 如果想要等待一条线程，那么你需要指定线程的Handle，以及相应的Timeout时间。当然，如果你想无限等待下去，Timeout参数可以指定系统常量INFINITE。 2. 使用对象 它可以等待如下几种类型的对象： Event，Mutex，Semaphore，Process，Thread  3. 返回类型 有三种返回类型： WAIT_OBJECT_0, 表示等待的对象有信号。（对线程来说，表示执行结束；对互斥量对象来说，指定的对象进入信号状态，可以执行）  WAIT_TIMEOUT, 表示等待指定时间内，对象一直没有信号。（线程没执行完；对互斥量来说，等到时间已过，对象依然是无信号状态）； WAIT_ABANDONED 表示对象有信号，但还是不能执行  一般是因为未获取到锁或其他原因（对于互斥量对象，拥有这个互斥量对象的线程在没有释放互斥量之前就已经终止，称作废弃互斥量，此时该互斥量归调用线程所拥有，并把这个互斥量设为非信号状态）
<div> </div>
<div class="cnblogs_code">
<pre>function WaitForSingleObject(
hHandle: THandle; {要等待的对象句柄}
dwMilliseconds: DWORD{等待的时间, 单位是毫秒}
): DWORD; stdcall; {返回值如下:}

WAIT_OBJECT_0{等着了, 本例中是: 等的那个进程终于结束了}
WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}

//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等</pre>
</div>
<div class="cnblogs_code">
<pre>//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 已关闭', );
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 已启动', );
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID); {建立线程监视}
end;
end;
</pre>
</div>
  
来源：https://www.cnblogs.com/hjdgz/p/11799175.html

頁: [1]

琼殿技术论坛's Archiver

Delphi 线程