xstrings.pas

关于c++ builder编程的很好的资料

unit xStrings;

interface

uses SysUtils, Classes, Windows, Dialogs;

const
  DEFAULT_DELIMITERS = ' '#9#10#13;
  
function EscapeRegularExpression(const AExpression: string): string;

function GetToken(const S: string; index: Integer; bTrail: Boolean = False; Delimiters: string = DEFAULT_DELIMITERS): string;
function CountWords(S: string; Delimiters: string = DEFAULT_DELIMITERS): Integer;
function BracketString(const S: string): string;

procedure TruncateCRLF(var S: string);
function IsContainingCRLF(const S: string): Boolean;
procedure RemoveCharacter(var S: string; C: Char);

procedure ReplaceString(var S: string; const Token, NewToken: string; bCaseSensitive: Boolean);
procedure ReplaceStringRegExp(var S: string; const RegExp, NewToken: string; bCaseSensitive: Boolean);

procedure Simple_ReplaceString(var S: string; const Substr: string; index, Count: Integer);

function UnquoteString(const S: string; C: Char = '"'): string;
function TrimParameters(const S: string): string;
function TrimNumberedParameters(const S: string): string;
function ExpandEnvStr(const S: string): string;

function FirstToken(var S: string; const Delimiter: string; Remove: Boolean): string;
function AddTimeStamp(const S: string): string;

function PartialIndexOf(SL: TStrings; S: string; StartIndex: Integer; bForward: Boolean): Integer;
function CompositeStrings(SL: TStrings; const Delimiter: string): string;


procedure RemoveDuplicates(SL: TStrings);
function ParseRPLNo(var Msg: string): Integer;

function RPos(const C: Char; const S: string): Integer;
function AnsiIPos(const Substr, S: string): Integer;
function MatchString(S, SubS: string; Options: TFindOptions): Integer;

function PadWithChar(const S: string; Len: Integer; C: Char = ' '; bHeadTail: Boolean = False): string;
procedure ObjectsToStrings(SL1, SL2: TStrings);

function WideCharToStr(WStr: PWChar; Len: Integer): string;
function PrintableString(const S: string): string;

function GetStringsNoCRLFText(SL: TStrings): string;

function WrapDBCSText(Line: string; CodePage: Integer = CP_ACP; MaxCol: Integer = 45): string;

implementation

uses regexpr;

procedure ExprReplaceFunc(const Match: string; var Replace: string);
begin
  Replace := '\' + Match;
end;

function EscapeRegularExpression(const AExpression: string): string;
begin
  with TRegExpr.Create do
    try
      Expression := '[\.\[\]\*\+\-\?\(\)\ \{\}\^\$\\]';
      Result := Replace(AExpression, '', @ExprReplaceFunc);
    finally
      Free;
    end;
end;

function GetToken(const S: string; index: Integer; bTrail: Boolean = False; Delimiters: string = DEFAULT_DELIMITERS): string;
var
  SL: TStrings;
begin
  SL := TStringList.Create;
  with TRegExpr.Create do
    try
      Expression := '[' + EscapeRegularExpression(Delimiters) + ']+';
      Split(S, SL, bTrail);
      
      if index - 1 < SL.Count then
        Result := SL[index - 1]
      else
        Result := '';
    finally
      Free;
      SL.Free;
    end;
end;

function CountWords(S: string; Delimiters: string = DEFAULT_DELIMITERS): Integer;
begin
  Result := 0;
  
  with TRegExpr.Create do
    try
      Expression := '[' + EscapeRegularExpression(Delimiters) + ']+';
      
      if Exec(S) then
      begin
        repeat
          if (Result = 0) and (matchpos[0] > 1) then
            Result := 1;
          
          Inc(Result);
        until not ExecNext;
        
        if matchpos[0] + matchlen[0] > Length(S) then dec(Result);
      end else // no match
        if S <> '' then Result := 1; // one token
    finally
      Free;
    end;
end;

function IsContainingCRLF(const S: string): Boolean;
var
  Len: Integer;
