share.pas

delphi工具类

    size,
    freeTime:integer;
  end;

  TestParam=record
    freq,
    waitTime,
    times:integer;
  end;

  TChannelCounter=class(TJPCounter)
  public
    procedure onCounter;override;
  end;

  TChannel=class
  private
    isBusy:boolean;
    counter:TChannelCounter;
  public
    constructor create(freeTime:integer);
    destructor  destroy;override;

    procedure   lock;
    procedure   unlock;
    function    timeGo:boolean;
    property    busy:boolean read isBusy;
    procedure   initCounter;
  end;

  TLinkExplorer=class(TChannel)
  private
    sckt:TSocket;

    testFreq,
    maxWait,
    maxTimes:integer;

    freqCounter,
    waitCounter,
    timesCounter:integer;
    isSended,
    isConnected:boolean;
    isOnTimer:boolean;

    timer:TTimer;

    sect:TRTLCriticalSection;

    function    reconnect:boolean;
    procedure   ontimer(sender:TObject);

    procedure   timesGo;
    procedure   freqTimeGo;
    procedure   waitTimeGo;
  public
    function    getSocket:TSocket;
    function    getState:boolean;
    procedure   respTest;
    procedure   init;
    constructor create(freq,waitTime,times,freeTime:integer);
    destructor  destroy;override;

    procedure   lock;
    procedure   unlock;
    procedure   close;

    function    connect(var sckt:TSocket):boolean;virtual;abstract;
    procedure   onResp;virtual;abstract;
    procedure   sendTest(sckt:TSocket);virtual;abstract;
  end;

  TLinkExplorerClass=class of TLinkExplorer;

  TChannelPool=class
  private
    pool:TList;
    initSize,
    size,
    freeTime:integer;
    tstParam:TestParam;
    exploer:TLinkExplorerClass;
    timer:TTimer;

    procedure onTimer(sender:TObject);
    function  createChannel:TChannel;
  public
    constructor create(exploer:TLinkExplorerClass;chlParam:ChannelParam;tstParam:TestParam);

    function    getChannel:TChannel;

    procedure   respTest(sckt:TSocket);
    procedure   init(sckt:TSocket);
    procedure   closeChannel(sckt:TSocket);

    procedure   test;
    procedure   sendTestActive;
    function    toString:string;
  end;

  {对象队列}
  TQueueElement=class
  private
    FState:STATE;
  public
    constructor create;
    procedure   setState(val:STATE);
    function    getState:STATE;
    procedure   assign(src:TQueueElement);virtual;abstract;
    procedure   free;
    procedure   leave;
  end;

  TQueueElementClass=class of TQueueElement;

  TQueueDock=class
  private
    element:TQueueElement;
  public
    constructor create(elementClass:TQueueElementClass);
    function    getElement:TQueueElement;
  end;

  TSWHObjectQueue=class
  private
    queue:TList;
    FSize,
    FCount,
    top,
    rear:integer;

    elementClass:TQueueElementClass;
    dock:TQueueDock;
    sct:TRTLCriticalSection;

    procedure   addInstance;
    function    getState:STATE;
    procedure   remove;
  public
    property    size:integer read FSize;
    property    count:integer read FCount;
    constructor create(elementClass:TQueueElementClass;size:integer);
    function    push(element:TQueueElement):boolean;
    function    pop:TQueueElement;
    function    isEmpty:boolean;
    function    isFull:boolean;
    function    getFreeElement:TQueueElement;
  end;

  {线程池的实现,版本1.0 ,支持双重模式
     a,执行体由线程池来维护（生成，调用）
     b,执行体和线程池分开来维护（执行体要使用实例池来另外维护）
  }
  TRunner=class
  private
    param:array[0..1024*10] of char;
  public
    function  moveParam(buf:pointer;len:integer):boolean;
    function  getParam:pchar;
    procedure enterExecSection;virtual;abstract;
    procedure run;virtual;abstract;
    procedure leaveExecSection;virtual;abstract;
  end;

  TRunnerClass=class of TRunner;

  TSWHThread10=class(TThread)
  private
    maxTime:integer;
    freeTime:integer;
    runner:TRunner;
    busy:boolean;
  public
    property    isBusy:boolean read busy;
    procedure   Execute;override;
    constructor create(runner:TRunner;waitTime:integer);
    function    timeGo:boolean;
    procedure   run(param:pointer;len:integer);
    procedure   setRunner(runner:TRunner);
  end;

  IThreadPool=interface
    function run(param:pointer;len:integer):boolean;
  end;

  TThreadPool=class(TInterfacedObject,IThreadPool)
  private
    runnerClass:TRunnerClass;
    pool:TList;

    seedSize,
    size,
    waitTime:integer;
    timer:TTimer;
    sect:TRTLCriticalSection;

    function  addThread:TSWHThread10;
    procedure onTimer(sender:Tobject);
    function  getFreeThrd:TSWHThread10;
  public
    {模式b}
    constructor create(seedSize,size,waitTime:integer);overload;

    {模式a}
    constructor create(runnerClass:TRunnerClass;seedSize,size,waitTime:integer);overload;
    function    run(param:pointer;len:integer):boolean;overload;

    function    toString:string;
  end;


  {日期的操作}
  DATESET=(SWH_YEAR,SWH_MON,SWH_DATE,SWH_HOUR,SWH_MIN,SWH_SEC,SWH_MSEC,SWH_COMMON);
  FIELDTYPE=(FIELD,STR);
  TNode=record
    dateField:DATESET;
    str:string;
  end;
  TNodeList=array of TNode;

  TSWHDate=class
  private
    date:TDateTime;
    class function  parseFormat(date:TDateTime;strFormat:string):TNodeList;
  public
    constructor     create(date:TDateTime);overload;
    constructor     create;overload;
    procedure       setDate(date:TDateTime);
    procedure       incDate(days:integer);
    function        getYear:integer;
    function        getMon:integer;
    function        getDate:integer;
    function        getHour:integer;
    function        getMin:integer;
    function        getSec:integer;
    function        getMSec:integer;
    class function  formatDateTime(dt:TDateTime;strFormat:string):string;overload;
    function        formatDateTime(strFormat:string):string;overload;
  end;


  {  日志   }
  IFormater=interface
    function   format(arg:string):string;overload;
    function   format(args:TStrings):string;overload;
  end;

  IWriter=interface
    procedure  write(log:string);
  end;

  TLogWriter=class
  private
    writer:IWriter;
    formater:IFormater;
    level:byte;
    enable:boolean;

    function    getLevel:byte;
    procedure   write(arg:string);overload;
    procedure   write(args:TStrings);overload;
  public
    constructor create(writer:IWriter;formater:IFormater);
    procedure   setEnable(val:boolean);

    procedure   debug(args:TStrings);overload;
    procedure   debug(arg:string);overload;

    procedure   track(args:TStrings);overload;
    procedure   track(arg:string);overload;

    procedure   error(args:TStrings);overload;
    procedure   error(arg:string);overload;
  end;

  TTxtLogFormat=class(TInterfacedObject,IFormater)
  public
    function   format(arg:string):string;overload;
    function   format(args:TStrings):string;overload;
  end;

  TTxtLogWriter=class(TInterfacedObject,IWriter)
  private
    procedure createLog;
  public
    procedure write(log:string);
  end;

