FastStrings

//==================================================
//All code herein is copyrighted by
//Peter Morris
//-----
//No copying, alteration, or use is permitted without
//prior permission from myself.
//------
//Do not alter / remove this copyright notice
//Email me at : support@droopyeyes.com
//
//The homepage for this library is http://www.droopyeyes.com
//
// CURRENT VERSION V3.2
//
//(Check out www.HowToDoThings.com for Delphi articles !)
//(Check out www.stuckindoors.com if you need a free events page on your site !)
//==================================================
//Ps
//Permission can be obtained very easily, and there is no ￡￡￡￡ involved,
//please email me for permission, this way you can be included on the
//email list to be notififed of updates / fixes etc.

//(It just includes sending my kids a postcard, nothing more !)

//Modifications
//==============================================================================
//Date  : 17 Dec, 1999
//Found : VRP (on #Delphi EFNET)
//Fixed : VRP
//Change: Added SmartPos.  This will allow people to easily change POS to SmartPos
//        as the parameters are in the same order.  Clever use of default params
//        means that the extra functionality of FastStrings may be used by passing
//        some extra params.
//==============================================================================
//Date  : 17 Dec, 1999
//Found : Bob Richardson
//Fixed : Pete M
//Change: Oops a daisy.  FastPosBack (and NoCase) were not setting SearchLen
//        if a valid StartPos was passed.
//==============================================================================
//Date  : 10 Jan, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Moved TFastPosProc into the interface section, so other routines
//        can use the same technique that I do in FastReplace
//==============================================================================
//Date  : 15 Jan, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Created a FastCharPos and FastCharPosNoCase, if the code knows that
//        the FindString is only 1 char, it can use faster methods.
//==============================================================================
//Date  : 1 Mar, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Changed the name of MyMove to FastCharMove, and added it to the
//        interface section.
//==============================================================================
//Date  : 5 Mar, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Changed FastPosNoCase to implement the above changes AND to use a
//        lookup table for UpCase characters.
//==============================================================================
//Date  : 5 Mar, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Realised that I was moving [EDI] into ah before comparing
//        with al, when I could have just compared al, [EDI].  doh !
//        Fastpos is now about 28% faster
//==============================================================================
//Date  : 12 Apr, 2000
//Found : hans gulo <hans@sangar.dhs.org>
//Fixed : Pete M
//Change: I was constantly converting to/from character indexes/pointers.
//        Considering we need pointers for MOVing data this was pointless +
//        Hans managed to write a quicker FastReplace in pure Object Pascal. (Nice job Hans)
//        Now I use pointers instead, this results in a much faster replace.
//        As I have always said, never assuming you have the fastest code :-)
//==============================================================================
//Date  : 02 May, 2000
//Found : hans gulo (again)
//Fixed : Pete M
//Change: In some (odd) circumstances FastMemPos(NC) would return a true result
//        for a substring that did not exist.
//==============================================================================
//Date  : 19 May, 2000
//Found : Dave Datta
//Fixed : Pete M
//Change: If the SOURCE was very small, and the REPLACE was very large, this
//        causes either an integer overflow or OutOfMemory.  In this case we
//        estimate the result size a lot lower and resize the result whenever
//        required (still not as often as StringReplace). See the const
//        cDeltaSize !!
//        You *may* still run out of memory, but that is a memory issue.
//==============================================================================
//Date  : 16 September, 2000
//Found : Lorenz Graf
//Fixed : Pete M
//Change: FastReplace had some EXIT statements before RESULT had been set.
//        I thought this would result in a Result of "", but it resulted in an
//        undetermined result (usually the same as the last valid result)
//        Set Result := '' in the first line of the code.
//==============================================================================
//Date  : 21 September, 2000
//Found : Chris Baldwin (TCrispy)
//Fixed : Pete M
//Change: NoCase routines were not working correctly with non-alphabetical
//        characters.  eg,   ) and #9 were thought to be the same
//        (Due to the UpCase routine simple ANDing the value eith $df)
//        Had to add lookup tables, which probably slows it down a little.
//==============================================================================
//Date  : 21 September, 2000
//Found : Pete M
//Fixed : Pete M
//Change: Forward searching routines could return errors if 0 was passed as the
//        StartPos.
//        This is actually an invalid value (1 is the first character)
//        So I inlcluded assert() statments.
//        Was *NOT* implemented in FastMEMPos as this is MEMORY and not a string
//==============================================================================
//Date  : 25 September, 2000
//Found : Lorenz Graf
//Fixed : Pete M
//Change: Incorrect value returned from FastMemPos if the SourceString and
//        FindString were the same values.
//        Also incorrect value returned from FastReplace if SourceString was ''
//==============================================================================
//Date  : 01 October, 2000
//Found : DJ (#delphi undernet)
//Fixed : Pete M
//Change: Uppercase table was incorrect for international alphabets.
//==============================================================================
//Date  : 23 November, 2000
//Found : DJ (#delphi undernet)
//Fixed : Pete M
//Change: CharUpperBuff(@GUpcaseTable[1], 256); should have been
//        CharUpperBuff(@GUpcaseTable[0], 256);
//==============================================================================
//Date  : 23 June, 2001
//Found : Lawrence Cheung <yllcheung@yahoo.com>
//Fixed : Pete M
//Change: FastPosBack ('bacdefga', 'a', 8, 1, 7);
//        The above example should return 2 but was returning 8
//==============================================================================
//Date  : 24 Aug, 2001
//Found : New development
//Fixed : Pete M
//Change: Removed FastMemPos, FastMemPosNoCase and replaced with BMPos and
//        BMPosNoCase.
//        These routines use my interpretation of a Boyer-Moore search routine.
//        If you call these routines directly you must first call
//        MakeBMTable or MakeBMTableNoCase, and you MUST call the correct routine !
//        Maybe I will create Boyer-Moore routines for backwards searching too.
//==============================================================================
//Date  : 06 Sept, 2001
//Found : Tim Frost <tim@roundhill.co.uk>
//Fixed : Pete M
//Change: Tim pointed out that using a global variable meant that the routines
//        were no longer thread safe.  I have had to change all POS type routines
//        so that they accept a JumpTable as an additional variable.  Sorry if
//        anyone calls these routines directly.
//==============================================================================
//Date  : 11 Sept, 2001
//Found : Misc
//Fixed : Pete M
//Change: MakeBMTable...... was not functioning correctly
//==============================================================================
//Date  : 10 January, 2002
//Found : Pete M
//Fixed : Pete M
//Change: A hideously small possibility that copying the remainder of the source
//        string to the end of Result when reaching the end of FastReplace
//        would run over the end of our buffer has been fixed. (No cases reported)
//==============================================================================
//Date  : 19 July, 2002
//Found : Robert Croshere <croshere@cns.nl>
//Fixed : Pete M
//Change: A bug when replacing a string with '' has been fixed.
//==============================================================================
//Date  : 14 August, 2002
//Found : Mark Derricutt <mark@talios.com>
//Fixed : Mark Derricutt <mark@talios.com>
//Change: Made compatible with Linux
//==============================================================================
//Date  : 23 October, 2002
//Fixed : Marc Bir <marc@delphihome.com>
//Change: Made compatible with Linux
//==============================================================================
//Date  : 02 November, 2002
//Fixed : Pete M
//Change: Added FastAnsiReplace.  Parameter compatible with StringReplace but
//        works with Multi-byte character sets (Japan, Korea, etc).
//==============================================================================
//Date  : 26 January, 2003
//Fixed : Pete M
//Change: Added FastTagReplace.  Lets you specify a TagStart and TagEnd, each
//        time text is encountered with these tags surrounding them, eg
//        <!UserName!> a callback procedure will be executed allowing you to
//        replace the tag with some specific text.
//==============================================================================
//Date  : 12 Febuary, 2003
//Fixed : Pete M
//Change: Added UserData: Integer to TFastTagReplaceProc so that a callback can
//        pass user data (such as an object instance)
//==============================================================================
//Date  : 15 Febuary, 2003
//Fixed : Pete M
//Change: It was possible for the procedure AddBuffer embedded within
//        FastTagReplace to not allocate a large enough buffer.
//==============================================================================
//Date  : 24 September, 2003
//Found : Michael Engesgaard <me@saxotech.com>
//Fixed : Pete M
//Change: FastAnsiReplace could overwrite the output buffer if the replace
//        string was much larger than the find string.
//==============================================================================

