:: 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;
|
Как вставить перенос строки?
// Способ первый
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;
|
При использовании материала - ссылка на сайт обязательна
|
|