implementation

{ TTxtLogWriter }

procedure TTxtLogWriter.createLog;
var
  dir: TSearchRec;
  ret: integer;
  path: string;
  f:TextFile;
begin
  //创建路径
  try
    path:=TShare.getAppRootDir;
    path:=path+'log';
    ret:=sysUtils.findFirst(path,faAnyFile,dir);

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

  //创建LOG
  path:=path+'\'+formatDateTime('yyyymmdd',now)+'.log';
  try
    if not fileExists(path) then
    begin
      try
        assignFile(f,path);
        rewrite(f);
      finally
        closeFile(f);
      end;
    end;
  except
    on Exception do  ;
  end;
end;

procedure TTxtLogWriter.write(log: string);
var
  path:string;
  f:TextFile;
begin
  createLog;

  path:=TShare.getAppRootDir+'log\'+formatDateTime('yyyymmdd',now)+'.log';
  try
    try
      assignFile(f,path);
      append(f);
      writeln(f,log);
    finally
      closeFile(f);
    end;
  except
    on Exception do;
  end;
end;

{ TTxtLogFormat }

function TTxtLogFormat.format(args: TStrings): string;
begin
  result:=formatDateTime('yyyy-mm-dd hh:mm:ss',now)+'---'+args.text;
end;

function TTxtLogFormat.format(arg: string): string;
begin
  result:=formatDateTime('yyyy-mm-dd hh:mm:ss',now)+'---'+arg;
end;

{ TLogWriter }

constructor TLogWriter.create(writer: Iwriter; formater: IFormater);
begin
  self.writer:=writer;
  self.formater:=formater;
  enable:=true;
end;

procedure TLogWriter.debug(arg: string);
begin
  if not enable then exit;

  level:=getLevel;
  if level<=0 then
  begin
    write(arg);
  end;
end;

procedure TLogWriter.debug(args: TStrings);
begin
  if not enable then exit;

  level:=getLevel;

  if level<=0 then
  begin
    write(args);
  end;