unit  FastStrings ;

interface

uses
{$IFNDEF LINUX}
   Windows ,
{$ENDIF}
   SysUtils ;

//This TYPE declaration will become apparent later
type
   TBMJumpTable  =  array [ 0..255 ]  of  Integer ;
   TFastPosProc  =  function ( const  aSource ,  aFind :  Pointer ;  const  aSourceLen ,  aFindLen :  Integer ;  var  JumpTable :  TBMJumpTable ):  Pointer ;
   TFastPosIndexProc  =  function ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ;  var  JumpTable :  TBMJumpTable ):  Integer ;
   TFastTagReplaceProc  =  procedure ( var  Tag :  string ;  const  UserData :  Integer );

   //Boyer-Moore routines
procedure  MakeBMTable ( Buffer :  PChar ;  BufferLen :  Integer ;  var  JumpTable :  TBMJumpTable );
procedure  MakeBMTableNoCase ( Buffer :  PChar ;  BufferLen :  Integer ;  var  JumpTable :  TBMJumpTable );
function  BMPos ( const  aSource ,  aFind :  Pointer ;  const  aSourceLen ,  aFindLen :  Integer ;  var  JumpTable :  TBMJumpTable ):  Pointer ;
function  BMPosNoCase ( const  aSource ,  aFind :  Pointer ;  const  aSourceLen ,  aFindLen :  Integer ;  var  JumpTable :  TBMJumpTable ):  Pointer ;

function  FastAnsiReplace ( const  S ,  OldPattern ,  NewPattern :  string ;  Flags :  TReplaceFlags ):  string ;
procedure  FastCharMove ( const  Source ;  var  Dest ;  Count :  Integer );
function  FastCharPos ( const  aSource :  string ;  const  C :  Char ;  StartPos :  Integer ):  Integer ;
function  FastCharPosNoCase ( const  aSource :  string ;  C :  Char ;  StartPos :  Integer ):  Integer ;
function  FastPos ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
function  FastPosNoCase ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
function  FastPosBack ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
function  FastPosBackNoCase ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
function  FastReplace ( const  aSourceString :  string ;  const  aFindString ,  aReplaceString :  string ;
   CaseSensitive :  Boolean  =  False ):  string ;
