faststringfuncs.pas

duiwenjiandechuli fangbianguanli.

  Value             : Integer;
begin
  Result := 0;
  Multiplier := 1;
  Position := Length(aHex);
  while Position > 0 do
  begin
    Value := FastCharPosNoCase(cHexChars, aHex[Position], 1) - 1;
    if Value = -1 then
      raise Exception.Create('Invalid hex character ' + aHex[Position]);

    Result := Result + (Value * Multiplier);
    Multiplier := Multiplier * 16;
    Dec(Position);
  end;
end;

//Get the left X amount of chars

function LeftStr(const aSourceString: string; Size: Integer): string;
begin
  if Size > Length(aSourceString) then
    Result := aSourceString
  else
  begin
    SetLength(Result, Size);
    Move(aSourceString[1], Result[1], Size);
  end;
end;

//Do strings match with wildcards, eg
//StringMatches('The cat sat on the mat', 'The * sat * the *') = True

function StringMatches(Value, Pattern: string): Boolean;
var
  NextPos,
    Star1,
    Star2           : Integer;
  NextPattern       : string;
begin
  Star1 := FastCharPos(Pattern, '*', 1);
  if Star1 = 0 then
    Result := (Value = Pattern)
  else
  begin
    Result := (Copy(Value, 1, Star1 - 1) = Copy(Pattern, 1, Star1 - 1));
    if Result then
    begin
      if Star1 > 1 then
        Value := Copy(Value, Star1, Length(Value));
      Pattern := Copy(Pattern, Star1 + 1, Length(Pattern));

      NextPattern := Pattern;
      Star2 := FastCharPos(NextPattern, '*', 1);
      if Star2 > 0 then
        NextPattern := Copy(NextPattern, 1, Star2 - 1);

      //pos(NextPattern,Value);
      NextPos := FastPos(Value, NextPattern, Length(Value), Length(NextPattern),
        1);
      if (NextPos = 0) and not (NextPattern = '') then
        Result := False
      else
      begin
        Value := Copy(Value, NextPos, Length(Value));
        if Pattern = '' then
          Result := True
        else
          Result := Result and StringMatches(Value, Pattern);
      end;
    end;
  end;
end;

//Missing text will tell you what text is missing, eg
//MissingText('the ? sat on the mat','the cat sat on the mat','?') = 'cat'

function MissingText(Pattern, Source: string; SearchText: string = '?'): string;
var
  Position          : Longint;
  BeforeText,
    AfterText       : string;
  BeforePos,
    AfterPos        : Integer;
  lSearchText,
    lBeforeText,
    lAfterText,
    lSource         : Longint;
begin
  Result := '';
  Position := Pos(SearchText, Pattern);
  if Position = 0 then
    exit;

  lSearchText := Length(SearchText);
  lSource := Length(Source);
  BeforeText := Copy(Pattern, 1, Position - 1);
  AfterText := Copy(Pattern, Position + lSearchText, lSource);

  lBeforeText := Length(BeforeText);
  lAfterText := Length(AfterText);

  AfterPos := lBeforeText;
  repeat
    AfterPos := FastPosNoCase(Source, AfterText, lSource, lAfterText, AfterPos +
      lSearchText);
    if AfterPos > 0 then
    begin
      BeforePos := FastPosBackNoCase(Source, BeforeText, AfterPos - 1,
        lBeforeText, AfterPos - (lBeforeText - 1));
      if (BeforePos > 0) then
      begin
        Result := Copy(Source, BeforePos + lBeforeText, AfterPos - (BeforePos +
          lBeforeText));
        Break;
      end;
    end;
  until AfterPos = 0;
end;

//Generates a random filename but preserves the original path + extension

function RandomFilename(aFilename: string): string;
var
  Path,
    Filename,
    Ext             : string;
begin
  Result := aFilename;
  Path := ExtractFilepath(aFilename);
  Ext := ExtractFileExt(aFilename);
  Filename := ExtractFilename(aFilename);
  if Length(Ext) > 0 then
    Filename := Copy(Filename, 1, Length(Filename) - Length(Ext));
  repeat
    Result := Path + RandomStr(32) + Ext;
  until not FileExists(Result);
