share.~pas

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

{*******************************************************}
{                                                       }
{              荆鹏亿信分公司SP系统                     }
{　　　　　　　　　　　　　　 　　　　　　　　　        }
{                   公共单元                            }
{                                                       }
{         程序员：宋伟华    2004.2.03                   }
{                                                       }
{  版权 (c)  2003-2004 荆鹏软件开发有限公司　　　　　　 }
{                                                       }
{*******************************************************}
unit Share;

interface

uses
  sysUtils,Dialogs,Windows,Messages,iniFiles,Forms,Classes,ActiveX,IdGlobal,ADODB,
  Contnrs,ExtCtrls,DateUtils,winsock,csintf;

const
   EOF=-1;

type
  STATE=(EMPTY,USING,FULL,NORMAL);

  TShare=class
  public
    //对Ini文件的基本操作
    class function  ReadFrmIni(Path,Section,Key:string):string;
    class procedure Write2Ini(Path,Section,Key,Val:string);

    class function  ContainCh(aStr:string):boolean;

    class function  MakeByte(A,B:Byte):Byte;
    class function  MsgIDComp(MsgIDA,MsgIDB:Int64Rec):boolean;
    class function  Char2Byte(aChr:Char):byte;

    class function  Bin2HexStr(buf:Pchar;Count:Cardinal):string;
    class function  bin2HexStrFromEnd(buf:pchar;count:cardinal):string;
    class function  UniBin2PasStr(buf:pchar;Cnt:Cardinal): WideString;
    class procedure PasStr2UniBuf(PasStr:string;buf:pchar);

    class function  getAppRootDir:string;
    class function  FormatADOConStr(Provider,UserPassword,UserID,DBName,ServerIP:string):string;overload;
    class function  formatADOConstr(userName,pwd,dbName:string):string;overload;

    class procedure strTokenize(doStr:string;sign:string;var reslt:TStrings);

    class function  AddSQL(PreSQL,strSQL: string):string;overload;
    class function  addSQL(strPre,strSQL,s:string):string;overload;
    class function  createInsertSQL(tabName,fields,values:string):string;

    class function  fillChar(chr:char;cnt:integer):string;
    class function  compareStr(intStr1,intStr2:string):shortint;
    class function  isInteger(str:string):boolean;
    class function  compareIntegerStr(str1,str2:string):shortint;

    class function  doSQLStr(strSQL:string):string;

    class procedure adoDataSetOpen(con:TADOConnection;query:TADOQuery;strSQL:String);
    class procedure adoDataSetUpdate(con:TADOConnection;query:TADOQuery);

    class function  swhPower(Mantissa,Exponent:Integer):double;
    class function  buf2PasStr(const buf;len:integer): string;

    class procedure       writeLog(path,log:string);
    class function        getNow:string;
  end;

  TTimerEvent=procedure(sender:TObject) of Object;
  TTimerProc=procedure;

  TSPTimer = class(TComponent)
  private
    FInterval: Cardinal;
    FWindowHandle: HWND;
    FEnabled: Boolean;
    FOnTimer:TTimerEvent;
    FDoTimer:TTimerProc;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure setDoTimer(doTimer:TTimerProc);
    procedure setOnTimer(onTimer:TTimerEvent);

    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer;
  public
    property    OnTimer:TTimerEvent read FOnTimer write setOnTimer;
    property    DoTimer:TTimerProc read FDoTimer write setDoTimer;

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property    Enabled: Boolean read FEnabled write SetEnabled default true;
    property    Interval: Cardinal read FInterval write SetInterval default 1000;
  end;

  TMutexer=class
  private
    seed:boolean;//=false 处于占有状态;=true 处于空闲状态
  public
    constructor create;
    function getSeed:boolean;
    procedure Lock;
    procedure Unlock;
  end;

  TCardList=class
  private
    List:array of Cardinal;
    FSize:integer;
    top:integer;
    procedure setSize(val:integer);
  public
    constructor create;
    property Size:integer read FSize write setSize;
    procedure LoadData(lst:array of Cardinal);
    function FindElement(element:Cardinal):Boolean;
    function getElement:Cardinal;
    procedure first;
    procedure last;
    function next:integer;
    function getElemets:string;
  end;

  TIterator=class
  private
    link:array of TObject;
    top:integer;
  public
    constructor create;
    procedure addNode(obj:TObject);
    procedure first;
    procedure next;
    function getNode:TObject;
  end;

  IBehavior=interface
    function Filter(obj:TObject):boolean;
  end;

  TFilter=class
  private
    reslt:TIterator;
    Action:IBehavior;
  public
    constructor create(behavior:IBehavior;data:array of TObject);
    function getIterator:TIterator;
  end;


  {序列生成器}
  TSeqNumBuf=record
    min,
    max,
    seqNum:Cardinal;
  end;

  TIniFileInf=record
    filePath,
    section,
    key:string;
  end;

  TDBTabInf=record
    con:TADOConnection;
    tabName,
    propertyName,
    propertyVal,
    valName:string;
  end;

  IIOOperator=interface
    procedure retrieve(bufSize:cardinal;var min,max:cardinal);
  end;

  TSeqNumGenerator=class
  private
    bufSize:Cardinal;
    buf:TSeqNumBuf;
    ioOper:IIOOperator;
    sect:TRTLCriticalSection;

    procedure fillBuf;
  public
    constructor create(bufSize:cardinal;ioOper:IIOOperator);
    function    getSeqNum:cardinal;
    function    getCurSeqNum:cardinal;
  end;

  TIniIOOper=class(TInterfacedObject,IIOOperator)
  private
    iniFileInf:TIniFileInf;
  public
    constructor create(iniFileInf:TIniFileInf);
    procedure   retrieve(bufSize:cardinal;var min,max:cardinal);
  end;

  TDBIOOper=class(TInterfacedObject,IIOOperator)
  private
    dbTabInf:TDBTabInf;
    query:TADOQuery;
  public
    constructor create(dbTabInf:TDBTabInf);
    procedure   retrieve(bufSize:cardinal;var min,max:cardinal);
  end;


  {       写数据库SQL语句缓冲管理         }
  {               说明                    }
  {   本抽象类不提供格式化SQL语句的模板， }
  {它具有很灵活的表象。因此，在其子类中   }
  {根据需要来扩加相应的格式化功能。       }
  IDBWriter=interface
    procedure commit(sqlStrs:string);
  end;

  TDBWriteBuffer=class
  private
    sqlStrs:TStrings;
    FSize,
    sqlCounter,
    FWaitTime,
    timeCounter:integer;
    DBWriter:IDBWriter;
    timer:TTimer;

    sect:TRTLCriticalSection;
    procedure OnTimer(sender:TObject);
  public
    property size:integer read FSize write FSize;
    property waitTime:integer read FWaitTime write FWaitTime;

    constructor create(waitTime,size:integer;DBWriter:IDBWriter);

    destructor  destroy;override;
    procedure   sqlPush(sqlStr:string);
    function    sqlPop:string;
    procedure   timeGo;
    procedure   commit;
    function    toStrinig:string;
  end;

  {模版}
  TADODBWriter=class(TInterfacedObject,IDBWriter)
  private
    query:TADOQuery;
    con:TADOConnection;
  public
    constructor create(con:TADOConnection);
    procedure   commit(sqlStrs:string);
  end;


  {       队列机       }
  TLock=class
  private
    aLock:boolean;
  public
    constructor create;
    procedure lock;
    procedure unlock;
    function getState:boolean;
  end;

  TJPObjectQueue=class
  private
    queue:array of TObject;

    FSize,
    FSafeSize,
    FCount,
    rear,
    top:integer;

    lock:TLock;
  protected
    function pPush(obj:TObject):boolean;
    function pSafePush(obj:TObject):boolean;

    function pPop:TObject;
    procedure pRemoveNoFree;
  public
    property size:integer read FSize write FSize;
    property safeSize:integer read FSafeSize write FSafeSize;
    property count:integer read FCount write FCount;
    property head:integer read top;
    property bottom:integer read rear;

    constructor create(size,safeSize:integer);

    function isEmpty:boolean;
    function isSafeFull:boolean;
    function isFull:boolean;

    procedure remove;
  end;

  {等待队列}
  TWaitUnit=class
  private
    waitTime:integer;
    data:TObject;

    isFreeData:boolean;
  public
    property freeData:boolean read isFreeData write isFreeData;

    constructor create(data:TObject);
    function getID:cardinal;virtual;abstract;
    procedure timeGo;
    function getTime:cardinal;
    procedure resetTime;
    function getData:TObject;
    destructor destroy;override;
  end;

  TJPWaitObjectQueue=class
  private
    FSize,
    FSafeSize,
    FCount,
    FMaxTime:integer;

    lock:TLock;

    function getObjByID(id:cardinal;var index:cardinal):TWaitUnit;
    function getFreePos:integer;
  protected
    function cusPush(obj:TWaitUnit):boolean;
    function cusSafePush(obj:TWaitUnit):boolean;
    function cusGetByID(id:cardinal;var index:integer):TWaitUnit;
    procedure timeGo;
    function getByIndex(ind:integer):TWaitUnit;
  public
    queue:array of TWaitUnit;

    property size:integer read FSize write FSize;
    property safeSize:integer read FSafeSize write FSafeSize;
    property count:integer read FCount write FCount;
    property maxTime:integer read FMaxTime write FMaxTime;
    property rLock:TLock read lock;

    constructor create(size,safeSize,maxTime:integer);

    function isEmpty:boolean;
    function isFull:boolean;
    function isSafeFull:boolean;

    procedure removeByIndex(index:cardinal);
    procedure removeNoFreeByIndex(index:cardinal);virtual;abstract;

    procedure removeByID(id:cardinal);
    procedure removeNoFreeByID(id:cardinal);

    procedure moveData;virtual;abstract;
    procedure moveDataByID(id:Cardinal);virtual;abstract;
  end;


  {            列表
       说明：必须把LinkNode结构中的指针指向你的数据结构中
   }
  PLinkNode=^LinkNode;
  LinkNode=packed record
    data:pointer;
    next,
    prior:PLinkNode;
  end;

  IIterator=interface
    procedure first;
    function  eol:boolean;
    procedure next;
    function  getData:PLinkNode;
  end;

  IReverseIterator=interface
    procedure last;
    function  bol:boolean;
    procedure prior;
    function  getData:PLinkNode;
  end;

  TJPIterator=class;

  TJPAbstractLink=class
  private
    link,
    rear:PLinkNode;

    FMax,
    cnt:integer;
    sect:TRTLCriticalSection;
  protected
    property max:integer read FMax;

    function vPush(pData:pointer):boolean;
    function vNext(pNode:PLinkNode):PLinkNode;
    function vPrior(pNode:PLinkNode):PLinkNode;
    function vRemove(pNode:PLinkNode):boolean;
  public
    property count:integer read cnt;
    property head:PLinkNode read link;
    property bottom:PLinkNode read rear;

    constructor create(max:integer);
    function    getIterator:IIterator;
  end;

  TJPIterator=class(TInterfacedObject,IIterator)
  private
    link:TJPAbstractLink;
    top:PLinkNode;
  public
    constructor create(link:TJpAbstractLink);
    procedure first;
    function  eol:boolean;
    procedure next;
    function  getData:PLinkNode;
  end;

  {ini文件的操作接口}
  IIniOperator=interface
    function getIniPath:string;
    function refresh:boolean;
    function save:boolean;
  end;

  {计数器}
  TJPCounter=class
  private
    maxTime,
    waitTime:integer;
  public
    procedure   onCounter;virtual;abstract;

    constructor create(maxTime:integer);
    procedure   resetCounter;
    function    timeGo:boolean;
  end;

  {观察者模式}
  TAbstractObserver=class
    procedure action(param:pointer);virtual;abstract;
  end;

  TSubject=class
  private
    list:TList;
  public
    constructor create;
    destructor  destroy;override;
    procedure   addObserver(obj:TAbstractObserver);
    procedure   delObserver(obj:TAbstractObserver);
    procedure   inform(param:pointer);
  end;

  {xml操作者}
  TAbstractXML=class
  private
    procedure createLogDir;
  protected
    function getPath:string;
  public
    constructor create;
    procedure   addLog(p:pointer);virtual;abstract;
  end;

  {静态队列}
  TStaticQueue=class
  private
    buffer:array of pointer;

    size,cnt,top,rear:cardinal;
    sect:TRTLCriticalSection;
  public
    constructor create(size:integer);

    function  isEmpty:boolean;
    function  isFull:Boolean;
    function  push(p:pointer):Boolean;
    function  pop:pointer;
    procedure remove;
    function  popAndRemove:pointer;virtual;
  end;

  {                        处理链
      看似一个处理的电路，支持“断路”、“多段电路的串联”、
   “和遗留模块的接口”}
  IWorkerAction=interface
    procedure action(param:pointer);
  end;

  IWorkerChainNode=interface(IWorkerAction)
    function  getNext:IWorkerAction;
    procedure setNext(next:IWorkerAction);
  end;

  IWorkerChainHead=interface(IWorkerAction)
    function  getWorker:IWorkerAction;
    procedure setWorker(worker:IWorkerAction);
  end;

  IWorkerChainRear=interface(IWorkerAction)
    function  getInterface:IWorkerAction;
    function  getLastNode:IWorkerChainNode;
    procedure setLastNode(node:IWorkerChainNode);
  end;

  TDefaultWorkerChainHead=class(TInterfacedObject,IWorkerChainHead)
  private
    worker:IWorkerAction;
  public
    constructor create(chainRear:IWorkerChainRear);
    procedure action(param:pointer);
    function  getWorker:IWorkerAction;
    procedure setWorker(worker:IWorkerAction);
  end;

  TDefaultWorkerChainRear=class(TInterfacedObject,IWorkerChainRear)
  private
    intf:IWorkerAction;
    lastNode:IWorkerChainNode;
  public
    constructor create(intf:IWorkerAction);
    procedure action(param:pointer);
    function  getInterface:IWorkerAction;

    function  getLastNode:IWorkerChainNode;
    procedure setLastNode(node:IWorkerChainNode);
  end;

  TDefaultWorkerChainNode=class(TInterfacedObject,IWorkerChainNode)
  private
    nextWorker:IWorkerAction;
  public
    function  getNext:IWorkerAction;
    procedure setNext(next:IWorkerAction);
    procedure action(param:pointer);virtual;abstract;
  end;

  IWorkerChainManager=interface
    function getChainHead:IWorkerChainHead;
    procedure addWorker(worker:IWorkerChainNode);
  end;

  TDefaultWorkerChainManager=class(TInterfacedObject,IWorkerChainManager)
  private
    head:IWorkerChainHead;
    rear:IWorkerChainRear;
  public
    constructor create(otherIntf:IWorkerAction);
    function getChainHead:IWorkerChainHead;
    procedure addWorker(worker:IWorkerChainNode);
  end;

  IChainConnector=IWorkerAction;

  {       实例池
    调用：
        sub:=TSubmit(p.getObj);
        try
          sub.ii:=13;

          showMessage(format('count=%D',[p.cnt]));
        finally
          sub.leave;
        end;}

  TInstancePool=class;

  TPoolObject=class
  private
    pool:TInstancePool;
  public
    constructor create(pool:TInstancePool);
    procedure   passivate;
  end;

  TPoolObject11=class(TPoolObject)
  private
    FState:STATE;
  public
    property    state:STATE read FState;
    constructor create;
    procedure   passivate;
    procedure   leave;
    procedure   enter;
  end;

  TJPObjectClass=class of TPoolObject;
  TJPObjectClass11=class of TPoolObject11;


  TInstancePool=class
  private
    initSize,
    maxSize:integer;
    objClass:TJPObjectClass;
    pool:TList;

    count:integer;
    sect:TRTLCriticalSection;

    function  createObj:TObject;
  public
    constructor create(objClass:TJPObjectClass;initSize,maxSize:integer);

    function    getCount:integer;
    function    getPoolCount:integer;
    function    activate:TPoolObject;
    procedure   passivate(obj:TPoolObject);
  end;

  TInstancePool11=class(TInstancePool)
  private
    initSize,
    maxSize:integer;
    objClass:TJPObjectClass11;
    pool:TList;

    count:integer;
    sect:TRTLCriticalSection;

    function  createObj:TObject;
  public
    property    cnt:integer read count write count;
    constructor create(objClass:TJPObjectClass11;initSize,maxSize:integer);
    procedure   passivate(obj:TPoolObject);
    function    activate:TPoolObject11;

    function    getObj:TPoolObject11;
  end;

  {链路测试器}
  ChannelParam=record
    initSize,
    size,
    freeTime:integer;
  end;

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