Code:

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

>> Нахождение последнего вхождения подстроки в строку

 

Функция возвращает начало последнего вхождения

подстроки FindS в строку SrcS, т.е. первое с конца.

Если возвращает ноль, то подстрока не найдена.

Можно использовать в текстовых редакторах

при поиске текста вверх от курсора ввода.

 

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

Автор: Fenik, chook_nu @ uraltc.ru, Новоуральск

Copyright: Автор: Федоровских Николай

 

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

 

function PosR2L(const FindS, SrcS: string): Integer;

{Функция возвращает начало последнего вхождения

подстроки FindS в строку SrcS, т.е. первое с конца.

Если возвращает ноль, то подстрока не найдена.

Можно использовать в текстовых редакторах

при поиске текста вверх от курсора ввода.}

 

function InvertS(const S: string): string;

{Инверсия строки S}

var

i, Len: Integer;

begin

Len := Length(S);

SetLength(Result, Len);

for i := 1to Len do

Result[i] := S[Len - i + 1];

end;

 

var

ps: Integer;

begin

{Например: нужно найти последнее вхождение

строки 'ро' в строке 'пирожок в коробке'.

Инвертируем обе строки и получаем

'ор' и 'екборок в кожорип',

а затем ищем первое вхождение с помощью стандартной

функции Pos(Substr, S: string): string;

Если подстрока Substr есть в строке S, то

эта функция возвращает позицию первого вхождения,

а иначе возвращает ноль.}

ps := Pos(InvertS(FindS), InvertS(SrcS));

{Если подстрока найдена определяем её истинное положение

в строке, иначе возвращаем ноль}

if ps <> 0then

Result := Length(SrcS) - Length(FindS) - ps + 2

else

Result := 0;

end;

Пример использования:

 

p := PosR2L('са', 'Мой сапог догнал самолёт.'); // p:=18;

 


 

Code:

{

Letzte Position von SubStr in S ermitteln.

Returns the last occurence of SubStr in S.

}

 

function LastPos(SubStr, S: string): Integer;

var

Found, Len, Pos: integer;

begin

Pos := Length(S);

Len := Length(SubStr);

Found := 0;

while (Pos > 0) and (Found = 0) do

begin

if Copy(S, Pos, Len) = SubStr then

Found := Pos;

Dec(Pos);

end;

LastPos := Found;

end;

 

 

 


 

Code:

// by Manuel Wiersch

 

function LastPos(const SubStr: AnsiString; const S: AnsiString): LongInt;

asm

TEST EAX,EAX // EAX auf 0 prufen (d.h. SubStr = nil)

JE @@noWork // wenn EAX = 0 dann Sprung zu noWork

TEST EDX,EDX

// Test ob S = nil

JE @@stringEmpty // bei Erfolg -> Sprung zum Label 'stringEmpty'

PUSH EBX

PUSH ESI

PUSH EDI // Register auf dem Stack sichern Grund: OH

// OH: "In einer asm-Anweisung mu? der Inhalt

// der Register EDI, ESI, ESP, EBP und EBX

// erhalten bleiben (dh. vorher auf dem Stack

// speichern) MOV ESI, EAX

// ESI = Sourceindex -> Adresse vom SubStr

MOV EDI, EDX // EDI = Destinationindex -> Adresse von S

MOV ECX,[EDI-4] // Lange von S ins Zahlregister

MOV EDX,[ESI-4] // Lange des SubStr in EDX

DEC EDX // Length(SubStr) - 1

JS @@fail

// Vorzeichenbedingter Sprung (JumpIfSign)

// d.h. (EDX < 0) -> Sprung zu 'fail'

STD; // SetDirectionFlag -> Stringroutinen von hinten

// abarbeiten

ADD ESI, EDX // Pointer auf das letzte Zeichen vom SubStr

ADD EDI, ECX

DEC EDI // Pointer auf das letzte Zeichen von S

MOV AL, [ESI] // letztes Zeichen des SubStr in AL laden

DEC ESI // Pointer auf das vorletzte Zeichen setzen.

SUB ECX, EDX // Anzahl der Stringdurchlaufe

// = Length(s) - Length(substr) + 1

JLE @@fail // Sprung zu 'fail' wenn ECX <= 0

@@loop:

REPNE SCASB // Wdh. solange ungleich (repeat while not equal)

// scan string for byte

JNE @@fail

