zoukankan      html  css  js  c++  java
  • delphi 把多个线程的请求阻塞到另一个线程 TElegantThread

    本例是把多个线程访问数据库的请求,全部阻塞到一个线程。

    这是实际编程中常见的一种问题。

    示例源码下载,所需支持单元均在源码中,且附详细说明。

    TElegantThread 的父类是 TSimpleThread

    unit uElegantThread;
    
    interface
    
    uses
      Classes, SysUtils, uSimpleThread, uSimpleList, uSyncObjs;
    
    type
    
      PSyncRec = ^TSyncRec;
    
      TSyncRec = record
        FMethod: TThreadMethod;
        FProcedure: TThreadProcedure;
        FSignal: TSuperEvent;
        Queued: boolean;
        DebugInfo: string;
      end;
    
      TSyncRecList = Class(TSimpleList<PSyncRec>)
      protected
        procedure FreeItem(Item: PSyncRec); override;
      End;
    
      TElegantThread = class(TSimpleThread)
      private
        FSyncRecList: TSyncRecList;
    
        procedure LockList;
        procedure UnlockList;
    
        procedure Check;
        procedure DoCheck;
    
      public
    
        // AAllowedActiveX 允许此线程访问 COM 如:IE ,
        // 当然,获取 Ie 的 IHtmlDocument2 接口,也必须在此线程内执行
        constructor Create(AAllowedActiveX: boolean = false);
        destructor Destroy; override;
    
        // ADebugInfo 是调用者用来查错用,一般可以写上过程名 如:'DoSomeThing';
        procedure Queue(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
        procedure Queue(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload;
    
        procedure Synchronize(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
        procedure Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload;
    
      end;
    
    implementation
    
    { TSyncRecList }
    
    procedure TSyncRecList.FreeItem(Item: PSyncRec);
    begin
      inherited;
      if Assigned(Item.FSignal) then
        Item.FSignal.Free;
      Dispose(Item);
    end;
    
    { TElegantThread }
    
    procedure TElegantThread.Check;
    begin
      ExeProcInThread(DoCheck);
    end;
    
    constructor TElegantThread.Create(AAllowedActiveX: boolean);
    begin
      inherited;
      FSyncRecList := TSyncRecList.Create;
    end;
    
    destructor TElegantThread.Destroy;
    begin
      WaitThreadStop;
      FSyncRecList.Free;
      inherited;
    end;
    
    procedure TElegantThread.DoCheck;
    var
      p: PSyncRec;
      sErrMsg: string;
    begin
    
      LockList;
      try
        p := FSyncRecList.PopFirst; // 每次从 List 取出一个过程来执行
      finally
        UnlockList;
      end;
    
      if Assigned(p) then
      begin
    
        try
    
          if Assigned(p.FMethod) then
            p.FMethod // 执行
          else if Assigned(p.FProcedure) then
            p.FProcedure(); // 执行
    
        except
          on E: Exception do // 错误处理
          begin
            sErrMsg := 'DebugInfo:' + p.DebugInfo + #13#10;
            sErrMsg := sErrMsg + 'ErrMsg:' + E.Message;
            DoOnDebugMsg(sErrMsg);
          end;
        end;
    
        if not p.Queued then // 如果是阻塞,请设为有信号,调用者即可返回
        begin
          p.FSignal.SetEvent;
        end;
    
        Dispose(p);
        Check; // 继续下一次 DoCheck,也就是本过程。
        // 父类 TSimpleThread 已特殊处理,不会递归。
    
      end;
    
    end;
    
    procedure TElegantThread.LockList;
    begin
      FSyncRecList.Lock;
    end;
    
    procedure TElegantThread.Queue(AMethod: TThreadMethod; ADebugInfo: string);
    var
      p: PSyncRec;
    begin
      // 此过程为排队执行
    
      new(p);
      p.FProcedure := nil;
      p.FMethod := AMethod;
      p.Queued := true;
    
      LockList;
      try
        FSyncRecList.Add(p); // 把要执行的过程加入 List
        Check; // 启动线程
      finally
        UnlockList;
      end;
    
    end;
    
    procedure TElegantThread.Queue(AProcedure: TThreadProcedure; ADebugInfo: string);
    var
      p: PSyncRec;
    begin
      new(p);
      p.FProcedure := AProcedure;
      p.FMethod := nil;
      p.Queued := true;
      LockList;
      try
        FSyncRecList.Add(p);
        Check;
      finally
        UnlockList;
      end;
    end;
    
    procedure TElegantThread.Synchronize(AMethod: TThreadMethod; ADebugInfo: string);
    var
      p: PSyncRec;
      o: TSuperEvent;
    begin
    
      // 此过程为阻塞执行,即调用者必须等到此过程被执行完成才能返回
    
      new(p);
    
      p.FProcedure := nil;
      p.FMethod := AMethod;
      p.Queued := false;
      p.FSignal := TSuperEvent.Create; // 创建一个信号
      p.FSignal.ResetEvent; // 清除信号
      o := p.FSignal;
    
      LockList;
      try
        FSyncRecList.Add(p);
        Check;
      finally
        UnlockList;
      end;
    
      o.WaitFor; // 等待信号出现
      o.Free;
    
    end;
    
    procedure TElegantThread.Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string);
    var
      p: PSyncRec;
      o: TSuperEvent;
    begin
      new(p);
    
      p.FProcedure := AProcedure;
      p.FMethod := nil;
      p.Queued := false;
      p.FSignal := TSuperEvent.Create;
      p.FSignal.ResetEvent;
      o := p.FSignal;
    
      LockList;
      try
        FSyncRecList.Add(p);
        Check;
      finally
        UnlockList;
      end;
    
      o.WaitFor;
      o.Free;
    
    end;
    
    procedure TElegantThread.UnlockList;
    begin
      FSyncRecList.Unlock;
    end;
    
    end.
    
    uElegantThread.pas

    附:delphi 进阶基础技能说明

    http://www.cnblogs.com/lackey/p/4782777.html

  • 相关阅读:
    [置顶] windows player,wzplayerV2 for windows
    wzplayer 近期将会支持BlackBerry和WinPhone8
    wzplayerEx for android(真正硬解接口,支持加密的 player)
    ffmpeg for ios 交叉编译 (支持i686 armv7 armv7s) 包含lame支持
    ffmpeg for ios 交叉编译 (支持i686 armv7 armv7s) 包含lame支持
    编译cegcc 0.59.1
    wzplayer 近期将会支持BlackBerry和WinPhone8
    wzplayerEx for android(真正硬解接口,支持加密的 player)
    windows player,wzplayerV2 for windows(20140416)更新
    编译cegcc 0.59.1
  • 原文地址:https://www.cnblogs.com/findumars/p/5648522.html
Copyright © 2011-2022 走看看