share.pas

delphi工具类

      result:=true;
    end;
  finally
    leaveCriticalSection(sect);
  end;
end;

{ TSubject }

procedure TSubject.addObserver(obj: TAbstractObserver);
begin
  if obj=nil then exit;

  list.Add(pointer(obj));
end;

constructor TSubject.create;
begin
  list:=TList.Create;
end;

procedure TSubject.delObserver(obj: TAbstractObserver);
begin
  if obj=nil then exit;

  list.Remove(pointer(obj));
end;

destructor TSubject.destroy;
begin
  list.Free;

  inherited;
end;


procedure TSubject.inform(param: pointer);
var
  i:integer;
begin
  for i:=0 to list.count-1 do
    if list[i]<>nil then
    begin
      TAbstractObserver(list[i]).action(param);
    end;
end;

{ TDBIOOper }

constructor TDBIOOper.create(dbTabInf: TDBTabInf);
begin
  self.dbTabInf:=dbTabInf;

  query:=TADOQuery.Create(nil);
  query.Connection:=self.dbTabInf.con;
end;

procedure TDBIOOper.retrieve(bufSize: cardinal; var min, max: cardinal);
var
  tmpCard,tmpCard1:Cardinal;
  strSQL:string;
begin
  try
    {预定式模式：首先，把数据存储值修改。然后，完成本地的数据修改}
    strSQL:=format('SELECT %S FROM %S WHERE %S=''%S''',[dbTabInf.valName,dbTabInf.tabName,
            dbTabInf.propertyName,dbTabInf.propertyVal]); 
    TShare.adoDataSetOpen(dbTabInf.con,query,strSQL);
    tmpCard:=strtocard(query.fieldByName(dbTabInf.valName).asString);

    tmpCard1:=tmpCard+bufSize;

    {如果超出了Cardinal的最大范围，从1从新开始}
    if tmpCard1>=high(cardinal)-BufSize  then
    begin
      tmpCard:=1;
      tmpCard1:=tmpCard+bufSize;
    end;

    {写库操作}
    strSQL:=format('UPDATE %S SET %S=%D WHERE %S=''%S''',[dbTabInf.tabName,dbTabInf.valName,tmpCard1,
                                                          dbTabInf.propertyName,dbTabInf.propertyVal]);
    query.close;
    query.SQL.Clear;
    query.SQL.Add(strSQL);
    TShare.adoDataSetUpdate(dbTabInf.con,query);

    min:=tmpCard;
    max:=tmpCard1-1;
  finally
    query.Close;
  end;
end;

{ TAbstractXML }
constructor TAbstractXML.create;
var
  opFile:TextFile;
  path:string;
begin
  createLogDir;//创建log目录

  path:=extractFilePath(application.ExeName)+'log\'+formatDateTime('yyyymmdd',now)+'.xml';
  try
    if not fileExists(path) then
    begin
      try
        AssignFile(opFile,path);
        Rewrite(opFile);
        Writeln(opFile,'<?xml version="1.0" encoding="GBK"?>');
        Writeln(opFile,'<log>');
        Writeln(opFile,'</log>');
      finally
        CloseFile(opFile);
      end;
    end;
  except
    on Exception do  ;
  end;
end;

procedure TAbstractXML.createLogDir;
var
  dir: TSearchRec;
  ret: integer;
  path: string;
begin
  try
    path:=extractFilePath(forms.application.ExeName);
    path:=path+'log';
    ret:=sysUtils.findFirst(path,faAnyFile,dir);


    if ret<>NO_ERROR then
    begin
      createDir(path);
    end;
  finally
    sysutils.findClose(dir);
  end;
end;

function TAbstractXML.getPath: string;
begin
  result:=extractFilePath(application.ExeName)+'log\'+formatDateTime('yyyymmdd',now)+'.xml';
end;

{ TJPIterator }
constructor TJPIterator.create(link: TJpAbstractLink);
begin
  self.link:=link;
  top:=link.head;
end;

function TJPIterator.eol: boolean;
begin
  result:=false;

  if top=nil then result:=true;
end;

procedure TJPIterator.first;
begin
  top:=link.head;
end;

function TJPIterator.getData: PLinkNode;
begin
  result:=top;
end;

procedure TJPIterator.next;
begin
  top:=top^.next;
end;

{ TADODBWriter }

procedure TADODBWriter.commit(sqlStrs: string);
var
  i:integer;
begin
  i:=0;

  while i<=2 do
  begin
    try
      with query do
      begin
        close;
        SQL.Clear;
        SQL.Add(sqlStrs);
        execSQL;
      end;

      break;
    except
      on exception do
      begin
        try
          con.Close;
          con.Open;
        except
          on exception do ;
        end;

        inc(i);
      end;
    end;
  end;
end;

constructor TADODBWriter.create(con: TADOConnection);
begin
  self.con:=con;

  query:=TADOQuery.Create(nil);
  query.Connection:=self.con;
end;

{ TStaticQueue }

constructor TStaticQueue.create(size: integer);
var
  i:integer;
begin
  self.size:=size;
  setLength(buffer,size);

  for i:=low(buffer) to high(buffer) do
    buffer[i]:=nil;

  cnt:=0;
  top:=0;
  rear:=0;

  initializeCriticalSection(sect);
end;

function TStaticQueue.isEmpty: boolean;
begin
  result:=false;

  if cnt<=0 then
    result:=true;
end;

function TStaticQueue.isFull: Boolean;
begin
  result:=false;

  if cnt>=size then
    result:=true;
end;

function TStaticQueue.pop:pointer;
begin
  enterCriticalSection(sect);
  try
    result:=nil;

    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