share.~pas

SMGSession,一个短信网关接口代码

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

  TChannel=class
  private
    isBusy:boolean;
    counter:TChannelCounter;

    sect:TRTLCriticalSection;
  public
    constructor create(freeTime:integer);
    destructor  destroy;override;

    procedure   enterCriticalSect;
    procedure   leaveCriticalSect;
    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;

    procedure   timesGo;
    function    reconnect:boolean;
    procedure   ontimer(sender:TObject);
    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;

    sect:TRTLCriticalSection;

    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;

implementation

{ 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.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 F:exception do
      begin
        try
          con.Close;
          con.Open;
        except
          on E: Exception do codesite.sendmsg(E.Message+#13+#10+' TShare.adoDataSetOpen in share of cmserver 1');
        end;
        codesite.sendmsg(F.Message+#13+#10+' TShare.adoDataSetOpen in share of cmserver 2');
        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 F:exception do
      begin
        try
          con.Close;
          con.Open;
        except
          on E: Exception do codesite.sendmsg(E.Message+#13+#10+'TShare.adoDataSetUpdate in share of cmserver 1');
        end;
        codesite.sendmsg(F.Message+#13+#10+'TShare.adoDataSetUpdate in share of cmserver 2');
        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
           result:=1;
  end;
var
  str1Len,str2Len:integer;
begin
  result:=-2;
  str1:=trim(str1);
  str2:=trim(str2);

  if (str1='') or (str2='') then exit;
  if (not isInteger(str1)) or (not isInteger(str2)) then exit;

  str1Len:=length(str1);
  str2Len:=length(str2);

  if (str1Len<=9) and (str2Len<=9) then
  begin
    result:=compareInt(strtoint(str1),strtoint(str2));
  end else begin
              if str1Len>str2Len then
                str2:=fillChar('0',str1Len-str2Len)+str2
              else if str1Len<str2Len then
                      str1:=fillChar('0',str2Len-str1Len)+str1;

              result:=compareStr(str1,str2);
            end;
end;

class function TShare.compareStr(intStr1, intStr2: string): shortint;
var
  i,len:integer;
  tmp1,tmp2:integer;
begin
  result:=-2;

  if intStr1=intStr2 then
  begin
    result:=0;
    exit;
  end;

  i:=1;
  len:=length(intStr1);
  while i<=len do
  begin
    tmp1:=strtoint(copy(intStr1,i,9));
    tmp2:=strtoint(copy(intStr2,i,9));

    if tmp1>tmp2 then
    begin
      result:=1;
      break;
    end else if tmp1<tmp2 then
             begin
               result:=-1;
               break;
             end;

    inc(i,9);
  end;
end;


class function TShare.ContainCh(aStr: string): boolean;
var
  i:integer;
begin
  Result:=false;
  for i:=1 to Length(aStr) do
    if ord(aStr[i])>=128 then
    begin
      Result:=true;
      Break;
    end;
end;

class function TShare.createInsertSQL(tabName, fields,
  values: string): string;
begin
  result:=format('INSERT INTO %S(%S) VALUES(%S)',[tabName,fields,values]);
end;

class function TShare.doSQLStr(strSQL: string): string;
begin
  result:=StringReplace(strSQL,'''','‘',[rfReplaceAll]);
  result:=StringReplace(result,'"','“',[rfReplaceAll]);
  result:=StringReplace(result,'*','×',[rfReplaceAll]);
  result:=StringReplace(result,'%','％',[rfReplaceAll]);
  result:=StringReplace(result,'?','？',[rfReplaceAll]);
  result:=StringReplace(result,'#','#',[rfReplaceAll]);
end;

class function TShare.fillChar(chr: char;cnt:integer): string;
var
  i:integer;
begin
  result:='';
  for i:=1 to cnt do
    result:=result+chr;
end;

class function TShare.FormatADOConStr(Provider,UserPassword,UserID,DBName,ServerIP:string): string;
begin
  if Provider='' then Provider:='SQLOLEDB.1';
  if ServerIP='' then ServerIP:='.';

  Result:=Format('Provider=%s;Password=%s;User ID=%s;Initial Catalog=%s;Data Source=%s',[Provider,UserPassword,UserID,DBName,ServerIP]);
end;

class function TShare.FormatADOConStr(userName, pwd,
  dbName: string): string;
begin
  result:=Format('Provider=MSDAORA.1;Password=%S;User ID=%S;Data Source=%S',[pwd,userName,dbName]);
end;

class function TShare.getAppRootDir: string;
begin
  result:=extractFilePath(application.ExeName);
end;

class function TShare.getNow: string;
begin
  result:=formatDateTime('yyyy-mm-dd hh:mm:ss',now);
end;

class function TShare.isInteger(str: string): boolean;
var
  i:integer;
begin
  result:=true;

  str:=trim(str);
  if str='' then
  begin
    result:=false;
    exit;
  end;

  i:=1;
  while (str[i] in ['0'..'9']) and (i<=length(str)) do  inc(i);

  if i<=length(str) then  result:=false;
end;

class function TShare.MakeByte(A, B: Byte): Byte;
begin
  Result :=B or A shl 4;
end;

class function TShare.MsgIDComp(MsgIDA, MsgIDB: Int64Rec): boolean;
begin
  Result:=false;
  if (MsgIDA.Lo=MsgIDB.Lo) and (MsgIDA.Hi=MsgIDB.Hi) then Result:=true;
end;

class procedure TShare.PasStr2UniBuf(PasStr: string; buf: pchar);
var
  WStr:WideString;
  i:integer;
  buffer:array[0..1023] of char;
  MsgLen:integer;
begin
  WStr:=PasStr;
  MsgLen:=length(WStr)*2;
  move(Pointer(@WStr[1])^,pointer(@buffer[0])^,MsgLen);
  i:=0;

  while i<MsgLen do
  begin
    buf[i]:=buffer[i+1];
    buf[i+1]:=buffer[i];
    inc(i,2);
  end;
end;

class function TShare.ReadFrmIni(Path, Section, Key: string): string;
var
  iniFile:TIniFile;
begin
  iniFile:=TIniFile.Create(Path);
  try
    Result:=iniFile.ReadString(Section,Key,'err');
  finally
    iniFile.Free;
  end;
end;

class procedure TShare.strTokenize(doStr, sign: string;
  var reslt: TStrings);
begin
  reslt.Clear;
  reslt.Text:=StringReplace(doStr,sign,#13,[rfReplaceAll]);
end;

class function TShare.swhPower(Mantissa, Exponent: Integer): double;
var
  i,
  exp:integer;
begin
  result:=1;

  if exponent<>0 then
  begin
    if exponent<0 then exp:=-exponent
    else exp:=exponent;

    for i:=1 to exp do
      result:=result*mantissa;
  end;

  if exponent<0 then result:=1/result;
end;

class function TShare.UniBin2PasStr(buf:pchar;Cnt:Cardinal): WideString;
var
  i:Cardinal;
  tmpWStr:WideString;
begin
  tmpWStr:='';
  i:=0;
  while i<Cnt do
  begin
    tmpWStr:=tmpWStr+WideChar(MakeWord(ord(buf[i+1]),ord(buf[i])));
    i:=i+2;
  end;

  Result:=tmpWStr;
end;

class procedure TShare.Write2Ini(Path, Section, Key, Val: string);
var
  iniFile:TIniFile;
begin
  iniFile:=TIniFile.Create(Path);
  try
    iniFile.WriteString(Section,Key,Val);
  finally
    iniFile.Free;
  end;
end;

class procedure TShare.writeLog(path, log: string);
var
  f:TextFile;
begin
  assignFile(f,path);

  try
    append(f);
    writeln(f,getNow+log);