How to count the number of times that the same string appears in multi-line text files in Delphi

{2002.8.5 kingron}
{Source: Source string}
{Sub: Sub string}
{Return: Count}
{Ex: strsubcount ('abccdcd', 'bc') = 2}
Function strsubcount (const source, Sub: string): integer;
VaR
Buf: string;
I: integer;
Len: integer;
Begin
Result: = 0;
Buf: = source;
I: = pos (sub, Buf );
Len: = length (sub );
While I <> 0 do
Begin
INC (result );
Delete (BUF, 1, I + len-1 );
I: = pos (sub, Buf );
End;
End; {strsubcount}

{The following function returns the position after the specified position of substr in S}
{Example: posexx ('AB', 'abcabcabcab', 3) returns 4}
Function posexx (const substr: ansistring; const S: ansistring; const start: integer): integer;
Type
Strrec = record
Allocsiz: longint;
Refcnt: longint;
Length: longint;
End;
Const
Skew = sizeof (strrec );
ASM
{-> Eax pointer to substr}
{EdX pointer to string}
{ECx pointer to start // CS}
{<-Eax position of substr in S or 0}

Test eax, eax
Je @ nowork
Test edX, EDX
Je @ stringempty
Test ECx, ECx
Je @ stringempty

Push EBX
Push ESI
Push EDI

MoV ESI, eax {point ESI}
MoV EDI, EDX {point EDI}

MoV EBX, ECx
MoV ECx, [EDI-skew]. strrec. Length
Push EDI {remembers position to calculate index}

Cmp ebx, ECx
JG @ fail

MoV edX, [ESI-skew]. strrec. Length {edX = BSTR}

Dec edX {edX = length (substr )-}
JS @ fail {<0? Return}
MoV Al, [esi] {Al = first char}
Inc esi {point ESI to 2' nd char of substr}
Sub ECx, EDX {# positions in S to look}
{= Length (S)-length (substr) + 1}
Jle @ fail
Dec EBX
Sub ECx, EBX
Jle @ fail
Add EDI, EBX

@ Loop:
Repne scasb
JNE @ fail
MoV EBX, ECx {save outer loop}
Push ESI {save outer loop substr pointer}
Push EDI {save outer loop s}

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 nter}
JMP @ Loop

@ Fail:
Pop edX {Get Rid Of saved s nter}
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;

{Posex returns the position of the sub in the source index. If the number of occurrences is insufficient, 0 is returned. If no index is found, 0 is returned}
{Example: posex ('abccd', 'bcd', 2) returns 5, posex ('abccd', 'adb') returns 0, poxex ('abc ', 'A', 2) returns 0}
Function posex (const source, Sub: string; index: integer): integer;
VaR
Buf: string;
I, Len, C: integer;
Begin
C: = 0;
Result: = 0;
Buf: = source;
I: = pos (sub, source );
Len: = length (sub );
While I <> 0 do
Begin
INC (C );
INC (result, I );
Delete (BUF, 1, I + len-1 );
I: = pos (sub, Buf );
If C> = index then break;
If I> 0 then Inc (result, len-1 );
End;
If C <index then result: = 0;
End;
Below is the code written by zswang, which may be more efficient:
Function posex1 (const source, Sub: string; index: integer = 1): integer;
VaR
I, J, K, L: integer;
T: string;
Begin
Result: = 0;
T: = source;
K: = 0;
L: = length (sub );
For I: = 1 to index do begin
J: = pos (sub, t );
If j <= 0 Then exit;
Delete (T, 1, J + L-1 );
INC (K, J + L-1 );
End;
Dec (K, L-1 );
Result: = K;
End; {posex1}
The following code is written by Dirk and uses real recursion:
Function posn (substring, mainstring: string; N: integer): integer;
{
Function posn get recursive-the n th position of "substring" in
"Mainstring". Does the mainstring not contain substrign the result
Is 0. Works with chars and strings.
}
Begin
If pos (substring, mainstring) = 0 then
Begin
Posn: = 0;
Exit;
End
Else
Begin
If n = 1 then
Posn: = pos (substring, mainstring)
Else
Begin
Posn: = pos (substring, mainstring) + posn (substring, copy (mainstring,
(Pos (substring, mainstring) + 1), length (mainstring), n-1 );
End;
End;
End;

Function substrconut (mstr: string; Msub: string): integer;
{Number of times the substring is returned}
Begin
Result: =
(Length (mstr)-length (stringreplace (mstr, Msub, '', [rfreplaceall]) Div
Length (Msub );
End