自定义博客皮肤VIP专享

*博客头图:

格式为PNG、JPG,宽度*高度大于1920*100像素,不超过2MB,主视觉建议放在右侧,请参照线上博客头图

请上传大于1920*100像素的图片!

博客底图:

图片格式为PNG、JPG,不超过1MB,可上下左右平铺至整个背景

栏目图:

图片格式为PNG、JPG,图片宽度*高度为300*38像素,不超过0.5MB

主标题颜色:

RGB颜色,例如:#AFAFAF

Hover:

RGB颜色,例如:#AFAFAF

副标题颜色:

RGB颜色,例如:#AFAFAF

自定义博客皮肤

-+

  • 博客(0)
  • 资源 (18)
  • 收藏
  • 关注

空空如也

IOCP 完成端口 简单通信实例

该资源是Delphi7写的一个IOCP简单例子,例子主要目的是理解IOCP,没有过的的封装,便于初学者学习和理解IOCP到底是怎么一回事,是怎么实现网络通信的。 嘿哥博客:http://www.cnblogs.com/Herge/

2016-06-22

intraweb11.0.63破解 for delphi7

本资源来自互联网,整理后上传,本资源仅供学习使用,请勿作用商业用途 delphi开发网站,似乎14年开始intraweb很火 于是果断开始研究intraweb,做了几个demo,感觉吊炸天呀! 1、卸载之前的intraweb(install package里面先删除intraweb控件) 2、复杂文件末尾的bat代码,制作删除控件的bat 3、运行iw11.0.63.exe安装intraweb 4、IW11063\下的文件替换到刚才安装的intraweb目录下面

2016-03-25

iw11.0.63 破解 for delphi7

1、卸载之前的intraweb版本 2、运行iw11.0.63.exe安装intraweb 3、用Crack下的所有文件替换到刚才安装的intraweb的 LibD7目录下面 本资源来自互联网,整理后上传,本资源仅供学习使用,请勿作用商业用途

2016-03-24

delphi 远程桌面代码

通过注册微软的mstsc组件,调用系统的远程,实现远程桌面,可以通过写代码保存N多服务器远程,自由控制 RDPClient.Server := '192.168.1.2'; //RDPClient.AdvancedSettings2.RDPPort := 3389; RDPClient.UserName := 'administrator'; RDPClient.AdvancedSettings2.ClearTextPassword := 'PWD'; RDPClient.ConnectingText := 'IP'; 详情请看源码

2016-01-15

adobe pdf 添加书签

用adobe打开pdf的时候总是默认打开第一页不能记忆上次阅读位置,自己写程序就是为了方便,所以想办法自己做了一个自己使用的专属pdf阅读器,支持添加书签功能,其他拓展功能等待其他高手。 本pdf阅读器实现书签的思路是利用句柄遍历获取Edit里面的当前页数再想办法保存到文件,详情可以查看源码,源码里面是用来pdf的active控件,需要的可以在百度里面搜索【delphi开发pdf阅读器】 看下pdf的控件如何安装。本人菜鸟,希望高手勿喷。

2015-03-31

xe5破解程序

本破解文件只可用于个人研究交流使用,不得做商业用途,请在试用后的24小时内删除破解文件,还原软件试用状态。如果您觉得RAD Studio XE5还不错的话,请通过正规渠道购买正版软件,谢谢!破解前先关闭杀毒软件,会提示软件不安全,暂停杀毒软件即可,不然可能导致破解不成功,本文来自互联网 http://www.52pojie.cn/thread-215523-1-1.html

2015-03-11

RemObjectsDataAbstract_v4.0.19.565

Data Abstract,基于得奖的RemObjects SDK之上,是一个创新的框架,用于创建强大并且可伸缩的多级数据库解决方案。利用它的交叉平台功能,以及从应用代码抽象细节和基础数据库的差别的能力,Data Abstract使您更加容易的建立访问多个不同数据库的应用。先进的工具如Schema Modeler并与开发环境紧密集成,使它利用快速应用开发(RAD)方法简单地建立复杂的数据库访问。优化的连接和断开应用设计,Data Abstract允许您建立性能优越应用,即使有带宽和连接数限制的快速以太网内,如一个移动设备。 核心特征 ·建立可伸缩的多级交叉平台数据库应用,支持.NET, Mono和Win32; ·目标不同的数据库后端使用一个通用的代码基础; ·使用Schema Modeler设计您的数据的接口; ·利用新的wizards和IDE增强功能比以前更加简单的建立DA应用; 主要特征 ·完成不同数据库的抽象:不同的数据库如Microsoft SQL Server、InterBase、Oracle、MySQL、DBISAM、DB/2使用相同的代码; ·用无级焦点建立您的应用,最大伸缩性和无缝群集成; ·立即,按需,分页或任何这些组合的流数据; ·自动地再同步域,并支持远程数据; ·用更新规则设计复杂的更新序列,不需要任何一行代码; ·增强的商业处理器给您更多地控制您的商业更新; ·交叉数据自动增量和基于生成器的域支持; ·与自动生成的SQL或专有语法一起使用,无论执行或访问RDBMS具体特征要求; ·完全支持无级主/从传输更新; ·更新规则:创建复杂的更新序列而不要求一行代码; ·用创新的RAD方式Schema Modeler设计您的数据访问层; ·利用Data Abstract的宏处理器最小化SQL语法; ·容易的创建您自有的数据驱动; ·支持规则表达式,用于客户端数据验证; ·无需部署许可;

2014-04-24

AOC_iMenu屏幕亮度调整

AOC的显示器没有按钮调整亮度什么的,可以下载这个iMenu 软件控制亮度,安装后面板上进行控制就行,简单易用。本软件来自互联网。

2014-04-24

Hydra demo

自己用Hydra 做的插件例子,适合入门

2014-04-18

ASP_NET_MVC3中文版教程.

第四节 添加一个模型 在本节中我们将追加一些类来管理数据库中的电影。这些类将成为我们的MVC应用程序中的“模型”部分。 我们将使用一个.NET Framework的被称之为“Entity Framework”的数据访问技术来定义这些模型类,并使用这些类来进行操作。Entity Framework(通常被简称为“EF”)支持一个被称之为“code-first”的开发范例。Code-first允许你通过书写一些简单的类来创建模型对象。你可以通过访问这些类的方式来访问数据库,这是一种非常方便快捷的开发模式。 4.1 利用NuGet来安装EFCodeFirst 我们可以利用NuGet包管理器(安装ASP.NET MVC3时会自动安装)来把EFCodeFirst类库添加到我们的MvcMovie工程中。这个类库使得我们可以直接使用code-first。点击“工具”菜单下的“Library Package Manager”子菜单下的“Add Library Package Reference”菜单选项,如图4-1所示。 图4-1 使用NuGet包管理器 点击“Add Library Package Reference”菜单选项后,将会弹出一个对话框,标题为“Add Library Package Reference”,如图4-2所示。 图4-2 “Add Library Package Reference”对话框 默认状态下,左边的“All”选项处于选择状态。因为还没有安装任何包,所以右边面板中显示“找不到任何项”。点击左边面板中的“online”选项,NuGet包管理器将会在服务器上检索所有当前能够获取的包,如图4-3所示。 图4-3 NuGet包管理器正在检索包信息 服务器上有几百个当前能够获取的包,现在我们只关注EFCodeFirst包。在右上角的搜索输入框中输入“EFCode”。在检索结果中,选择EFCodeFirst包,并且点击Install按钮安装包,如图4-4所示。

2014-04-18

AJAX企业级开发

AJAX企业级开发宝典,Pdf显示不好复制上来,下载慢慢看吧

2014-04-18

pdf-pdg-wdl三类文件阅读器

pdf-pdg-wdl三类文件阅读器 三种格式都可以打开 不可多得的好软件。

2014-04-18

RemObjects Hydra - 3.2.39.777

delphi RemObjects Hydra 是基于RO的软件,通过 Hydra 可以快速开发插件项目,该版本是破解版,勿做商业用途,否则后果自负。

2014-04-18

Delphi.COM深入编程

Delphi.COM深入编程

2014-04-18

Delphi7编程技巧与实例精解.pdf

不做过多的介绍,现在delphi的资料太少,下载看看就知道。

2014-04-18

Delphi 线程池

