讲到多线程编程就要注意线程之间信息的同步
    从 CreateThread 说起
    function CreateThread(
    lpThreadAttributes: Pointer; {安全设置}
    dwStackSize: DWORD; {堆栈大小}
    lpStartAddress: TFNThreadStartRoutine; {入口函数，函数也是全局的}
    lpParameter: Pointer; {函数参数，指针组好是全局的}
    dwCreationFlags: DWORD; {启动选项}
    var lpThreadId: DWORD {输出线程 ID }
    ): THandle; stdcall; {返回线程句柄}

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

    参数讲解
    CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
    0: 线程建立后立即执行入口函数;
    CREATE_SUSPENDED: 线程建立后会挂起等待.

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

    线程同步的四种方法

    {建立事件}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;

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

    “临界区”(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:


    var CS: TRTLCriticalSection; {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的}
    InitializeCriticalSection(CS); {初始化}
    EnterCriticalSection(CS); {开始: 轮到我了其他线程走开}
    LeaveCriticalSection(CS); {结束: 其他线程可以来了}
    DeleteCriticalSection(CS); {删除: 注意不能过早删除}
    //也可用 TryEnterCriticalSection 替代 EnterCriticalSection.

    一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数; 不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.


    function WaitForSingleObject(
    hHandle: THandle; {要等待的对象句柄}
    dwMilliseconds: DWORD {等待的时间, 单位是毫秒}
    ): DWORD; stdcall; {返回值如下:}

    WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}
    WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
    WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}
    //WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.

    原理分析:
    互斥对象是系统内核对象, 各线程都可以拥有它, 谁拥有谁就能执行;
    执行完毕, 用 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 将直接创建一个新的互斥对象; 下个例子将会有名字. }

    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.