function  FastTagReplace ( const  SourceString ,  TagStart ,  TagEnd :  string ;
   FastTagReplaceProc :  TFastTagReplaceProc ;  const  UserData :  Integer ):  string ;
function  SmartPos ( const  SearchStr ,  SourceStr :  string ;
   const  CaseSensitive :  Boolean  =  TRUE ;
   const  StartPos :  Integer  =  1 ;
   const  ForwardSearch :  Boolean  =  TRUE ):  Integer ;

implementation

const
   cDeltaSize  =  1.5 ;

var
   GUpcaseTable :  array [ 0..255 ]  of  char ;
   GUpcaseLUT :  Pointer ;

   //MakeBMJumpTable takes a FindString and makes a JumpTable

procedure  MakeBMTable ( Buffer :  PChar ;  BufferLen :  Integer ;  var  JumpTable :  TBMJumpTable );
begin
   if  BufferLen  =  0  then
     raise  Exception . Create ( 'BufferLen is 0' );
   asm
         push     EDI
         push     ESI

         mov      EDI ,  JumpTable
         mov      EAX ,  BufferLen
         mov      ECX ,  $100
         REPNE    STOSD

         mov      ECX ,  BufferLen
         mov      EDI ,  JumpTable
         mov      ESI ,  Buffer
         dec      ECX
         xor      EAX ,  EAX
@@ loop :
         mov      AL ,  [ ESI ]
         lea      ESI ,  ESI  +  1
         mov      [ EDI  +  EAX  *  4 ],  ECX
         dec      ECX
         jg       @@ loop

         pop      ESI
         pop      EDI
   end ;
end ;

procedure  MakeBMTableNoCase ( Buffer :  PChar ;  BufferLen :  Integer ;  var  JumpTable :  TBMJumpTable );
begin
   if  BufferLen  =  0  then
     raise  Exception . Create ( 'BufferLen is 0' );
   asm
         push     EDI
         push     ESI

         mov      EDI ,  JumpTable
         mov      EAX ,  BufferLen
         mov      ECX ,  $100
         REPNE    STOSD

         mov      EDX ,  GUpcaseLUT
         mov      ECX ,  BufferLen
         mov      EDI ,  JumpTable
         mov      ESI ,  Buffer
         dec      ECX
         xor      EAX ,  EAX
@@ loop :
         mov      AL ,  [ ESI ]
         lea      ESI ,  ESI  +  1
         mov      AL ,  [ EDX  +  EAX ]
         mov      [ EDI  +  EAX  *  4 ],  ECX
         dec      ECX
         jg       @@ loop

         pop      ESI
         pop      EDI
   end ;
end ;

function  BMPos ( const  aSource ,  aFind :  Pointer ;  const  aSourceLen ,  aFindLen :  Integer ;  var  JumpTable :  TBMJumpTable ):  Pointer ;
var
   LastPos :  Pointer ;
begin
   LastPos  :=  Pointer ( Integer ( aSource )  +  aSourceLen  -  1 );
   asm
         push     ESI
         push     EDI
         push     EBX

         mov      EAX ,  aFindLen
         mov      ESI ,  aSource
         lea      ESI ,  ESI  +  EAX  -  1
         std
         mov      EBX ,  JumpTable

@@ comparetext :
         cmp      ESI ,  LastPos
         jg       @@ NotFound
         mov      EAX ,  aFindLen
         mov      EDI ,  aFind
         mov      ECX ,  EAX
         push     ESI  //Remember where we are
         lea      EDI ,  EDI  +  EAX  -  1
         xor      EAX ,  EAX
@@ CompareNext :
         mov      al ,  [ ESI ]
         cmp      al ,  [ EDI ]
         jne      @@ LookAhead
         lea      ESI ,  ESI  -  1
         lea      EDI ,  EDI  -  1
         dec      ECX
         jz       @@ Found
         jmp      @@ CompareNext

@@ LookAhead :
         //Look up the char in our Jump Table
         pop      ESI
         mov      al ,  [ ESI ]
         mov      EAX ,  [ EBX  +  EAX  *  4 ]
         lea      ESI ,  ESI  +  EAX
         jmp      @@ CompareText

@@ NotFound :
         mov      Result ,  0
         jmp      @@ TheEnd
@@ Found :
         pop      EDI  //We are just popping, we don't need the value
         inc      ESI
         mov      Result ,  ESI
@@ TheEnd :
         cld
         pop      EBX
         pop      EDI
         pop      ESI
   end ;
end ;

function  BMPosNoCase ( const  aSource ,  aFind :  Pointer ;  const  aSourceLen ,  aFindLen :  Integer ;  var  JumpTable :  TBMJumpTable ):  Pointer ;
var
   LastPos :  Pointer ;
begin
   LastPos  :=  Pointer ( Integer ( aSource )  +  aSourceLen  -  1 );
   asm
         push     ESI
         push     EDI
         push     EBX

         mov      EAX ,  aFindLen
         mov      ESI ,  aSource
         lea      ESI ,  ESI  +  EAX  -  1
         std
         mov      EDX ,  GUpcaseLUT

@@ comparetext :
         cmp      ESI ,  LastPos
         jg       @@ NotFound
         mov      EAX ,  aFindLen
         mov      EDI ,  aFind
         push     ESI  //Remember where we are
         mov      ECX ,  EAX
         lea      EDI ,  EDI  +  EAX  -  1
         xor      EAX ,  EAX
