Функции для работы со строками

[BlackSpirit]

Надумал я пофлудить на тему работы со строками.

И так, на текущий момент в Stealth 6.1.3, мне известны следующие функции работы со строками:

Code: Select all

function Length(const S: String): Integer; // Возвращает количество символов в строке S.
procedure SetLength(var S: String; L: LongInt); // Изменяет размер строки

function PadL(S: String; I: LongInt): String; // Дополнение строки s пробелами слева до длины l 
function PadR(S: String; I: LongInt): String; // Дополнение строки s пробелами справа до длины l 
function PadZ(S: String; I: LongInt): String; // Дополнение строки s символами '0' слева до длины l 
function Replicate(C: Char; I: LongInt): String; // Создание строки длиной l из символов c  
function StringOfChar(C: Char; I: LongInt): String; // Синоним Replicate 

function BMSearch(I: Integer; const S,P: String): Integer; // Возвращает первое вхождение подстроки P в строке S начиная с позиции I.
procedure StrBreakApart(const S,D: String; P: TStrings); // Режет строку S на подстроки, используя символ-разделитель D. Результат запишет в список P.

function Pos(StrSub: String; Str: String): Integer; // Возвращает позицию (индекс) первого вхождения StrSub в строке Str. Если StrSub нет в Str, возвращает 0.
function Insert(Source: String; var S: String; Index: Integer): Integer; // Вставляет строку Source в строку S, начиная с номера символа, равного Index
procedure Delete(var S: String; Index, Count: Integer); // Удаляет из строки S подстроку, начинающуюся с номера символа, равного Index, и содержащую до Count символов.
function Copy(S: String; Index, Count: Integer): String; // Возвращает подстроку строки S, начиная с номера символа, равного Index и содержащую до Count символов.

Функции преобразования:

Code: Select all

function IntToStr(N: Integer): String; // Преобразует целое число N в строку. 
function Int64ToStr(N: Int64): String;
function IntToHex(N: Integer, Len: Byte): String; // Преобразует целое число N в строку в 16-ричном формате длинной Len цифр.

function StrToInt(S: String): Integer; // Преобразует строку S в целое число.Понимает 16-ричный формат, нужно только перед таким числом в строке иметь символ '$'.
function StrToInt64(S: String): Int64;

function FloatToStr(X: Extended): String; // Преобразует число с плавающей точкой X в строку.
function StrToFloat(S: String): Extended; // Преобразует строку S в число с плавающей точкой. 

