Работа со строками
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.
|
- Подробности
- Родительская категория: Работа со строками
- Категория: Разбор строки, выделение элементов, поиск
Страница 12 из 21