@@ CompareNext :
         mov      al ,  [ ESI ]
         mov      bl ,  [ EDX  +  EAX ]
         mov      al ,  [ EDI ]
         cmp      bl ,  [ EDX  +  EAX ]
         jne      @@ LookAhead
         lea      ESI ,  ESI  -  1
         lea      EDI ,  EDI  -  1
         dec      ECX
         jz       @@ Found
         jmp      @@ CompareNext

@@ LookAhead :
         //Look up the char in our Jump Table
         pop      ESI
         mov      EBX ,  JumpTable
         mov      al ,  [ ESI ]
         mov      al ,  [ EDX  +  EAX ]
         mov      EAX ,  [ EBX  +  EAX  *  4 ]
         lea      ESI ,  ESI  +  EAX
         jmp      @@ CompareText

@@ NotFound :
         mov      Result ,  0
         jmp      @@ TheEnd
@@ Found :
         pop      EDI  //We are just popping, we don't need the value
         inc      ESI
         mov      Result ,  ESI
@@ TheEnd :
         cld
         pop      EBX
         pop      EDI
         pop      ESI
   end ;
end ;

//NOTE : FastCharPos and FastCharPosNoCase do not require you to pass the length
//       of the string, this was only done in FastPos and FastPosNoCase because
//       they are used by FastReplace many times over, thus saving a LENGTH()
//       operation each time.  I can't see you using these two routines for the
//       same purposes so I didn't do that this time !

function  FastCharPos ( const  aSource :  string ;  const  C :  Char ;  StartPos :  Integer ):  Integer ;
var
   L :  Integer ;
begin
   //If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
   Assert ( StartPos  >  0 );

   Result  :=  0 ;
   L  :=  Length ( aSource );
   if  L  =  0  then
     exit ;
   if  StartPos  >  L  then
     exit ;
   Dec ( StartPos );
   asm
       PUSH  EDI                  //Preserve this register

       mov   EDI ,  aSource         //Point EDI at aSource
       add   EDI ,  StartPos
       mov   ECX ,  L               //Make a note of how many chars to search through
       sub   ECX ,  StartPos
       mov   AL ,   C               //and which char we want
     @ Loop :
       cmp   Al ,  [ EDI ]            //compare it against the SourceString
       jz    @ Found
       inc   EDI
       dec   ECX
       jnz   @ Loop
       jmp   @ NotFound
     @ Found :
       sub   EDI ,  aSource         //EDI has been incremented, so EDI-OrigAdress = Char pos !
       inc   EDI
       mov   Result ,    EDI
     @ NotFound :

       POP   EDI
   end ;
end ;

function  FastCharPosNoCase ( const  aSource :  string ;  C :  Char ;  StartPos :  Integer ):  Integer ;
var
   L :  Integer ;
begin
   Result  :=  0 ;
   L  :=  Length ( aSource );
   if  L  =  0  then
     exit ;
   if  StartPos  >  L  then
     exit ;
   Dec ( StartPos );
   if  StartPos  <  0  then
     StartPos  :=  0 ;

   asm
       PUSH  EDI                  //Preserve this register
       PUSH  EBX
       mov   EDX ,  GUpcaseLUT

       mov   EDI ,  aSource         //Point EDI at aSource
       add   EDI ,  StartPos
       mov   ECX ,  L               //Make a note of how many chars to search through
       sub   ECX ,  StartPos

       xor   EBX ,  EBX
       mov   BL ,   C
       mov   AL ,  [ EDX + EBX ]
     @ Loop :
       mov   BL ,  [ EDI ]
       inc   EDI
       cmp   Al ,  [ EDX + EBX ]
       jz    @ Found
       dec   ECX
       jnz   @ Loop
       jmp   @ NotFound
     @ Found :
       sub   EDI ,  aSource         //EDI has been incremented, so EDI-OrigAdress = Char pos !
       mov   Result ,    EDI
     @ NotFound :

       POP   EBX
       POP   EDI
   end ;
end ;

//The first thing to note here is that I am passing the SourceLength and FindLength
//As neither Source or Find will alter at any point during FastReplace there is
//no need to call the LENGTH subroutine each time !

function  FastPos ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
var
   JumpTable :  TBMJumpTable ;
begin
   //If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
   Assert ( StartPos  >  0 );
   if  aFindLen  <  1  then
   begin
     Result  :=  0 ;
     exit ;
   end ;
   if  aFindLen  >  aSourceLen  then
   begin
     Result  :=  0 ;
     exit ;
   end ;

   MakeBMTable ( PChar ( aFindString ),  aFindLen ,  JumpTable );
   Result  :=  Integer ( BMPos ( PChar ( aSourceString )  +  ( StartPos  -  1 ),  PChar ( aFindString ),  aSourceLen  -  ( StartPos  -  1 ),  aFindLen ,  JumpTable ));
   if  Result  >  0  then
     Result  :=  Result  -  Integer (@ aSourceString [ 1 ])  +  1 ;
end ;

function  FastPosNoCase ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
var
   JumpTable :  TBMJumpTable ;
