zoukankan      html  css  js  c++  java
  • delphi 线程使用

    unit untWorkThread;

    interface

    uses
      Windows,Classes,SysUtils;

    type
      TWorkItem=class
      end;
      TProcessWork=procedure (Sender:TObject;Work:TWorkItem) of Object;
      TWorkThread=class(TThread)
      private
        FCriticalSection:TRTLCriticalSection;
        hEvent:Cardinal;
        FList:TList;
        FProcessWork:TProcessWork;
        procedure ProcessWork(Work:TWorkItem);
        function GetWork(var AWork:TWorkItem):Boolean;
      protected
        procedure Execute;override;
      public
        procedure AddWork(AWork:TWorkItem);
        constructor Create;
        destructor Destroy; override;
        property OnProcessWork:TProcessWork read FProcessWork write FProcessWork;
      end;

    implementation

    {TWorkThread}

    constructor TWorkThread.Create;
    begin
      InitializeCriticalSection(FCriticalSection);
      hEvent:=CreateEvent(nil,False,False,nil);
      FList:=TList.Create;
      Self.FreeOnTerminate:=False;
      inherited Create(False);
    end;

    destructor TWorkThread.Destroy;
    var
      i:Integer;
    begin
      for i:=FList.Count-1 downto 0 do TWorkItem(FList.Items[i]).Free;
      DeleteCriticalSection(FCriticalSection);
      FList.Free;
      CloseHandle(hEvent);
    end;

    function TWorkThread.GetWork(var AWork:TWorkItem):Boolean;
    begin
      Result:=False;
      EnterCriticalSection(FCriticalSection);
      try
        if FList.Count>0 then
        begin
          AWork:=TWorkItem(FList.Items[0]);
          FList.Delete(0);
          Result:=True;
        end;
      finally
        LeaveCriticalSection(FCriticalSection);
      end;
    end;

    procedure TWorkThread.Execute;
    var
      Work:TWorkItem;
    begin
      while not Self.Terminated do
      begin
        WaitForSingleObject(hEvent,INFINITE);
        while GetWork(Work) do
        begin
          ProcessWork(Work);
          Work.Free;
        end;
      end;
    end;

    procedure TWorkThread.ProcessWork(Work:TWorkItem);
    begin
      if Assigned(FProcessWork) then FProcessWork(Self,Work);
    end;

    procedure TWorkThread.AddWork(AWork:TWorkItem);
    begin
      EnterCriticalSection(FCriticalSection);
      try
        FList.Add(AWork);
      finally
        LeaveCriticalSection(FCriticalSection);
      end;
      SetEvent(hEvent);
    end;

    end.
  • 相关阅读:
    Linux 创建sftp用户并限制目录权限
    idea操作maven时控制台中文显示乱码/maven项目启动方式
    Docker 容器镜像删除
    Golang 在 Mac、Linux、Windows 下如何交叉编译
    Linux后台运行Jar方法
    MAC安装JDK及环境变量配置
    Docker 容器镜像删除
    UnicodeEncodeError: 'ascii' codec can't encode characters in position 0-2: ordinal not in range(128)
    《设计模式之禅》之状态模式
    《设计模式之禅》之访问者模式
  • 原文地址:https://www.cnblogs.com/jxgxy/p/2796822.html
Copyright © 2011-2022 走看看