stringplus.pas

delphi：字符串处理函数包 很强的字符串处理包

                                  var sDest : String) : Integer;
const
  BIN_DEF_PREFIX = '\';
var
  blWasError : Boolean;
  bBuild     : Byte;
  cAct       : Char;
  nPos       : Integer;
  nConvPos   : Integer;
  nLen       : Integer;
begin

  // search for binary sequences
  sDest:='';
  nLen:=Length(sSrc);
  nPos:=1;
  blWasError:=False;
  Result:=0;
  while ((nPos <= nLen) and (not blWasError)) do begin

    // sequence detected?
    if (sSrc[nPos] = BIN_DEF_PREFIX) then begin
      if (nPos < nLen) then begin

        // non-binary?
        if (sSrc[nPos + 1] = BIN_DEF_PREFIX) then begin
          sDest:=sDest + BIN_DEF_PREFIX;
          Inc(Result);
          Inc(nPos, 2);
        end
        else begin

          // valid binary?
          if (nPos < nLen - 1) then begin
            bBuild:=0;
            for nConvPos:=(nPos + 1) to (nPos + 2) do begin
              cAct:=UpCase(sSrc[nConvPos]);
              if (cAct >= '0') and (cAct <= '9') then begin
                bBuild:=bBuild shl 4;
                bBuild:=bBuild or (Ord(cAct) - Ord('0'));
              end
              else begin
                if (cAct >= 'A') and (cAct <= 'F') then begin
                  bBuild:=bBuild shl 4;
                  bBuild:=bBuild or (Ord(cAct) - Ord('A') + 10);
                end
                else blWasError:=True;
              end;
            end;
            sDest:=sDest + Chr(bBuild);
            Inc(Result);
            Inc(nPos, 3);
          end
          else
            blWasError:=True;
        end;
      end
      else
        blWasError:=True;
    end
    else begin
      sDest:=sDest + sSrc[nPos];
      Inc(nPos);
      Inc(Result);
    end;
  end;

  // return the real string if succeded
  if (blWasError) then begin
    FillChar(sDest[1], Length(sDest), #0);
    sDest:='';
    Result:=-1;
  end;
end;



class function TStrPlus.RelativePath(const sAbsPath : String) : String;
var
  nI   : Integer;
  nPos : Integer;
  nLen : Integer;
begin
  // (short) non-absolute path?
  nLen:=Length(sAbsPath);
  if (nLen < 3) then begin
    if (nLen = 0) then
      Result:=''
    else
      if (sAbsPath[1] = '\') then
        Result:=Copy(sAbsPath, 2, nLen - 1)
      else
        Result:=sAbsPath;
    Exit;
  end;

  // drive path?
  if (sAbsPath[2] = ':') then begin
    if (sAbsPath[3] = '\') then
      Result:=Copy(sAbsPath, 4, nLen - 3)
    else
      Result:=Copy(sAbsPath, 3, nLen - 2);
    Exit;
  end;

  // NETBIOS path?
  if ((sAbsPath[1] = '\') and (sAbsPath[2] = '\')) then begin
    nI:=0;
    for nPos:=3 to nLen do begin
      if (sAbsPath[nPos] = '\') then begin
        Inc(nI);
        if (nI = 2) then begin
          Result:=Copy(sAbsPath, nPos + 1, nLen - nPos);
          Exit;
        end;
      end;
    end;
    Result:='';
    Exit;
  end;

  // handle the non-absolute path
  if (sAbsPath[1] = '\') then
    Result:=Copy(sAbsPath, 2, nLen - 1)
  else
    Result:=sAbsPath;
end;


class function TStrPlus.PurePath(const sPath : String) : String;
var
  nLen : Integer;
begin
  // no ending '\'?
  if (GetLastChar(sPath) <> '\') then begin
    Result:=sPath;
    Exit;
  end;

  // drive path?
  nLen:=Length(sPath);
  if (nLen = 3) then
    if (sPath[2] = ':') then begin
      Result:=sPath;
      Exit;
    end;

  // cut now
  Result:=Copy(sPath, 1, nLen - 1);
end;


class function TStrPlus.RTLPath(const sPath : String) : String;
begin
  // this construction is simple
  if (Length(sPath) = 0) then
    Result:=''
  else
    if ((GetLastChar(sPath) = '\') or (GetLastChar(sPath) = ':')) then
      Result:=sPath
    else
      Result:=sPath + '\';
end;


class function TStrPlus.LongFileName(const sShortName : String) : String;
var
  sTemp : String;
  dta   : TSearchRec;
begin
  // no NETBIOS, joker or phantom file names
  if (Pos('\\', sShortName) > 0)  or (Pos('*', sShortName) > 0) or
      (Pos('?', sShortName) > 0) or ((not FileExists(sShortName) and
      (not DirectoryExists(sShortName)))) then begin
    Result:=sShortName;
    Exit;
  end;
  sTemp:=sShortName;
  Result:='';
  while (FindFirst(sTemp, $3f, dta) = 0) do begin
    Result:='\' + dta.Name + Result;
    SysUtils.FindClose(dta);
    SetLength(sTemp, Length(ExtractFilePath(sTemp)) - 1);
    if (Length(sTemp) <= 2) then
      Break;
  end;
  Result:=sTemp + Result;
end;


// hextab used in the following method (must be upcased!)
const
  HEXTAB : String = '0123456789ABCDEF';


class function TStrPlus.BytesToHexStr(pData : Pointer;
                                      nNumOfBytes : Integer;
                                      cSeparator : Char = #0) : String;
var
  nI       : Integer;
  nPos     : Integer;
  pBytePtr : PChar;
  bValue   : Byte;
  blSepa   : Boolean;
begin
  pBytePtr:=pData;
  blSepa:=(cSeparator <> Chr(0));
  if (blSepa) then
    SetLength(Result, nNumOfBytes * 3 - 1)
  else
    SetLength(Result, nNumOfBytes shl 1);
  nPos:=1;
  for nI:=1 to nNumOfBytes do begin
    bValue:=Ord(pBytePtr^);
    Inc(pBytePtr);
    Result[nPos]:=HEXTAB[(bValue shr 4) + 1];
    Inc(nPos);
    Result[nPos]:=HEXTAB[(bValue and $0f) + 1];
    Inc(nPos);
    if ((nI < nNumOfBytes) and blSepa) then begin
      Result[nPos]:=cSeparator;
      Inc(nPos);
    end;
  end;
end;


class function TStrPlus.HexStrToBytes(const sSource : String;
                                      pData : Pointer) : Integer;
var
  nI       : Integer;
  nLen     : Integer;
  nPos     : Integer;
  pBytePtr : PChar;
  bValue   : Byte;
  cTemp    : Char;
begin
  // assume an error
  Result:=-1;

  // illegal length?
  nLen:=Length(sSource);
  if (nLen and 1 <> 0) then
    Exit;

  // try to convert all the bytes
  pBytePtr:=pData;
  nPos:=1;
  while (nPos < nLen) do begin
    bValue:=0;
    for nI:=0 to 1 do begin
      cTemp:=UpCase(sSource[nPos]);
      if ((cTemp >= '0') and (cTemp <= '9')) then
        bValue:=(bValue shl 4) or (Ord(cTemp) - Ord('0'))
      else
        if ((cTemp >= 'A') and (cTemp <= 'F')) then
          bValue:=(bValue shl 4) or (Ord(cTemp) - Ord('A') + 10)
        else
          Exit; // illegal character detected
      Inc(nPos);
    end;
    pBytePtr^:=Chr(bValue);
    Inc(pBytePtr);
  end;

  // successfully converted
  Result:=nLen shr 1;
end;


class function TStrPlus.IsBinHexStr(const sCheckThis : String;
                                    nMustBinLen : Integer = -1) : Boolean;
var
  nI, nJ   : Integer;
  nLen     : Integer;
  cActChar : Char;
begin
  // assume an error
  Result:=False;

  // correct length?
  nLen:=Length(sCheckThis);
  if ((nLen and 1) <> 0) then
    Exit;
  if (nMustBinLen <> -1) then
    if ((nLen shr 1) <> nMustBinLen) then
      Exit;

  // now check the single chars (used the HEXTAB string from above)
  for nI:=1 to nLen do begin

    cActChar:=Upcase(sCheckThis[nI]);
    nJ:=0;
    while (nJ < 16) do begin
      if (HEXTAB[nJ + 1] = cActChar) then
        Break;
      Inc(nJ);
    end;

    // no found in tab?
    if (nJ = 16) then
      Exit;
  end;

  // success
  Result:=True;

end;




class function TStrPlus.GetHeapStatusInfo : String;
var
  hstat : THeapStatus;
begin
  hstat:=GetHeapStatus;
  with hstat do begin
    Result:='TotalAddrSpace = ' + IntToStr(TotalAddrSpace) + #13#10 +
            'TotalUncommitted = ' + IntToStr(TotalUncommitted) + #13#10 +
            'TotalCommitted = ' + IntToStr(TotalCommitted) + #13#10 +
            'TotalAllocated = ' + IntToStr(TotalAllocated) + #13#10 +
            'TotalFree = ' + IntToStr(TotalFree) + #13#10 +
            'FreeSmall = ' + IntToStr(FreeSmall) + #13#10 +
            'FreeBig = ' + IntToStr(FreeBig) + #13#10 +
            'Unused = ' + IntToStr(Unused) + #13#10 +
            'Overhead = ' + IntToStr(Overhead) + #13#10 +
            'HeapErrorCode = ' + IntToStr(HeapErrorCode);
  end;
end;



class function TStrPlus.VersionFormat(nMajor : Integer;
                                      nMinor : Integer = -1;
                                      nBuild : Integer = -1;
                                      const sAddOn : String = '') : String;
var
  sTemp : String;
begin
  Result:=IntToStr(nMajor);
  if ((nMinor <> -1) and (nMinor < 100)) then begin
    sTemp:=IntToStr(nMinor);
    Result:=Result + '.' + Copy('00', 1, 2 - Length(sTemp)) + sTemp;
    if ((nBuild <> -1)  and (nBuild < 1000)) then begin
      sTemp:=IntToStr(nBuild);
      Result:=Result + '.' + Copy('000', 1, 3 - Length(sTemp)) + sTemp;
    end;
  end;
  if (Length(sAddOn) > 0) then
    Result:=Result + ' ' + sAddOn;
end;


class function TStrPlus.VersionFormatEx
  (nMajor : Integer;
   nMinor : Integer = -1;
   nSubMinor : Integer = -1;
   nBuild : Integer = -1;
   const sAddOn : String = '') : String;
var
  sTemp : String;
begin
  Result:=IntToStr(nMajor);
  if ((nMinor <> -1) and (nMinor < 100)) then begin
    sTemp:=IntToStr(nMinor);
    Result:=Result + '.' + Copy('00', 1, 2 - Length(sTemp)) + sTemp;
    if ((nSubMinor <> -1) and (nSubMinor < 100)) then begin
      sTemp:=IntToStr(nSubMinor);
      Result:=Result + '.' + Copy('00', 1, 2 - Length(sTemp)) + sTemp;
      if ((nBuild <> -1)  and (nBuild < 1000)) then begin
        sTemp:=IntToStr(nBuild);
        Result:=Result + '.' + Copy('000', 1, 3 - Length(sTemp)) + sTemp;
      end;
    end;  
  end;
  if (Length(sAddOn) > 0) then
    Result:=Result + ' ' + sAddOn;
end;



class function TStrPlus.StringToWideString(const sASCIIStr : String)
                                             : WideString;
var
  nLen : Integer;
begin
  nLen:=Length(sASCIIStr);
  SetLength(Result, nLen);
  StringToWideChar(sASCIIStr, PWideChar(Result), nLen + 1);
end;

class function TStrPlus.FileAttrToStr(lAttributes : WORD32) : String;
begin
  if ((lAttributes and FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE) then
    Result:='A'
  else
    Result:='';
  if ((lAttributes and FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY) then
    Result:=Result + 'R';
  if ((lAttributes and FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN) then
    Result:=Result + 'H';
  if ((lAttributes and FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM) then
    Result:=Result + 'S';
  if ((lAttributes and FILE_ATTRIBUTE_COMPRESSED)
        = FILE_ATTRIBUTE_COMPRESSED) then
    Result:=Result + 'C';
end;


class function TStrPlus.ExtractFileExtension(const sFileName : String) : String;
var
  nPos : Integer;
  nLen : Integer;
begin
  nLen:=Length(sFileName);
  nPos:=nLen;
  while (nPos > 0) do begin
    if (sFileName[nPos] = '.') then begin
      Result:=Copy(sFileName, nPos + 1, nLen - nPos);
      Exit;
    end;
    Dec(nPos);
  end;

  // no extension found at all
  Result:='';
end;


class function TStrPlus.StringSplit(const sSource : String;
                                    cSplitter : Char) : TStringList;
var
  nStartPos : Integer;
  nPos      : Integer;
  nLen      : Integer;

begin
  // create the list
  Result:=TStringList.Create;
  Result.BeginUpdate;

  // now scan the string
  nStartPos:=1;
  nLen:=Length(sSource);
  for nPos:=1 to nLen do
    if (sSource[nPos] = cSplitter) then begin
      Result.Add(Copy(sSource, nStartPos, nPos - nStartPos));
      nStartPos:=nPos + 1;
    end;

  // add the final string
  if (nStartPos <= nLen) then
    Result.Add(Copy(sSource, nStartPos, nLen - nStartPos + 1));
  Result.EndUpdate;
end;


class function TStrPlus.IPAddrToStr(lIPAddr : WORD32;
                                    blBigEndian : Boolean) : String;
var
  nI : Integer;
begin
  if (blBigEndian) then
    for nI:=3 downto 0 do begin
      if (nI < 3) then
        Result:=IntToStr((lIPAddr shr (nI shl 3)) and $0ff) + '.' + Result
      else
        Result:=IntToStr((lIPAddr shr (nI shl 3)) and $0ff);
    end
  else
    for nI:=0 to 3 do begin