end;

function TLogWriter.getLevel: byte;
var
  ini:TIniFile;
  l:string;
begin
  result:=100;

  ini:=TIniFile.Create(TShare.getAppRootDir+'log.ini');
  try
    l:=ini.ReadString('init','level','TRACK');

    if l='DEBUG' then
      result:=2
    else if l='TRACK' then
            result:=1
         else if l='ERROR' then
                result:=0;
  finally
    ini.Free;
  end;
end;

procedure TLogWriter.write(arg:string);
begin
  writer.write(formater.format(arg));
end;

procedure TLogWriter.track(arg: string);
begin
  if not enable then exit;

  level:=getLevel;
  if level<=1 then
  begin
    write(arg);
  end;
end;

procedure TLogWriter.track(args: TStrings);
begin
  if not enable then exit;

  level:=getLevel;

  if level<=1 then
  begin
    write(args);
  end;
end;

procedure TLogWriter.write(args: TStrings);
begin
  writer.write(formater.format(args));
end;

procedure TLogWriter.error(args: TStrings);
begin
  if not enable then exit;

  level:=getLevel;

  if level<=2 then
  begin
    write(args);
  end;
end;

procedure TLogWriter.error(arg: string);
begin
  if not enable then exit;

  level:=getLevel;
  if level<=2 then
  begin
    write(arg);
  end;
end;

procedure TLogWriter.setEnable(val: boolean);
begin
  enable:=val;
end;

{ TShare }

class function TShare.AddSQL(PreSQL, strSQL: string): string;
begin
  result:=addSQL(preSQL,strSQL,';');
end;

class function TShare.AddSQL(strPre, strSQL, s: string): string;
begin
  if strSQL='' then exit;

  if strPre<>'' then
    result:=strPre+s+strSQL
  else result:=strSQL;
end;

class procedure TShare.adoDataSetExec(con: TADOConnection;
  query: TADOQuery; strSQL: string);
begin
  query.Connection:=con;
  query.Close;
  query.SQL.Clear;
  query.SQL.Add(strSQL);

  adoDataSetUpdate(con,query);
end;

class procedure TShare.adoDataSetOpen(con: TADOConnection;
  query: TADOQuery;strSQL:string);
var
  i:byte;
begin
  if (query=nil) or (con=nil) then  exit;

  query.Connection:=con;

  with query do
  begin
    close;
    SQL.Clear;
    SQL.Add(strSQL);
  end;

  i:=0;
  while i<=2 do
  begin
    try
      query.Open;
      break;
    except
      on exception do
      begin
        try
          con.Close;
          con.Open;
        except
          on exception do ;
        end;

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

class procedure TShare.adoDataSetUpdate(con: TADOConnection;
  query: TADOQuery);
var
  i:byte;
begin
  if (query=nil) or (con=nil) then  exit;

  query.Connection:=con;

  i:=0;
  while i<=2 do
  begin
    try
      query.ExecSQL;

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

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

class function TShare.Bin2HexStr(buf: Pchar; Count: Cardinal): string;
var
  HexBuf:pchar;
  i:integer;
begin
  i:=Count*2+1;
  GetMem(HexBuf,i);
  ZeroMemory(HexBuf,i);

  try
    BinToHex(buf,HexBuf,Count);

    Result:=StrPas(HexBuf);
  finally
    FreeMem(HexBuf);
  end;
end;

class function TShare.bin2HexStrFromEnd(buf: pchar;
  count: cardinal): string;
var
  i,j:integer;
  buffer:pchar;
begin
  getMem(buffer,count);
  try
    j:=0;
    for i:=count-1 downto 0 do
    begin
      buffer[j]:=buf[i];

      inc(j);
    end;

    result:=bin2HexStr(buffer,count);
  finally
    freeMem(buffer);
  end;
end;

class function TShare.buf2PasStr(const buf; len: integer): string;
var
  buffer:pchar;
  i:integer;
begin
  buffer:=pchar(@buf);

  for i:=0 to len-1 do
    result:=result+','+inttostr(ord(buffer[i]));
end;


class function TShare.Char2Byte(aChr: Char): byte;
var
  byteRlt:byte;
begin
  byteRlt:=0;

  case aChr of
    '0'..'9':byteRlt:=ord(aChr)-48;
    'a'..'f':byteRlt:=ord(aChr)-87;
    'A'..'F':byteRlt:=ord(aChr)-55;
  end;

  result:=byteRlt;
end;

class function TShare.compareIntegerStr(str1, str2: string): shortint;

  function compareInt(int1,int2:integer):shortint;
  begin
    result:=0;

    if int1<int2 then
      result:=-1
    else if int1>int2 then