在外国网站搜下来的线程池 压缩包里面有demo {** * ThreadPool is a abstract class framework for creating specialized * pool of workers (TPoolWorker, separate threads) which are managed * by a manager (TPoolManager, also a thread) * * * License * * The contents of this file are subject to the Mozilla Public License * Version 1.1 (the "License"); you may not use this file except in * compliance with the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the * License for the specific language governing rights and limitations * under the License. * * The Original Code is ThreadPool.pas * * The Initial Developer of the Original Code is Waldemar Derr. * Portions created by Waldemar Derr are Copyright (C) 2010 Waldemar Derr. * All Rights Reserved. * * * Change log * * 1.0.6 / 2011-01-27 * - TPoolManager.DispatchOwnerDestroyed is now atomic * * 1.0.5 / 2011-01-13 * - TThreadProcedures introduced for thread safe transport of TThreadProcedure * - Some synchronizations between the manager and his workers * - New class method TThreadManager.TerminateSingletonInstances for sure termination of * all managers and his workers * * 1.0.4 / 2011-01-05 * - TPoolWorker.DoneTask parameter changed to Successful:Boolean * * 1.0.3 / 2010-12-31 (I wish you a successful new year ;-) * - Revised termination synchronization between the manager and his workers * Is much safer and faster now, because the MREW sync is not obtained from * the thread context of the worker. * - Code rationalization * Lesser locks and code with the same functionality * * 1.0.2 / 2010-12-28 * - Support for named threads (if the conditional symbol DEBUG is defined) * - Task sort optimized * - "Execution Loop" concept is introduced in TPoolThread * - CodeSite integration * - Some bugfix and code reorganization * * 1.0.1 / 2010-12-16 * - Priorities for tasks and their handling in manager implemented * - Some optimizing * * 1.0.0 / 2010-12-14 * - First release * - Working successful and exactly as designed in examples * * * @author Waldemar Derr <[email protected]> * @version $Id: ThreadPool.pas 52 2011-01-28 10:14:32Z WladiD $ *} unit ThreadPool; interface {$INCLUDE Compile.inc} uses SysUtils, Generics.Defaults, Generics.Collections, Contnrs, SyncObjs, Windows, Classes, Forms {$IFDEF CODE_SITE} , CodeSiteLogging {$ENDIF}; const Version = '1.0.6'; type {** * Class forward declarations *} TPoolTask = class; TPoolWorker = class; TPoolManager = class; {** * Class type declarations *} TPoolTaskClass = class of TPoolTask; TPoolWorkerClass = class of TPoolWorker; TPoolManagerClass = class of TPoolManager; {** * Derived generic list types *} TWorkerList = TObjectList<TPoolWorker>; TTaskList = TObjectList<TPoolTask>; {** * Enumeration of pissible states of a task * * @see TPoolTask *} TTaskState = (tsUnknown, tsInWork, tsError, tsSuccess); {** * Enumeration for common priorities of a task * * @see TPoolTask.Priority *} TTaskPriority = ( tpLowest = 0, tpLower = 1, tpLow = 2, tpNormal = 3, tpHigh = 4, tpHigher = 5, tpHighest = 255, tpCustom = -1); {** * Enumeration of possible states of a worker * * @see TPoolWorker *} TWorkerState = (wsReady, wsBusy, wsTaskDone); {** * Anonymous method for a task * * Compatible to TPoolTask.IsTheSame *} TTaskFunc = reference to function(Task:TPoolTask):Boolean; {** * Status event * * @param Progress Float value between 0 and 1. 1 = 100% = Complete. *} TStatusEvent = reference to procedure(Sender:TObject; Progress:Single); TManagerProc = TProc<TPoolManager>; {** * Anonymous notify event, which is compatible with commonly used TNotifyEvent *} TAnonymousNotifyEvent = reference to procedure(Sender:TObject); {** * TPoolTask represent a dual data holder * * Derived task classes can add further input fields and also any output fields. * But what are input and what are output fields? * This is answered by your implementation of the correspondig TPoolWorker. *} TPoolTask = class(TObject) private {** * As long as the task is processed, the reference of the worker stays here * * This info is set and required only by the manager, don't access it from workers at all. *} FProcessingBy:TPoolWorker; function GetPriority:TTaskPriority; procedure SetPriority(Priority:TTaskPriority); protected FOwner:TObject; FOnStart:TAnonymousNotifyEvent; FOnCancel:TAnonymousNotifyEvent; FOnDone:TAnonymousNotifyEvent; FState:TTaskState; FPriority:Byte; class function Compare(const Left, Right:TPoolTask):Integer; virtual; procedure Assign(Source:TPoolTask); virtual; function IsTheSame(Compare:TPoolTask):Boolean; virtual; {** * Both, Priority and PriorityRaw, sets the same field for the priority of the task * * The higher the priority the sooner it's taked for processing, if not all tasks * can be processed at the same time. * * PriorityRaw is introduced for purposes, where you need a finer resolution (range of byte) * Priority is comfortable, but allows only 7 common priorities through a enumeration * * Publish one of them in your derived task, if you need it. * * You must also enable the property SortTasks (disabled by default) in the corresponding * derived manager. * * @see TPoolManager.SortTasks *} property Priority:TTaskPriority read GetPriority write SetPriority; property PriorityRaw:Byte read FPriority write FPriority; public constructor Create(Owner:TObject); virtual; function Clone:TPoolTask; property Owner:TObject read FOwner; property State:TTaskState read FState; {** * Generic event, which is fired, if the processing of the task is started *} property OnStart:TAnonymousNotifyEvent read FOnStart write FOnStart; {** * Generic event, which is fired, if the task is canceled *} property OnCancel:TAnonymousNotifyEvent read FOnCancel write FOnCancel; {** * Generic event, which is fired, if the task is done and was not canceled *} property OnDone:TAnonymousNotifyEvent read FOnDone write FOnDone; end; TThreadProcedures = class; {** * TPoolThread contains only the intersected structures/functionality of TPoolWorker and * TPoolManager and act as the base class for them. * * The Execute method is full implemented and should be not overriden by descendants, instead * a simple "Execution Loop" concept is introduced there: * - InitializeExecutionLoop is executed once before the loop * - ExecutionLoop is so long executed in loop as ExecutionLoopCondition returns TRUE. * But each run of the loop requires a signal on MainSignal (see method TriggerMainSignal). * - If ExecutionLoopCondition returns FALSE, the loop will be breaked and FinalizeExecutionLoop * is called finally. * * Don't create any instances of this class! *} TPoolThread = class(TThread) private FMainSignal:TEvent; FInExecutionLoop:Boolean; function GetSleeping:Boolean; protected procedure ExecutionLoopInitialize; virtual; abstract; function ExecutionLoopCondition:Boolean; virtual; procedure ExecutionLoop; virtual; abstract; procedure ExecutionLoopFinalize; virtual; abstract; procedure Execute; override; procedure TriggerMainSignal; property MainSignal:TEvent read FMainSignal; {** * Says, whether this thread is currently in active execution. It's FALSE, if it waits for * the signal (MainSignal) *} property InExecutionLoop:Boolean read FInExecutionLoop; public constructor Create(CreateSuspended:Boolean); destructor Destroy; override; procedure Terminate; reintroduce; virtual; {** * Says, whether this thread is currently sleeping. * It's TRUE, if it waits for the signal (MainSignal). *} property Sleeping:Boolean read GetSleeping; end; {** * TPoolWorker is our workhorse and should do the work to complete a task * * This implementation contains all needed mechanisms for interacting with the corresponding * TPoolManager. * * Of course, here are no code for doing the whole work. This must be implemented in * ExecuteTask by the derived class. *} TPoolWorker = class(TPoolThread) private {$IFDEF CODE_SITE} FWorkerIndex:Integer; {$ENDIF} FOwner:TPoolManager; FState:TWorkerState; FCanceled:Boolean; FProcessTasks:TTaskList; {$IFDEF CODE_SITE} property WorkerIndex:Integer read FWorkerIndex; {$ENDIF} property ProcessTasks:TTaskList read FProcessTasks; protected FContextTask:TPoolTask; procedure FireEvent(FireEventProc:TProc<TPoolTask>; HasEventFunc:TTaskFunc); procedure InitializeTask(SameTasks:TTaskList); {** * ExecuteTask is the right place to implement the main work * * You have to use the property ContextTask for do the job. * * It's important to call the DoneTask method with a corresponding value in any case, * if the task is done. * * As running condition they should check for the property Canceled, not for Terminated. * * For example: * - On error: DoneTask(FALSE); * - On success: DoneTask(TRUE); *} procedure ExecuteTask; virtual; abstract; procedure DoneTask(Successful:Boolean); procedure ExecutionLoopInitialize; override; procedure ExecutionLoop; override; procedure ExecutionLoopFinalize; override; procedure Cancel; property Owner:TPoolManager read FOwner; property Canceled:Boolean read FCanceled; property ContextTask:TPoolTask read FContextTask; public constructor Create(Owner:TPoolManager); virtual; destructor Destroy; override; procedure Terminate; override; property State:TWorkerState read FState write FState; end; {** * TPoolManager is the key class of the whole concept. It's almost full implemented. * Derived managers must only implement the class method WorkerClass. * For more comfort it's recommended to reintroduce the class method Singleton. * Nothing more is needed, but you can introduce new methods for easier tasks handling. * * @see TPoolManager.WorkerClass * @see TPoolManager.Singleton * * Singleton pattern * ----------------- * * Because it makes no sense, to hold any instances of the manager, the singleton pattern was * choosed for rich features (e.g. Demand mode). * * To access the manager you should call always the class method Singleton on the derived * manager class, which always return a valid instance of the corresponding class. * On the first call it creates and starts the manager thread and you are instantly able, * to add your tasks. * * Of course you are able to instantiate many instances manually, but this is not a part of * concept and the behaviour isn't tested. * * @see TPoolManager.Singleton * * Concurrent workers * ------------------ * * Each manager is able to manage a amount of workers (TPoolWorker) for processing the added * tasks. The workers are created only on demand. Each worker get's the next task from the * task queue, after it has done their current one. If there are no further tasks in the queue, * all sleeping workers are terminated automatically. But this behaviour is influenced by the * property SpareWorkersCount. * * @see TPoolManager.ConcurrentWorkersCount * * Spared workers * -------------- * * You can define a amount of workers, which are not terminated automatically, unless you * decrease the property SpareWorkersCount or terminate the manager manually. This is usefull * for often small tasks. * * The "Demand mode" is disabled, if you define more than 0 SpareWorkersCount. * * @see TPoolManager.SpareWorkersCount * * Demand mode * ----------- * * By default a single instance/thread for each derived TPoolManager class is created by the * first call of the class method Singleton and resist, until your application is closed or * you manually terminate it. * * This bahavior can be changed, by simple passing an "init" procedure, before the first call * of Singleton is done. If you do that, the manager terminates himself automatically, if all * added tasks are done or get canceled. The property SpareWorkersCount must be zero (0), * otherwise the demand mode can't be activated. * * @see TPoolManager.RegisterSingletonOnDemandProc *} TPoolManager = class(TPoolThread) private {** * I dont't like to waste the global namespace with types, which are only locally required *} type TTaskComparer = TDelegatedComparer<TPoolTask>; TOwner = class public Owner:TObject; TasksTotalCount:Integer; TasksDoneCount:Integer; OnTasksStatus:TStatusEvent; OnTasksComplete:TAnonymousNotifyEvent; end; TOwnerList = TObjectList<TOwner>; TOwnersAssign = class ManagerClass:TPoolManagerClass; Owners:TOwnerList; end; TDemandProcAssign = class ManagerClass:TPoolManagerClass; DemandProc:TManagerProc; end; {** * Private section for class related stuff *} private class var FSingleInstances:array of TPoolManager; FDemandProcs:array of TDemandProcAssign; FStoredOwners:array of TOwnersAssign; {$IFNDEF COMPILER_15_UP} FCPUCount:Cardinal; // Is already stored in a TThread field since Delphi XE {$ENDIF} class function GetDemandProcIndex(ReturnOnFreeIndex:Boolean = FALSE):Integer; class function GetCPUCount:Integer; {** * Private section for object related stuff *} private FOwners:TOwnerList; FOwnersDoneList:TObjectList; FContextProcedures:TThreadProcedures; FDemandMode:Boolean; FComparer:TTaskComparer; FTasksSorted:Boolean; FDynamicTerminateEnabled:Boolean; FWorkers:TWorkerList; FTasks:TTaskList; FTasksLock:TMultiReadExclusiveWriteSynchronizer; FConcurrentWorkersCount:Integer; FSpareWorkersCount:Integer; function GetOwner(Owner:TObject; AutoAdd:Boolean = TRUE):TOwner; procedure UnregisterOwner(Owner:TObject); procedure OwnerAddTasksCount(Owner:TObject; AddTotalCount, AddDoneCount:Integer; FireEvents:Boolean = TRUE); procedure AddOwnerDone(Owner:TObject); procedure StoreOwners; procedure SetSortTasks(SortTasks:Boolean); function GetSortTasks:Boolean; property Owners:TOwnerList read FOwners; {** * @see TPoolManager.RegisterSingletonOnDemandProc *} property DemandMode:Boolean read FDemandMode; {** * Protected section for class related stuff *} protected class destructor Destroy; class procedure SingletonTerminateGate(Sender:TObject); {** * WorkerClass should return the class of the corresponding TPoolWorker * * This is the one and only method, which you _must_ implement in any derived manager. * * Example: * <code> * TMyManager = class(TPoolManager) * protected * class function WorkerClass:TPoolWorkerClass; override; * end; * * implementation * * class function TMyManager.WorkerClass:TPoolWorkerClass; * begin * Result:=TMyWorker; * end; * </code> *} class function WorkerClass:TPoolWorkerClass; virtual; abstract; {** * Protected section for object related stuff *} protected procedure BeginReadTasks; procedure EndReadTasks; function BeginWriteTasks:Boolean; procedure EndWriteTasks; function GetTaskIndex(State:TTaskState; StartIndex:Integer):Integer; function GetSameTaskIndex(CompareTask:TPoolTask; StartIndex:Integer):Integer; function CreateWorker:TPoolWorker; virtual; procedure CustomTaskCancel(CompareFunction:TTaskFunc); function CustomTaskExists(CompareFunction:TTaskFunc):Boolean; function CustomTaskCounter(CompareFunction:TTaskFunc):Integer; procedure WorkerTerminated(TerminatedWorker:TPoolWorker); virtual; procedure WorkerTaskDone(DoneWorker:TPoolWorker; WorkerState:TWorkerState); virtual; procedure ExecutionLoopInitialize; override; function ExecutionLoopCondition:Boolean; override; procedure ExecutionLoop; override; procedure ExecutionLoopFinalize; override; procedure SetConcurrentWorkersCount(ConcurrentWorkersCount:Integer); procedure SetConcurrentWorkersCountPerCPU(ConcurrentWorkersCountPerCPU:Integer); procedure SetSpareWorkersCount(SpareWorkersCount:Integer); procedure SetSpareWorkersCountPerCPU(SpareWorkersCountPerCPU:Integer); property Workers:TWorkerList read FWorkers; property Tasks:TTaskList read FTasks; {** * Defines, whether the tasks should be sorted, before the next is picked for processing * * How the tasks are sorted, must be implemented in the class method TPoolTask.Compare. * If you need such sorting mechanism, you must set this property to TRUE in the * derived constructor. * * @see TPoolTask.Compare * @default FALSE *} property SortTasks:Boolean read GetSortTasks write SetSortTasks; property ContextProcedures:TThreadProcedures read FContextProcedures; {** * Class related public section *} public class function Singleton:TPoolManager; class function HasSingleton:Boolean; class procedure TerminateSingletonInstances(Wait:Boolean = TRUE); class procedure RegisterSingletonOnDemandProc(DemandProc:TManagerProc); class function HasSingletonOnDemandProc:Boolean; class procedure UnregisterSingletonOnDemandProc; class procedure DispatchOwnerDestroyed(Owner:TObject); {** * Object related public section *} public constructor Create; virtual; destructor Destroy; override; procedure Terminate; override; procedure AddTask(Task:TPoolTask); virtual; procedure CancelAllTasks; procedure CancelTasksByOwner(Owner:TObject); procedure CancelTasksBySame(Task:TPoolTask); function TaskExists(Task:TPoolTask):Boolean; function TasksCountByOwner(Owner:TObject):Integer; procedure RegisterOwner(Owner:TObject; OnTasksStatus:TStatusEvent; OnTasksComplete:TAnonymousNotifyEvent); function RestoreOwners:Boolean; {** * Defines, how many worker threads (derived from TPoolWorker) are at the same time allowed * * @default 8 *} property ConcurrentWorkersCount:Integer read FConcurrentWorkersCount write SetConcurrentWorkersCount; {** * Defines, how many workers for each CPU are at the same time allowed * This is a write only property. To determine, how many workers are indeed defined, * see ConcurrentWorkersCount. If a value is lower than 1, 2 is assigned. * * @see TPoolManager.ConcurrentWorkersCount *} property ConcurrentWorkersCountPerCPU:Integer write SetConcurrentWorkersCountPerCPU; {** * Defines, how many worker threads should be spared * * The manager terminate workers, which are in the State wsReady. * With this property you are able to define a amount of sleeping workers that are not * terminated. This is useful for tasks which are done often, but their execution is fast. * In such cases the creation of a new thread costs more CPU cycles than the Execute method. * * This value should be lower than or equal to ConcurrentWorkersCount. * * @default 0 *} property SpareWorkersCount:Integer read FSpareWorkersCount write SetSpareWorkersCount; {** * Defines, how many workers for each CPU should be spared * This is a write only property. To determine, how many spared workers are indeed defined, * see SpareWorkersCount. If a value is lower than 1, 2 is assigned. * * @see TPoolManager.SpareWorkersCount *} property SpareWorkersCountPerCPU:Integer write SetSpareWorkersCountPerCPU; end; TThreadProcedures = class private type TThreadProcedureArray = array of TThreadProcedure; var FProcedures:TThreadProcedureArray; {$IFDEF USE_SPIN_LOCK} FProceduresLock:TSpinLock; {$ELSE} FProceduresLock:TCriticalSection; {$ENDIF} FChangedSignal:TEvent; FOwnChangedSignal:Boolean; public constructor Create(ForeignChangedSignal:TEvent = nil); destructor Destroy; override; procedure Add(ThreadProcedure:TThreadProcedure); function Execute:Integer; property ChangedSignal:TEvent read FChangedSignal; end; implementation {** TPoolTask **} constructor TPoolTask.Create(Owner:TObject); begin FOwner:=Owner; FState:=tsUnknown; Priority:=tpNormal; end; {** * Getter for the property Priority *} function TPoolTask.GetPriority:TTaskPriority; begin case FPriority of Ord(tpLowest): Result:=tpLowest; Ord(tpLower): Result:=tpLower; Ord(tpLow): Result:=tpLow; Ord(tpNormal): Result:=tpNormal; Ord(tpHigh): Result:=tpHigh; Ord(tpHigher): Result:=tpHigher; Ord(tpHighest): Result:=tpHighest; else Result:=tpCustom; end; end; {** * Determine, whether the passed task is the same as the current instance * * The manager checks every time, before they start a new task, whether there are other * "same" tasks in the queue and initialize the worker with a bunch at once. *} function TPoolTask.IsTheSame(Compare: TPoolTask): Boolean; begin Result:=FALSE; end; procedure TPoolTask.SetPriority(Priority:TTaskPriority); begin Assert(Priority <> tpCustom, 'The priority "tpCustom" can''t be assigned.'); FPriority:=Ord(Priority); end; {** * Assigns data from other task * * The Assign method should only assign events and fields, which are required for doing the task, * no results. *} procedure TPoolTask.Assign(Source:TPoolTask); begin PriorityRaw:=Source.PriorityRaw; OnDone:=Source.OnDone; OnStart:=Source.OnStart; OnCancel:=Source.OnCancel; end; {** * Creates a new instance of the task *} function TPoolTask.Clone:TPoolTask; begin Result:=TPoolTaskClass(ClassType).Create(Owner); Result.Assign(Self); end; {** * Compares two tasks * * Compare is used for sorting the tasks. This method considers only the priority, * but can be overriden by a derived task. * * @see TPoolTask.Priority * @see TPoolManager.SortTasks *} class function TPoolTask.Compare(const Left, Right:TPoolTask):Integer; begin Result:=Right.FPriority - Left.FPriority; end; {** TPoolThread **} constructor TPoolThread.Create(CreateSuspended:Boolean); begin inherited Create(CreateSuspended); FMainSignal:=TEvent.Create(nil, FALSE, FALSE, ''); end; destructor TPoolThread.Destroy; begin FreeAndNil(FMainSignal); inherited Destroy; end; function TPoolThread.GetSleeping:Boolean; begin Result:=not InExecutionLoop; end; procedure TPoolThread.TriggerMainSignal; begin MainSignal.SetEvent; end; procedure TPoolThread.Execute; begin {$IFDEF DEBUG} NameThreadForDebugging(AnsiString(ClassName)); {$ENDIF} {$IFDEF CODE_SITE} if Self is TPoolWorker then CodeSiteManager.SetCurrentThreadName(Format('%s #%d', [ClassName, TPoolWorker(Self).WorkerIndex])) else CodeSiteManager.SetCurrentThreadName(ClassName); {$ENDIF} {** * This is the whole secret of the "Execution Loop" concept *} ExecutionLoopInitialize; try while ExecutionLoopCondition do begin MainSignal.WaitFor(INFINITE); FInExecutionLoop:=TRUE; try {$IFDEF CODE_SITE} CodeSite.AddSeparator; {$ENDIF} ExecutionLoop; finally FInExecutionLoop:=FALSE; end; end; finally ExecutionLoopFinalize; end; end; function TPoolThread.ExecutionLoopCondition:Boolean; begin Result:=not Terminated; end; procedure TPoolThread.Terminate; begin inherited Terminate; TriggerMainSignal; end; {** TPoolWorker **} constructor TPoolWorker.Create(Owner:TPoolManager); begin inherited Create(FALSE); FOwner:=Owner; FProcessTasks:=TTaskList.Create(FALSE); FreeOnTerminate:=TRUE; end; destructor TPoolWorker.Destroy; begin FContextTask.Free; FProcessTasks.Free; inherited Destroy; end; procedure TPoolWorker.ExecutionLoopInitialize; begin end; procedure TPoolWorker.ExecutionLoop; begin {$IFDEF CSW_EXECUTION_LOOP} CodeSite.EnterMethod(Self, 'ExecutionLoop'); {$ENDIF} try if Assigned(ContextTask) and (State = wsBusy) then begin FireEvent( procedure(Task:TPoolTask) begin Task.OnStart(ContextTask); end, function(Task:TPoolTask):Boolean begin Result:=Assigned(Task.OnStart); end); {$IFDEF CSW_EXECUTE_TASK} CodeSite.EnterMethod(Self, 'ExecuteTask'); {$ENDIF} ExecuteTask; {$IFDEF CSW_EXECUTE_TASK} CodeSite.ExitMethod(Self, 'ExecuteTask'); {$ENDIF} end; finally FCanceled:=FALSE; end; {$IFDEF CSW_EXECUTION_LOOP} CodeSite.ExitMethod(Self, 'ExecutionLoop'); {$ENDIF} end; procedure TPoolWorker.ExecutionLoopFinalize; begin {$IFDEF CSW_EXECUTION_LOOP_FINALIZE} CodeSite.EnterMethod(Self, 'FinalizeExecutionLoop'); {$ENDIF} Owner.WorkerTerminated(Self); {$IFDEF CSW_EXECUTION_LOOP_FINALIZE} CodeSite.SendNote('Worker is on the way for termination'); CodeSite.ExitMethod(Self, 'FinalizeExecutionLoop'); {$ENDIF} end; procedure TPoolWorker.FireEvent(FireEventProc:TProc<TPoolTask>; HasEventFunc:TTaskFunc); var FireEventTasks:TTaskList; SynchronizeProc:TThreadProcedure; cc:Integer; HasHasEventFunc:Boolean; function IsTaskValid(Task:TPoolTask):Boolean; begin Result:=Owner.Tasks.IndexOf(Task) >= 0; end; begin SynchronizeProc:=nil; HasHasEventFunc:=Assigned(HasEventFunc); FireEventTasks:=TTaskList.Create(TRUE); try Owner.BeginReadTasks; try for cc:=0 to ProcessTasks.Count - 1 do if IsTaskValid(ProcessTasks[cc]) and ( not HasHasEventFunc or ( HasHasEventFunc and HasEventFunc(ProcessTasks[cc]) ) ) then FireEventTasks.Add(ProcessTasks[cc].Clone); if FireEventTasks.Count > 0 then begin SynchronizeProc:=procedure var cc:Integer; begin for cc:=0 to FireEventTasks.Count - 1 do FireEventProc(FireEventTasks[cc]); end; end; finally Owner.EndReadTasks; end; if Assigned(SynchronizeProc) then Synchronize(SynchronizeProc); finally FireEventTasks.Free; {** * Prevent memory leaks *} FireEventProc:=nil; HasEventFunc:=nil; SynchronizeProc:=nil; end; end; {** * Conditions: * - This method should be called only by manager and also only from their thread context * - The passed list should never be empty * - The tasks in the list must have as State = tsInWork *} procedure TPoolWorker.InitializeTask(SameTasks:TTaskList); {$IFNDEF COMPILER_15_UP} procedure AddProcessTasks; var cc:Integer; begin for cc:=0 to SameTasks.Count - 1 do FProcessTasks.Add(SameTasks[cc]); end; {$ENDIF} begin if Assigned(FContextTask) then FreeAndNil(FContextTask); FProcessTasks.Clear; if SameTasks.Count > 1 then {$IFDEF COMPILER_15_UP} FProcessTasks.AddRange(SameTasks) // This will not work on Delphi 2010: compiler error {$ELSE} AddProcessTasks {$ENDIF} else FProcessTasks.Add(SameTasks[0]); {** * The context task is always a clone of the first task *} FContextTask:=SameTasks[0].Clone; ContextTask.FOwner:=Self; State:=wsBusy; TriggerMainSignal; end; {** * This method must be called after the processing of a task was done, indifferent, whether it was * canceled or not, it must always called ! * * @see TPoolWorker.ExecuteTask *} procedure TPoolWorker.DoneTask(Successful:Boolean); var DoneState:TWorkerState; begin {$IFDEF CSW_DONE_TASK} CodeSite.EnterMethod(Self, 'DoneTask'); {$ENDIF} if not Canceled then begin try if Successful then ContextTask.FState:=tsSuccess else ContextTask.FState:=tsError; FireEvent( procedure(DoneTask:TPoolTask) begin DoneTask.OnDone(ContextTask); end, function(DoneTask:TPoolTask):Boolean begin Result:=Assigned(DoneTask.OnDone); end); finally DoneState:=wsTaskDone; end; end else begin DoneState:=wsReady; {$IFDEF CSW_DONE_TASK} CodeSite.SendWarning('Canceled'); {$ENDIF} end; {** * Signal the manager, that we have done our task *} Owner.WorkerTaskDone(Self, DoneState); {$IFDEF CSW_DONE_TASK} CodeSite.ExitMethod(Self, 'DoneTask'); {$ENDIF} end; procedure TPoolWorker.Terminate; begin Cancel; inherited Terminate; end; procedure TPoolWorker.Cancel; begin if not Canceled then FCanceled:=TRUE; end; {** TPoolManager **} class destructor TPoolManager.Destroy; var cc:Integer; begin for cc:=0 to Length(FDemandProcs) - 1 do if Assigned(FDemandProcs[cc]) then begin FDemandProcs[cc].DemandProc:=nil; // prevent a possible memory leak FDemandProcs[cc].Free; end; FDemandProcs:=nil; for cc:=0 to Length(FStoredOwners) - 1 do if Assigned(FStoredOwners[cc]) then begin if Assigned(FStoredOwners[cc].Owners) then FStoredOwners[cc].Owners.Free; FStoredOwners[cc].Free; end; FStoredOwners:=nil; end; constructor TPoolManager.Create; begin {** * The manager should start immediately (Suspended = FALSE) *} inherited Create(FALSE); FWorkers:=TWorkerList.Create(FALSE); FTasks:=TTaskList.Create(TRUE); FOwners:=TOwnerList.Create(TRUE); FOwnersDoneList:=TObjectList.Create(FALSE); FConcurrentWorkersCount:=8; FSpareWorkersCount:=0; FTasksLock:=TMultiReadExclusiveWriteSynchronizer.Create; FContextProcedures:=TThreadProcedures.Create(MainSignal); FreeOnTerminate:=TRUE; end; destructor TPoolManager.Destroy; begin FTasks.Free; FWorkers.Free; FOwners.Free; FOwnersDoneList.Free; SortTasks:=FALSE; // Destroy the comparer FTasksLock.Free; FContextProcedures.Free; inherited Destroy; end; procedure TPoolManager.AddOwnerDone(Owner:TObject); begin if not Assigned(Owner) then Exit; FOwnersDoneList.Add(Owner); end; {** * Adds a task to the manager * * The passed task is fully managed by the TPoolManager and should not be freed externally. * * Conditions for the execution of the passed task: * - If there are no workers yet and the property ConcurrentWorker is greater than zero, the first * worker thread will be created, receive this task and begin the work * - If there is a sleeping worker thread (State = wsReady), it receive this task immediately and * begin the work * - If the count of working workers (TPoolWorker.State = wsBusy) is lower than the property * ConcurrentWorkersCount, then a new worker thread will be created, receive this task and * begin the work * - Otherwise, this task waiting for processing, until one of the above condition are be true *} procedure TPoolManager.AddTask(Task:TPoolTask); begin ContextProcedures.Add( procedure begin BeginWriteTasks; try Tasks.Add(Task); OwnerAddTasksCount(Task.Owner, 1, 0, FALSE); FTasksSorted:=FALSE; finally EndWriteTasks; end; end); end; procedure TPoolManager.BeginReadTasks; begin FTasksLock.BeginRead; end; function TPoolManager.BeginWriteTasks:Boolean; begin Result:=FTasksLock.BeginWrite; end; {** * Customizable cancel method for tasks, through the ability for passing a anonymous compare method * * @param CompareFunction Each task on which this method answers with TRUE, will be canceled *} procedure TPoolManager.CustomTaskCancel(CompareFunction:TTaskFunc); var CanceledTasks:TTaskList; TaskIndex, WorkerIndex:Integer; begin CanceledTasks:=TTaskList.Create(TRUE); try BeginWriteTasks; try TaskIndex:=0; while TaskIndex < Tasks.Count do begin if Assigned(Tasks[TaskIndex]) and CompareFunction(Tasks[TaskIndex]) then begin {** * Try to find the connected worker, if the task is in work *} if (Tasks[TaskIndex].State = tsInWork) and Assigned(Tasks[TaskIndex].FProcessingBy) then WorkerIndex:=Workers.IndexOf(Tasks[TaskIndex].FProcessingBy) else WorkerIndex:=-1; {** * Memorize this cancel operation for owner based stats *} AddOwnerDone(Tasks[TaskIndex].Owner); {** * If the task has a cancel event handler, so extract it from the tasks list... * (the task is destroyed later, after all OnCancel events were fired) *} if Assigned(Tasks[TaskIndex].OnCancel) then CanceledTasks.Add(Tasks.Extract(Tasks[TaskIndex])) // Mnemonic: Extract removes without freeing, although it is owner of it {** * ...otherwise simply delete it (it will be freed too) *} else Tasks.Delete(TaskIndex); {** * Perform a cancel operation on the worker, if one was detected previously *} if (WorkerIndex >= 0) and not Workers[WorkerIndex].Canceled and (Workers[WorkerIndex].State = wsBusy) then Workers[WorkerIndex].Cancel; end else Inc(TaskIndex); end; finally EndWriteTasks; end; finally {** * Fire the OnCancel event in batch for all canceled tasks *} if CanceledTasks.Count > 0 then begin Queue( procedure var cc:Integer; begin try for cc:=0 to CanceledTasks.Count - 1 do CanceledTasks[cc].OnCancel(CanceledTasks[cc]); finally CanceledTasks.Free; end; end); end else CanceledTasks.Free; end; end; function TPoolManager.CustomTaskCounter(CompareFunction:TTaskFunc):Integer; var cc:Integer; begin Result:=0; BeginReadTasks; try for cc:=0 to Tasks.Count - 1 do Inc(Result, Ord(Assigned(Tasks[cc]) and CompareFunction(Tasks[cc]))); finally EndReadTasks; CompareFunction:=nil; end; end; function TPoolManager.CustomTaskExists(CompareFunction:TTaskFunc):Boolean; var cc:Integer; begin BeginReadTasks; try cc:=0; while (cc < Tasks.Count) and not (Assigned(Tasks[cc]) and CompareFunction(Tasks[cc])) do Inc(cc); Result:=cc < Tasks.Count; finally EndReadTasks; CompareFunction:=nil; end; end; {** * Cancels all tasks, which are the "same" to the passed task * * @see TPoolTask.IsTheSame *} procedure TPoolManager.CancelTasksBySame(Task:TPoolTask); begin ContextProcedures.Add( procedure begin CustomTaskCancel(Task.IsTheSame); end); end; procedure TPoolManager.CancelAllTasks; begin ContextProcedures.Add( procedure begin CustomTaskCancel( function(Compare:TPoolTask):Boolean begin Result:=TRUE; end); end); end; {** * Cancels all tasks, which have the passed Owner * * @see TPoolTask.Owner *} procedure TPoolManager.CancelTasksByOwner(Owner:TObject); begin ContextProcedures.Add( procedure begin CustomTaskCancel( function(Compare:TPoolTask):Boolean begin Result:=Compare.Owner = Owner; end); end); end; procedure TPoolManager.EndReadTasks; begin FTasksLock.EndRead; end; procedure TPoolManager.EndWriteTasks; begin FTasksLock.EndWrite; end; {** * Updates the internal owner based statistics *} procedure TPoolManager.OwnerAddTasksCount(Owner:TObject; AddTotalCount, AddDoneCount:Integer; FireEvents:Boolean); var OwnerEntry, OriginOwnerEntry:TOwner; SyncProc:TThreadProcedure; begin if not Assigned(Owner) or ((AddTotalCount = 0) and (AddDoneCount = 0)) then Exit; SyncProc:=nil; OriginOwnerEntry:=GetOwner(Owner); if AddTotalCount <> 0 then OriginOwnerEntry.TasksTotalCount:=OriginOwnerEntry.TasksTotalCount + AddTotalCount; if AddDoneCount <> 0 then OriginOwnerEntry.TasksDoneCount:=OriginOwnerEntry.TasksDoneCount + AddDoneCount; {** * Local clone for the OwnerEntry *} OwnerEntry:=TOwner.Create; OwnerEntry.Owner:=Owner; OwnerEntry.TasksDoneCount:=OriginOwnerEntry.TasksDoneCount; OwnerEntry.TasksTotalCount:=OriginOwnerEntry.TasksTotalCount; OwnerEntry.OnTasksStatus:=OriginOwnerEntry.OnTasksStatus; OwnerEntry.OnTasksComplete:=OriginOwnerEntry.OnTasksComplete; if FireEvents and Assigned(OwnerEntry.OnTasksStatus) and (OwnerEntry.TasksDoneCount < OwnerEntry.TasksTotalCount) then begin SyncProc:=procedure begin try OwnerEntry.OnTasksStatus(Owner, OwnerEntry.TasksDoneCount / OwnerEntry.TasksTotalCount); finally OwnerEntry.Free; end; end end else if OwnerEntry.TasksDoneCount = OwnerEntry.TasksTotalCount then begin if FireEvents and (Assigned(OwnerEntry.OnTasksComplete) or Assigned(OwnerEntry.OnTasksStatus)) then SyncProc:=procedure begin try if Assigned(OwnerEntry.OnTasksStatus) then OwnerEntry.OnTasksStatus(Owner, 1); if Assigned(OwnerEntry.OnTasksComplete) then OwnerEntry.OnTasksComplete(Owner); finally OwnerEntry.Free; end; end; OwnerEntry.TasksTotalCount:=0; OwnerEntry.TasksDoneCount:=0; OriginOwnerEntry.TasksTotalCount:=0; OriginOwnerEntry.TasksDoneCount:=0; end; if Assigned(SyncProc) then Queue(SyncProc) else OwnerEntry.Free; end; {** * Registers any TObject instance as owner and connect it with some events * * Because each TPoolTask can have a owner, internally owner based statistics are led, so * you can, for example, easily implement a progress bar. * * For best practise, the passed event handlers should be methods of the passed owner object. * * The registered owner can simple unregistered on all singleton instances by * DispatchOwnerDestroyed. * * @see TPoolManager.DispatchOwnerDestroyed *} procedure TPoolManager.RegisterOwner(Owner:TObject; OnTasksStatus:TStatusEvent; OnTasksComplete:TAnonymousNotifyEvent); begin Assert(Assigned(Owner), 'You can''t register a nil owner.'); ContextProcedures.Add( procedure var OwnerEntry:TOwner; begin OwnerEntry:=GetOwner(Owner); OwnerEntry.OnTasksStatus:=OnTasksStatus; OwnerEntry.OnTasksComplete:=OnTasksComplete; end); end; function TPoolManager.GetTaskIndex(State:TTaskState; StartIndex:Integer):Integer; begin for Result:=StartIndex to Tasks.Count - 1 do if Assigned(Tasks[Result]) and (Tasks[Result].State = State) then Exit; Result:=-1; end; function TPoolManager.GetSameTaskIndex(CompareTask:TPoolTask; StartIndex:Integer):Integer; begin for Result:=StartIndex to Tasks.Count - 1 do if Assigned(Tasks[Result]) and (CompareTask.IsTheSame(Tasks[Result])) then Exit; Result:=-1; end; {** * Getter for the property SortTasks *} function TPoolManager.GetSortTasks:Boolean; begin Result:=Assigned(FComparer); end; class function TPoolManager.GetCPUCount:Integer; begin {$IFDEF COMPILER_15_UP} Result:=ProcessorCount; // ProcessorCount is available since Delphi XE {$ELSE} if FCPUCount = 0 then FCPUCount:=System.CPUCount; Result:=FCPUCount; {$ENDIF} end; {** * Notice... * - that this method has no locks! * - when AutoAdd is TRUE (default), so you must obtain a write lock before *} function TPoolManager.GetOwner(Owner:TObject; AutoAdd:Boolean):TOwner; var Index:Integer; begin Index:=0; while (Index < Owners.Count) and (Owners[Index].Owner <> Owner) do Inc(Index); if Index = Owners.Count then begin if AutoAdd then begin Result:=TOwner.Create; Result.Owner:=Owner; Owners.Add(Result); end else Result:=nil; end else Result:=Owners[Index] end; {** * Creates a new unmanaged worker * * Don't call it directly. This method is called by GetReadyWorker automatically on demand. * With this you are able to customize the inited worker in any derived manager. * * @see TPoolManager.GetReadyWorker *} function TPoolManager.CreateWorker:TPoolWorker; begin Result:=WorkerClass.Create(Self); end; procedure TPoolManager.ExecutionLoopInitialize; begin FDynamicTerminateEnabled:=FALSE; end; procedure TPoolManager.ExecutionLoop; var ConcurrentWorkersCount, SpareWorkersCount:Integer; function DynamicTerminate:Boolean; function HasTasks:Boolean; begin BeginReadTasks; try Result:=Tasks.Count > 0; finally EndReadTasks; end; end; begin Result:=FDynamicTerminateEnabled and (SpareWorkersCount = 0) and not HasTasks; end; {** * Executes the context procedures * * @see TPoolManager.AddContextProcedure *} procedure CheckContextProcedures; {$IFDEF CSM_CHECK_CONTEXT_PROCEDURES} var ExecutedProcedures:Integer; begin CodeSite.EnterMethod(Self, 'CheckContextProcedures'); ExecutedProcedures:=ContextProcedures.Execute; CodeSite.Send('Executed procedures', ExecutedProcedures); CodeSite.ExitMethod(Self, 'CheckContextProcedures'); {$ELSE} begin ContextProcedures.Execute; {$ENDIF} end; {** * Check, whether there are further tasks for processing and try to assign it to a new or * sleeping worker * * @return TRUE, if there are further outstanding tasks *} procedure CheckOutstandigTasks; var TaskIndex:Integer; SameTasks:TTaskList; Worker:TPoolWorker; {** * Says, whether there are sleeping workers or the defined boundig (ConcurrentWorkersCount) * allows it to create a new worker * * It's just a try to determine this and you should don't surely rely on the answer, * because the lock on Workers is acquired and released again. So there are possible * situations, that this method return TRUE and the next call on GetReadyWorker * delivers nil. But you can use it as a condition to enters a complex code section, * as long you check the result of GetReadyWorker against nil. *} function HasReadyWorkers:Boolean; var cc, WorkersCount:Integer; begin WorkersCount:=Workers.Count; {** * First (fast) try: Check the bounding *} Result:=WorkersCount < ConcurrentWorkersCount; if Result then Exit; {** * Second (slow) try: Search for a sleeping worker *} Result:=TRUE; for cc:=0 to WorkersCount - 1 do if not Workers[cc].Terminated and (Workers[cc].State = wsReady) then Exit; Result:=FALSE; end; {** * Returns a "ready" worker thread * * If there are sleeping worker threads, so one of them will be returned. * If no sleeping threads are available and the bounding (ConcurrentWorkersCount) * is not exceeded, a new worker thread will be created and returned. * Otherwise nil will be returned and must be handled properly. * * New workers will be created, if needed and possible, by the method CreateWorker. * * @see TPoolManager.ConcurrentWorkersCount * @see TPoolManager.CreateWorker *} function GetReadyWorker:TPoolWorker; var cc, WorkersCount:Integer; begin Result:=nil; {** * Search for a sleeping worker *} WorkersCount:=Workers.Count; if WorkersCount > ConcurrentWorkersCount then Exit; for cc:=0 to WorkersCount - 1 do begin Result:=Workers[cc]; if not Result.Terminated and (Result.State = wsReady) then Break else Result:=nil; end; {** * No sleeping worker found, try to create a new one *} if not Assigned(Result) and (WorkersCount < ConcurrentWorkersCount) then begin Result:=CreateWorker; Workers.Add(Result); end; {$IFDEF CODE_SITE} if Assigned(Result) then Result.FWorkerIndex:=Workers.IndexOf(Result); {$ENDIF} end; procedure AddTheSameTasks(StartIndex:Integer); var SameTaskIndex:Integer; begin SameTaskIndex:=GetSameTaskIndex(SameTasks[0], StartIndex); if SameTaskIndex = -1 then Exit; repeat if Tasks[SameTaskIndex].State = tsUnknown then SameTasks.Add(Tasks[SameTaskIndex]); SameTaskIndex:=GetSameTaskIndex(SameTasks[0], SameTaskIndex + 1); until SameTaskIndex = -1; end; procedure SetInWorkState; var cc:Integer; begin for cc:=0 to SameTasks.Count - 1 do begin SameTasks[cc].FProcessingBy:=Worker; SameTasks[cc].FState:=tsInWork; end; end; begin {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.EnterMethod(Self, 'CheckOutstandigTasks'); {$ENDIF} if not HasReadyWorkers then begin {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.SendNote('No ready workers found'); CodeSite.ExitMethod(Self, 'CheckOutstandigTasks'); {$ENDIF} Exit; end; SameTasks:=TTaskList.Create(FALSE); BeginWriteTasks; try if SortTasks and not FTasksSorted then begin Tasks.Sort(FComparer); FTasksSorted:=TRUE; end; {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.EnterMethod('Search for outstanding tasks'); {$ENDIF} TaskIndex:=GetTaskIndex(tsUnknown, 0); if TaskIndex >= 0 then begin repeat {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.SendNote('Outstanding task found on index #%d...', [TaskIndex]); {$ENDIF} Worker:=GetReadyWorker; if not Assigned(Worker) then begin {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.SendWarning('...no further ready workers found'); {$ENDIF} Break; end; SameTasks.Clear; SameTasks.Add(Tasks[TaskIndex]); AddTheSameTasks(TaskIndex + 1); SetInWorkState; Worker.InitializeTask(SameTasks); {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.SendNote('...and initialized with worker on index #%d', [Workers.IndexOf(Worker)]); {$ENDIF} TaskIndex:=GetTaskIndex(tsUnknown, TaskIndex + 1); until TaskIndex = -1; FDynamicTerminateEnabled:=DemandMode; end; {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.ExitMethod('Search for outstanding tasks'); {$ENDIF} finally EndWriteTasks; SameTasks.Free; end; {$IFDEF CSM_CHECK_OUTSTANDING_TASKS} CodeSite.ExitMethod(Self, 'CheckOutstandigTasks'); {$ENDIF} end; procedure UpdateStats; var cc:Integer; begin for cc:=0 to FOwnersDoneList.Count - 1 do OwnerAddTasksCount(FOwnersDoneList[cc], 0, 1, // Condition for the paramater FireEvents, to minimize the syncs (cc = (FOwnersDoneList.Count - 1)) or ( ((cc + 1) < FOwnersDoneList.Count) and (FOwnersDoneList[cc] <> FOwnersDoneList[cc + 1]) )); FOwnersDoneList.Clear; end; {** * Terminates workers which are sleeping (State = wsReady) with the property * SpareWorkersCount in mind. *} procedure TerminateSleepingWorkers; var SleepingWorkerIndex:Integer; function GetSleepingWorkersCount(out FirstSleepingIndex:Integer):Integer; var WorkerIndex:Integer; begin Result:=0; FirstSleepingIndex:=-1; for WorkerIndex:=0 to Workers.Count - 1 do if (Workers[WorkerIndex].State = wsReady) and not Workers[WorkerIndex].Terminated then begin Inc(Result); if FirstSleepingIndex = -1 then FirstSleepingIndex:=WorkerIndex; end; {$IFDEF CSM_TERMINATE_SLEEPING_WORKERS} CodeSite.Send('Sleeping workers count', Result); {$ENDIF} end; begin {$IFDEF CSM_TERMINATE_SLEEPING_WORKERS} CodeSite.EnterMethod(Self, 'TerminateSleepingWorkers'); {$ENDIF} while GetSleepingWorkersCount(SleepingWorkerIndex) > SpareWorkersCount do begin {$IFDEF CSM_TERMINATE_SLEEPING_WORKERS} CodeSite.SendNote('Terminate worker on index #%d', [SleepingWorkerIndex]); {$ENDIF} Workers[SleepingWorkerIndex].Terminate; end; {$IFDEF CSM_TERMINATE_SLEEPING_WORKERS} CodeSite.ExitMethod(Self, 'TerminateSleepingWorkers'); {$ENDIF} end; begin {$IFDEF CSM_EXECUTION_LOOP} CodeSite.EnterMethod(Self, 'ExecutionLoop'); {$ENDIF} {** * Store the boundings for the count of workers, to prevent any side effects for this loop *} ConcurrentWorkersCount:=Self.ConcurrentWorkersCount; SpareWorkersCount:=Self.SpareWorkersCount; CheckContextProcedures; {** * Context procedures are able to terminate this thread, but in that case further * processing must be prevented. *} if not Terminated then begin CheckOutstandigTasks; UpdateStats; end; TerminateSleepingWorkers; if not Terminated and DynamicTerminate then begin Terminate; TriggerMainSignal; end; {$IFDEF CSM_EXECUTION_LOOP} CodeSite.ExitMethod(Self, 'ExecutionLoop'); {$ENDIF} end; function TPoolManager.ExecutionLoopCondition:Boolean; begin {** * Manager is so long active as any workers exists *} Result:=not Terminated or (Workers.Count > 0); end; procedure TPoolManager.ExecutionLoopFinalize; begin {$IFDEF CSM_EXECUTION_LOOP_FINALIZE} CodeSite.EnterMethod(Self, 'FinalizeExecutionLoop'); {$ENDIF} {** * Exit the thread only, if there are no (write) locks *} BeginReadTasks; EndReadTasks; {$IFDEF CSM_EXECUTION_LOOP_FINALIZE} CodeSite.SendNote('Manager is on the way for termination'); CodeSite.ExitMethod(Self, 'FinalizeExecutionLoop'); {$ENDIF} end; {** * Notify all singleton instances, that the passed owner was be destroyed * * - You can call this method on the TPoolManager class or on any derived class. * - This method is blocking, but you are sure, that all managers were notified about the object * destroy. * - This method should only be called from the main thread. *} class procedure TPoolManager.DispatchOwnerDestroyed(Owner:TObject); var cc, ccc:Integer; CommitsProcessed, CommitsTotal:Integer; procedure ManagerCommit(PoolManager:TPoolManager); begin PoolManager.ContextProcedures.Add( procedure begin try PoolManager.UnregisterOwner(Owner); PoolManager.CancelTasksByOwner(Owner); {** * Because UnregisterOwner and CancelTasksByOwner adds itself to * ContextProcedures, we must manually execute it, but we are always on the * right place: * In the beginning of the ExecutionLoop inside the manager thread ;) *} PoolManager.ContextProcedures.Execute; finally {$IFDEF COMPILER_15_UP} TInterlocked.Increment(CommitsProcessed); {$ELSE} InterlockedIncrement(CommitsProcessed); {$ENDIF} end; end); Inc(CommitsTotal); end; begin if not Assigned(Owner) then Exit; Assert(CurrentThread.ThreadID = MainThreadID, 'Call DispatchOwnerDestroyed from the main thread'); CommitsProcessed:=0; CommitsTotal:=0; {** * Notify all singleton instances *} for cc:=0 to Length(FSingleInstances) - 1 do if Assigned(FSingleInstances[cc]) and not FSingleInstances[cc].Terminated then ManagerCommit(FSingleInstances[cc]); {** * Wait for all commits, if any *} if CommitsTotal > 0 then repeat CheckSynchronize(50); until CommitsProcessed = CommitsTotal; {** * Remove the destroyed owner from all stored owners *} for cc:=0 to Length(FStoredOwners) - 1 do begin if Assigned(FStoredOwners[cc]) and Assigned(FStoredOwners[cc].Owners) then begin for ccc:=FStoredOwners[cc].Owners.Count - 1 downto 0 do begin if Assigned(FStoredOwners[cc].Owners[ccc]) and (FStoredOwners[cc].Owners[ccc].Owner = Owner) then FStoredOwners[cc].Owners.Delete(ccc); end; if FStoredOwners[cc].Owners.Count = 0 then FreeAndNil(FStoredOwners[cc].Owners); end; end; end; {** * Setter for the property ConcurrentWorkersCount *} procedure TPoolManager.SetConcurrentWorkersCount(ConcurrentWorkersCount:Integer); begin if InterlockedExchange(FConcurrentWorkersCount, ConcurrentWorkersCount) <> ConcurrentWorkersCount then TriggerMainSignal; end; {** * Setter for the property ConcurrentWorkersCountPerCPU *} procedure TPoolManager.SetConcurrentWorkersCountPerCPU(ConcurrentWorkersCountPerCPU:Integer); var PerCPUCount:Integer; begin PerCPUCount:=ConcurrentWorkersCountPerCPU * GetCPUCount; if PerCPUCount = 0 then PerCPUCount:=2; ConcurrentWorkersCount:=PerCPUCount; end; {** * Setter for the property SortTasks *} procedure TPoolManager.SetSortTasks(SortTasks:Boolean); begin if SortTasks = Self.SortTasks then Exit; FreeAndNil(FComparer); if SortTasks then FComparer:=TTaskComparer.Create( function(const Left, Right:TPoolTask):Integer begin Result:=Ord(Assigned(Right)) - Ord(Assigned(Left)); if Result = 0 then Result:=TPoolTaskClass(Left.ClassType).Compare(Left, Right); end); end; {** * Setter for the property SpareWorkersCount *} procedure TPoolManager.SetSpareWorkersCount(SpareWorkersCount:Integer); begin if InterlockedExchange(FSpareWorkersCount, SpareWorkersCount) <> SpareWorkersCount then TriggerMainSignal; end; {** * Setter for the property SpareWorkersCountPerCPU *} procedure TPoolManager.SetSpareWorkersCountPerCPU(SpareWorkersCountPerCPU:Integer); var PerCPUCount:Integer; begin PerCPUCount:=SpareWorkersCountPerCPU * GetCPUCount; if PerCPUCount = 0 then PerCPUCount:=2; SpareWorkersCount:=PerCPUCount; end; {** * "Generic" singleton method * * It creates for each derived TPoolManager class, a single instance. For strong type access you can * reintroduce a new Singleton method, but obtain the instance form this one. The advantage of this * solution is, that you don't need to declare a new class field for the single instance in each * derived class. * * Derived TPoolManager's can use this Singleton concept as follows: * * <code> * TDerivedManager = class(TPoolManager) * public * class function Singleton:TDerivedManager; reintroduce; * end; * * implementation * * class function TDerivedManager.Singleton:TDerivedManager; * begin * Result:=TDerivedManager(inherited Singleton); // Don't worried about this hard type cast ;) see the implementation * end; * </code> *} class function TPoolManager.Singleton:TPoolManager; const GrowLength = 4; var Index, ArrayLength, DemandProcIndex:Integer; begin Assert(Self <> TPoolManager, 'Singleton must be called on a derived class.'); ArrayLength:=Length(FSingleInstances); // Mnemonic: Self is the current class in a class method for Index:=0 to ArrayLength - 1 do if Assigned(FSingleInstances[Index]) and (FSingleInstances[Index].ClassType = Self) then begin Result:=FSingleInstances[Index]; Exit; end; {** * No single instance exists for the current class, so we have to create a new one *} Result:=Self.Create; Result.OnTerminate:=SingletonTerminateGate; {** * Lookup for a demand "init" proc *} DemandProcIndex:=GetDemandProcIndex; if DemandProcIndex >= 0 then begin Result.FDemandMode:=TRUE; FDemandProcs[DemandProcIndex].DemandProc(Result); end; {** * Try to find a free position in array *} Index:=0; while (Index < ArrayLength) and Assigned(FSingleInstances[Index]) do Inc(Index); {** * Enlarge the array *} if Index = ArrayLength then SetLength(FSingleInstances, Index + GrowLength); {** * Store the instance in our class field *} FSingleInstances[Index]:=Result; end; {** * Determines, whether there is already a single instance available for the current class * * @see TPoolManager.Singleton *} class function TPoolManager.HasSingleton:Boolean; var Index:Integer; begin Assert(Self <> TPoolManager, 'HasSingleton must be called on a derived class.'); Result:=TRUE; for Index:=0 to Length(FSingleInstances) - 1 do if Assigned(FSingleInstances[Index]) and (FSingleInstances[Index].ClassType = Self) then Exit; Result:=FALSE; end; class function TPoolManager.GetDemandProcIndex(ReturnOnFreeIndex:Boolean):Integer; begin for Result:=0 to Length(FDemandProcs) - 1 do if (ReturnOnFreeIndex and not Assigned(FDemandProcs[Result])) or (Assigned(FDemandProcs[Result]) and (FDemandProcs[Result].ManagerClass = Self)) then Exit; Result:=-1; end; class procedure TPoolManager.RegisterSingletonOnDemandProc(DemandProc:TManagerProc); var Index:Integer; begin Assert(Self <> TPoolManager, 'RegisterSingletonOnDemandProc must be called on a derived class.'); Index:=GetDemandProcIndex(TRUE); if Index = -1 then begin Index:=Length(FDemandProcs); SetLength(FDemandProcs, Index + 1); end; if not Assigned(FDemandProcs[Index]) then begin FDemandProcs[Index]:=TDemandProcAssign.Create; FDemandProcs[Index].ManagerClass:=Self; end; FDemandProcs[Index].DemandProc:=DemandProc; end; {** * Stores all registered owners * * It's executed in SingletonTerminateGate, if this instance is in "Demand Mode". * This method must be called from the main thread. * * @see TPoolManager.SingletonTerminateGate *} procedure TPoolManager.StoreOwners; var Index, ArrLength, cc:Integer; Store:TOwnersAssign; begin {** * We need no locks, because this method should always be called from the main thread *} Index:=0; ArrLength:=Length(FStoredOwners); {** * Try to find the correct class position *} while (Index < ArrLength) and not (Assigned(FStoredOwners[Index]) and (FStoredOwners[Index].ManagerClass = ClassType)) do Inc(Index); {** * Create entry and grow the array, if not found *} if Index = ArrLength then begin Store:=TOwnersAssign.Create; Store.ManagerClass:=TPoolManagerClass(ClassType); Index:=ArrLength; SetLength(FStoredOwners, ArrLength + 1); FStoredOwners[Index]:=Store; end {** * Entry found *} else Store:=FStoredOwners[Index]; if Assigned(Store.Owners) then FreeAndNil(Store.Owners); {** * Remove owners, for which are no events registered and reset the stats *} for cc:=Owners.Count - 1 downto 0 do begin if not (Assigned(Owners[cc].OnTasksStatus) or Assigned(Owners[cc].OnTasksComplete)) then Owners.Delete(cc) {** * Reset stats for owners which are applied *} else begin Owners[cc].TasksDoneCount:=0; Owners[cc].TasksTotalCount:=0; end; end; {** * Steal the Owners list *} if Owners.Count > 0 then Store.Owners:=Owners; {** * There are no further access's on this list, except the Free call in Destroy *} FOwners:=nil; end; {** * Restores all previously registered owners * * This method should only called in a demand init proc (RegisterSingeltonOnDemandProc). * It must called from the main thread, else you running into a crazy access violations loop. * * Here is a usage example of this method in a demand init proc: * * <code> * procedure PoolInit(Manager:TPoolManager); * begin * Manager.ConcurrentWorkersCount:=16; * if not Manager.RestoreOwners then * Manager.RegisterOwner(Form1, Form1.TasksStatus, Form1.TaskDone); * end; * * TDerivedManager.RegisterSingletonOnDemandProc(PoolInit); * </code> * * @see TPoolManager.RegisterSingletonOnDemandProc * @see TPoolManager.RegisterOwner * * @return TRUE, if there was previously any owners stored, otherwise FALSE is returned. *} function TPoolManager.RestoreOwners:Boolean; var Index, ArrLength:Integer; begin {** * We need no locks, because this method should always be called from the main thread *} Index:=0; ArrLength:=Length(FStoredOwners); {** * Try to find the correct class position *} while (Index < ArrLength) and not (Assigned(FStoredOwners[Index]) and (FStoredOwners[Index].ManagerClass = ClassType)) do Inc(Index); Result:=(Index < ArrLength) and Assigned(FStoredOwners[Index].Owners); if not Result then Exit; {** * Reassign the Owners list *} Owners.Free; FOwners:=FStoredOwners[Index].Owners; FStoredOwners[Index].Owners:=nil; end; class function TPoolManager.HasSingletonOnDemandProc:Boolean; begin Assert(Self <> TPoolManager, 'HasSingletonOnDemandProc must be called on a derived class.'); Result:=GetDemandProcIndex >= 0; end; class procedure TPoolManager.UnregisterSingletonOnDemandProc; var Index:Integer; begin Assert(Self <> TPoolManager, 'UnregisterSingletonOnDemandProc must be called on a derived class.'); Index:=GetDemandProcIndex; if Index >= 0 then FreeAndNil(FDemandProcs[Index]); end; {** * Determines, with the implementation of TPoolTask.IsTheSame, whether the task exists * * This method can be called from any thread, because it do a read lock on the task list. *} function TPoolManager.TaskExists(Task:TPoolTask):Boolean; begin Result:=CustomTaskExists(Task.IsTheSame); end; {** * Return the count of tasks, which have the same passed owner *} function TPoolManager.TasksCountByOwner(Owner:TObject):Integer; begin Result:=CustomTaskCounter( function(Task:TPoolTask):Boolean begin Result:=Task.Owner = Owner; end); end; procedure TPoolManager.Terminate; begin ContextProcedures.Add( procedure var cc:Integer; begin {** * Terminate all running workers *} for cc:=0 to Workers.Count - 1 do Workers[cc].Terminate; inherited Terminate; end); end; {** * Terminates all singleton instances of the managers and his workers in one step * * This is useful on application exit. In this case the Wait parameter must be TRUE, because * otherwise all threads are hard killed. * * This method must called from the context of the main thread. *} class procedure TPoolManager.TerminateSingletonInstances(Wait:Boolean); var cc, SingleInstancesLength:Integer; AnyTerminateDischarged:Boolean; begin Assert(CurrentThread.ThreadID = MainThreadID, 'Call TerminateSingletonInstances from the main thread'); SingleInstancesLength:=Length(FSingleInstances); AnyTerminateDischarged:=FALSE; for cc:=0 to SingleInstancesLength - 1 do if Assigned(FSingleInstances[cc]) then begin FSingleInstances[cc].Terminate; AnyTerminateDischarged:=TRUE; end; if not (Wait and AnyTerminateDischarged) then Exit; repeat CheckSynchronize(50); cc:=0; while (cc < SingleInstancesLength) and not Assigned(FSingleInstances[cc]) do Inc(cc); until cc = SingleInstancesLength; end; {** * Event handler for TPoolManager.OnTerminate (just for singleton instances) * * Notice: It's always called from the context of the main thread. *} class procedure TPoolManager.SingletonTerminateGate(Sender:TObject); var cc:Integer; begin {** * Remove the connection from FSingleInstances, if one is there *} for cc:=0 to Length(FSingleInstances) - 1 do if FSingleInstances[cc] = Sender then begin if FSingleInstances[cc].DemandMode then FSingleInstances[cc].StoreOwners; FSingleInstances[cc]:=nil; Break; end; end; procedure TPoolManager.UnregisterOwner(Owner:TObject); begin ContextProcedures.Add( procedure begin Owners.Remove(GetOwner(Owner, FALSE)); end); end; {** * Callback method for TPoolWorker's, which has done their task * * It's called in TPoolWorker.DoneTask from their thread context *} procedure TPoolManager.WorkerTaskDone(DoneWorker:TPoolWorker; WorkerState:TWorkerState); var BlockSignal:TEvent; begin BlockSignal:=TEvent.Create(nil, FALSE, FALSE, ''); try ContextProcedures.Add( procedure var TaskIndex, ProcessedTaskIndex:Integer; begin try if WorkerState <> wsTaskDone then Exit; BeginWriteTasks; try {** * Remove the processed tasks from tasks *} for ProcessedTaskIndex:=0 to DoneWorker.ProcessTasks.Count - 1 do begin TaskIndex:=Tasks.IndexOf( DoneWorker.ProcessTasks[ProcessedTaskIndex]); if TaskIndex >= 0 then begin AddOwnerDone(Tasks[TaskIndex].Owner); Tasks.Delete(TaskIndex); end; end; finally EndWriteTasks; end; finally DoneWorker.State:=wsReady; BlockSignal.SetEvent; end; end); BlockSignal.WaitFor(INFINITE); finally BlockSignal.Free; end; end; {** * Callback method for TPoolWorker's, which are terminated * * It's called in TPoolWorker.ExecutionLoopFinalize automatically. *} procedure TPoolManager.WorkerTerminated(TerminatedWorker:TPoolWorker); var BlockSignal:TEvent; begin BlockSignal:=TEvent.Create(nil, FALSE, FALSE, ''); try ContextProcedures.Add( procedure begin try Workers.Remove(TerminatedWorker); finally BlockSignal.SetEvent; end; end); BlockSignal.WaitFor(INFINITE); finally BlockSignal.Free; end; end; {** TThreadProcedures **} constructor TThreadProcedures.Create(ForeignChangedSignal:TEvent); begin {$IFDEF USE_SPIN_LOCK} FProceduresLock:=TSpinLock.Create(TRUE); {$ELSE} FProceduresLock:=TCriticalSection.Create; {$ENDIF} if Assigned(ForeignChangedSignal) then FChangedSignal:=ForeignChangedSignal else FChangedSignal:=TEvent.Create(nil, FALSE, FALSE, ''); FOwnChangedSignal:=ForeignChangedSignal <> FChangedSignal; end; destructor TThreadProcedures.Destroy; var cc:Integer; begin {** * Possible memory leaks, if we don't reset all references of closures *} for cc:=0 to Length(FProcedures) - 1 do FProcedures[cc]:=nil; FProcedures:=nil; {$IFNDEF USE_SPIN_LOCK} FProceduresLock.Free; {$ENDIF} if FOwnChangedSignal then FChangedSignal.Free; inherited; end; procedure TThreadProcedures.Add(ThreadProcedure:TThreadProcedure); var Index:Integer; begin FProceduresLock.Enter; try Index:=Length(FProcedures); SetLength(FProcedures, Index + 1); FProcedures[Index]:=ThreadProcedure; finally {$IFDEF USE_SPIN_LOCK} FProceduresLock.Exit; {$ELSE} FProceduresLock.Leave; {$ENDIF} end; ChangedSignal.SetEvent; end; {** * Executes all added procedures * * @return The count of executed procedures *} function TThreadProcedures.Execute:Integer; var cc, ProceduresCount:Integer; LocalProcedures:TThreadProcedureArray; begin Result:=0; {** * Copy the current added procedures locally and reset FProcedures *} FProceduresLock.Enter; try if not Assigned(FProcedures) then Exit; ProceduresCount:=Length(FProcedures); LocalProcedures:=Copy(FProcedures, 0, ProceduresCount); FProcedures:=nil; finally {$IFDEF USE_SPIN_LOCK} FProceduresLock.Exit; {$ELSE} FProceduresLock.Leave; {$ENDIF} end; {** * Whole execution is outside the lock, so Add can be further called by other threads *} try for cc:=0 to ProceduresCount - 1 do begin LocalProcedures[cc](); LocalProcedures[cc]:=nil; Inc(Result); end; finally LocalProcedures:=nil; end; end; {$IFDEF CS_FILE_LOGGING} var Dest:TCodeSiteDestination; initialization Dest:=TCodeSiteDestination.Create(nil); Dest.LogFile.Active:=True; Dest.LogFile.FileName:='ThreadPool.csl'; Dest.LogFile.FilePath:='$(MyDocs)'; Dest.LogFile.MaxSize:=16 * 1024; // 16 MB Dest.LogFile.MaxParts:=2; CodeSite.Destination:=Dest; finalization Dest.Free; {$ENDIF} end.

