Работа со строками

Code:

//-----------------------------------------------------------------------------

// Name: cnsSmartPos

// Author: Com-N-Sense

// Date:

// Purpose: Find a substring in a string starting from any position in the string.

// Params: SubStr - a substring for search.

// S - the source string to search within

// StartPos - the index position to start the search.

// Result: Integer - the position of the substring,

// zero - if the substring was not found

// Remarks: This is the original Delphi "Pos" function modified to support

// the start pos parameter.

//-----------------------------------------------------------------------------

function SmartPosAsm(const substr : AnsiString; const s : AnsiString; StartPos : Cardinal) : Integer;

type

StrRec = packedrecord

allocSiz: Longint;

refCnt: Longint;

length: Longint;

end;

const

skew = sizeof(StrRec);

asm

{ ->EAX Pointer to substr }

{ EDX Pointer to string }

{ <-EAX Position of substr in s or 0 }

TEST EAX,EAX

JE @@noWork

TEST EDX,EDX

JE @@stringEmpty

PUSH EBX

PUSH ESI

PUSH EDI

MOV ESI,EAX { Point ESI to substr }

MOV EDI,EDX { Point EDI to s }

MOV EAX,ECX

MOV ECX,[EDI-skew].StrRec.length { ECX = Length(s) }

ADD EDI,EAX

SUB ECX,EAX

PUSH EDI { remember s position to calculate index }

MOV EDX,[ESI-skew].StrRec.length { EDX = Length(substr)

DEC EDX { EDX = Length(substr) - 1 }

JS @@fail { < 0 ? return 0 }

MOV AL,[ESI] { AL = first char of substr }

INC ESI { Point ESI to 2'nd char of substr }

SUB ECX,EDX { #positions in s to look at }

{ = Length(s) - Length(substr) + 1 }

JLE @@fail

@@loop:

REPNE SCASB

JNE @@fail

MOV EBX,ECX { save outer loop counter }

PUSH ESI { save outer loop substr pointer }

PUSH EDI { save outer loop s pointer }

MOV ECX,EDX

REPE CMPSB

POP EDI { restore outer loop s pointer }

POP ESI { restore outer loop substr pointer }

JE @@found

MOV ECX,EBX { restore outer loop counter }

JMP @@loop

@@fail:

POP EDX { get rid of saved s pointer }

XOR EAX,EAX

JMP @@exit

@@stringEmpty:

XOR EAX,EAX

JMP @@noWork

@@found:

POP EDX { restore pointer to first char of s }

MOV EAX,EDI { EDI points of char after match }

SUB EAX,EDX { the difference is the correct index }

@@exit:

POP EDI

POP ESI

POP EBX

@@noWork:

end; //SmartPosAsm

function cnsSmartPos(const substr : AnsiString; const s : AnsiString; StartPos : Cardinal) : Integer;

begin

dec(StartPos);

Result := SmartPosAsm(SubStr,S,StartPos);

if Result > 0then Result := Result + StartPos;

end; //cnsSmartPos

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Поиск подстроки в строке с заданной позиции

S - строка, в которой искать

SubStr - образец

fromPos - с какой позиции

Все на асемблере, принцип простой - ищется первый символ, затем часть строки

сравнивается с образцом начиная с этого символа

Если образец не найден, возвращает 0

Если найден - номер первого символа вхождения

Зависимости: Нету их!

Автор: Romkin, romkin @ pochtamt.ru, Москва

Copyright: Модернизированная функция из SysUtils

***************************************************** }

function TailPos(const S, SubStr: AnsiString; fromPos: integer): integer;

asm

PUSH EDI

PUSH ESI

PUSH EBX

PUSH EAX

OR EAX,EAX

JE @@2

OR EDX,EDX

JE @@2

DEC ECX

JS @@2

MOV EBX,[EAX-4]

SUB EBX,ECX

JLE @@2

SUB EBX,[EDX-4]

JL @@2

INC EBX

ADD EAX,ECX

MOV ECX,EBX

MOV EBX,[EDX-4]

DEC EBX

MOV EDI,EAX

@@1: MOV ESI,EDX

LODSB

REPNE SCASB

JNE @@2

MOV EAX,ECX

PUSH EDI

MOV ECX,EBX

REPE CMPSB

POP EDI

MOV ECX,EAX

JNE @@1

LEA EAX,[EDI-1]

POP EDX

SUB EAX,EDX

INC EAX

JMP @@3

@@2: POP EAX

XOR EAX,EAX

@@3: POP EBX

POP ESI

POP EDI

end;

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Поиск подстроки в строке с заданной позиции (стандартный вариант)

Вроде работает

Substr - подстрока, S - строка, fromPos - с какой позиции искать

Если вхождение не найдено, возвращает 0

Ограничения - как для ansiStrPos

Зависимости: SysUtils

Автор: Romkin, romkin @ pochtamt.ru, Москва

Copyright: Romkin

***************************************************** }

function fAnsiPos(const Substr, S: string; FromPos: integer): Integer;

var

P: PChar;

begin

Result := 0;

P := AnsiStrPos(PChar(S) + fromPos - 1, PChar(SubStr));

if P <> nilthen

Result := Integer(P) - Integer(PChar(S)) + 1;

end;

Code:

function CountPos(const subtext: string; Text: string): Integer;

begin

if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then

Result := 0

else

Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div

Length(subtext);

end;

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Подсчёт количества вхождений символа в строке

Функцийка считает количество повторений

символа заданного InputSubStr в строке InputStr.

Зависимости: Стандартные модули

Автор: Ru, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Одесса (Украина)

Copyright: DiVo 2003 creator Ru

Дата: 18 ноября 2003 г.

***************************************************** }

