share.pas

delphi工具类

           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.formatJetADOConstr(path,user,pwd:string): string;
begin
  result:=format(
                  'Provider=Microsoft.Jet.OLEDB.4.0;'+
                  'User ID=%s;'+
                  'Data Source=%s;'+
                  'Mode=Share Deny None;Extended Properties="";'+
                  'Jet OLEDB:Database Password=%s',[user,path,pwd]);
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.getTempDir: string;
var
  buf:array[0..255] of char;
begin
  system.fillchar(buf,sizeof(buf),0);

  getTempPath(256,buf);

  result:=strpas(buf);
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);
  finally
    closeFile(f);
  end;
end;

{ TSPTimer }

constructor TSPTimer.Create(AOwner: TComponent);
begin
  inherited;
  FEnabled:=true;
  FInterval:=1000;

  FOnTimer:=nil;
  FWindowHandle := Classes.AllocateHWnd(WndProc);
end;

destructor TSPTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;

  Classes.DeallocateHWnd(FWindowHandle);

  inherited;
end;

procedure TSPTimer.setDoTimer(doTimer: TTimerProc);
begin
  FDoTimer:=doTimer;

  UpdateTimer;
end;

procedure TSPTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;

    UpdateTimer;
  end;
end;

procedure TSPTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TSPTimer.setOnTimer(onTimer: TTimerEvent);
begin
  FOnTimer:=onTimer;

  UpdateTimer;
end;

procedure TSPTimer.Timer;
begin
  if Assigned(OnTimer) then
    OnTimer(nil);

  if Assigned(DoTimer) then
    DoTimer;
end;

procedure TSPTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);

  if (FInterval <> 0) and FEnabled and  (Assigned(DoTimer) or Assigned(OnTimer))  then
  begin
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
      raise EOutOfResources.Create('时钟类在开启的时候出错！');
  end;
end;

procedure TSPTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

{ TMutexer }

constructor TMutexer.create;
begin
  seed:=true;
end;

function TMutexer.getSeed: boolean;
begin
  result:=seed;
end;

procedure TMutexer.Lock;
begin
  if seed then
    seed:=false;
end;

procedure TMutexer.Unlock;
begin
  seed:=true;
end;

{ TCardList }

constructor TCardList.create;
begin
  top:=-1;
end;

function TCardList.FindElement(element: Cardinal):boolean;
var
  i:integer;
begin
  result:=true;
  i:=0;
  while (i<size) and (element<>list[i]) do
    inc(i);

  if i>=size then result:=false;
end;

procedure TCardList.first;
begin
  top:=-1;
end;

function TCardList.getElement: Cardinal;
begin
  result:=list[top];
end;

function TCardList.getElemets: string;
var
  i:integer;
begin
  for i:=low(list) to high(list) do
    if result<>'' then
      result:=result+';'+inttostr(list[i])
    else result:=inttostr(list[i]);
end;

procedure TCardList.last;
begin
  top:=size-1;
end;

procedure TCardList.LoadData(lst: array of Cardinal);
var
  i:integer;
  high1,high2:integer;
begin
  size:=high(lst)+1;

  high1:=high(list);
  high2:=high(lst);

  i:=0;
  while (i<=high1) and (i<=high2) do
  begin
    list[i]:=lst[i];
    inc(i);
  end;
end;

function TCardList.next:integer;
begin
  inc(top);

  result:=top;
  if top>=size then begin
    result:=EOF;
    top:=-1;
  end;
end;

procedure TCardList.setSize(val: integer);
begin
  if val<=0 then exit;

  if val<>FSize then
  begin
    FSize:=val;
    SetLength(List,FSize);
  end;
end;

{ TIterator }

procedure TIterator.addNode(obj: TObject);
begin
  setLength(link,high(link)+1);
  link[high(link)]:=obj;
end;

constructor TIterator.create;
begin
  top:=-1;
end;

procedure TIterator.first;
begin
  top:=-1;
end;

function TIterator.getNode: TObject;
begin
  result:=link[top];
end;

procedure TIterator.next;
begin
  inc(top);
  if top>=high(link)+1 then
    top:=EOF;
end;

{ TFilter }

constructor TFilter.create(behavior: IBehavior;data:array of TObject);
var
  i:integer;
begin
  Action:=behavior;

  for i:=low(data) to high(data) do
    if Action.Filter(data[i]) then
      reslt.addNode(data[i]);
end;

function TFilter.getIterator: TIterator;
begin
  result:=reslt;
end;

{ TSeqNumGenerator }

constructor TSeqNumGenerator.create(bufSize: cardinal;ioOper:IIOOperator);
begin
  self.bufSize:=bufSize;
  self.ioOper:=ioOper;

  buf.min:=1;
  buf.max:=bufSize;
  buf.seqNum:=bufSize;

  initializeCriticalSection(sect);
end;

procedure TSeqNumGenerator.fillBuf;
begin
  ioOper.retrieve(BufSize,buf.min,buf.max);
  buf.seqNum:=buf.min;
end;

function TSeqNumGenerator.getCurSeqNum: cardinal;
begin
  result:=buf.seqNum;
end;

function TSeqNumGenerator.getSeqNum: cardinal;
begin
  enterCriticalSection(sect);

  try
    inc(buf.seqNum);

    if buf.seqNum>buf.max then
       fillBuf;

    result:=buf.seqNum;
  finally
    leaveCriticalSection(sect);
  end;
end;

{ TIniIOOper }

constructor TIniIOOper.create(iniFileInf: TIniFileInf);
begin
  self.iniFileInf:=iniFileInf;
end;

procedure TIniIOOper.retrieve(bufSize:cardinal;var min, max: cardinal);
var
  iniFile:TIniFile;
  tmpCard,tmpCard1:Cardinal;
begin
  iniFile:=TIniFile.Create(iniFileInf.filePath);

  try
    {预定式模式：首先，把数据存储值修改。然后，完成本地的数据修改}
    tmpCard:=strtocard(iniFile.ReadString(iniFileInf.section,iniFileInf.key,'1'));
    tmpCard1:=tmpCard+bufSize;

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

    min:=tmpCard;
    max:=tmpCard1-1;
  finally
    iniFile.Free;
  end;
end;

{ TDBWriteBuffer }

procedure TDBWriteBuffer.commit;
begin
  enterCriticalSection(sect);

  try
    if sqlCounter<=0 then  exit;

    DBWriter.commit(sqlPop);
  finally
    leaveCriticalSection(sect);
  end;
end;

constructor TDBWriteBuffer.create(waitTime,size: integer;DBWriter:IDBWriter);
begin
  sqlStrs:=TStringList.Create;

  self.DBWriter:=DBWriter;
  self.waitTime:=waitTime;
  self.size:=size;

  sqlCounter:=0;
  timeCounter:=0;

  initializeCriticalSection(sect);

  timer:=TTimer.create(nil);
  timer.Interval:=1000;
  timer.OnTimer:=OnTimer;
  timer.Enabled:=true;
end;

destructor TDBWriteBuffer.destroy;
begin
  sqlStrs.Free;

  inherited;
end;

procedure TDBWriteBuffer.OnTimer(sender: TObject);
begin
  timeGo;
end;

function TDBWriteBuffer.sqlPop:string;
begin
  enterCriticalSection(sect);
  try
    result:='';

    if trim(sqlStrs.Text)<>'' then
    begin
      result:=sqlStrs.Text;
      sqlStrs.Clear;