begin
   //If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
   Assert ( StartPos  >  0 );
   if  aFindLen  <  1  then
   begin
     Result  :=  0 ;
     exit ;
   end ;
   if  aFindLen  >  aSourceLen  then
   begin
     Result  :=  0 ;
     exit ;
   end ;

   MakeBMTableNoCase ( PChar ( AFindString ),  aFindLen ,  JumpTable );
   Result  :=  Integer ( BMPosNoCase ( PChar ( aSourceString )  +  ( StartPos  -  1 ),  PChar ( aFindString ),  aSourceLen  -  ( StartPos  -  1 ),  aFindLen ,  JumpTable ));
   if  Result  >  0  then
     Result  :=  Result  -  Integer (@ aSourceString [ 1 ])  +  1 ;
end ;

function  FastPosBack ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
var
   SourceLen :  Integer ;
begin
   if  aFindLen  <  1  then
   begin
     Result  :=  0 ;
     exit ;
   end ;
   if  aFindLen  >  aSourceLen  then
   begin
     Result  :=  0 ;
     exit ;
   end ;

   if  ( StartPos  =  0 )  or  ( StartPos  +  aFindLen  >  aSourceLen )  then
     SourceLen  :=  aSourceLen  -  ( aFindLen  -  1 )
   else
     SourceLen  :=  StartPos ;

   asm
           push  ESI
           push  EDI
           push  EBX

           mov  EDI ,  aSourceString
           add  EDI ,  SourceLen
           Dec  EDI

           mov  ESI ,  aFindString
           mov  ECX ,  SourceLen
           Mov   Al ,  [ ESI ]

     @ ScaSB :
           cmp   Al ,  [ EDI ]
           jne   @ NextChar

     @ CompareStrings :
           mov   EBX ,  aFindLen
           dec   EBX
           jz    @ FullMatch

     @ CompareNext :
           mov   Ah ,  [ ESI + EBX ]
           cmp   Ah ,  [ EDI + EBX ]
           Jnz   @ NextChar

     @ Matches :
           Dec   EBX
           Jnz   @ CompareNext

     @ FullMatch :
           mov   EAX ,  EDI
           sub   EAX ,  aSourceString
           inc   EAX
           mov   Result ,  EAX
           jmp   @ TheEnd
     @ NextChar :
           dec   EDI
           dec   ECX
           jnz   @ ScaSB

           mov   Result , 0

     @ TheEnd :
           pop   EBX
           pop   EDI
           pop   ESI
   end ;
end ;

function  FastPosBackNoCase ( const  aSourceString ,  aFindString :  string ;  const  aSourceLen ,  aFindLen ,  StartPos :  Integer ):  Integer ;
var
   SourceLen :  Integer ;
begin
   if  aFindLen  <  1  then
   begin
     Result  :=  0 ;
     exit ;
   end ;
   if  aFindLen  >  aSourceLen  then
   begin
     Result  :=  0 ;
     exit ;
   end ;

   if  ( StartPos  =  0 )  or  ( StartPos  +  aFindLen  >  aSourceLen )  then
     SourceLen  :=  aSourceLen  -  ( aFindLen  -  1 )
   else
     SourceLen  :=  StartPos ;

   asm
           push  ESI
           push  EDI
           push  EBX

           mov   EDI ,  aSourceString
           add   EDI ,  SourceLen
           Dec   EDI

           mov   ESI ,  aFindString
           mov   ECX ,  SourceLen

           mov   EDX ,  GUpcaseLUT
           xor   EBX ,  EBX

           mov   Bl ,  [ ESI ]
           mov   Al ,  [ EDX + EBX ]

     @ ScaSB :
           mov   Bl ,  [ EDI ]
           cmp   Al ,  [ EDX + EBX ]
           jne   @ NextChar

     @ CompareStrings :
           PUSH  ECX
           mov   ECX ,  aFindLen
           dec   ECX
           jz    @ FullMatch

     @ CompareNext :
           mov   Bl ,  [ ESI + ECX ]
           mov   Ah ,  [ EDX + EBX ]
           mov   Bl ,  [ EDI + ECX ]
           cmp   Ah ,  [ EDX + EBX ]
           Jz    @ Matches

     //Go back to findind the first char
           POP   ECX
           Jmp   @ NextChar

     @ Matches :
           Dec   ECX
           Jnz   @ CompareNext

     @ FullMatch :
           POP   ECX

           mov   EAX ,  EDI
           sub   EAX ,  aSourceString
           inc   EAX
           mov   Result ,  EAX
           jmp   @ TheEnd
     @ NextChar :
           dec   EDI
           dec   ECX
           jnz   @ ScaSB

           mov   Result , 0

     @ TheEnd :
           pop   EBX
           pop   EDI
           pop   ESI
   end ;
end ;

//My move is not as fast as MOVE when source and destination are both
//DWord aligned, but certainly faster when they are not.
//As we are moving characters in a string, it is not very likely at all that
//both source and destination are DWord aligned, so moving bytes avoids the
//cycle penality of reading/writing DWords across physical boundaries