function CntChRepet(InputStr: string; InputSubStr: char): integer;

var

i: integer;

begin

result := 0;

for i := 1to length(InputStr) do

if InputStr[i] = InputSubStr then

inc(result);

end;

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Подсчитать количество вхождений подстроки в строке

Понадобилось подсчитать количество вхождений подстроки в строку,

вот и появилась эта функция. Возможно в ней и нет изюминки,

но может кому и пригодится.

Зависимости: System

Автор: Дмитрий, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:155133146, Тольятти

Copyright: Дмитрий

Дата: 17 октября 2002 г.

***************************************************** }

function CntRecurrences(substr, str: string): integer;

var

cnt, p: integer;

begin

cnt := 0;

while str <> ''do

begin

p := Pos(substr, str);

if p > 0then

inc(cnt)

else

p := 1;

Delete(str, 1, (p + Length(substr) - 1));

end;

Result := cnt;

end;

Code:

// Кол-во вхождений символа в строку

function SymbolEntersCount(s: string; ch: char): integer;

var

i: integer;

begin

Result := 0;

if Trim(s) <> ''then

for i := 1to Length(s) do

if s[i] = ch then

inc(Result);

end;

Code:

var t:TStringList;

begin

t:=TStringList.create; //создаём класс

t.text:=stringReplace('Ваша строка для разделения',' ',#13#10,[rfReplaceAll]);//мы заменяем все пробелы на символы конца строки

//теперь можно убедится что у вас строка разбина на элементы:

showmessage(t[0]);

showmessage(t[1]);

showmessage(t[2]);

showmessage(t[3]);

...

//после работы надо уничтожить класс

t.free;

Code:

var a:arrayofstring;//наш массив

s:string;//строка которую мы будем разбивать

begin

s:='Windows Messages SysUtils Variants Classes Graphics Controls Forms';

Repeat//мы постепенно заполняем массив на каждом шаге цикла по 1 элементу

setlength(a,length(a)+1);//увеличиваем размер массива на 1

if pos(' ',s)>0then//если есть пробел то надо взять слово до пробела

begin

a[length(a)-1]:=copy(s,1, pos(' ',s));//присвоение последнему элементу массива первого слова

s:=copy(s,pos(' ',s)+1, length(s));//удаляем из строки первое слово

end

else//в строке осталось только одно слово

begin

a[length(a)-1]:=s;// присвоим последнее слово

break;//выход из цикла

end;

Until False;//цикл бесконечный, выход изнутри

//теперь проверяем что получили

showmessage(a[0]);

showmessage(a[1]);

showmessage(a[2]);

Code:

procedure SplitOnWords(const s:string; Delimiters:setof char; Strings:TStrings);

var

p,sp:PChar;

str:string;

begin

include(Delimiters,#0); //чтоб уж наверняк

p:=pointer(s);

while true do

begin

//пропускаем все разделители в начале

while p^ in Delimiters do

if p^=#0then

exit

else

inc(p);

sp:=p;

//пока не кончилось слово.

whilenot (p^ in Delimiters) do inc(p);

//запоминаем слово

SetLength(str,cardinal(p)-cardinal(sp));

Move(sp^,pointer(str)^,cardinal(p)-cardinal(sp));

Strings.Add(str);

end;

end;

Code:

unit awMachMask; // © Alexandr Petrovich Sysoev

interface

uses Classes;

///////////////////////////////////////////////////// Работа со списком шаблонов

// Функции предназначены для сопоставления текстов (имен файлов) на

// соответствие заданному шаблону или списку шаблонов.

// Обычно используется для посторения простых фильтров, например аналогичных

// файловым фильтрам программы Total Commander.

//

// Каждый шаблон аналогичен шаблону имен файлов в MS-DOS и MS Windows,

// т.е. может включать "шаблонные" символы '*' и '?' и не может включать

// символ '|'.

// Любой шаблон может быть заключен в двойные кавычки ('''), при этом двойные

// кавычки имеющиеся в шаблоне должны быть удвоены. Если шаблон включает

// символы ';' или ' ' (пробел) то он обязательно должен быть заключен в

// двойные кавычки.

// В списке, шаблоны разделяются символом ';'.

// За первым списком шаблонов, может следовать символ '|', за которым может

// следовать второй список.

// Текст (имя файла) будет считаться соответствующим списку шаблонов только

// если он соответствует хотя бы одному шаблону из первого списка,

// и не соответствует ни одному шаблону из второго списка.

// Если первый список пуст, то подразумевается '*'

//

// Формальное описание синтаксиса списка шаблонов:

//

// Полный список шаблонов :: [<список включаемых шаблонов>]['|'<список исключаемых шаблонов>]

// список включаемых шаблонов :: <список шаблонов>

// список исключаемых шаблонов :: <список шаблонов>

// список шаблонов :: <шаблон>[';'<шаблон>]

// шаблон :: шаблон аналогичный шаблону имен файлов в

// MS-DOS и MS Windows, т.е. может включать

// "шаблонные" символы '*' и '?' и не может

// включать символ '|'. Шаблон может быть

// заключен в двойные кавычки (''') при этом

// двойные кавычки имеющиеся в шаблоне должны

// быть удвоены. Если шаблон включает символы

// ';' или ' ' (пробел) то он

// обязательно должен быть заключен в двойные

// кавычки.

//

// Например:

// '*.ini;*.wav' - соответствует любым файлам с расшиениями 'ini'

// или 'wav'

// '*.*|*.exe' - соответствует любым файлам, кроме файлов с

// расширением 'EXE'

// '*.mp3;*.wav|?.*;??.*' - соответствует любым файлам с расшиениями 'mp3'

// и 'wav' за исключением файлов у которых имя

// состоит из одного или двух символов.

// '|awString.*' - соответствует любым файлам за исключением файлов

// с именем awString и любым расширением.

//

Function IsMatchMask (aText, aMask :pChar ) :Boolean; overload;

Function IsMatchMask (aText, aMask :String; aFileNameMode :Boolean =True) :Boolean; overload;

// Выполняют сопоставление текста aText с одним шаблоном aMask.

// Возвращает True если сопоставление выполнено успешно, т.е. текст

// aText соответствует шаблону aMask.

// Если aFileNameModd=True, то объект используется для сопоставления

// имен файлов с шаблоном. А именно, в этом случае, если aText не

// содержит символа '.' то он добавляется в конец. Это необходимо для

// того, чтобы файлы без расширений соответствовали например шаблону '*.*'

Function IsMatchMaskList (aText, aMaskList :String; aFileNameMode :Boolean =True): Boolean;

// Выполняет сопоставление текста aText со списком шаблонов aMaskList.

// Возвращает True если сопоставление выполнено успешно, т.е. текст

// aText соответствует списку шаблонов aMaskList.

// Если aFileNameModd=True, то объект используется для сопоставления

// имен файлов с шаблоном. А именно, в этом случае, если aText не

// содержит символа '.' то он добавляется в конец. Это необходимо для

// того, чтобы файлы без расширений соответствовали например шаблону '*.*'

//

// Замечание, если требуется проверка сопоставления нескольких строк одному

// списку шаблонов, эффективнее будет воспользоваться объектом tMatchMaskList.

Type

tMatchMaskList = class(tObject)

Private

fMaskList :String;

fCaseSensitive :Boolean;

fFileNameMode :Boolean;

fPrepared :Boolean;

fIncludeMasks :tStringList;

fExcludeMasks :tStringList;

procedure SetMaskList (v :String );

procedure SetCaseSensitive (v :Boolean);

Public

constructor Create (Const aMaskList :String ='');

// Создает объект. Если задан параметр aMaskList, то он присваивается

// свойству MaskList.

destructor Destroy; override;

// Разрушает объект

procedure PrepareMasks;

// Осуществляет компиляцию списка шаблонов во внутреннюю структуру

// используемую при сопоставлении текста.

// Вызов данного метода не является обязательным и при необходимости

// будет вызван автоматически.

Function IsMatch (aText :String) :Boolean;

// Выполняет сопоставление текста aText со списком шаблонов MaskList.

// Возвращает True если сопоставление выполнено успешно, т.е. текст

// aText соответствует списку шаблонов MaskList.

Property MaskList :StringRead fMaskList Write SetMaskList ;

// Списко шаблонов используемый для сопоставления с текстом

Property CaseSensitive :Boolean Read fCaseSensitive Write SetCaseSensitive default False;

// Если False (по умолчанию), то при сопоставлении текста будет

// регистр символов не будет учитываться.

// Иначе, если True, сопоставление будет проводиться с учетом регистра.

Property FileNameMode :Boolean Read fFileNameMode Write fFileNameMode default True;

// Если True (по умолчанию), то объект используется для сопоставления

// имен файлов с шаблоном. А именно, в этом случае, если aText не

// содержит символа '.' то он добавляется в конец. Это необходимо для

// того, чтобы файлы без расширений соответствовали например шаблону '*.*'

End;

implementation

uses

SysUtils

;

Function IsMatchMask (aText, aMask :pChar ) :Boolean; overload;

begin

Result := False;

While True Dobegin

Case aMask^ of

'*' : // соответствует любому числу любых символов кроме конца строки

begin

// переместиться на очередной символ шаблона, при этом, подряд

// идущие '*' эквивалентны одному, поэтому пропуск всех '*'

repeat Inc(aMask); Until (aMask^<>'*');

// если за '*' следует любой символ кроме '?' то он должен совпасть

// с символом в тексте. т.е. нужно пропустить все не совпадающие,

// но не далее конца строки

If aMask^ <> '?'then

While (aText^ <> #0) And (aText^ <> aMask^) Do Inc(aText);

If aText^ <> #0Thenbegin// не конец строки, значит совпал символ

// '*' 'жадный' шаблон поэтому попробуем отдать совпавший символ

// ему. т.е. проверить совпадение продолжения строки с шаблоном,

// начиная с того-же '*'. если продолжение совпадает, то

If IsMatchMask (aText+1, aMask-1) Then Break; // это СОВПАДЕНИЕ

// продолжение не совпало, значит считаем что здесь закончилось

// соответствие '*'. Продолжим сопоставление со следующего

// символа шаблона

Inc(aMask); Inc(aText); // иначе переходим к следующему символу

End

ElseIf (aMask^ = #0) Then// конец строки и конец шаблона

Break // это СОВПАДЕНИЕ

Else// конец строки но не конец шаблона

Exit // это НЕ СОВПАДЕНИЕ

End;

'?' : // соответствует любому кроме конца строки

If (aText^ = #0) Then// конец строки

Exit // это НЕ СОВПАДЕНИЕ

Elsebegin// иначе

Inc(aMask); Inc(aText); // иначе переходим к следующему символу

End;

Else// символ в шаблоне должен совпасть с символом в строке

If aMask^ <> aText^ Then// символы не совпали -

Exit // это НЕ СОВПАДЕНИЕ

Elsebegin// совпал очередной символ

If (aMask^ = #0) Then// совпавший символ последний -

Break; // это СОВПАДЕНИЕ

Inc(aMask); Inc(aText); // иначе переходим к следующему символу

End;

End;

End;

Result := True;

End;

Function IsMatchMask (aText, aMask :String; aFileNameMode :Boolean =True) :Boolean; overload;

begin

If aFileNameMode And (Pos('.',aText)=0) then aText := aText+'.';

Result := IsMatchMask(pChar(aText),pChar(aMask));

End;

Function IsMatchMaskList (aText, aMaskList :String; aFileNameMode :Boolean =True) :Boolean;

begin

With tMatchMaskList.Create(aMaskList) Dotry

FileNameMode := aFileNameMode;

Result := IsMatch(aText);

finally

Free;

End;

End;

/////////////////////////////////////////////////////////// tFileMask

procedure tMatchMaskList.SetMaskList (v :String );

begin

If fMaskList = v Then Exit;

fMaskList := v;

fPrepared := False;

End;

procedure tMatchMaskList.SetCaseSensitive (v :Boolean);

begin

If fCaseSensitive = v Then Exit;

fCaseSensitive := v;

fPrepared := False;

End;

constructor tMatchMaskList.Create (Const aMaskList :String);

begin

MaskList := aMaskList;

fFileNameMode := True;

fIncludeMasks := TStringList.Create; With fIncludeMasks Dobegin

Delimiter := ';';

// Sorted := True;

// Duplicates := dupIgnore;

End;

fExcludeMasks := tStringList.Create; With fExcludeMasks Dobegin

Delimiter := ';';

// Sorted := True;

// Duplicates := dupIgnore;

End;

End;

destructor tMatchMaskList.Destroy;

begin

fIncludeMasks.Free;

fExcludeMasks.Free;

End;

procedure tMatchMaskList.PrepareMasks;

procedure CleanList(l :tStrings);

var i :Integer;

begin

For i := l.Count-1downto0DoIf l[i] = ''then l.Delete(i);

End;

var

s :String;

i :Integer;

begin

If fPrepared Then Exit;

If CaseSensitive Then

s := MaskList

Else

s := UpperCase(MaskList);

i := Pos('|',s);

If i = 0Thenbegin

fIncludeMasks.DelimitedText := s;

fExcludeMasks.DelimitedText := '';

End

Elsebegin

fIncludeMasks.DelimitedText := Copy(s,1,i-1);

fExcludeMasks.DelimitedText := Copy(s,i+1,MaxInt);

End;

CleanList(fIncludeMasks);

CleanList(fExcludeMasks);

// если список включаемых шаблонов пуст а

// список исключаемых шаблонов не пуст, то

// имеется ввиду что список включаемых шаблонов равен <все файлы>

If (fIncludeMasks.Count = 0) And (fExcludeMasks.Count <> 0) Then

fIncludeMasks.Add('*');

fPrepared := True;

End;

Function tMatchMaskList.IsMatch (aText :String) :Boolean;

var

i :Integer;

begin

Result := False;

If aText = ''then Exit;

IfNot CaseSensitive Then aText := UpperCase(aText);

If FileNameMode And (Pos('.',aText)=0) then aText := aText+'.';

IfNot fPrepared Then PrepareMasks;

// поиск в списке "включаемых" масок до первого совпадения

For i := 0To fIncludeMasks.Count-1Do

If IsMatchMask(PChar(aText),PChar(fIncludeMasks[i])) Thenbegin

Result := True;

Break;

End;

// если совпадение найдено, надо проверить по списку "исключаемых"

If Result Then

For i := 0To fExcludeMasks.Count-1Do

If IsMatchMask(PChar(aText),PChar(fExcludeMasks[i])) Thenbegin

Result := False;

Break;

End;

End;

end.