end;

//Makes a string of aLength filled with random characters

function RandomStr(aLength: Longint): string;
var
  X                 : Longint;
begin
  if aLength <= 0 then
    exit;
  SetLength(Result, aLength);
  for X := 1 to aLength do
    Result[X] := Chr(Random(26) + 65);
end;

function ReverseStr(const aSourceString: string): string;
var
  L                 : Integer;
  S,
    D               : Pointer;
begin
  L := Length(aSourceString);
  SetLength(Result, L);
  if L = 0 then
    exit;

  S := @aSourceString[1];
  D := @Result[L];

  asm
    push ESI
    push EDI

    mov  ECX, L
    mov  ESI, S
    mov  EDI, D

  @Loop:
    mov  Al, [ESI]
    inc  ESI
    mov  [EDI], Al
    dec  EDI
    dec  ECX
    jnz  @Loop

    pop  EDI
    pop  ESI
  end;
end;

//Returns X amount of chars from the right of a string

function RightStr(const aSourceString: string; Size: Integer): string;
begin
  if Size > Length(aSourceString) then
    Result := aSourceString
  else
  begin
    SetLength(Result, Size);
    FastCharMove(aSourceString[Length(aSourceString) - (Size - 1)], Result[1],
      Size);
  end;
end;

//Converts a typical HTML RRGGBB color to a TColor

function RGBToColor(aRGB: string): TColor;
begin
  if Length(aRGB) < 6 then
    raise EConvertError.Create('Not a valid RGB value');
  if aRGB[1] = '#' then
    aRGB := Copy(aRGB, 2, Length(aRGB));
  if Length(aRGB) <> 6 then
    raise EConvertError.Create('Not a valid RGB value');

  Result := HexToInt(aRGB);
  asm
    mov   EAX, Result
    BSwap EAX
    shr   EAX, 8
    mov   Result, EAX
  end;
end;

//Splits a delimited text line into TStrings (does not account for stuff in quotes but it should)

procedure Split(aValue: string; aDelimiter: Char; var Result: TStrings);
var
  X                 : Integer;
  S                 : string;
begin
  if Result = nil then
    Result := TStringList.Create;
  Result.Clear;
  S := '';
  for X := 1 to Length(aValue) do
  begin
    if aValue[X] <> aDelimiter then
      S := S + aValue[X]
    else
    begin
      Result.Add(S);
      S := '';
    end;
  end;
  if S <> '' then
    Result.Add(S);
end;

//counts how many times a substring exists within a string
//StringCount('XXXXX','XX') would return 2

function StringCount(const aSourceString, aFindString: string; const
  CaseSensitive: Boolean = TRUE): Integer;
var
  Find,
    Source,
    NextPos         : PChar;
  LSource,
    LFind           : Integer;
  Next              : TFastPosProc;
  JumpTable         : TBMJumpTable;
begin
  Result := 0;
  LSource := Length(aSourceString);
  if LSource = 0 then
    exit;

  LFind := Length(aFindString);
  if LFind = 0 then
    exit;

  if CaseSensitive then
  begin
    Next := BMPos;
    MakeBMTable(PChar(aFindString), Length(aFindString), JumpTable);
  end
  else
  begin
    Next := BMPosNoCase;
    MakeBMTableNoCase(PChar(aFindString), Length(aFindString), JumpTable);
  end;

  Source := @aSourceString[1];
  Find := @aFindString[1];

  repeat
    NextPos := Next(Source, Find, LSource, LFind, JumpTable);
    if NextPos <> nil then
    begin
      Dec(LSource, (NextPos - Source) + LFind);
      Inc(Result);
      Source := NextPos + LFind;
    end;
  until NextPos = nil;
end;

function SoundEx(const aSourceString: string): Integer;
var
  CurrentChar       : PChar;
  I, S, LastChar, SoundexGroup: Byte;
  Multiple          : Word;
