📄 share.~pas
字号:
if isEmpty then exit;
result:=buffer[top];
finally
leaveCriticalSection(sect);
end;
end;
function TStaticQueue.popAndRemove: pointer;
begin
enterCriticalSection(sect);
try
result:=pop;
remove;
finally
leaveCriticalSection(sect);
end;
end;
function TStaticQueue.push(p:pointer): Boolean;
begin
enterCriticalSection(sect);
try
result:=false;
if isFull then exit;
buffer[rear]:=p;
inc(rear);
inc(cnt);
if rear>=size then rear:=0;
result:=true;
finally
leaveCriticalSection(sect);
end;
end;
procedure TStaticQueue.remove;
begin
enterCriticalSection(sect);
try
if buffer[top]<>nil then
dispose(buffer[top]);
inc(top);
dec(cnt);
if top>=size then top:=0;
finally
leaveCriticalSection(sect);
end;
end;
{ TDefaultWorkerChainHead }
procedure TDefaultWorkerChainHead.action(param: pointer);
begin
getWorker.action(param);
end;
constructor TDefaultWorkerChainHead.create(chainRear: IWorkerChainRear);
begin
self.worker:=chainRear;
end;
function TDefaultWorkerChainHead.getWorker: IWorkerAction;
begin
result:=worker;
end;
procedure TDefaultWorkerChainHead.setWorker(worker: IWorkerAction);
begin
self.worker:=worker;
end;
{ TDefaultWorkerChainRear }
procedure TDefaultWorkerChainRear.action(param: pointer);
begin
getInterface.action(param);
end;
constructor TDefaultWorkerChainRear.create(intf: IWorkerAction);
begin
self.intf:=intf;
end;
function TDefaultWorkerChainRear.getInterface: IWorkerAction;
begin
result:=intf;
end;
function TDefaultWorkerChainRear.getLastNode: IWorkerChainNode;
begin
result:=lastNode;
end;
procedure TDefaultWorkerChainRear.setLastNode(node: IWorkerChainNode);
begin
lastNode:=node;
end;
{ TDefaultWorkerChainNode }
function TDefaultWorkerChainNode.getNext: IWorkerAction;
begin
result:=nextWorker;
end;
procedure TDefaultWorkerChainNode.setNext(next: IWorkerAction);
begin
nextWorker:=next;
end;
{ TDefaultWorkerChainFactory }
procedure TDefaultWorkerChainManager.addWorker(worker: IWorkerChainNode);
begin
if worker=nil then exit;
worker.setNext(rear);
if rear.getLastNode<>nil then
begin
rear.getLastNode.setNext(worker);
end else head.setWorker(worker);
rear.setLastNode(worker);
end;
constructor TDefaultWorkerChainManager.create(otherIntf: IWorkerAction);
begin
rear:=TDefaultWorkerChainRear.create(otherIntf);
rear.setLastNode(nil);
head:=TDefaultWorkerChainHead.create(rear);
end;
function TDefaultWorkerChainManager.getChainHead:IWorkerChainHead;
begin
result:=head;
end;
{ TInstancePool }
function TInstancePool.activate:TPoolObject;
begin
enterCriticalSection(sect);
try
result:=nil;
if pool.Count<=0 then
begin
if count<maxSize then
begin
pool.Add(createObj);
inc(count);
end else begin
exit;
end;
end;
result:=TPoolObject(pool.Items[0]);
pool.Delete(0);
finally
leaveCriticalSection(sect);
end;
end;
constructor TInstancePool.create(objClass: TJPObjectClass; initSize,maxSize: integer);
var
i:integer;
begin
self.objClass:=objClass;
self.initSize:=initSize;
self.maxSize:=maxSize;
pool:=TList.Create;
pool.Capacity:=maxSize;
initializeCriticalSection(sect);
count:=initSize;
if initSize>=0 then
for i:=1 to initSize do
pool.Add(createObj);
end;
function TInstancePool.createObj: TObject;
begin
result:=TPoolObject(objClass.NewInstance).Create(self);
end;
function TInstancePool.getCount: integer;
begin
result:=count;
end;
function TInstancePool.getPoolCount: integer;
begin
result:=pool.Count;
end;
procedure TInstancePool.passivate(obj:TPoolObject);
begin
enterCriticalSection(sect);
try
pool.Add(obj);
finally
leaveCriticalSection(sect);
end;
end;
{ TPoolObject }
constructor TPoolObject.create(pool: TInstancePool);
begin
self.pool:=pool;
end;
procedure TPoolObject.passivate;
begin
if pool<>nil then
pool.passivate(self);
end;
{ TQueueElement }
constructor TQueueElement.create;
begin
FState:=EMPTY;
end;
procedure TQueueElement.free;
begin
raise exception.Create('不允许释放');
end;
function TQueueElement.getState: STATE;
begin
result:=FState;
end;
procedure TQueueElement.leave;
begin
self.setState(NORMAL);
end;
procedure TQueueElement.setState(val: STATE);
begin
if val<>FState then
FState:=val;
end;
{ TSWHObjectQueue }
procedure TSWHObjectQueue.addInstance;
var
obj:TObject;
begin
obj:=elementClass.NewInstance;
queue.Add(TQueueElement(obj).Create);
end;
constructor TSWHObjectQueue.create(elementClass: TQueueElementClass;
size: integer);
var
i:integer;
begin
self.elementClass:=elementClass;
queue:=TList.Create;
queue.Capacity:=size;
FSize:=size;
FCount:=0;
top:=0;
rear:=0;
{实例化实例池}
for i:=1 to size do
addInstance;
{实例化坞}
dock:=TQueueDock.create(elementClass);
initializeCriticalSection(sct);
end;
function TSWHObjectQueue.getFreeElement: TQueueElement;
begin
result:=dock.getElement;
end;
function TSWHObjectQueue.getState: STATE;
begin
result:=NORMAL;
if count<=0 then result:=EMPTY;
if count>=size then result:=FULL;
end;
function TSWHObjectQueue.isEmpty: boolean;
begin
result:=false;
if getState=EMPTY then result:=true;
end;
function TSWHObjectQueue.isFull: boolean;
begin
result:=false;
if getState=FULL then result:=true;
end;
function TSWHObjectQueue.pop: TQueueElement;
begin
enterCriticalSection(sct);
result:=nil;
try
if not (getState=EMPTY) then
begin
result:=queue[rear];
remove;
end;
finally
leaveCriticalSection(sct);
end;
end;
function TSWHObjectQueue.push(element: TQueueElement): boolean;
begin
enterCriticalSection(sct);
result:=false;
try
if getState=FULL then exit;
TQueueElement(queue[top]).assign(element);
inc(top);
inc(FCount);
if top>=size then top:=0;
result:=true;
finally
leaveCriticalSection(sct);
end;
end;
procedure TSWHObjectQueue.remove;
begin
inc(rear);
dec(FCount);
if rear>=size then rear:=0;
end;
{ TQueueDock }
constructor TQueueDock.create(elementClass: TQueueElementClass);
var
e:TQueueElement;
begin
e:=TQueueElement(elementClass.NewInstance).create;
e.setState(NORMAL);
element:=e;
end;
function TQueueDock.getElement: TQueueElement;
begin
result:=nil;
if element.getState=NORMAL then
begin
result:=element;
element.setState(USING);
end;
end;
{ TPoolObject11 }
constructor TPoolObject11.create;
begin
FState:=NORMAL;
end;
procedure TPoolObject11.enter;
begin
FState:=USING;
end;
procedure TPoolObject11.leave;
begin
FState:=NORMAL;
end;
procedure TPoolObject11.passivate;
begin
raise exception.Create('在新的版本中不支持此方法');
end;
{ TInstancePool11 }
function TInstancePool11.activate: TPoolObject11;
begin
raise exception.Create('新版本不支持');
end;
constructor TInstancePool11.create(objClass: TJPObjectClass11; initSize,
maxSize: integer);
var
i:integer;
begin
self.objClass:=objClass;
self.initSize:=initSize;
self.maxSize:=maxSize;
pool:=TList.Create;
pool.Capacity:=maxSize;
initializeCriticalSection(sect);
count:=initSize;
if initSize>=0 then
for i:=1 to initSize do
pool.Add(createObj);
end;
function TInstancePool11.createObj: TObject;
begin
result:=TPoolObject11(objClass.NewInstance).Create;
end;
function TInstancePool11.getObj: TPoolObject11;
var
i:integer;
pObj:TPoolObject11;
begin
enterCriticalSection(sect);
try
result:=nil;
{遍历实例池}
for i:=0 to pool.Count-1 do
begin
pObj:=TPoolObject11(pool.Items[i]);
if pObj.state=NORMAL then
begin
result:=pObj;
break;
end;
end;
{如果没有空闲实例,就生成新得实例}
if i>=pool.Count then
begin
if count<maxSize then
begin
result:=TPoolObject11(createObj);
pool.Add(result);
inc(count);
end else exit;
end;
{此实例进入锁定状态}
result.enter;
finally
leaveCriticalSection(sect);
end;
end;
procedure TInstancePool11.passivate(obj: TPoolObject);
begin
raise exception.Create('新版本不支持');
end;
{ TSWHThread10 }
constructor TSWHThread10.create(runner:TRunner;waitTime: integer);
begin
inherited create(true);
self.maxTime:=waitTime;
self.runner:=runner;
self.freeTime:=0;
FreeOnTerminate:=true;
busy:=false;
end;
procedure TSWHThread10.Execute;
begin
inherited;
while not terminated do
begin
runner.enterExecSection;
busy:=true;
try
try
freeTime:=0;
runner.run;
except
on E: Exception do codesite.sendmsg(E.Message+#13+#10+'TSWHThread10.Execute in share of cmserver');
end;
finally
busy:=false;
runner.leaveExecSection;
suspend;
end;
end;
end;
procedure TSWHThread10.run(param:pointer;len:integer);
begin
if runner<>nil then
begin
if runner.moveParam(param,len) then
resume
else raise Exception.Create('出入的参数多大');
end;
end;
procedure TSWHThread10.setRunner(runner: TRunner);
begin
self.runner:=runner;
end;
function TSWHThread10.timeGo:boolean;
begin
result:=false;
if suspended then
begin
inc(freeTime);
if freeTime>=maxTime then
begin
if suspended then
begin
if runner<>nil then
runner.Free;
self.Terminate;
self.Resume;
result:=true;
end;
end;
end;
end;
{ TThreadPool }
function TThreadPool.addThread:TSWHThread10;
var
obj:TObject;
begin
obj:=runnerClass.NewInstance;
result:=TSWHThread10.create(TRunner(obj).Create,waitTime);
pool.Add(result);
end;
constructor TThreadPool.create(runnerClass: TRunnerClass; seedSize,size,waitTime: integer);
begin
self.runnerClass:=runnerClass;
self.create(seedSize,size,waitTime);
end;
constructor TThreadPool.create(seedSize, size, waitTime: integer);
begin
self.size:=size;
self.seedSize:=seedSize;
self.waitTime:=waitTime;
timer:=TTimer.Create(nil);
timer.Interval:=1000;
timer.OnTimer:=onTimer;
timer.Enabled:=true;
pool:=TList.Create;
initializeCriticalSection(sect);
end;
function TThreadPool.getFreeThrd: TSWHThread10;
var
i:integer;
thrd:TSWHThread10;
begin
result:=nil;
for i:=0 to pool.Count-1 do
begin
thrd:=TSWHThread10(pool[i]);
if (thrd<>nil) and (not thrd.isBusy) then
begin
result:=thrd;
break;
end;
end;
if (result=nil) and (pool.Count<size) then
begin
result:=addThread;
end;
end;
procedure TThreadPool.onTimer(sender: Tobject);
//var
//i:integer;
begin
{enterCriticalSection(sect);
try
try
if pool.Count<=seedSize then exit; //保留种子线程
for i:=pool.Count-1 downto 0 do
begin
if TSWHThread10(pool[i]).timeGo then
begin
if TSWHThread10(pool[i]).Suspended then
pool.Delete(i);
if pool.Count<=seedSize then break;
end;
e
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -