stringplus.pas

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

      if (nI > 0) then
        Result:=IntToStr((lIPAddr shr (nI shl 3)) and $0ff) + '.' + Result
      else
        Result:=IntToStr((lIPAddr shr (nI shl 3)) and $0ff);
    end;
end;


class function TStrPlus.FilterIllegalChars(const sDirtyStr : String;
                                           blAllowLineBreaks : Boolean)
                                             : String;
var
  nPos     : Integer;
  nLen     : Integer;
  nNewLen  : Integer;
  cActChar : Char;
  blAddIt  : Boolean;
begin
  // fast filtering
  nLen:=Length(sDirtyStr);
  SetLength(Result, nLen);
  nNewLen:=0;
  for nPos:=1 to nLen do begin
    cActChar:=sDirtyStr[nPos];
    blAddIt:=False;
    case cActChar of
      #0..#31 : begin
        if (blAllowLineBreaks) then
          case cActChar of
            #13 : blAddIt:=True;
            #10 : blAddIt:=True;
          end;
      end;
    else
      blAddIt:=True;
    end;
    if (blAddIt) then begin
      Inc(nNewLen);
      Result[nNewLen]:=cActChar;
    end;
  end;
  SetLength(Result, nNewLen);
end;


class function TStrPlus.Replace(const sSource : String;
                                const sThis : String;
                                const sThat : String) : String;
var
  nPos       : Integer;
  nThisLen   : Integer;
  sNewSource : String;
begin
  // avoid silly cases
  nThisLen:=Length(sThis);
  if ((Length(sSource) = 0) or (nThisLen = 0)) then begin
    Result:=sSource;
    Exit;
  end;

  // FIXME: maybe faster with linear scanning and buffer build
  sNewSource:=sSource;
  Result:='';
  repeat
    nPos:=Pos(sThis, sNewSource);
    if (nPos <> 0) then begin
      Result:=Result + Copy(sNewSource, 1, nPos - 1) + sThat;
      sNewSource:=Copy(sNewSource,
                    nPos + nThisLen,
                    Length(sNewSource) - (nPos + nThisLen) + 1);
    end
    else
      Result:=Result + sNewSource;
  until (nPos = 0);
end;


class function TStrPlus.RootPath(const sPath : String) : String;
var
  nI   : Integer;
  nPos : Integer;
  nLen : Integer;
