faststringfuncs.pas

delphi的XMPRPC通讯例子

var
  I: byte;
begin
 SetLength(result,length(s));
 for I := 1 to Length(S) do
    begin
        Result[I] := char(byte(S[I]) xor (Key shr 8));
        Key := (byte(S[I]) + Key) * cKey1 + cKey2;
    end;
end;

//Convert a text-HEX value (FF0088 for example) to an integer
function  HexToInt(aHex : string) : int64;
var
  Multiplier      : Int64;
  Position        : Byte;
  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.