' by Olaf Schmidt, os@datenhaus.de, 20010106 Option Explicit Private src%(), saSrc&(5) Private Fnd%(), saFnd&(5) Private Rep%(), saRep&(5) Private Out%(), saOut&(5) Private PosArr&(), UBPosArr& ' VB5 -> msvbvm50.dll Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&) Private Declare Function SysAllocStringByteLen& Lib "oleaut32" (ByVal olestr&, ByVal BLen&) Friend Function Replace10(Text As String, sOld As String, sNew As String, _ Optional ByVal Start As Long = 1, _ Optional ByVal Count As Long = 2147483647, _ Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _ ) As String Dim lenSrc&, lenFnd&, LenRep&, LenOut& Dim i&, j&, InPos&, OutPos&, CFnd&, Dist&, LCmp&, LFnd&, Fnd0% lenSrc = Len(Text) If lenSrc = 0 Then Exit Function lenFnd = Len(sOld): LenRep = Len(sNew) If lenFnd = 0 Then Replace10 = Text: Exit Function saRep(3) = StrPtr(sNew) saSrc(3) = StrPtr(Text) saFnd(3) = StrPtr(sOld): Fnd0 = Fnd(0) If lenFnd = LenRep Then RtlMoveMemory ByVal VarPtr(Replace10), SysAllocStringByteLen(saSrc(3), lenSrc + lenSrc), 4 saOut(3) = StrPtr(Replace10) End If If Compare = vbBinaryCompare Then For i = Start - 1 To lenSrc - 1 If src(i) <> Fnd0 Then 'Inline-Cascading for first Char i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then i = i + 1 If src(i) <> Fnd0 Then GoTo nxt_i End If End If End If End If End If End If End If For j = 1 To lenFnd - 1 'Search all others If src(i + j) <> Fnd(j) Then GoTo nxt_i Next j 'Found at Position i (0 based) If i >= lenSrc Then Exit For CFnd = CFnd + 1 If lenFnd = LenRep Then For j = 0 To LenRep - 1: Out(i + j) = Rep(j): Next j Else If CFnd > UBPosArr Then ReDim Preserve PosArr(UBPosArr + 512): UBPosArr = UBound(PosArr) End If PosArr(CFnd) = i End If If CFnd = Count Then Exit For i = i + lenFnd - 1 nxt_i: Next i Else 'vbStringCompare If Fnd0 > 64& And Fnd0 < 91& Or Fnd0 > 191& And Fnd0 < 223& Then Fnd0 = Fnd0 + 32& For i = Start - 1 To lenSrc - 1 LCmp = src(i): If LCmp > 64& And LCmp < 91& Or LCmp > 191& And LCmp < 223& Then LCmp = LCmp + 32& If LCmp <> Fnd0 Then 'Inline-Cascading for first Char i = i + 1: LCmp = src(i): If LCmp > 64& And LCmp < 91& Or LCmp > 191& And LCmp < 223& Then LCmp = LCmp + 32& If LCmp <> Fnd0 Then i = i + 1: LCmp = src(i): If LCmp > 64& And LCmp < 91& Or LCmp > 191& And LCmp < 223& Then LCmp = LCmp + 32& If LCmp <> Fnd0 Then i = i + 1: LCmp = src(i): If LCmp > 64& And LCmp < 91& Or LCmp > 191& And LCmp < 223& Then LCmp = LCmp + 32& If LCmp <> Fnd0 Then GoTo nxt_ii End If End If End If For j = 0 To lenFnd - 1 'Search all others LCmp = src(i + j): If LCmp > 64& And LCmp < 91& Or LCmp > 191& And LCmp < 223& Then LCmp = LCmp + 32& LFnd = Fnd(j): If LFnd > 64& And LFnd < 91& Or LFnd > 191& And LFnd < 223& Then LFnd = LFnd + 32& If LCmp <> LFnd Then GoTo nxt_ii Next j 'Found at Position i (0 based) If i >= lenSrc Then Exit For CFnd = CFnd + 1 If lenFnd = LenRep Then For j = 0 To LenRep - 1: Out(i + j) = Rep(j): Next j Else If CFnd > UBPosArr Then ReDim Preserve PosArr(UBPosArr + 512): UBPosArr = UBound(PosArr) End If PosArr(CFnd) = i End If If CFnd = Count Then Exit For i = i + lenFnd - 1 nxt_ii: Next i End If 'Generate Output If lenFnd <> LenRep Then If CFnd = 0 Then Replace10 = Text Else LenOut = lenSrc + (LenRep - lenFnd) * CFnd RtlMoveMemory ByVal VarPtr(Replace10), SysAllocStringByteLen(0, LenOut + LenOut), 4 saOut(3) = StrPtr(Replace10) OutPos = 0: InPos = 0 For i = 1 To CFnd Dist = PosArr(i) - InPos If Dist > 100 Then RtlMoveMemory Out(OutPos), src(InPos), Dist + Dist ElseIf Dist > 0 Then j = 0 Do 'Inline-Cascading Out(OutPos + j) = src(InPos + j): j = j + 1: If j = Dist Then Exit Do Out(OutPos + j) = src(InPos + j): j = j + 1: If j = Dist Then Exit Do Out(OutPos + j) = src(InPos + j): j = j + 1: If j = Dist Then Exit Do Out(OutPos + j) = src(InPos + j): j = j + 1: If j = Dist Then Exit Do Loop End If OutPos = OutPos + Dist InPos = PosArr(i) + lenFnd If LenRep > 100 Then RtlMoveMemory Out(OutPos), Rep(0), LenRep + LenRep ElseIf LenRep > 0 Then j = 0 Do 'Inline-Cascading Out(OutPos + j) = Rep(j): j = j + 1: If j = LenRep Then Exit Do Out(OutPos + j) = Rep(j): j = j + 1: If j = LenRep Then Exit Do Out(OutPos + j) = Rep(j): j = j + 1: If j = LenRep Then Exit Do Out(OutPos + j) = Rep(j): j = j + 1: If j = LenRep Then Exit Do Loop End If OutPos = OutPos + LenRep Next i If (lenSrc - InPos) > 0 Then RtlMoveMemory Out(OutPos), src(InPos), (lenSrc - InPos) + (lenSrc - InPos) End If End If End If End Function Private Sub Class_Initialize() ReDim PosArr(512): UBPosArr = UBound(PosArr) saSrc(0) = 1: saSrc(1) = 2: saSrc(4) = 2147483647 RtlMoveMemory ByVal ArrPtr(src), VarPtr(saSrc(0)), 4 saFnd(0) = 1: saFnd(1) = 2: saFnd(4) = 2147483647 RtlMoveMemory ByVal ArrPtr(Fnd), VarPtr(saFnd(0)), 4 saRep(0) = 1: saRep(1) = 2: saRep(4) = 2147483647 RtlMoveMemory ByVal ArrPtr(Rep), VarPtr(saRep(0)), 4 saOut(0) = 1: saOut(1) = 2: saOut(4) = 2147483647 RtlMoveMemory ByVal ArrPtr(Out), VarPtr(saOut(0)), 4 End Sub Private Sub Class_Terminate() RtlMoveMemory ByVal ArrPtr(src), 0&, 4 RtlMoveMemory ByVal ArrPtr(Fnd), 0&, 4 RtlMoveMemory ByVal ArrPtr(Rep), 0&, 4 RtlMoveMemory ByVal ArrPtr(Out), 0&, 4 End Sub