FAQ VCL
Операции над строками

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как сжать строку с цифрами в BCD-число?

function NumStringToBCD(const inStr: string): string;

  function Pack(ch1, ch2: Char): Char;
  begin
    Assert((ch1 >= '0') and (ch1 <= '9'));
    Assert((ch2 >= '0') and (ch2 <= '9'));
    {Ord('0') is $30, so we can just use the low nybble of the character as value.}
    Result := Chr((Ord(ch1) and $F) or ((Ord(ch2) and $F) shl 4));
  end;

var
  i: Integer;
begin
  if Odd(Length(inStr)) then
    Result := NumStringToBCD('0' + inStr)
  else
  begin
    SetLength(Result, Length(inStr) div 2);
    for i := 1 to Length(Result) do
      Result[i] := Pack(inStr[2*i-1], inStr[2*i]);
  end;
end;

function BCDToNumString(const inStr: string): string;

  procedure UnPack(ch: Char; var ch1, ch2: Char);
  begin
    ch1 := Chr((Ord(ch) and $F) + $30);
    ch2 := Chr(((Ord(ch) shr 4) and $F) + $30);
    Assert((ch1 >= '0') and (ch1 <= '9'));
    Assert((ch2 >= '0') and (ch2 <= '9'));
  end;

var
  i: Integer;