procedure  FastCharMove ( const  Source ;  var  Dest ;  Count :  Integer );
asm
//Note:  When this function is called, delphi passes the parameters as follows
//ECX = Count
//EAX = Const Source
//EDX = Var Dest

         //If no bytes to copy, just quit altogether, no point pushing registers
         cmp    ECX , 0
         Je     @ JustQuit

         //Preserve the critical delphi registers
         push   ESI
         push   EDI

         //move Source into ESI  (generally the SOURCE register)
         //move Dest into EDI (generally the DEST register for string commands)
         //This may not actually be neccessary, as I am not using MOVsb etc
         //I may be able just to use EAX and EDX, there may be a penalty for
         //not using ESI, EDI but I doubt it, this is another thing worth trying !
         mov    ESI ,  EAX
         mov    EDI ,  EDX

         //The following loop is the same as repNZ MovSB, but oddly quicker !
     @ Loop :
         //Get the source byte
         Mov    AL ,  [ ESI ]
         //Point to next byte
         Inc    ESI
         //Put it into the Dest
         mov    [ EDI ],  AL
         //Point dest to next position
         Inc    EDI
         //Dec ECX to note how many we have left to copy
         Dec    ECX
         //If ECX <> 0 then loop
         Jnz    @ Loop

         //Another optimization note.
         //Many people like to do this

         //Mov AL, [ESI]
         //Mov [EDI], Al
         //Inc ESI
         //Inc ESI

         //There is a hidden problem here, I wont go into too much detail, but
         //the pentium can continue processing instructions while it is still
         //working out the result of INC ESI or INC EDI
         //(almost like a multithreaded CPU)
         //if, however, you go to use them while they are still being calculated
         //the processor will stop until they are calculated (a penalty)
         //Therefore I alter ESI and EDI as far in advance as possible of using them

         //Pop the critical Delphi registers that we have altered
         pop    EDI
         pop    ESI
     @ JustQuit :
end ;

function  FastAnsiReplace ( const  S ,  OldPattern ,  NewPattern :  string ;
   Flags :  TReplaceFlags ):  string ;
var
   BufferSize ,  BytesWritten :  Integer ;
   SourceString ,  FindString :  string ;
   ResultPChar :  PChar ;
   FindPChar ,  ReplacePChar :  PChar ;
   SPChar ,  SourceStringPChar ,  PrevSourceStringPChar :  PChar ;
   FinalSourceMarker :  PChar ;
   SourceLength ,  FindLength ,  ReplaceLength ,  CopySize :  Integer ;
   FinalSourcePosition :  Integer ;
begin
   //Set up string lengths
   BytesWritten  :=  0 ;
   SourceLength  :=  Length ( S );
   FindLength  :=  Length ( OldPattern );
   ReplaceLength  :=  Length ( NewPattern );
   //Quick exit
   if  ( SourceLength  =  0 )  or  ( FindLength  =  0 )  or
     ( FindLength  >  SourceLength )  then
   begin
     Result  :=  S ;
     Exit ;
   end ;

   //Set up the source string and find string
   if  rfIgnoreCase  in  Flags  then
   begin
     SourceString  :=  AnsiUpperCase ( S );
     FindString  :=  AnsiUpperCase ( OldPattern );
   end
   else
   begin
     SourceString  :=  S ;
     FindString  :=  OldPattern ;
   end ;

   //Set up the result buffer size and pointers
   try
     if  ReplaceLength  <=  FindLength  then
       //Result cannot be larger, only same size or smaller
       BufferSize  :=  SourceLength
     else
       //Assume a source string made entired of the sub string
       BufferSize  :=  ( SourceLength  *  ReplaceLength )  div
         FindLength ;

     //10 times is okay for starters. We don't want to
     //go allocating much more than we need.
     if  BufferSize  >  ( SourceLength  *  10 )  then
       BufferSize  :=  SourceLength  *  10 ;
   except
     //Oops, integer overflow! Better start with a string
     //of the same size as the source.
     BufferSize  :=  SourceLength ;
   end ;
   SetLength ( Result ,  BufferSize );
   ResultPChar  :=  @ Result [ 1 ];

   //Set up the pointers to S and SourceString
   SPChar  :=  @ S [ 1 ];
   SourceStringPChar  :=  @ SourceString [ 1 ];
   PrevSourceStringPChar  :=  SourceStringPChar ;
   FinalSourceMarker  :=  @ SourceString [ SourceLength  -  ( FindLength  -  1 )];

   //Set up the pointer to FindString
   FindPChar  :=  @ FindString [ 1 ];

   //Set the pointer to ReplaceString
   if  ReplaceLength  >  0  then
     ReplacePChar  :=  @ NewPattern [ 1 ]
   else
     ReplacePChar  :=  nil ;

   //Replace routine
   repeat
     //Find the sub string
     SourceStringPChar  :=  AnsiStrPos ( PrevSourceStringPChar ,
       FindPChar );
     if  SourceStringPChar  =  nil  then
       Break ;
     //How many characters do we need to copy before
     //the string occurs
     CopySize  :=  SourceStringPChar  -  PrevSourceStringPChar ;

     //Check we have enough space in our Result buffer
     if  CopySize  +  ReplaceLength  >  BufferSize  -  BytesWritten  then
     begin
       BufferSize  :=  Trunc (( BytesWritten  +  CopySize  +  ReplaceLength )  *  cDeltaSize );
       SetLength ( Result ,  BufferSize );
       ResultPChar  :=  @ Result [ BytesWritten  +  1 ];
     end ;

     //Copy the preceeding characters to our result buffer
     Move ( SPChar ^,  ResultPChar ^,  CopySize );
     Inc ( BytesWritten ,  CopySize );
     //Advance the copy position of S
     Inc ( SPChar ,  CopySize  +  FindLength );
     //Advance the Result pointer
     Inc ( ResultPChar ,  CopySize );
     //Copy the replace string into the Result buffer
     if  Assigned ( ReplacePChar )  then
     begin
       Move ( ReplacePChar ^,  ResultPChar ^,  ReplaceLength );
       Inc ( ResultPChar ,  ReplaceLength );
       Inc ( BytesWritten ,  ReplaceLength );
     end ;

     //Fake delete the start of the source string
     PrevSourceStringPChar  :=  SourceStringPChar  +  FindLength ;
   until  ( PrevSourceStringPChar  >  FinalSourceMarker )  or
     not  ( rfReplaceAll  in  Flags );

   FinalSourcePosition  :=  Integer ( SPChar  -  @ S [ 1 ]);
   CopySize  :=  SourceLength  -  FinalSourcePosition ;
   SetLength ( Result ,  BytesWritten  +  CopySize );
   if  CopySize  >  0  then
     Move ( SPChar ^,  Result [ BytesWritten  +  1 ],  CopySize );
