StrUtils

unit StrUtils; //delphi5 有的函数，delphi7没有的一些函数
 
interface 
 
const 
  CR = #13; 
  LF = #10; 
 
{                                  } 
{  *** Pascal string functions *** } 
{                                  } 
 
{ AddBackSlash adds a trailing backslash to a string if one doesn't already } 
{ exist. } 
function AddBackSlash(const S: string): string; 
 
{ DecStrLen decrements the length of a string by the number specified. } 
procedure DecStrLen(var S: string; DecBy: Integer); 
 
{ GetCurLine returns the CR/LF delimited string of which the character } 
{ at index Position is an element. } 
function GetCurLine(const S: string; Position: Integer): string; 
 
{ GetStrAllocSize returns the memory allocation size of a given string. } 
function GetStrAllocSize(const S: string): Longint; 
 
{ GetStrRefCount returns the reference count of a given string. } 
function GetStrRefCount(const S: string): Longint; 
 
{ KillChars strips all characters out of string S that are contained in } 
{ constant character array A and returns result } 
function KillChars(const S: string; A: array of Char; CaseSensitive: Boolean): 
  string; 
 
{ LastPos finds the last occurance of SubStr in S } 
function LastPos(const SubStr, S: string): Integer; 
 
{ RealizeLength sets string length to null-terminated length. } 
procedure RealizeLength(var S: string); 
 
{ RemoveBackSlash removes a trailing backslash from a string if one is } 
{ present. } 
function RemoveBackSlash(const S: string): string; 
 
{ RemoveSpaces strips all spaces out of string S and returns result } 
function RemoveSpaces(const S: string): string; 
 
{ RverseStr reverses the characters in a string, and returns new string } 
function ReverseStr(const S: string): string; 
 
{                                  } 
{  *** PChar string functions ***  } 
{                                  } 
 
{ StrGetCurLine assumes StartPos is a pointer to a long string and    } 
{ CurPos points to any character in that string (up to TotalLen bytes } 
{ away from StartPos).  This procedure returns the CRLF-delimited     } 
{ line of text in LineStart which holds char CurPos^.  The length of  } 
{ that line is given by LineLen. } 
procedure StrGetCurLine(StartPos, CurPos: PChar; TotalLen: integer; 
  var LineStart: PChar; var LineLen: integer); 
 
{ StrLastPos finds the last occurance of Str2 in Str1 } 
function StrLastPos(Str1, Str2: PChar): PChar; 
 
{ StrIPos returns the first occurence of Str2 in Str1 with case insensitivity } 
function StrIPos(Str1, Str2: PChar): PChar; 
 
{ StrIScan returns the first occurance of Chr in Str with case insensitivity } 
function StrIScan(Str: PChar; Chr: Char): PChar; 
 
{ Reverses the characters in a string } 
procedure StrReverse(P: PChar); 
 
implementation 
 
uses SysUtils; 
 
type 
  TCharSet = set of Char; 
 
{                                  } 
{  *** Pascal string functions *** } 
{                                  } 
 
function AddBackSlash(const S: string): string; 
begin 
  Result := S; 
  if Result[Length(Result)] <> '\' then  // if last char isn't a backslash... 
    Result := Result + '\';              // make it so 
end; 
 
procedure DecStrLen(var S: string; DecBy: Integer); 
begin 
  SetLength(S, Length(S) - DecBy);       // decrement string length by DecBy 
end; 
 
function GetCurLine(const S: string; Position: Integer): string; 
var 
  ResP: PChar; 
  ResLen: integer; 
begin 
  StrGetCurLine(PChar(S), PChar(Longint(S) + Position - 1), Length(S), ResP, 
    ResLen); 
  SetString(Result, ResP, ResLen); 
end; 
 
function GetStrAllocSize(const S: string): Longint; 
var 
  P: ^Longint; 
begin 
  P := Pointer(S);                        // pointer to string structure 
  dec(P, 3);                              // 12-byte negative offset 
  Result := P^ and not $80000000 shr 1;   // ignore bits 0 and 31 
end; 
 
function GetStrRefCount(const S: string): Longint; 
var 
  P: ^Longint; 
begin 
  P := Pointer(S);                        // pointer to string structure 
  dec(P, 2);                              // 8-byte negative offset 
  Result := P^; 
end; 
 
function KillChars(const S: string; A: array of Char; CaseSensitive: Boolean): 
  string; 
var 
  CharSet: TCharSet; 
  i, count: integer; 
begin 
  CharSet := [];                         // empty character set 
  for i := Low(A) to High(A) do begin 
    Include(CharSet, A[i]);              // fill set with array items 
    if not CaseSensitive then begin      // if not case sensitive, then also 
      if A[i] in ['A'..'Z'] then 
        Include(CharSet, Chr(Ord(A[i]) + 32))  // include lower cased or 
      else if A[i] in ['a'..'z'] then 
        Include(CharSet, Chr(Ord(A[i]) - 32))  // include upper cased character 
    end; 
  end; 
  SetLength(Result, Length(S));          // set length to prevent realloc 
  count := 0; 
  for i := 1 to Length(S) do begin       // iterate over string S 
    if not (S[i] in CharSet) then begin  // add good chars to Result 
      Result[count + 1] := S[i]; 
      inc(Count);                        // keep track of num chars copies 
    end; 
  end; 
  SetLength(Result, count);              // set length to num chars copied 
end; 
 
function LastPos(const SubStr, S: string): Integer; 
var 
  FoundStr: PChar; 
begin 
  Result := 0; 
  FoundStr := StrLastPos(PChar(S), PChar(SubStr)); 
  if FoundStr <> nil then 
    Result := (Cardinal(Length(S)) - StrLen(FoundStr)) + 1; 
end; 
 
procedure RealizeLength(var S: string); 
begin 
  SetLength(S, StrLen(PChar(S))); 
end; 
 
function RemoveBackSlash(const S: string): string; 
begin 
  Result := S; 
  if Result[Length(Result)] = '\' then   // if last character is a backslash... 
    DecStrLen(Result, 1);                // decrement string length 
end; 
 
function RemoveSpaces(const S: string): string; 
begin 
  Result := KillChars(S, [' '], True); 
end; 
 
function ReverseStr(const S: string): string; 
begin 
  Result := S; 
  StrReverse(PChar(Result)); 
end; 
 
{                                  } 
{  *** PChar string functions ***  } 
{                                  } 
 
procedure StrGetCurLine(StartPos, CurPos: PChar; TotalLen: integer; 
                        var LineStart: PChar; var LineLen: integer); 
var 
  FloatPos, EndPos: PChar; 
begin 
  FloatPos := CurPos; 
  LineStart := nil; 
  repeat 
    if FloatPos^ = LF then 
    begin 
      dec(FloatPos); 
      if FloatPos^ = CR then 
      begin 
        inc(FloatPos, 2); 
        LineStart := FloatPos; 
      end; 
    end 
    else 
      dec(FloatPos); 
  until (FloatPos <= StartPos) or (LineStart <> nil); 
  if LineStart = nil then LineStart := StartPos; 
  FloatPos := CurPos; 
  EndPos := StartPos; 
  inc(EndPos, TotalLen - 1); 
  LineLen := 0; 
  repeat 
    if FloatPos^ = CR then 
    begin 
      inc(FloatPos); 
      if FloatPos^ = LF then 
      begin 
        dec(FloatPos, 2); 
        LineLen := FloatPos - LineStart + 1; 
      end; 
    end 
    else 
      inc(FloatPos); 
  until (FloatPos >= EndPos) or (LineLen <> 0); 
  if LineLen = 0 then 
    LineLen := integer(EndPos) - integer(LineStart); 
end; 
 
function StrIPos(Str1, Str2: PChar): PChar; 
{ Warning: this function is slow for very long strings. } 
begin 
  Result := Str1; 
  dec(Result); 
  repeat 
    inc(Result); 
    Result := StrIScan(Result, Str2^); 
  until (Result = nil) or (StrLIComp(Result, Str2, StrLen(Str2)) = 0); 
end; 
 
function StrIScan(Str: PChar; Chr: Char): PChar; 
asm 
  push  edi                 // save edi 
  push  eax                 // save eax (Str addr) 
  mov   edi, Str            // store Str in edi 
  mov   ecx, $FFFFFFFF      // max counter 
  xor   al, al              // null char in al 
  repne scasb               // search for null 
  not   ecx                 // ecx = length of Str 
  pop   edi                 // restore Str in edi 
  mov   al, Chr             // put Chr in al 
  cmp   al, 'a'             // if al is lowercase... 
  jb    @@1 
  cmp   al, 'z' 
  ja    @@1 
  sub   al, $20             // force al to uppercase 
@@1: 
  mov   ah, byte ptr [EDI]  // put char from Str in ah 
  cmp   ah, 'a'             // if al is lowercase... 
  jb    @@2 
  cmp   ah, 'z' 
  ja    @@2 
  sub   ah, $20             // force al to uppercase 
@@2: 
  inc   edi                 // inc to next char in string 
  cmp   al, ah              // are chars the same? 
  je    @@3                 // jump if yes 
  loop  @@1                 // loop if no 
  mov   eax, 0              // if char is not in string... 
  jne   @@4                 // go to end of proc 
@@3:                        // if char is in string... 
  mov   eax, edi            // move char position into eax 
  dec   eax                 // go back one character because of inc edi 
@@4: 
  pop   edi                 // restore edi 
end; 
 
function StrLastPos(Str1, Str2: PChar): PChar; 
var 
  Found: Boolean; 
begin 
  if (Str1 <> nil) and (Str2 <> nil) and (StrLen(Str1) >= StrLen(Str2)) then 
  begin 
    Found := False; 
    Result := Str1; 
    inc(Result, StrLen(Str1) - StrLen(Str2)); 
    repeat 
      if StrPos(Result, Str2) <> nil then 
        Found := True 
      else 
        dec(Result); 
    until (Result <= Str1) or Found; 
    if not Found then Result := nil; 
  end 
  else 
    Result := nil; 
end; 
 
procedure StrReverse(P: PChar); 
var 
  E: PChar; 
  c: char; 
begin 
  if StrLen(P) > 1 then begin 
    E := P; 
    inc(E, StrLen(P) - 1);          // E -> last char in P 
    repeat 
      c := P^;                      // store beginning char in temp 
      P^ := E^;                     // store end char in beginning 
      E^ := c;                      // store temp char in end 
      inc(P);                       // increment beginning 
      dec(E);                       // decrement end 
    until abs(Integer(P) - Integer(E)) <= 1; 
  end; 
end;