begin
  if aSourceString = '' then
    Result := 0
  else
  begin
    //Store first letter immediately
    Result := Ord(Upcase(aSourceString[1]));

    //Last character found = 0
    LastChar := 0;
    Multiple := 26;

    //Point to first character
    CurrentChar := @aSourceString[1];

    for I := 1 to Length(aSourceString) do
    begin
      Inc(CurrentChar);

      S := Ord(CurrentChar^);
      if (S > 64) and (S < 123) then
      begin
        SoundexGroup := cSoundexTable[S];
        if (SoundexGroup <> LastChar) and (SoundexGroup > 0) then
        begin
          Inc(Result, SoundexGroup * Multiple);
          if Multiple = 936 then
            Break;                      {26 * 6 * 6}
          Multiple := Multiple * 6;
          LastChar := SoundexGroup;
        end;
      end;
    end;
  end;
end;

//Used by ExtractHTML and ExtractNonHTML

function StripHTMLorNonHTML(const S: string; WantHTML: Boolean): string;
var
  X                 : Integer;
  TagCnt            : Integer;
  ResChar           : PChar;
  SrcChar           : PChar;
begin
  TagCnt := 0;
  SetLength(Result, Length(S));
  if Length(S) = 0 then
    Exit;

  ResChar := @Result[1];
  SrcChar := @S[1];
  for X := 1 to Length(S) do
  begin
    case SrcChar^ of
      '<':
        begin
          Inc(TagCnt);
          if WantHTML and (TagCnt = 1) then
          begin
            ResChar^ := '<';
            Inc(ResChar);
          end;
        end;
      '>':
        begin
          Dec(TagCnt);
          if WantHTML and (TagCnt = 0) then
          begin
            ResChar^ := '>';
            Inc(ResChar);
          end;
        end;
    else
      case WantHTML of
        False:
          if TagCnt <= 0 then
          begin
            ResChar^ := SrcChar^;
            Inc(ResChar);
            TagCnt := 0;
          end;
        True:
          if TagCnt >= 1 then
          begin
            ResChar^ := SrcChar^;
            Inc(ResChar);
          end
          else if TagCnt < 0 then
            TagCnt := 0;
      end;
    end;
    Inc(SrcChar);
  end;
  SetLength(Result, ResChar - PChar(@Result[1]));
  Result := FastReplace(Result, '&nbsp;', ' ', False);
  Result := FastReplace(Result, '&amp;', '&', False);
  Result := FastReplace(Result, '&lt;', '<', False);
  Result := FastReplace(Result, '&gt;', '>', False);
  Result := FastReplace(Result, '&quot;', '"', False);
end;

//Generates a UniqueFilename, makes sure the file does not exist before returning a result

function UniqueFilename(aFilename: string): string;
var
  Path,
    Filename,
    Ext             : string;
  Index             : Integer;
begin
  Result := aFilename;
  if FileExists(aFilename) then
  begin
    Path := ExtractFilepath(aFilename);
    Ext := ExtractFileExt(aFilename);
    Filename := ExtractFilename(aFilename);
    if Length(Ext) > 0 then
      Filename := Copy(Filename, 1, Length(Filename) - Length(Ext));
    Index := 2;
    repeat
      Result := Path + Filename + IntToStr(Index) + Ext;
      Inc(Index);
    until not FileExists(Result);
  end;
end;

//Decodes all that %3c stuff you get in a URL

function URLToText(aValue: string): string;
var
  X                 : Integer;
begin
  Result := '';
  X := 1;
  while X <= Length(aValue) do
  begin
    if aValue[X] <> '%' then
      Result := Result + aValue[X]
    else
    begin
      Result := Result + Chr(HexToInt(Copy(aValue, X + 1, 2)));
      Inc(X, 2);
    end;
    Inc(X);
  end;
end;

//Returns the whole word at a position

function WordAt(Text: string; Position: Integer): string;
var
  L,
    X               : Integer;
begin
  Result := '';
  L := Length(Text);

  if (Position > L) or (Position < 1) then
    Exit;
  for X := Position to L do
  begin
    if Upcase(Text[X]) in ['A'..'Z', '0'..'9'] then
      Result := Result + Text[X]
    else
      Break;
  end;

  for X := Position - 1 downto 1 do
  begin
    if Upcase(Text[X]) in ['A'..'Z', '0'..'9'] then
      Result := Text[X] + Result
    else
      Break;
  end;
end;

end.