function FormatDateTime(const Formatting: String; DateTime: TDateTime: String; // Мощная функция, по форматированию дат/времен, подробнее см. http://www.delphibasics.ru/FormatDateTime.php
function DateTimeToStr(DateTime: TDateTime): String; // Преобразует дату и время DateTime в строку.
function DateToStr(Date: TDateTime): String; // Преобразует дату Date в строку.
function TimeToStr(Time: TDateTime): String; // Преобразует время Time в строку.

Форматирования:

Code: Select all

function Trim(const S: String): String; // Удаляет из строки S начальные и завершающие пробелы и управляющие символы.
function TrimLeft(const S: String): String; // Удаляет из строки S начальные пробелы и управляющие символы.
function TrimRight(const S: String): String; // Удаляет из строки S завершающие пробелы и управляющие символы.

function AnsiLowerCase(const S: String): String; // Возвращает строку S, преобразованную к нижнему регистру.
function AnsiUpperCase(const S: String): String; // Возвращает строку S, преобразованную к верхнему регистру.

Есть еще непонимающие русские буквы:

Code: Select all

function LowerCase(const S: String): String;
function UpperCase(const S: String): String;

чтобы они заработали нужна заплатка вида SetLocale(LC_ALL, "ru_RU"), т.к. по умолчанию всегда стоит локаль C;

Кроме того, если в скрипте написать uses sysutils; то станут доступны функции:

Code: Select all

function StringReplace(const S, OldPattern, NewPattern: String; Flags: TReplaceFlags): String; // Заменяет в строке S подстроку OldPattern на строку NewPattern с учётом флага TReplaceFlags. 
//Для работы с этой функцией нужно создать переменную типа TReplaceFlags - это множество, и включить в него одно или оба значения из следующих:
//   rfReplaceAll - будут заменены все вхождения. Если это значение не будет включено во множество, то будет заменено только первое вхождение;
//   rfIgnoreCase - замена будет без учёта регистра символов. Если это значение не будет включено во множество, то замена будет чувствительна к регистру символов.

А также, аналогично, непонимающие русские буквы:

Code: Select all

function CompareStr(const FirstString, SecondString: String ) : Integer; // Сравнивает строки с учетом регистра
function CompareText(const FirstString, SecondString: String ) : Integer; // Сравнивает строки с без учета регистра

Вот собственно и все, что есть по умолчанию.

[BlackSpirit]

Но мы пойдем дальше и вспомним, что в Stealth разрешен экспорт функций из различных DLL. А там!, можно взять несколько вкусностей из WinAPI (kernel32.dll, Shell32.dll, User32.dll и пр.) и стандартной бибилиотеки языка C - msvcrt.dll:

для замещения забытых функций, понимающих русский язык:

Code: Select all

function AnsiCompareStr(const s1,s2: PChar): Integer; external '[email protected] stdcall'; // Сравнивает строки с учетом регистра 
function AnsiCompareText(const s1,s2: PChar): Integer; external '[email protected] stdcall';// Сравнивает строки с без учета регистра

Для желающих ваять парсеры:

Code: Select all

function IsDigit(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент цифра ['0' - '9']
function IsLatin(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент латинский символ ['А' - 'Z'] или ['a' - 'z']
function IsLatinOrDigit(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент цифра или латинский символ.
function IsIdent(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент символ, из которого может состоять идентификатор языка Pascal. 
function IsHexDigit(const c: Char): Boolean; external '[email protected] cdecl';// Возвращает истину, если аргумент символ, из которого может состоять число в шеснадцатиричном формате.
function IsPunct(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент любой отображаемый символ кроме букв и цифр.
function IsSpace(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент пробел или табуляция.
function IsCntrl(const c: Char): Boolean; external '[email protected] cdecl'; // Возвращает истину, если аргумент - это неотображаемый (управляющий) символ.
function IsLetter(const c: Char): Boolean; external '[email protected] stdcall'; // Возвращает истину, если аргумент - это буква латинского или русского алфавита.
function IsLetterOrDigit(const c: Char): Boolean; external '[email protected] stdcall';// Возвращает истину, если аргумент - это цифра или буква латинского или русского алфавита.

А также, для гурманов:

Code: Select all

function IsCharLower(const c: Char): Boolean; external '[email protected] stdcall'; // Возвращает истину, если аргумент - это знак в нижнем регистре (понимает русские буквы).
function IsCharUpper(const c: Char): Boolean; external '[email protected] stdcall';// Возвращает истину, если аргумент - это знак в верхнем регистре (понимает русские буквы).
function CharLower(const c: Char): Char; external '[email protected] cdecl'; // Возвращает нижний регистр символа в аргументе (понимает русские буквы).
function CharUpper(const c: Char): Char; external '[email protected] cdecl'; // Возвращает верхний регистр символа в аргументе (понимает русские буквы).

И мазохистов:

Code: Select all

function SetLocale(Category: Integer; const Locale: Pchar): Pchar;  external '[email protected] cdecl'; // Устанавливает значение локали нужной категории, возвращает ранее действовавшее значение локали.

где Category может принимать значения:

Code: Select all

const LC_ALL      = 0; // категория "все" (суммарно все что ниже)
const LC_COLLATE  = 1; // Категория "правила сравнения/сортировки строк"
const LC_CTYPE    = 2; // Категория "кодировка"
const LC_MONETARY = 3; // Категория "формат валюты"
const LC_NUMERIC  = 4; // Категория "Формат чисел" (резделитель дробей, группировка разрядов и проч.)
const LC_TIME     = 5; // Категория "формат времени" 
const LC_MESSAGES = 6; // Категория "язык системных сообщений"

----------------------------------------------------------------------------------

Теперь можно подумать над тем, чего тут нехватает. А нехватает, прежде всего, аналога функции Pos, способного действовать без учета регистра. Собственно, всегда можно выйти из положения, если преобразовать аргументы Pos, например, в нижний регистр. Прием это простой, но ресурсоемкий. Можно сделать эффективнее, мы переделаем функцию Pos, добавив в нее еще один аргумент:

Code: Select all

////////////////////////////////////////////////////////////////////////////////////////////////////
// Вспомогательная функция для реализации StrPos. Возвращает указатель PChar на первое вхождение s2 в s1. 
function StrStrI(const s1,s2: PChar): PChar; external '[email protected] stdcall';

////////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращает позицию первого вхождения Pattern  в Source. Игнорирует регистр при поиске, если 
// IgnoreCase = True и  учитывает регистр при IgnoreCase = False. 
function StrPos(const Pattern, Source: String; IgnoreCase: Boolean): Integer;
var L: Integer;
begin
  if IgnoreCase = False then Result := BMSearch(1, Source, Pattern) // Обычный поиск с учетом регистра
  else begin // Поиск без учета регистра 
    L := Length(Source);
    if L > 0 then begin
      Result := Length(StrStrI(Source, Pattern)); // Вычисляем позицию вхождения Pattern в Source считая "с конца"
      if Result > 0 then Result := L-Result+1; // Если что-то нашли и результат не 0, то пересчитываем в позицию "с начала"
    end;
  end;
end;

Собственно этот StrPos может быть краеугольным камнем огромного количества удобных прибамбасов. Прежде всего вспомним, что в родном паскалевском StrUtils есть классные функции AnsiContainsStr, AnsiStartsStr, AnsiEndsStr. Их забыли, воткнуть в Stealth, но мы их воссаздадим в формате StrPos, т.е. с аргументом IgnoreCase:

Code: Select all

///////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращается истина, если строка Source начинается подстрокой Pattern. При IgnoreCase = True не 
// учитывает регистр.
function StrStarts(const Source, Pattern: String; IgnoreCase: Boolean): Boolean;
begin
  Result := (Length(Source) >= Length(Pattern)) and (StrPos(Pattern, Source, IgnoreCase) = 1);
end;

///////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращется истина, если строка Source заканчивается подстрокой Pattern. При IgnoreCase = True 
// не учитывает регистр.
function StrEnds(const Source, Pattern: String; IgnoreCase: Boolean): Boolean;
begin
  Result := (Length(Source) >= Length(Pattern)) and (StrPos(Pattern, Source, IgnoreCase) = Length(Source)-Length(Pattern)+1);
end;

///////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращается истина, если строка Source содержит подстроку Pattern. При IgnoreCase = True не 
// учитывает регистр.
function StrSub(const Source, Pattern: String; IgnoreCase: Boolean): Boolean;
begin
  Result := (Length(Source) >= Length(Pattern))  and (StrPos(Pattern, Source, IgnoreCase) >= 1);
end; 

Для сравнения строк можно применить аналогичный подход:

Code: Select all

///////////////////////////////////////////////////////////////////////////////////////////////////
// Функция сортировки строк. Возвращает:
//  1, если строка S1 раньше по алфавиту чем S2 c учетом IgnoreCase
// -1, если строка S1 позднее по алфавиту чем S2 c учетом IgnoreCase
//  0, если строка S1 совпадает S2 c учетом IgnoreCase
function StrCompare(const S1, S2: String; IgnoreCase: Boolean): Integer;
begin
  if IgnoreCase then Result := AnsiCompareText(S1,S2) else Result := AnsiCompareStr(S1,S2);
end;

что позволит сделать, для ровного счета еще и такую штуку:

Code: Select all

///////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращается истина, если строка S1 равна строке S2 c учетом IgnoreCase
function StrEqual(const S1, S2: String; IgnoreCase: Boolean): Boolean;
begin
  Result := (StrCompare(S1,S2) = 0);
end; 

Также, можно сделать свой аналог AnsiReplaceStr, в уже опробованном формате:

Code: Select all

///////////////////////////////////////////////////////////////////////////////////////////////////
// Возвращается строка, полученная в результате замены в Source всех вхождений Pattern на строку 
// Template. При IgnoreCase = True при поиске не учитывает регистр.
function StrReplace(const Pattern, Template, Source: String; IgnoreCase: Boolean): String;
var LP,E: Integer;
begin
  Result := Source;
  LP := Length(Pattern);
  repeat
    E := StrPos(Pattern, Result, IgnoreCase);
    if E > 0 then Result := Copy(Result, 1, E-1)+Template+Copy(Result, E+LP, Length(Result)-LP);
  until E = 0; 
end;

Тогда можно будет не использовать эту приблуду uses sysutils; - и зачем ее вообще прилепили?

[BlackSpirit]

Ну, а теперь, самое, на мой взгляд, интересное. Все эти чудесные функции не заменят гениальнейшего изобретения человечества - регулярных выражений. Не знаю как уж так вышло, но наши не любят регулярные выражения. Вообще зря, штука эта архиудобная, а при определенной сноровке и вовсе оружие в руках терминатора.

PascalScript конечно не предназначен для создания мощных регулярных выражений, но на практике и не нужно ничего сверх оператора "или" и жадного квантора типа "*".

Не мудрствуя лукаво, мы, на скорую руку, на основе функций StrEqual, StrStarts, StrEnds, StrSub и StrBreakApart, сляпаем примитивный RegExp!


Для начала структурка для хранения "узла" регулярного выражения:

Code: Select all

type TRegExpNode = record // "узел" регулярного выражения
  Pattern: String; // шаблон строки для сравнения, выделяется из запроса разделителем "|", предварительно очищается от служебных символов '*' и '"'
  Comparator: function(const Source, Pattern: String; IgnoreCase: Boolean): Boolean; // функция сравнения (StrEqual, StrStarts, StrEnds, StrSub), применяемая к шаблону 
end;

И, собственно, массив "узлов":

Code: Select all

type TRegExp = Array Of TRegExpNode;

Для формирования TRegExp воспользуемся такой функцией:

Code: Select all

function RegExp(const Query: String): TRegExp;
var SL: TStringList; Idx, L: Integer;
begin
  SL := TStringList.Create;
  if (Query <> '') then StrBreakApart(Query, '|', SL); // разбиваем запрос на подстроки  
  SetLength(Result, SL.Count);
  for Idx := 0 to SL.Count-1 do begin
    L := Length(SL.Strings[Idx]); 
    if (L > 1) and (SL.Strings[Idx][1] = '"') and (SL.Strings[Idx][L] = '"') then begin 
      Result[Idx].Pattern := Copy(SL.Strings[Idx], 2, L-2); // вырезаем концевые '"'
      Result[Idx].Comparator := @StrEqual; // ищем точное совпадение, т.е '"шаблон"'
    end else if (L > 1) and (SL.Strings[Idx][1] = '*') and (SL.Strings[Idx][L] <> '*') then begin
      Result[Idx].Pattern := Copy(SL.Strings[Idx], 2, L-1); // вырезаем '*' в начале строки
      Result[Idx].Comparator := @StrEnds;// ищем подстроку заканчивающуюся шаблоном, т.е '*подстрока' 
    end else if (L > 1) and (SL.Strings[Idx][1] <> '*') and (SL.Strings[Idx][L] = '*') then begin    
      Result[Idx].Pattern := Copy(SL.Strings[Idx], 1, L-1); // вырезаем '*' в конце строки
      Result[Idx].Comparator := @StrStarts; // ищем подстроку начинающуюся с шаблона, т.е 'подстрока*'
    end else begin
      if (L > 1) and (SL.Strings[Idx][1] = '*') and (SL.Strings[Idx][L] = '*') then
        Result[Idx].Pattern := Copy(SL.Strings[Idx], 2, L-2) // если надо вырезаем концевые '*'  
      else
        Result[Idx].Pattern := SL.Strings[Idx]; // или не меняем шаблон 
      Result[Idx].Comparator := @StrSub; // ищем просто подстроку, т.е '*подстрока*'
    end;
  end;  
  SL.Free;
end;

Функция возвращает TRegExp, заполненный в соответствии со строкой запроса Query. Чтобы узнать число узлов в регулярном выражении нужно использовать Length(RegExp).
Чтобы получить доступ до шаблона конкретного узла RegExp[Idx].Pattern

Пример

Code: Select all

 var RE: TRegExp; Idx: Integer;
 begin
   RE := RegExp('System: This is*|System: That is*|System: Try*|System: It appears*|System: Your ghostly*|System: You can''t*');
   Idx := StrMatch(LastJournalMessage, RE, True);
 end.

В примере для поиска по строкам используется функция StrMatch, имеющая вот такое устройство:

Code: Select all

function StrMatch(const Source: String; const RegExp: TRegExp; IgnoreCase: Boolean): Integer;
var Idx: Integer;
begin
  Result := -1;
  if Length(Source) = 0 then Exit;
  for Idx := 0 to Length(RegExp)-1 do begin  
    if RegExp[Idx].Comparator(Source, RegExp[Idx].Pattern, IgnoreCase) then begin // Если нашлась подстрока
      Result := Idx; // Запоминаем текущий номер "узла"
      Break; // Выходим из процедуры
    end;
  end; 
end;

Функция возвращает порядковый номер (начиная с 0) "узла" регулярного выражения RegExp который соответствует строке Source. Сравнение происходит с учетом IgnoreCase.
Примеры:

Code: Select all

  StrMatch('Мама мыла раму', RegExp('мама*|папа'), True); // вернет 0
  StrMatch('Мама мыла раму', RegExp('папа|дедушка|*раму'), True); // вернет 2
  StrMatch('Мама мыла раму', RegExp('папа|бабушка|дедушка|мыл'), True); // вернет 3
  StrMatch('Мама мыла раму', RegExp('бабушка|"Мама мыла раму"'), True); // вернет 1
  StrMatch('Мама мыла раму', RegExp('мыл*|*мама'), True); // вернет -1
  StrMatch('Мама мыла раму', RegExp('"мама мыла раму"|папа'), False); // вернет -1

Важно сказать, что из-за того, что реализация у нас "примитивная", функции RegExp и StrMatch не распознают '*' как квантификатор, когда символ не находится по краям
подзапроса. Так шаблон типа 'ма*ма' будет пониматься буквально, т.е будет искаться подстрока 'ма*ма'. Шаблон вида '**мама' будет пониматься тоже буквально, как поиск StrEnds подстроки '*мама' и т.д.

-------------------------------------------------

Все вышесказанное я оформил в виде инклюда http://ge.tt/7zc1n6x/v/0, который можно положить в папку "[StealthPath]\Scripts\Include"
и использовать в своих скриптах, сказав {$Include 'strs.inc'}

[nepret]

гууд ворк)

[Vizit0r]

да, работа серьезная.

Тогда можно будет не использовать эту приблуду uses sysutils; - и зачем ее вообще прилепили?

тебе не надо - другим пригодится - там же не только функции для работы со строками.

Прежде всего вспомним, что в родном паскалевском StrUtils есть классные функции AnsiContainsStr, AnsiStartsStr, AnsiEndsStr. Их забыли, воткнуть в Stealth

не то чтобы забыли, а никому оно особо и не надо было. Народ обычно ленится использовать хоть что-то круче BMSearch, не говоря уже про такие глубокие функции.

Важно сказать, что из-за того, что реализация у нас "примитивная", функции RegExp и StrMatch не распознают '*' как квантификатор, когда символ не находится по краям
подзапроса. Так шаблон типа 'ма*ма' будет пониматься буквально, т.е будет искаться подстрока 'ма*ма'. Шаблон вида '**мама' будет пониматься тоже буквально, как поиск StrEnds подстроки '*мама' и т.д.

а я все пытался вспомнить, что мне это напоминает, а потом вспомнил формат Speech keys из уо файлов. Один в один. Видимо там тоже решили не усложнять.



P.S. Может проще было мне прокинуть из дельфей методы по работе с regexp?

[BlackSpirit]

P.S. Может проще было мне прокинуть из дельфей методы по работе с regexp?

Если речь идет, например, о такой штуке http://www.regexpstudio.com/ru/TRegExpr/Help/About.html, то это однозначно не повредит!

Вообще, если помечтать, я хотел бы, что бы и в функциях работы с журналом были доступны регулярные выражения.

И такой момент. Важно не переборщить с синтаксисом регэкспов - нужно, что-бы был "упрощенный" режим, т.е. схожий с поисковиками типа Yandex/Google или командной строкой. Такие регулярные выражения будут интуитивно понятны почти всем и не потребуют серьезного изучения от тех, кому оно особо не надо.

И еще. Было бы реально круто, если в Стелсе был бы реализован StrPos, или любой другой аналог Pos (а еще лучше PosEx/BMSearch), способный работать без учета регистра. Но только не самописный (на for-ах и проч.), а типа как у меня в примере на основе серьезной функции сделанной внутри на ASM или C.