MOV EBX,ECX { Zahleregister, ESI und EDI sichern, da nun der

Vergleich durchgefuhrt wird ob die nachfolgenden

Zeichen von SubStr in S vorhanden sind }

PUSH ESI

PUSH EDI

MOV ECX,EDX // Lange des SubStrings in ECX

REPE CMPSB // Solange (ECX > 0) und (Compare string fo byte)

// dh. solange S[i] = SubStr[i]

POP EDI

POP ESI // alten Source- und Destinationpointer vom Stack holen

JE @@found // Und schon haben wir den Index da ECX = 0

// dh. alle Zeichen wurden gefunden

MOV ECX, EBX // ECX wieder auf alte Anzahl setzen und

JMP @@loop // Start bei 'loop'

@@fail:

XOR EAX,EAX // EAX auf 0 setzen

JMP @@exit @@stringEmpty:

XOR EAX,EAX

JMP @@noWork @@found:

MOV EAX, EBX // in EBX steht nun der aktuelle Index

INC EAX // um 1 erhohen, um die Position des 1. Zeichens zu

// bekommen

@@exit:

POP EDI

POP ESI

POP EBX

@@noWork: CLD; // DirectionFlag loschen

end;

Code:

// Get the Position of a string, starting at the end

// Ruckwartiges Vorkommen einer Zeichenkette innerhalb eines strings, Position von hinten

 

function LastPos(SearchStr, Str: string): Integer;

var

i: Integer;

TempStr: string;

begin

Result := Pos(SearchStr, Str);

if Result = 0then Exit;

if (Length(Str) > 0) and (Length(SearchStr) > 0) then

begin

for i := Length(Str) + Length(SearchStr) - 1downto Result do

begin

TempStr := Copy(Str, i, Length(Str));

if Pos(SearchStr, TempStr) > 0then

begin

Result := i;

break;

end;

end;

end;

end;

 

// Search for the next occurence of a string from a certain Position

// Nachstes Vorkommen einer Zeichenkette ab einer frei definierbaren Stelle im string

 

function NextPos(SearchStr, Str: string; Position: Integer): Integer;

begin

Delete(Str, 1, Position - 1);

Result := Pos(SearchStr, upperCase(Str));

if Result = 0then Exit;

if (Length(Str) > 0) and (Length(SearchStr) > 0) then

Result := Result + Position + 1;

end;

 

// Get the number of characters from a certain Position to the string to be searched

// Anzahl der Zeichen von einer definierbaren Position zur gesuchten Zeichenkette

 

function NextPosRel(SearchStr, Str: string; Position: Integer): Integer;

begin

Delete(Str, 1, Position - 1);

Result := Pos(SearchStr, UpperCase(Str)) - 1;

end;

 

// simple replacement for strings

// einfaches Ersetzen von Zeichenketten

 

function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;

begin

while Pos(SearchStr, Str) <> 0do

begin

Insert(ReplaceStr, Str, Pos(SearchStr, Str));

Delete(Str, Pos(SearchStr, Str), Length(SearchStr));

end;

Result := Str;

end;

 

Code:

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

>> Поиск N-ого вхождения подстроки в строку

 

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

Автор: panov, panov @ hotbox.ru, Екатеринбург

Copyright: panov

 

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

 

function SearchString(const FindStr, SourceString: string; Num: Integer):

Integer;

var

FirstSym: PChar; //Ссылка на первый символ

 

function MyPos(const FindStr, SourceString: PChar; Num: Integer): PChar;

begin

Result := AnsiStrPos(SourceString, FindStr);

//Поиск вхождения подстроки в строку

if (Result = nil) then

Exit; //Подстрока не найдена

Inc(Result); //Смещаем указатель на следующий символ

if Num = 1then

Exit; //Если нужно первое вхождение - заканчиваем

if num > 1then

Result := MyPos(FindStr, Result, num - 1);

//Рекурсивный поиск следующего вхождения

end;

 

begin

FirstSym := PChar(SourceString);

//Присваиваем адрес первого символа исходной строки

Result := MyPos(PChar(FindStr), PChar(SourceString), Num) - FirstSym;

//Номер позиции в строке

if Result < 0then

Result := 0; //Возвращаем номер позиции

end;

//Пример использования:

 

var

StrF, StrSrc: string;

n: Integer;

begin

...

StrF := 'стр';

StrSrc := 'Поиск подстроки в строке';

n := SearchString(StrF, StrSrc, 2); //n будет равна 19

end;

 

Code:

unit splitfns;

interface

