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 TForm2.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;


Как преобразовать кириллицу из DFM (#1082) в нормальную строку?

uses
  RegularExpressions;

var
  s: string = '#39#1090#1077#1082#1089#1090#13#10#1074#13#10' +
              '#1082#1072#1074#1099#1095#1082#1072#1093#39';

function DecodeFromUTF8Str(s: string): string;
var
  m: TMatch;
  i: Integer;
begin
   Result := StringReplace(s, '''', '', [rfReplaceAll]);
   for m in TRegEx.Matches(Result, '#(\d{4}|\d{2})') do
      Result := StringReplace(
         Result, m.Value, Chr(m.Groups.Item[1].Value.ToInteger), []
      );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DecodeFromUTF8Str(s));
end;


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

procedure TForm2.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;

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