⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 share.~pas

📁 SMGSession,一个短信网关接口代码
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
    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 + -