uses Classes, Sysutils;

function GetNextToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;

 

{Returns the next token (substring) from string S, starting at index StartPos and ending 1 character

before the next occurrence of Separator (or at the end of S, whichever comes first).}

 

{StartPos returns the starting position for the next token, 1 more than the position in S of

the end of this token}

 

procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);

 

{Splits a string containing designated separators into tokens and adds them to MyStringList NOTE: MyStringList must be Created before being passed to this procedure and Freed after use}

 

function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;

 

{Used to join 2 strings with a separator character between them and can be used in a Join function}

{The StringLimit parameter prevents the length of the Result String from exceeding a preset maximum}

 

implementation

 

function GetNextToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;

varIndex: integer;

begin

Result := '';

{Step over repeated separators}

While (S[StartPos] in Separator) and (StartPos <= length(S)) do StartPos := StartPos + 1;

 

if StartPos > length(S) then Exit;

 

{Set Index to StartPos}

Index := StartPos;

 

{Find the next Separator}

Whilenot (S[Index] in Separator) and (Index <= length(S))doIndex := Index + 1;

 

{Copy the token to the Result}

Result := Copy(S, StartPos, Index - StartPos);

 

{SetStartPos to next Character after the Separator}

StartPos := Index + 1;

end;

 

procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);

var Start: integer;

begin

Start := 1;

While Start <= Length(S) do MyStringList.Add(GetNextToken(S, Separator, Start));

end;

 

function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;

begin

if Length(aToken) + Length(S) < StringLimit then

begin

{Add a separator unless the Result string is empty}

if S = ''then Result := ''else Result := S + Separator;

 

{Add the token}

Result := Result + aToken;

end

else

{if the StringLimit would be

exceeded, raise an exception}

Raise Exception.Create('Cannot add token');

end;

end.

 

 

пример использования:

 

Code:

...

data:= TStringList.Create;

splited:=TStringList.Create;

data.LoadFromFile(s);

