String replacement function (the speed exceeds the stringreplace provided by Delphi)

// String replacement function
// Author QQ 287412388
// This code can be copied and modified at will. If any problem is found, please notify me.
//

Function _ stringreplace _ (const SRC, oldstr, newstr: string): string;

Const
Default_list_buff_size = 2048;

Type
Pdatalist = ^ tdatalist;
Tdatalist = record
Buff: pointer;
Len: integer;
Next: pdatalist;
Position: integer;
// Index range
Start: integer;
Tail: integer;
End;

Pdatanode = ^ tdatanode;
Tdatanode = record
Position: integer;
Len: integer;
Begpos: integer;
Newpos: integer;
End;

VaR
Node, header: pdatalist;
Newstr_size, oldstr_size: integer;

Function newdatanode (LEN: integer = 4096): pdatalist;
Begin
New (result );
Getmem (result ^. Buff, Len );
Result ^. Len: = Len;
Result ^. Next: = nil;
Result ^. Position: = 0;
End;

Procedure freedatalist (data: pdatalist );
VaR
Tmpnode, node: pdatalist;
Begin
Node: = data;
While (node <> nil) Do
Begin
Freemem (node ^. Buff );
Tmpnode: = node;
Node: = node. Next;
Dispose (tmpnode );
End;
End;

Procedure adddata (value: integer );
VaR
P: pinteger;
Begin
If node ^. Position = default_list_buff_size then
Begin
Node. Next: = newdatanode (default_list_buff_size * 4 );
Node: = node. Next;
Zeromemory (node ^. Buff, node ^. Len );
End;
P: = pinteger (node ^. Buff );
INC (p, node ^. position );
P ^: = value;
INC (node ^. position );
End;

Function getdatanode (Index: integer; var Ref: pointer): integer;
VaR
Anode: pdatalist;
Pi: pinteger;
Begin
Result: = 0;
If ref <> nil then
Anode: = ref
Else
Anode: = header;
While (anode <> nil) Do
Begin
If (index> = anode. Start) and (index <= anode. Tail) then
Begin
Pi: = pinteger (anode. Buff );
INC (PI, (index-anode. Start ));
Result: = PI ^;
Ref: = anode;
Break;
End
Else anode: = anode. Next;
End;
End;

Procedure getdatanode_ii (Index: integer; var p1, p2: integer; var Ref: pointer );
VaR
Anode: pdatalist;
Pi: pinteger;
Begin
If ref <> nil then
Anode: = ref
Else
Anode: = header;
While (anode <> nil) Do
Begin
If (index> = anode. Start) and (index <= anode. Tail) then
Begin
Pi: = pinteger (anode. Buff );
INC (PI, (index-anode. Start ));
P1: = PI ^;
If (index + 1) <= anode. Tail then
Begin
INC (PI );
P2: = PI ^;
Ref: = anode;
Exit;
End;
Break;
End
Else anode: = anode. Next;
End;
P2: = getdatanode (index + 1, ref );
End;

Procedure filldatanode (Index: integer; pnode: pdatanode; var Ref: pointer );
VaR
Position, nextposition: integer;
Begin
Getdatanode_ii (index, position, nextposition, ref );
Pnode ^. Len: = nextposition-position-oldstr_size;
Pnode ^. begpos: = Position + oldstr_size;
Pnode ^. Position: = position;
Pnode ^. newpos: = position;
End;

Procedure internalcopymemory (PD, PS: pchar; Len: integer );
Begin
If Len = 0 then
Exit;
Case Len
1: PD ^: = Ps ^;
2: pword (PD) ^: = DWORD (PS ^ );
3: Begin
PD ^: = Ps ^;
(PD + 1) ^: = (PS + 1) ^;
(PD + 2) ^: = (PS + 2) ^;
End;
4: pinteger (PD) ^: = pinteger (PS) ^;
Else
Copymemory (PD, PS, Len );
End;
//\\
End;