begin
  // short (not an absolute) path?
  nLen:=Length(sPath);
  if (nLen < 3) then begin
    Result:=sPath;
    Exit;
  end;

  // drive path?
  if (sPath[2] = ':') then begin
    if (sPath[3] = '\') then
      Result:=Copy(sPath, 1, 3)
    else
      Result:=Copy(sPath, 1, 2) + '\';
    Exit;
  end;

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

  // not an absolute path
  Result:=sPath;
end;


class function TStrPlus.IsUnicodeOS : Boolean;
begin
  Result:=_blUnicodeSupported;
end;

class function TStrPlus.CompareFromBegin(const sSub : String;
                                         const sMain : String;
                                         nToCmp : Integer) : Boolean;
var
  nI    : Integer;
  pSub  : PChar;
  pMain : PChar;
begin
  // we use the zero string property of long strings for a fast comparison
  pSub:=PChar(sSub);
  pMain:=PChar(sMain);
  nI:=0;
  while ((pSub^ <> #0) and (nI < nToCmp)) do begin

    if ((pMain^ <> #0) and (pMain^ = pSub^)) then begin
      Inc(pSub);
      Inc(pMain);
      Inc(nI);
    end
    else begin
      Result:=False;
      Exit;
    end;
  end;
  Result:=True;
end;


class function TStrPlus.CompareFromEnd(const sSub : String;
                                       const sMain : String;
                                       blCaseSensitive : Boolean) : Boolean;
var
  nMainPos : Integer;
  nSubPos  : Integer;
  nBottom  : Integer;
  nSubLen  : Integer;
  nMainLen : Integer;
  sSubNew  : String;
  sMainNew : String;
begin
  // assume non nonequality
  Result:=False;

  // treat simple cases
  if ((sSub = '') or (sMain = '')) then
    Exit;
  nSubLen:=Length(sSub);
  nMainLen:=Length(sMain);
  if (nSubLen > nMainLen) then
    Exit;

  // prepare the string for comparison, i.n.
  if (blCaseSensitive) then begin
    sSubNew:=sSub;
    sMainNew:=sMain;
  end
  else begin
    sSubNew:=AnsiUpperCase(sSub);
    sMainNew:=AnsiUpperCase(sMain);
  end;

  // compare now
  nSubPos:=nSubLen;
  nBottom:=nMainLen - nSubLen + 1;
  for nMainPos:=nMainLen downto nBottom do
    if (sSubNew[nSubPos] <> sMainNew[nMainPos]) then
      Exit
    else
      Dec(nSubPos);

  // equal
  Result:=True;
end;


class function TStrPlus.ParentPath(const sPath : String) : String;
var
  nI       : Integer;
  nPos     : Integer;
  nLen     : Integer;
  sPathNew : String;
begin
  // be pessimistic
  Result:='';

  // first get a non-RTL path
  sPathNew:=PurePath(sPath);

  // does it make sense to parse it? (minimum is "a:\b")
  nLen:=Length(sPathNew);
  if (nLen < 4) then
    Exit;

  // now search the upper level (minimum criteria see above)
  nPos:=nLen;
  while (nPos > 1) do
    if (sPathNew[nPos] = '\') then
      Break
    else
      Dec(nPos);

  // network paths need another check
  if (Copy(sPathNew, 1, 2) = '\\') then begin

    // skip hopeless cases (minimum is "\\a\b\c")
    if (nPos < 4) then
      Exit;

    // search for a '\' in between
    for nI:=(nPos - 1) downto 3 do
      if (sPathNew[nI] = '\') then
        Break;
    if (nI > 3) then
      Result:=Copy(sPathNew, 1, nPos - 1);
  end
  else
    // check special drive path case
    if ((sPathNew[2] = ':') and (nPos = 3)) then
      Result:=Copy(sPathNew, 1, 3)
    else
      Result:=Copy(sPathNew, 1, nPos - 1);
end;


class function TStrPlus.ListToStr(theList : TStringList;
                                  cSeparator : Char = ',') : String;
var
  nI     : Integer;
  nUpIdx : Integer;
begin
  // (FIXME: slow build routine, buffer will be much)
  nUpIdx:=theList.Count - 1;
  Result:='';
  for nI:=0 to nUpIdx do begin
    Result:=Result + theList.Strings[nI];
    if (nI < nUpIdx) then
      Result:=Result + cSeparator;
  end;
end;



class function TStrPlus.StrToList(const sTheStr : String;
                                  cSeparator : Char = ',';
                                  blTrim : Boolean = True) : TStringList;
var
  nLen      : Integer;
  nPos      : Integer;
  nLastSepa : Integer;
  sEntry    : String;
begin
  nLen:=Length(sTheStr);
  nLastSepa:=0;
  Result:=TStringList.Create;
  Result.BeginUpdate;
  for nPos:=1 to nLen do begin
    if (sTheStr[nPos] = cSeparator) then begin
      sEntry:=Copy(sTheStr,
                   nLastSepa + 1,
                   nPos - nLastSepa - 1);
      if (blTrim) then
        Result.Add(Trim(sEntry))
      else
        Result.Add(sEntry);
      nLastSepa:=nPos;
    end;
  end;
  if (nLastSepa < nLen) then begin
    sEntry:=Copy(sTheStr,
                 nLastSepa + 1,
                 nLen - nLastSepa);
    if (blTrim) then
      Result.Add(Trim(sEntry))
    else
      Result.Add(sEntry);
  end;
  Result.EndUpdate;
end;


class function TStrPlus.MakeTempFileName(
        const sPath : String;
        const sPrefix : String = '') : String;
var
  buf : array[0..MAX_PATH] of Char;
begin

  if (0 = Windows.GetTempFileName(PChar(sPath),
        PChar(sPrefix),
        0,
        @buf)) then begin
    // FIXME: good workaround/replacement (at least it's 8.3 compatible)?
    Result:=RTLPath(sPath) +
            IntToHex(Random(65536), 4) +
            IntToHex(Random(65536), 4) +
            '.TMP';
  end
  else begin
    Result:=String(PChar(@buf));
  end;
end;


class function TStrPlus.ExtractCStrings(pRawList : Pointer) : TStringList;
var
  pRun : PChar;
begin
  Result:=TStringList.Create;
  Result.BeginUpdate;
  pRun:=pRawList;
  while (pRun^ <> #0) do begin
    Result.Add(String(pRun));
    pRun:=pRun + Length(String(pRun)) + 1;
  end;
  Result.EndUpdate;
end;


class function TStrPlus.HexDump(
  data : Pointer;
  nNumOfBytes : Integer;
  nBytesPerLine : Integer) : String;
var
  nPos, nC, nAddrW : Integer;
  pc : PChar;
  sLeft, sRight, sPad, sAddr : String;
  cVal : Char;
  lst : TStringList;
begin

  if (Nil = data) then begin
    Result := '(nil)';
    Exit;
  end;

  if (1 > nNumOfBytes) then begin
    Result := '';
    Exit;
  end;

  if (1 > nBytesPerLine) then nBytesPerLine := 16;

  lst := TStringList.Create;
  lst.Capacity := nNumOfBytes div nBytesPerLine + 1;

  if (0 = (nNumOfBytes and $ffff0000)) then nAddrW := 4 else nAddrW := 8;

  pc := PChar(data);

  nPos := 0;
  nC := 0;

  sAddr := IntToHex(0, nAddrW);

  while (nNumOfBytes > nPos) do begin

    cVal := pc[nPos];

    sLeft := sLeft + IntToHex(Byte(cVal), 2) + ' ';

    if (' ' > cVal) then sRight := sRight + '.'
    else                 sRight := sRight + cVal;

    Inc(nPos);
    Inc(nC);

    if (nBytesPerLine <= nC) then begin
      lst.Add(sAddr + '  ' + sLeft + '   ' + sRight);
      nC := 0;
      sLeft := '';
      sRight := '';
      sAddr := IntToHex(nPos, nAddrW);
    end;
  end;

  if (0 < nC) then begin

    nC := (nBytesPerLine - nC) * 3;
    SetLength(sPad, nC);
    for nPos := 1 to nC do sPad[nPos] := ' ';

    lst.Add(sAddr + '  ' + sLeft + sPad + '   ' + sRight);
  end;

  pc := lst.GetText;

  Result := pc;

  StrDispose(pc);
end;

class function TStrPlus.Base64Encode(
  pRaw : Pointer;
  nLen : Integer) : String;
var
  hnd  : WORD32;
  nEnc : Integer;
  pbuf : PChar;
begin

  GetMem(pbuf, BASE64_CALCOUTP_ENC(nLen) + 1);

  hnd := BASE64_HANDLE_INIT;

  nEnc := BASE64_Encode(hnd, pRaw, nLen, pbuf, 1);

  pbuf[nEnc] := #0;

  Result := pbuf;

  FreeMem(pbuf);
end;


class function TStrPlus.Base64Decode(
  const sEnc : String;
  var vnLen : Integer) : PChar;
var
  hnd : WORD32;
begin
  GetMem(Result, BASE64_CALCOUTP_DEC(Length(sEnc)) + 1);

  hnd := BASE64_HANDLE_INIT;
  vnLen := BASE64_Decode(hnd, PChar(sEnc), Length(sEnc), Result);

  if (-1 = vnLen) then begin
    FreeMem(Result);
    Result := Nil;
  end
  else begin
    Result[vnLen] := #0;
  end;
end;


// startup to do...
initialization
  // this unit uses the internal random generator,
  // so it's better to init. it right here
  Randomize;

  // Windows NT4/2K/XP/2003?
  versionInfo.dwOSVersionInfoSize:=SizeOf(versionInfo);
  GetVersionEx(versionInfo);
  _blUnicodeSupported:=(VER_PLATFORM_WIN32_NT = versioninfo.dwPlatformId);

end.