Split(data.Text,[',',' ',#10,#13,';','\"','.','!','-','+','*','/','\',

'(',')','[',']','{','}','<','>','''','"','?','"','#',#0],splited);

for i:= 0to splited.Count-1do

begin

ifnot words.Find(splited.Strings,adr) then

words.Add(splited.Strings[i]);

application.processmessages;[i]//make program to respond to user

//commands while processing in case of very long string.

end;

...

 

 

 

Автор:Song

Взято из https://forum.sources

 

 


 

 

Некоторое время назад одна любезная душа прислала мне этот модуль. Я нашел его весьма полезным, но применять его вам надлежит с некоторой долей осторожности, ибо тэг %s иногда приводит к исключительным ситуациям.

 

Code:

unit Scanf;

 

interface

uses SysUtils;

 

type

 

EFormatError = class(ExCeption);

 

function Sscanf(const s: string; const fmt: string;

const Pointers: arrayof Pointer): Integer;

implementation

 

{ Sscanf выполняет синтаксический разбор входной строки. Параметры...

 

s - входная строка для разбора

fmt - 'C' scanf-форматоподобная строка для управления разбором

%d - преобразование в Long Integer

%f - преобразование в Extended Float

%s - преобразование в строку (ограничено пробелами)

другой символ - приращение позиции s на "другой символ"

пробел - ничего не делает

Pointers - массив указателей на присваиваемые переменные

 

результат - количество действительно присвоенных переменных

 

Например, ...

Sscanf('Name. Bill Time. 7:32.77 Age. 8',

'. %s . %d:%f . %d', [@Name, @hrs, @min, @age]);

 

возвратит ...

Name = Bill hrs = 7 min = 32.77 age = 8 }

 

function Sscanf(const s: string; const fmt: string;

 

const Pointers: arrayof Pointer): Integer;

var

 

i, j, n, m: integer;

s1: string;

L: LongInt;

X: Extended;

 

function GetInt: Integer;

begin

s1 := '';

while (s[n] = ' ') and (Length(s) > n) do

inc(n);

while (s[n] in ['0'..'9', '+', '-'])

and (Length(s) >= n) do

begin

s1 := s1 + s[n];

inc(n);

end;

Result := Length(s1);

end;

 

function GetFloat: Integer;

begin

s1 := '';

while (s[n] = ' ') and (Length(s) > n) do

inc(n);

while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])

and (Length(s) >= n) do

begin

s1 := s1 + s[n];

inc(n);

end;

Result := Length(s1);

end;

 

function GetString: Integer;

begin

s1 := '';

while (s[n] = ' ') and (Length(s) > n) do

inc(n);

while (s[n] <> ' ') and (Length(s) >= n) do

begin

s1 := s1 + s[n];

inc(n);

end;

Result := Length(s1);

end;

 

function ScanStr(c: Char): Boolean;

begin

while (s[n] <> c) and (Length(s) > n) do

inc(n);

inc(n);

 

if (n <= Length(s)) then

Result := True

else

Result := False;

end;

 

function GetFmt: Integer;

begin

Result := -1;

 

while (TRUE) do

begin

while (fmt[m] = ' ') and (Length(fmt) > m) do

inc(m);

if (m >= Length(fmt)) then

break;

 

if (fmt[m] = '%') then

begin

inc(m);

case fmt[m] of

'd': Result := vtInteger;

'f': Result := vtExtended;

's': Result := vtString;

end;

inc(m);

break;

end;

 

if (ScanStr(fmt[m]) = False) then

break;

inc(m);

end;

end;

 

begin

 

n := 1;

m := 1;

Result := 0;

 

for i := 0to High(Pointers) do

begin

j := GetFmt;

 

case j of

vtInteger:

begin

if GetInt > 0then

begin

L := StrToInt(s1);

Move(L, Pointers[i]^, SizeOf(LongInt));

inc(Result);

end

else

break;

end;

 

vtExtended:

begin

if GetFloat > 0then

begin

X := StrToFloat(s1);

Move(X, Pointers[i]^, SizeOf(Extended));

inc(Result);

end

else

break;

end;

 

vtString:

begin

if GetString > 0then

begin

Move(s1, Pointers[i]^, Length(s1) + 1);

inc(Result);

end

else

break;

end;

 

else

break;

end;

end;

end;

 

end.

 

 

 

https://delphiworld.narod.

DelphiWorld 6.0

 

 

 

Code:

// Parse a string, for example:

// How do I get the "B" from "A|B|C|D|E|F"?

 

function Parse(Char, S: string; Count: Integer): string;

var

I: Integer;

T: string;

begin

if S[Length(S)] <> Char then

S := S + Char;

for I := 1to Count do

begin

T := Copy(S, 0, Pos(Char, S) - 1);

S := Copy(S, Pos(Char, S) + 1, Length(S));

end;

Result := T;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(Parse('|', 'A|B|C|D|E|F', 2));

end;

 

{

Parameters:

 

Parse([Character, for example "|"], [The string],

[The number, the "B" is the 2nd part of the string]);

 

This function is handy to use when sending data over the internet,

for example a chat program: Name|Text. Note: Be sure there's no "Char" in the string!

Use a unused character like "|" or "?".

}

 

 

Взято с сайта: https://www.swissdelphicenter

У семейства x86 есть группа специализированных строковых инструкций, одна из которых - scasb/scasw - производит поиск байта/слова в строке. Использовать преимущества этой инструкции в Delphi позволяют длинные строки, которых в старых паскалях не было.

 

Никаких сложностей с пониманием, на мой взгляд, быть не должно. Единственное это смена режима открытия файла (FileMode := 0), которая позволит открыть файлы заблокированные ядром Windows и сдвиг указателя файла при чтении нового блока влево на длину искомой строки. Сдвиг делается на случай разрезания искомой строки на части при чтении файла. Полный текст проверенной программы:

 

 

Code:

program search;

{$APPTYPE CONSOLE}

uses SysUtils;

const buffSize = 16384;

var F : File;

var buff : AnsiString;

var oldFileMode : integer;

var SearchString: shortString='SunSB';

var SearchPos : integer = -1;

var readed : integer;

var blockStart: integer;

begin

SetLength( buff, buffSize);

assignFile( F, 'Speedometer2.exe');

oldFileMode := FileMode;

FileMode := 0;

reset( F,1);

whilenot eof( F ) dobegin

blockStart := filePos( F );

blockRead( F, buff[1], buffSize, readed);

SearchPos:=Pos( SearchString, buff );

if SearchPos > 0thenbegin

WriteLn( 'Substr found at pos ',

blockStart+SearchPos );

break;

end;

if readed=buffSize then

seek( F, ( filePos( F ) -

length( SearchString )));

end;

closeFile( F );

FileMode := oldFileMode;

SetLength( buff, 0 );

if SearchPos = 0then

WriteLn( 'Substr not found.');

readLn;

end.