begin
  Len := Length(S);
  Result := (Len >= 2) and (S[Len - 1] = #13) and (S[Len] = #10);
end;

procedure TruncateCRLF(var S: string);
var
  I: Integer;
begin
  I := 1;
  while I <= Length(S) do
    if (S[I] = #13) or (S[I] = #10) then Delete(S, I, 1)
    else Inc(I);
end;

procedure RemoveCharacter(var S: string; C: Char);
var
  I: Integer;
begin
  I := 0;
  while I < Length(S) do
    if S[I] = C then
      Delete(S, I, 1)
    else
      Inc(I);
end;

procedure ReplaceString(var S: string; const Token, NewToken: string; bCaseSensitive: Boolean);
begin
  with TRegExpr.Create do
    try
      ModifierI := not bCaseSensitive;
      
      Expression := EscapeRegularExpression(Token);
      S := Replace(S, NewToken);
    finally
      Free;
    end;
end;

procedure ReplaceStringRegExp(var S: string; const RegExp, NewToken: string; bCaseSensitive: Boolean);
begin
  with TRegExpr.Create do
    try
      ModifierI := not bCaseSensitive;
      
      Expression := RegExp;
      S := Replace(S, NewToken);
    finally
      Free;
    end;
end;


procedure Simple_ReplaceString(var S: string; const Substr: string; index, Count: Integer);
begin
  S := Format('%s%s%s',[Copy(S, 1, index - 1), Substr, Copy(S, index + Count, Maxint)]);
end;

function BracketString(const S: string): string;
begin
  Result := S;
  if (Result = '') or (Result[1] <> '[') then Result := '[' + Result;
  if Result[Length(Result)] <> ']' then Result := Result + ']';
end;

function UnquoteString(const S: string; C: Char = '"'): string;
var
  iLeft, iRight: Integer;
begin
  if S = '' then Exit;
  
  Result := S;
  
  repeat
    iLeft := AnsiPos(C, Result);
    if iLeft = 0 then Break;
    iRight := AnsiPos(C, Copy(Result, iLeft + 1, Maxint));
    if iRight = 0 then Break;
    
    Delete(Result, iLeft + iRight, 1);
    Delete(Result, iLeft, 1);
  until False;
  
  Result := Trim(Result);
end;

function TrimParameters(const S: string): string;
var
  I: Integer;
begin
  Result := S;
  
  I := AnsiIPos('.exe', Result);
  if I = 0 then Exit;
  
  Result := Trim(Copy(Result, 1, I + 4));
end;

function TrimNumberedParameters(const S: string): string;
var
  I, index: Integer;
  bRemoved: Boolean;
begin
  Result := S;
  
  I := 1;
  repeat
    bRemoved := False;
    
    index := Pos('"%' + IntToStr(I) + '"', Result);
    if index > 0 then
    begin
      Delete(Result, index, 4);
      bRemoved := True;
    end;
    
    index := Pos('%' + IntToStr(I), Result);
    if index > 0 then
    begin
      Delete(Result, index, 2);
      bRemoved := True;
    end;
  until not bRemoved;
  
  Result := Trim(Result);
end;

function ExpandEnvStr(const S: string): string;
var
  Buf          : array[0..255] of Char;
  Len          : DWORD;                
  iLeft, iRight: Integer;              
  EnvName      : string;               
begin
  Result := S;
  
  repeat
    iLeft := AnsiPos('%', Result);
    if iLeft = 0 then Break;
    iRight := AnsiPos('%', Copy(Result, iLeft + 1, Maxint));
    if iRight = 0 then Break;
    
    EnvName := Copy(Result, iLeft + 1, iRight - 1);
    Len := GetEnvironmentVariable(PChar(EnvName), @Buf, SizeOf(Buf));
    Simple_ReplaceString(Result, StrPas(Buf), iLeft, iRight + 1);
  until False;
  
  Result := Trim(Result);
end;

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 + Length(Delimiter), Maxint));
  end else
  begin
    Result := S;
    if Remove then S := '';
  end;
end;

function CompositeStrings(SL: TStrings; const Delimiter: string): string;
var
  I: Integer;
begin
  Result := '';
  
  with SL do
  begin
    for I := 0 to Count - 2 do
      Result := Result + Strings[I] + Delimiter;
    if Count > 0 then
      Result := Result + Strings[Count - 1];
  end;
end;