Procedure writedataii (PD: pchar; areplacecount: integer );
VaR
PS: pchar;
Index: integer;
P1: pdatanode;
Noderef: pointer;
//\\
Tmpint: integer;
Begin
Noderef: = nil;
New (P1 );
For index: = 0 to areplacecount-1 do
Begin
If Index = 0 then
Begin
Tmpint: = getdatanode (index + 1, noderef );
P1 ^. Position: = 1;
P1 ^. begpos: = 1;
P1 ^. Len: = tmpint-1;
P1 ^. newpos: = tmpint;
End
Else
Filldatanode (index, P1, noderef );

If index> 0 then
Begin
If P1 ^. begpos <P1 ^. newpos then
Begin
If P1 ^. Len> 0 then
Begin
PS: = pointer (SRC );
INC (Ps, P1 ^. begpos-1 );
Internalcopymemory (PD, PS, P1 ^. Len );
INC (PD, P1 ^. Len );
End;
If newstr_size> 0 then
Begin
Internalcopymemory (PD, pointer (newstr), newstr_size );
INC (PD, newstr_size );
End;
End
Else begin
If newstr_size> 0 then
Begin
Internalcopymemory (PD, pointer (newstr), newstr_size );
INC (PD, newstr_size );
End;
If P1 ^. Len> 0 then
Begin
PS: = pointer (SRC );
INC (Ps, P1 ^. begpos-1 );
Internalcopymemory (PD, PS, P1 ^. Len );
INC (PD, P1 ^. Len );
End;
End;
End
Else begin
If P1 ^. Len> 0 then
Begin
PS: = pointer (SRC );
INC (Ps, P1 ^. begpos-1 );
Internalcopymemory (PD, PS, P1 ^. Len );
INC (PD, P1 ^. Len );
End;
End;
End; // For end
Dispose (P1 );
End;

 

VaR
Offset, outsize: integer;
Replacecount: integer;
PD: pchar;
Index: integer;
Begin
Offset: = 1;

Newstr_size: = length (newstr );
Oldstr_size: = length (oldstr );

Header: = newdatanode (default_list_buff_size * 4 );
Zeromemory (header ^. Buff, header ^. Len );
Node: = header;

Adddata (1); // forward
Replacecount: = 0;
While (true) Do
Begin
Offset: = posex (oldstr, SRC, offset );
If Offset> 0 then
Begin
Adddata (offset );
INC (replacecount );
INC (offset );
End
Else begin
Adddata (length (SRC) + 1 );
Break;
End;
End;

Index: = 0;
Node: = header;
While (node <> nil) Do
Begin
Node. Start: = index;
Node. Tail: = index + default_list_buff_size-1;
Index: = node. Tail + 1;
Node: = node. Next;
End;

// Calculate the length of output characters
If replacecount = 0 then
Begin
Result: = SRC;
Exit;
End;

// Allocate the output buffer
Outsize: = length (SRC)-oldstr_size * replacecount;
Outsize: = outsize + newstr_size * replacecount;
Setlength (result, outsize );

// Copy data to the output buffer
PD: = pointer (result );
Writedataii (PD, replacecount + 1); //-1 Delete the last entry without calculation

// Release the memory block
Freedatalist (header );
//\\
End;

// Test code, for reference only
Procedure tform1.button1click (Sender: tobject );
VaR
Tmpstr: string;
FS: tfilestream;
D: DWORD;
I: integer;
Begin
D: = gettickcount ();
For I: = 1 to 1000 do
Tmpstr: = _ stringreplace _ (SRC, 'A', 'A ');

D: = gettickcount ()-D;
Showmessage (inttostr (d ));

FS: = tfilestream. Create ('e: \ Text. txt ', fmcreate );
FS. Write (tmpstr [1], length (tmpstr ));
FS. Free ();

// Getmem (Ps, 1024 );
End;