end ;

function  FastReplace ( const  aSourceString :  string ;  const  aFindString ,  aReplaceString :  string ;
   CaseSensitive :  Boolean  =  False ):  string ;
var
   PResult :  PChar ;
   PReplace :  PChar ;
   PSource :  PChar ;
   PFind :  PChar ;
   PPosition :  PChar ;
   CurrentPos ,
     BytesUsed ,
     lResult ,
     lReplace ,
     lSource ,
     lFind :  Integer ;
   Find :  TFastPosProc ;
   CopySize :  Integer ;
   JumpTable :  TBMJumpTable ;
begin
   LSource  :=  Length ( aSourceString );
   if  LSource  =  0  then
   begin
     Result  :=  aSourceString ;
     exit ;
   end ;
   PSource  :=  @ aSourceString [ 1 ];

   LFind  :=  Length ( aFindString );
   if  LFind  =  0  then
     exit ;
   PFind  :=  @ aFindString [ 1 ];

   LReplace  :=  Length ( aReplaceString );

   //Here we may get an Integer Overflow, or OutOfMemory, if so, we use a Delta
   try
     if  LReplace  <=  LFind  then
       SetLength ( Result ,  lSource )
     else
       SetLength ( Result ,  ( LSource  *  LReplace )  div  LFind );
   except
     SetLength ( Result ,  0 );
   end ;

   LResult  :=  Length ( Result );
   if  LResult  =  0  then
   begin
     LResult  :=  Trunc (( LSource  +  LReplace )  *  cDeltaSize );
     SetLength ( Result ,  LResult );
   end ;

   PResult  :=  @ Result [ 1 ];

   if  CaseSensitive  then
   begin
     MakeBMTable ( PChar ( AFindString ),  lFind ,  JumpTable );
     Find  :=  BMPos ;
   end
   else
   begin
     MakeBMTableNoCase ( PChar ( AFindString ),  lFind ,  JumpTable );
     Find  :=  BMPosNoCase ;
   end ;

   BytesUsed  :=  0 ;
   if  LReplace  >  0  then
   begin
     PReplace  :=  @ aReplaceString [ 1 ];
     repeat
       PPosition  :=  Find ( PSource ,  PFind ,  lSource ,  lFind ,  JumpTable );
       if  PPosition  =  nil  then
         break ;

       CopySize  :=  PPosition  -  PSource ;
       Inc ( BytesUsed ,  CopySize  +  LReplace );

       if  BytesUsed  >=  LResult  then
       begin
         //We have run out of space
         CurrentPos  :=  Integer ( PResult )  -  Integer (@ Result [ 1 ])  +  1 ;
         LResult  :=  Trunc ( LResult  *  cDeltaSize );
         SetLength ( Result ,  LResult );
         PResult  :=  @ Result [ CurrentPos ];
       end ;

       FastCharMove ( PSource ^,  PResult ^,  CopySize );
       Dec ( lSource ,  CopySize  +  LFind );
       Inc ( PSource ,  CopySize  +  LFind );
       Inc ( PResult ,  CopySize );

       FastCharMove ( PReplace ^,  PResult ^,  LReplace );
       Inc ( PResult ,  LReplace );

     until  lSource  <  lFind ;
   end
   else
   begin
     repeat
       PPosition  :=  Find ( PSource ,  PFind ,  lSource ,  lFind ,  JumpTable );
       if  PPosition  =  nil  then
         break ;

       CopySize  :=  PPosition  -  PSource ;
       FastCharMove ( PSource ^,  PResult ^,  CopySize );
       Dec ( lSource ,  CopySize  +  LFind );
       Inc ( PSource ,  CopySize  +  LFind );
       Inc ( PResult ,  CopySize );
       Inc ( BytesUsed ,  CopySize );
     until  lSource  <  lFind ;
   end ;

   SetLength ( Result ,  ( PResult  +  LSource )  -  @ Result [ 1 ]);
   if  LSource  >  0  then
     FastCharMove ( PSource ^,  Result [ BytesUsed  +  1 ],  LSource );
end ;

function  FastTagReplace ( const  SourceString ,  TagStart ,  TagEnd :  string ;
   FastTagReplaceProc :  TFastTagReplaceProc ;  const  UserData :  Integer ):  string ;