function AddTimeStamp(const S: string): string;
begin
  if S = '' then
    Result := DateTimeToStr(Now)
  else if S[Length(S)] = #10 then
    Result := Copy(S, 1, Length(S) - 2) + ' at ' + DateTimeToStr(Now) + #13#10
  else
    Result := S + ' at ' + DateTimeToStr(Now);
end;

function PartialIndexOf(SL: TStrings; S: string; StartIndex: Integer; bForward: Boolean): Integer;
begin
  with SL do
  begin
    if bForward then
    begin
      for Result := StartIndex to Count - 1 do
        if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
    end else
    begin
      for Result := StartIndex downto 0 do
        if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
    end;
  end;
  
  Result := -1;
end;

// duplicated string must be adjacent ..
procedure RemoveDuplicates(SL: TStrings);
var
  I: Integer;
begin
  with SL do
  begin
    I := 1;
    while I < Count do
      if CompareText(Strings[I], Strings[I - 1]) = 0 then
        Delete(I)
      else
        Inc(I);
  end;
end;

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;

function RPos(const C: Char; const S: string): Integer;
var
  I: Integer;
begin
  Result := 0;
  I := Length(S);
  repeat
    if S[I] = C then
    begin
      Result := I;
      Exit;
    end;
    dec(I);
  until I < 1;
end;

function AnsiIPos(const Substr, S: string): Integer;
begin
  Result := AnsiPos(AnsiLowerCase(Substr), AnsiLowerCase(S));
end;

function MatchString(S, SubS: string; Options: TFindOptions): Integer;
const
  Delimiters = [#0..#47, #58..#64, #123..#255];
var
  EndI: Integer;
begin
  if not (frMatchCase in Options) then
  begin
    S := AnsiUpperCase(S);
    SubS := AnsiUpperCase(SubS);
  end;
  
  if frWholeWord in Options then
  begin
    Result := 1;
    EndI := Length(SubS);
    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(SubS)), SubS) = 0) then Break;
      Inc(Result);
      Inc(EndI);
    end;
    Result := EndI;
    if Result > Length(S) then Result := 0;
  end else Result := AnsiPos(SubS, S);
end;

procedure ObjectsToStrings(SL1, SL2: TStrings);
var
  I: Integer;
begin
  if not Assigned(SL1) or not Assigned(SL2) then Exit;
  
  SL2.Clear;
  for I := 0 to SL1.Count - 1 do
    if Assigned(SL1.Objects[I]) then
      SL2.Add(StrPas(PChar(SL1.Objects[I])));
end;

function PadWithChar(const S: string; Len: Integer; C: Char = ' '; bHeadTail: Boolean = False): string;
begin
  Result := S;
  
  while Length(Result) < Len do
    if bHeadTail then
      Result := C + Result
    else
      Result := Result + C;
end;

function WideCharToStr(WStr: PWChar; Len: Integer): string;
begin
  if Len = 0 then Len := -1;
  Len := WideCharToMultiByte(CP_ACP, 0, WStr, Len, nil, 0, nil, nil);
  SetLength(Result, Len);
  WideCharToMultiByte(CP_ACP, 0, WStr, Len, PChar(Result), Len, nil, nil);
end;

function PrintableString(const S: string): string;
var
  I     : Integer;
  C     : Char;   
  OrdVal: Byte;   
begin
  Result := '';
  
  for I := 1 to Length(S) do
  begin
    C := S[I];
    OrdVal := Ord(C);
    
    if (OrdVal <= 32) and (OrdVal <> $20) then
      Result := Result + '#' + IntToHex(OrdVal, 2)
    else
      Result := Result + C;
  end;
end;

function GetStringsNoCRLFText(SL: TStrings): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to SL.Count - 1 do
    Result := Result + SL[I];
end;

function WrapDBCSText(Line: string; CodePage: Integer = CP_ACP; MaxCol: Integer = 45): string;
const
  Delimiters = [' ', #9];
  
  function GetLastDBCSDelimiter(const S: string; index: Integer): Integer;
  begin
    Result := index;
    
    while Result >= 1 do
    begin
      if (S[Result] in Delimiters) or (S[Result] in [#13, #10]) then
        Exit;
      
      dec(Result);
    end;
    
    //