Полезные функции работы со строками

документ распечатан

Полезные функции работы со строками

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

Перейдем от слов к делу, надо уже скорее знакомить Вас с этими функциями! Первая, которую я предложу Вам проверяет есть ли подстрока в строке, и если есть - возвращает true, иначе - false.

Функция эта выглядит так:

function MatchStrings(source, pattern: String): Boolean;
var

pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;


function MatchPattern(element, pattern: PChar): Boolean;


function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;


begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;

begin

StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;

Использовать ее нужно примерно так:

MatchStrings('Михаил' , '*' + 'Михаил автор данной статьи' + '*');

Вызов этой функции в данном примере возвратит true, так как строка 'Михаил' содержится в строке 'Михаил автор этой статьи'. Символы '*' нужны для корректности работы функции. Разберем небольшой пример, будем вводить текст в поле Edit1, и искать его в Memo1, по нажатию на командной кнопке Button1. Итак, разместим перечисленные компоненты на форме. Скопируйте описание функции и поместите его после 

implementation

{$R *.DFM}
 

А обработчик нажатия на командную кнопку может иметь такой вид:

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;//число совпадений
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*'+edit1.text+'*') = true then
inc(n_sov) else;
end;
showmessage(inttostr(n_sov));
end;

 

На всякий случай :) приведу полный код примера:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function MatchStrings(source, pattern: String): Boolean;
var

pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;


function MatchPattern(element, pattern: PChar): Boolean;


function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;


begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin

StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;//число совпадений
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*'+edit1.text+'*') = true then
inc(n_sov) else;
end;
showmessage(inttostr(n_sov));
end;

end.

 

Если вдруг кто-то не знает, то функция inc(x:ordinal); увеличивает число на единицу (а функция Dec - уменьшает). Таким образом мы просто проходим в цикле все строки Memo1 и ищем совпадения. К сожалению эта функция умеет только указывать если подстрока  в строке, но неплохо было бы ее доработать, чтобы она возвращала позицию символа, с которого начинается совпадение. Если у вас есть идеи, то пожалуйста пишите!

Теперь познакомимся с более интересной функцией, которая заменяет одну подстроку на другую в строке. Она выглядит таким образом:

function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1) - 1);
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;

Эта функция заменяет Sub1 на Sub2 в строке Str и возвращает измененную строку.

Сразу усовершенствуем наш пример, дабы разобраться с использованием этой функции. Добавьте на форму еще одно текстовое поле Edit2. В Edit1 будем вводить слово, которое надо заменить, а в поле Edit2 слово, на которое надо заменить.

Теперь обработчик нажатия на кнопку у меня выглядит так:

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*' +edit1.text+ '*') = true
    then begin
    Memo1.lines[i]:=ReplaceSub(memo1.lines[i],edit1.text,edit2.text);
    inc(n_sov);
    end;
end;
showmessage(inttostr(n_sov));
end;

 

Ну и опять, на всякий случай, приведу полный код примера:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function MatchStrings(source, pattern: String): Boolean;
var

pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;


function MatchPattern(element, pattern: PChar): Boolean;


function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;


begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin

StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;

function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1) - 1);
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*' +edit1.text+ '*') = true
then begin
Memo1.lines[i]:=ReplaceSub(memo1.lines[i],edit1.text,edit2.text);
inc(n_sov);
end;
end;
showmessage(inttostr(n_sov));
end;

end.

На этом пока все. Надеюсь сумело помочь Вам в Ваших начинаниях



Опубликовал admin
15 Июн, Воскресенье 2003г.

Комментарии

Опишите пожалуста что за function MatchPattern. Не понятно что она делает.




Программирование для чайников.