var
   TagStartPChar :  PChar ;
   TagEndPChar :  PChar ;
   SourceStringPChar :  PChar ;
   TagStartFindPos :  PChar ;
   TagEndFindPos :  PChar ;
   TagStartLength :  Integer ;
   TagEndLength :  Integer ;
   DestPChar :  PChar ;
   FinalSourceMarkerStart :  PChar ;
   FinalSourceMarkerEnd :  PChar ;
   BytesWritten :  Integer ;
   BufferSize :  Integer ;
   CopySize :  Integer ;
   ReplaceString :  string ;

   procedure  AddBuffer ( const  Buffer :  Pointer ;  Size :  Integer );
   begin
     if  BytesWritten  +  Size  >  BufferSize  then
     begin
       BufferSize  :=  Trunc ( BufferSize  *  cDeltaSize );
       if  BufferSize  <=  ( BytesWritten  +  Size )  then
         BufferSize  :=  Trunc (( BytesWritten  +  Size )  *  cDeltaSize );
       SetLength ( Result ,  BufferSize );
       DestPChar  :=  @ Result [ BytesWritten  +  1 ];
     end ;
     Inc ( BytesWritten ,  Size );
     FastCharMove ( Buffer ^,  DestPChar ^,  Size );
     DestPChar  :=  DestPChar  +  Size ;
   end ;

begin
   Assert ( Assigned (@ FastTagReplaceProc ));
   TagStartPChar  :=  PChar ( TagStart );
   TagEndPChar  :=  PChar ( TagEnd );
   if  ( SourceString  =  '' )  or  ( TagStart  =  '' )  or  ( TagEnd  =  '' )  then
   begin
     Result  :=  SourceString ;
     Exit ;
   end ;

   SourceStringPChar  :=  PChar ( SourceString );
   TagStartLength  :=  Length ( TagStart );
   TagEndLength  :=  Length ( TagEnd );
   FinalSourceMarkerEnd  :=  SourceStringPChar  +  Length ( SourceString )  -  TagEndLength ;
   FinalSourceMarkerStart  :=  FinalSourceMarkerEnd  -  TagStartLength ;

   BytesWritten  :=  0 ;
   BufferSize  :=  Length ( SourceString );
   SetLength ( Result ,  BufferSize );
   DestPChar  :=  @ Result [ 1 ];

   repeat
     TagStartFindPos  :=  AnsiStrPos ( SourceStringPChar ,  TagStartPChar );
     if  ( TagStartFindPos  =  nil )  or  ( TagStartFindPos  >  FinalSourceMarkerStart )  then
       Break ;
     TagEndFindPos  :=  AnsiStrPos ( TagStartFindPos  +  TagStartLength ,  TagEndPChar );
     if  ( TagEndFindPos  =  nil )  or  ( TagEndFindPos  >  FinalSourceMarkerEnd )  then
       Break ;
     CopySize  :=  TagStartFindPos  -  SourceStringPChar ;
     AddBuffer ( SourceStringPChar ,  CopySize );
     CopySize  :=  TagEndFindPos  -  ( TagStartFindPos  +  TagStartLength );
     SetLength ( ReplaceString ,  CopySize );
     if  CopySize  >  0  then
       Move (( TagStartFindPos  +  TagStartLength )^,  ReplaceString [ 1 ],  CopySize );
     FastTagReplaceProc ( ReplaceString ,  UserData );
     if  Length ( ReplaceString )  >  0  then
       AddBuffer (@ ReplaceString [ 1 ],  Length ( ReplaceString ));
     SourceStringPChar  :=  TagEndFindPos  +  TagEndLength ;
   until  SourceStringPChar  >  FinalSourceMarkerStart ;
   CopySize  :=  PChar (@ SourceString [ Length ( SourceString )])  -  ( SourceStringPChar  -  1 );
   if  CopySize  >  0  then
     AddBuffer ( SourceStringPChar ,  CopySize );
   SetLength ( Result ,  BytesWritten );
end ;

function  SmartPos ( const  SearchStr ,  SourceStr :  string ;
   const  CaseSensitive :  Boolean  =  TRUE ;
   const  StartPos :  Integer  =  1 ;
   const  ForwardSearch :  Boolean  =  TRUE ):  Integer ;
begin
   // NOTE:  When using StartPos, the returned value is absolute!
   if  ( CaseSensitive )  then
     if  ( ForwardSearch )  then
       Result  :=
         FastPos ( SourceStr ,  SearchStr ,  Length ( SourceStr ),  Length ( SearchStr ),  StartPos )
     else
       Result  :=
         FastPosBack ( SourceStr ,  SearchStr ,  Length ( SourceStr ),  Length ( SearchStr ),  StartPos )
   else  if  ( ForwardSearch )  then
     Result  :=
       FastPosNoCase ( SourceStr ,  SearchStr ,  Length ( SourceStr ),  Length ( SearchStr ),  StartPos )
   else
     Result  :=
       FastPosBackNoCase ( SourceStr ,  SearchStr ,  Length ( SourceStr ),  Length ( SearchStr ),  StartPos )
end ;

var
   I :  Integer ;
initialization
{$IFNDEF LINUX}
   for  I  :=  0  to  255  do
     GUpcaseTable [ I ]  :=  Chr ( I );
   CharUpperBuff (@ GUpcaseTable [ 0 ],  256 );
{$ELSE}
   for  I  :=  0  to  255  do
     GUpcaseTable [ I ]  :=  UpCase ( Chr ( I ));
{$ENDIF}
   GUpcaseLUT  :=  @ GUpcaseTable [ 0 ];
end .