2014-04-18

sql2000 示例数据库,研究RO可以用的着

这个是安装sql2000示例数据库用,现在点击安装即可

2014-04-18

全RemObjects文档翻译

RO00 - RemObjects SDK文档总目录 这些年来生成了很多文档,这当然是好事情,但是却很难从中找到你需要的. 本文目标包括: 提供基本文章推荐的阅读顺序 最近的更新列表,说明有什么变化 展示所有文档的状态 告诉你那个文档被更新 那个文档中的范例可以下载 当人们搜索适当的文章时可能有不同的需要,例如你可能很熟悉我们的产品只想看看随着时间的推移产品有多少改变,这样,推荐你使用下面的阅读顺序: see 查看RemObjects SDK新特性 see 从Win32到.NET see 对'Vinci'的更新 see 跨平台和与其他技术的整合 see 了解产品架构 see 产品提供的源码范例 see 用贡献的文档 see 老版本 see 最近的更新文档 这个文档包含所有可用的文章列表list. 注意:本文章随着其它文章的更新而更新。而且最近相关文档也不完整,对'Vinci' 的回顾和更新将放在下面合适的地方 RemObjects SDK新手上路 如果你刚接触我们的产品,那么你可能对基于RemObject SDK的Data Abstract产品没有什么了解 WP01. RO05 – 如何写 RemObjects SDK服务器端 (Delphi Version) RO06 – 如何写RemObjects SDK客户端 (Delphi Version) RO45 -如何写 RemObjects SDK服务器端 (.NET Version) RO46 -如何写RemObjects SDK客户端 (.NET Version) RO25 – 理解客户端 RO29 – 使用服务端测试工具 RO41 – 将.NET 标准事件处理变为RemObjects SDK执行方式 RO42 – 介绍对Free Pascal支持 - new for 'Vinci' 从Win32到.NET 为了迁移的需要,你可能已经发现有些文档存在.Net版本,或有些文章包含.Net的相关信息.使用标记Delphi 或.NET 将嵌入在已经存在的Delphi应用程序的代码转到.Net的一个选择是使用Hydra产品 . RO16 – 类工厂预览 RO25 – 理解客户端 如何写RemObjects SDK服务端 - Delphi: RO05, .NET: RO45 如何写RemObjects SDK客户端 - Delphi: RO06, .NET: RO46 HY09 –主要介绍Hydra 3.0.1 对'Vinci'的更新 下面的文档包含了对'Vinci'的变化,你将会看到new for 'Vinci'标记. RO38 – 比较RemObjects SDK通道 - new for 'Vinci' RO40 – 对XML-RPC的支持 - new for 'Vinci' RO25 – 理解客户端 RO37 – 新的Super通道 RO42 – 介绍对Free Pascal的支持 - new for 'Vinci' 跨平台和与其他技术的整合 RO42 -介绍对Free Pascal的支持 - new for 'Vinci' RO40 -对XML-RPC的支持 - new for 'Vinci' RO19 – DataSnap整合包 RO20 – 如何用DataSnap类写服务端 RO21 – 不用DataSnapModule 的简单DataSnap服务端 理解架构 RO25 – 理解客户端 RO07 - Smart Services™ RO16 –类工厂预览 RO37 – 新的Super通道 RO38 – 比对RemObjects SDK的通道- new for 'Vinci' RO11 – 使用RemObjects SDK创建异步执行客户端 RO15 – 原理: RemObjects SDK消息流程-客户端 文档提供的源码范例 有些文档,主要的教程,我们提供了压缩的源码文件,你可以点击文档下面的超链接下载 RO05 – 如何写 RemObjects SDK服务端 (Delphi Version) RO06 –如何写 RemObjects SDK 客户端 (Delphi Version) RO20 – 如何使用DataSnap类写服务端 RO35 - ROCalc service (by Andrea Raimondi) 有贡献的文章 这些文章不是RemObjects软件公司人员写的,他们很伟大.如果你也许做出奉献请将你的大作发送到[email protected]. 不必担心你的英文语法,我们将修改你的文章并保证不改变你的主题. RO10 – 不要再如此频繁的调用: 最小服务调用改进执行(by Kevin Powick) RO13 - Smart Project: 使用RemObjects SDK创建可升级的Smart Services™ (by Nathanial Woolls) RO33 - SSL/TLS for RemObjects SDK (by Henrick Hellström) RO34 - I Cannot ROmember (by Brian Moelk) RO35 - ROCalc service (by Andrea Raimondi) RO36 - RemObjects SDK 3中的广播事件 (by Derek Davidson) RO39 – 在一个事务中更新多个ClientDataSet (by Erick Sasse) 产品历史和老版本 如果你的应用程序还在使用我们的老版本产品,你能再这里发现有用的信息. 注意: 关于DataSnap的文章也包含再这里,因为他们在Data Abstract产品之前就已经存在了. (see its ROadmap at DA00). RO19 – DataSnap整合包 RO20 – 如何使用DataSnap类写服务端 RO21 – 不使用DataSnapModule 创建简单的DataSnap服务 RO27 - RemObjects 3.0 SDK预览 RO31 - RemObjects SDK 3.0代码级别特性 最近更新文章 这里只列出了最主要的更新文章. 次要更新包含修正错别字和语法等.规则很简单,主要更新就是我们觉得有必要重新阅读的更正. 2007-07-10: RO29 – 使用服务端测试器 新的截屏和对.NET版本的说明. 2007-07-07: RO21 –不用DataSnapModule创建简单的DataSnap服务端 截屏带有数据并更加整洁. 2007-06-27: RO11 – 使用RemObjects SDK创建异步客户端 重新整理文章,但是只涵盖了Delphi. 不含.NET. And so on

2014-04-18

空空如也

TA创建的收藏夹 TA关注的收藏夹

TA关注的人

提示
确定要删除当前文章?
取消 删除