xstrings.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

  Result := Format('%s%s%s',[Copy(S, 1, index - 1), Substr, Copy(S, index + Count, Maxint)]);
end;

//------------------------------------------------------------------//
//快速生成len长度的随机16进制字符串。
function RandomString (len : integer) : string;
const Tbl : array [0 .. $1F] of char = (
  '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B',
  'C', 'D', 'E', 'F', 'G', 'H', 'K', 'M', 'N', 'P', 'Q', 'R',
  'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z');
var i, n, k, x, j : integer;
begin
  SetString (Result, nil, len);
  n := len * 5; // bits in random number
  j := 1;
  while n > 0 do begin
    if n > 30 then k := 30 // work with 32-bits numbers
     else k := n;
    x := Random (1 shl k - 1);
    for i := 1 to k div 5 do begin
      Result [j] := Tbl [x and $1F];
      inc (j);
      x := x ShR 5;
     end;
    dec (n, k)
   end;
end;

//------------------------------------------------------------------//
//字符串匹配
//TFindModes中ftWholeWord(必须全字匹配),ftMatchCase(必须大小写匹配)。
//若按规则成功地在s中找到subs，返回subs在s中的位置，如：
//MatchString('I am a good boy.','Goo'); 返回8
//MatchString('I am a good boy.','Goo',[frWholeWord]); 返回0
//MatchString('I am a good boy.','Goo',[frMatchCase]); 返回0
function MatchString(s, substr: string; Modes: TFindModes = []): Integer;
const
  Delimiters = [#0..#47, #58..#64, #123..#255];
var
  EndI: Integer;
begin
  if not (fmMatchCase in Modes) then
  begin
    s := AnsiUpperCase(S);
    substr := AnsiUpperCase(substr);
  end;

  if fmWholeWord in Modes then
  begin
    Result := 1;
    EndI := Length(substr);
    while EndI <= Length(S) do
    begin
      if ((Result = 1) or (S[Result - 1] in Delimiters)) and ((EndI = Length(S)) or (S[EndI + 1] in Delimiters)) and
        (AnsiCompareStr(Copy(S, Result, Length(substr)), substr) = 0) then Break;
      Inc(Result);
      Inc(EndI);
    end;
    Result := EndI;
    if Result > Length(S) then Result := 0;
  end else Result := AnsiPos(substr, S);
end;

//------------------------------------------------------------------//
//字符串匹配，如：
//('David Stidolph','*Stido???')
//返回True。
function IsMatchString(const s, substr: String): Boolean;
var
  pSource: Array [0..255] of Char;
  pPattern: Array [0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;

    function IsPatternWild(pattern: PChar): Boolean;
    begin
      Result := StrScan(pattern,'*') <> nil;
      if not Result then Result := StrScan(pattern,'?') <> nil;
    end;

  begin
    if 0 = StrComp(pattern,'*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else begin
      case pattern^ of
      '*': if MatchPattern(element,@pattern[1]) then
             Result := True
           else
             Result := MatchPattern(@element[1],pattern);
      '?': Result := MatchPattern(@element[1],@pattern[1]);
      else
        if element^ = pattern^ then
          Result := MatchPattern(@element[1],@pattern[1])
        else
          Result := False;
      end;
    end;
  end;

begin
  StrPCopy(pSource,s);
  StrPCopy(pPattern,substr);
  Result := MatchPattern(pSource,pPattern);
end;

//------------------------------------------------------------------//
//在s中查找substr，找到时返回substr前面的字符串，未找到则返回空串
function Before(const s, substr: string): string;
var
   n: Integer;
begin
   n:=Pos(substr, s);
   if n = 0 then
      Result:=''
   else
      Result:=Copy(s, 1, n - 1);
end;

//------------------------------------------------------------------//
//在s中查找substr，找到时返回substr后面的字符串，未找到则返回空串
function After(const s, substr: string): string;
var
   n: Integer;
begin
   n:=Pos(substr, s);
   if n = 0 then
      Result:=''
   else
      Result:=Copy(s, n+Length(substr), Length(s)-(n+Length(substr))+1);
end;

//------------------------------------------------------------------//
//查找Search,返回Front,Back之间的字符串，如：
//Inside('This doucment include source code (write in pascal).','(',')');
//返回write in pascal
function Inside(const Search, Front, Back: string): string;
var
   Index, Len: Integer;
begin
   Index:=RPos(Front, Before(Search, Back));
   Len:=Pos(Back, Search);
   if (Index > 0) and (Len > 0) then
      Result:=Copy(Search, Index + 1, Len - (Index + 1))
   else
      Result:='';
end;

//------------------------------------------------------------------//
//根据Inside函数限定的范围，返回字符串前部
//LeftInside('This (doucment) include source code (write in pascal).','(',')');
//返回This
function LeftInside(const Search, Front, Back: string): string;
begin
   Result:=Before(Search, Front + Inside(Search, Front, Back) + Back);
end;

//------------------------------------------------------------------//
//根据Inside函数限定的范围，返回字符串后部
//RightSide('This (doucment) include source code (write in pascal).','(',')');
//返回 include source code (write in pascal).
function RightSide(const Search, Front, Back: string): string;
begin
   Result:=After(Search, Front + Inside(Search, Front, Back) + Back);
end;

//------------------------------------------------------------------//
//切去标记，原字符串InTxt被切去一部分，切去部分在返回值中。
//s:='Money, 600, Box, Walk On Moon';
//Memo1.Lines.Add(GetToken(s));
function CutToken(var InTxt : String; SpaceChar : TSysCharSet = [',']) : String;
var
  i : Integer;
begin
  //查找第一个空字符
  i:=1;
  While (i<=length(InTxt)) and not (InTxt[i] in SpaceChar) do inc(i);
  //取得文本直到遇到空字符
  Result := Copy(InTxt,1,i-1);
  //从InTxt中删除取得的部分
  Delete(InTxt,1,i);
  //删除InTxt前部的空字符
  i:=1;
  While (i<=length(InTxt)) and (InTxt[i] in SpaceChar) do inc(i);
  Delete(InTxt,1,i-1);
end;

//------------------------------------------------------------------//
//取得第一个标记串。Remove=True与CutToken类似，速度更快。但需要指定分界符
function FirstToken(var S: string; const Delimiter: string; Remove: Boolean): string;
var
  I: Integer;
begin
  I := Pos(Delimiter, S);
  if I <> 0 then
  begin
    Result := Copy(S, 1, I - 1);
    if Remove then S := Trim(Copy(S, I + 1, Maxint));
  end else
  begin
    Result := S;
    if Remove then S := '';
  end;
end;

//------------------------------------------------------------------//
//取得字符串标记，如
//s:='I am a boy.'
//GetToken(s,1);             返回'I'
//GetToken(s,4);             返回'boy'
//GetToken(s,2,True);        返回'am a boy'
//GetWords(s);               返回4
//s:='You said : I am a good boy.';
//GetToken(s,1,False,[':']); 返回'You said'
//GetToken(s,2,False,[':']); 返回'I am a good boy.'
//GetWords(s);               返回7
//GetWords(s,[':'])          返回2
function GetToken(const S: string; index: Integer; bTrail: Boolean = False; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string;
var
  I, W, head, tail: Integer;
  bInWord         : Boolean;
begin
  I := 1;
  W := 0;
  bInWord := False;
  head := 1;
  tail := Length(S);
  while (I <= Length(S)) and (W <= index) do
  begin
    if S[I] in Delimiters then
    begin
      if (W = index) and bInWord then tail := I - 1;
      bInWord := False;
    end else
    begin
      if not bInWord then
      begin
        bInWord := True;
        Inc(W);
        if W = index then head := I;
      end;
    end;
    
    Inc(I);
  end;
  
  if bTrail then tail := Length(S);
  if W >= index then Result := Copy(S, head, tail - head + 1)
  else Result := '';
end;

//------------------------------------------------------------------//
//计算字符串中有多少个单词，例子如GetToken所示。
function GetWords(S: string; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): Integer;
var
  bInWord: Boolean;
  I      : Integer;
begin
  Result := 0;
  I := 1;
  bInWord := False;
  while I <= Length(S) do
  begin
    if S[I] in Delimiters then bInWord := False
    else
    begin
      if not bInWord then
      begin
        bInWord := True;
        Inc(Result);
      end;
    end;
    
    Inc(I);
  end;
end;

//------------------------------------------------------------------//
//str的函数形式
function ToStr(x:variant):string;
var
    s:string;
begin
    Str(x:19:2,s);
    ToStr:=Trim(s);
end;

//------------------------------------------------------------------//
//val的函数形式
function ToVal(const s:string):double;
var
    x:double;
    code:integer;
begin
    Val(s,x,code);
    if code<0 then
    	ToVal:=0
    else
    	ToVal:=x;
end;

//------------------------------------------------------------------//
//字符串首字符的ASC码
function ToAsc(const s : String ): integer;
Begin
  If Length( s ) > 0 Then
    ToAsc := Ord( s[1] )
  Else
    ToAsc := 0;
End;

//------------------------------------------------------------------//
//许多TCP上层协议，当客户端向服务端提出一个命令请求时，服务端会以3码
//数字作为每个响应的头部，让客户端便于分析请求的执行结果，处理信件传递
//的SMTP就是如此。本函数将状态码分离出来，交给状态码判断程序过滤处理，
//函数返回后，Msg参数的状态码被删除，方便后续处理。例如：
//s:=Recv;       若s为'214-This is sendmail version 8.9.3'
//ParseRPLNo(s); 返回214
//s现在为214-This is sendmail version 8.9.3

function ParseRPLNo(var Msg: string): Integer;
var
  S: string;
begin
  S := GetToken(Msg, 1, False);
  Result := StrToIntDef(S, 0);
  Msg := GetToken(Msg, 2, True);
end;

end.