begin
  SetLength(Result, Length(inStr) * 2);
  for i := 1 to Length( inStr ) do
    UnPack(inStr[i], Result[2*i-1], Result[2*i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S1, S2, Res: string;
begin
  S1 := '151515151515151515151';
  S2 := NumStringToBCD(S1);
  Res := 'S1: ' + S1 + #13 +
         'Length(S2): ' + IntToStr(Length(S2)) + #13 +
         'S2 unpacked again: ' + BCDToNumString(S2);
  ShowMessage(Res);
end;


Как заменить множество подряд стоящих пробелов одним?

// Способ первый
function SpaceCutter(const Str: string): string;
var
  i: Integer;
  PS, CurPos: PChar;
  b: Boolean;
  StrL: Cardinal;
  Ch: Char;
begin
  StrL := Length(Str);
  PS := GetMemory(StrL+1);
  CurPos := PS;
  b := True;
  for i := 1 to StrL do
  begin
    Ch := Str[i];
    if Ch <> ' ' then
    begin
      b := False;
      CurPos[0] := Ch;
      Inc(CurPos);
    end
    else
    begin
      if not b then
      begin
        CurPos[0] := Ch;
        Inc(CurPos);
        b := True;
      end;
    end;
  end;
  CurPos[0] := #0;
  Result := PS;
  FreeMemory(PS);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TempStr: string;
begin
  TempStr := 'а,  б,   в,    г,     …';
  ShowMessage(SpaceCutter(TempStr));
end;

// Способ второй
uses
  {...,} System.RegularExpressions;

procedure TForm1.Button1Click(Sender: TObject);
var
  RegEx: TRegEx;
  TempStr: string;
begin
  RegEx := TRegEx.Create('  +');
  TempStr := 'а,  б,   в,    г,     …';
  ShowMessage(RegEx.Replace(TempStr, ' '));
end;

// Или немного иначе
procedure TForm1.Button2Click(Sender: TObject);
var
  TempStr: string;
begin
  TempStr := 'а,  б,   в,    г,     …';
  ShowMessage( TRegEx.Replace( TempStr, '  +', ' ' ) );
end;


Как найти строки, не содержащие указанных слов?

uses
  {...,} System.RegularExpressions;

procedure TForm1.Button1Click(Sender: TObject);
const
  s1 = 'Поспупил платёж';
  s2 = 'Поспупила сумма';
  s3 = 'Поспупила сумка';
var
  r: TRegEx;
begin
  // Исключаем строки в которых встречается 'плат' или 'сумм'
  if r.IsMatch(s1, '^(?!.*плат|.*сумм).*$', [roIgnoreCase]) then
    ShowMessage(s1);
  if r.IsMatch(s2, '^(?!.*плат|.*сумм).*$', [roIgnoreCase]) then
    ShowMessage(s2);
  if r.IsMatch(s3, '^(?!.*плат|.*сумм).*$', [roIgnoreCase]) then
    ShowMessage(s3);
end;


Как проверить пароль на соответствие требованиям?

uses
  {...,} System.RegularExpressions;

procedure TForm1.Button1Click(Sender: TObject);
const
  s1 = 'Qw3rT6Ui';
  s2 = 'Qw3rT6 i';
var
  r: TRegEx;
begin
  // (?=^.{8,}$)          - не менее 8 символов
  // ((?=.*\d)|(?=.*\W+)) - есть хотя бы одна цифра
  // (?![.\n|\r])         - не содержит символов переноса строк и возврата каретки
  // (?!.*[\s])           - не содержит пробелов
  // (?=.*[A-Z])          - содержит прописные латинские буквы
  // (?=.*[a-z])          - содержит строчные латинские буквы
  if r.IsMatch(s1, '(?=^.{8,}$)((?=.*\d)|(?=.*\W+))(?![.\n|\r])(?!.*[\s])(?=.*[A-Z])(?=.*[a-z]).*$', [roIgnoreCase]) then
    ShowMessage(s1);
  if r.IsMatch(s2, '(?=^.{8,}$)((?=.*\d)|(?=.*\W+))(?![.\n|\r])(?!.*[\s])(?=.*[A-Z])(?=.*[a-z]).*$', [roIgnoreCase]) then
    ShowMessage(s2);
end;


Как проверить соответствует ли строка одному из требуемых вариантов?

uses
  {...,} StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Проверка осуществляется без учета регистра
  if AnsiMatchText(Edit1.Text, ['привет', 'Пока']) then
    ShowMessage('Соответствует');
end;


Как вставить перенос строки?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('a' + Chr(13) + 'b');
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('a'#13'b');
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('a' + sLineBreak + 'b');
end;


Как выбрать текст между квадратными скобками?

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(TRegEx.Match('aaa [111]', '\[(.+?)\]').Groups[1].Value);
  // или немного иначе
  ShowMessage(TRegEx.Match('aaa [111]', '\[([^\[\]]+)\]').Groups[1].Value);
end;


Как проверить строку на наличие троекратного повторения какого-либо символа?

uses
  {...,} RegularExpressions;

procedure TForm1.Button1Click(Sender: TObject);
const
  s = '123'#13'qqq'#13'wer'#13'123'#13'aaa'#13'wer'#13'123'#13'zzz'#13'wer';
  r = '(.)\1{2}'; // или так  r = '(.)\1\1+';
var
  m: TMatch;
  mc: TMatchCollection;
begin
  mc := TRegEx.Matches(s, r, [roSingleLine]);
  for m in mc do
    ShowMessage(Format('%s, start=%d, end=%d', [m.Value, m.Index, m.Length]));
end;


Как сконвертировать юникодные числовые символы в цифры?

procedure TForm1.Button1Click(Sender: TObject);
const
  MAP_FOLDDIGITS = 128;
  Arr: array[0..3] of record
    Lang: string;
    StartPos, EndPos: Integer;
  end = (
    (Lang: 'Деванагари'; StartPos: $966;  EndPos: $96F),
    (Lang: 'Арабский';   StartPos: $660;  EndPos: $669),
    (Lang: 'Тибетский';  StartPos: $F20;  EndPos: $F29),
    (Lang: 'Кхмерский';  StartPos: $17E0; EndPos: $17E9)
  );
  INDEX = 1;
var
  s: string;
  i: Integer;
  Num: PChar;
begin
  s := '';
  for i := Arr[INDEX].StartPos to Arr[INDEX].EndPos do
    s := s + Chr(i);
  GetMem(Num, FoldString(MAP_FOLDDIGITS, PChar(s), -1, Num, $0) * SizeOf(Char));
  FoldString(MAP_FOLDDIGITS, PChar(s), -1, Num, i);
  ShowMessage(Format('%s'#13'%s   ->   %s', [Arr[INDEX].Lang, s, Num]));
  FreeMem(Num);
end;


Как разбить строку на подстроки с ограничением по длине (что-то вроде WordWrap)?

procedure TForm1.Button1Click(Sender: TObject);
const
  s1 = 'Не волнуйтесь, если что-то не работает. Если бы всё работало - вас бы уволили.';
  s2 = '''Не волнуйтесь, если что-то не работает. Если бы всё работало - вас бы уволили.''';
begin
  // Функция WrapText не вставляет разделители в строкицитаты -
  // строки, заключенные в одиночные кавычки.
  ShowMessage(WrapText(s1, #13#10, ['.', ' ', #9, '-'], 20));
  ShowMessage(WrapText(s2, #13#10, ['.', ' ', #9, '-'], 20));
end;

При использовании материала - ссылка на сайт обязательна