' paste to Strings2.bas ' the good: fastest with very short delimiters & array strings ' the bad: too slow with long delimiter / array strings ' means: RtlMoveMemory is good when going continually left to right, bad otherwise ' BUT VB6 arrays are better when copying from right to left! (compiler optimizes better?) Public Function JoinRev(SourceArray() As String, Optional Delimiter As String = " ") As String ' is it possible to use too many safe array hacks? Static HI1(0 To 6) As Long, HPI1 As Long Static HI2(0 To 6) As Long, HPI2 As Long Static HL1(0 To 6) As Long, HPL1 As Long Static HL2(0 To 6) As Long, HPL2 As Long Static HL3(0 To 6) As Long, HPL3 As Long Static HL4(0 To 6) As Long, HPL4 As Long Static HS(0 To 6) As Long, HPS As Long Static HSI(0 To 6) As Long, HPSI As Long Static HSL(0 To 6) As Long, HPSL As Long ' it looks like not! Dim I1() As Integer, API1 As Long Dim I2() As Integer, API2 As Long Dim L1() As Long, APL1 As Long Dim L2() As Long, APL2 As Long Dim L3() As Long, APL3 As Long Dim L4() As Long, APL4 As Long Dim S() As Long, APS As Long Dim SI() As Integer, APSI As Long Dim SL() As Long, APSL As Long ' delimiter optimizations Dim DI1 As Integer, DL1 As Long, DL2 As Long, DL3 As Long, DL4 As Long ' regular variables are nice too Dim J As Long, L As Long, LD As Long, PC As Long, PD As Long, T As Long, US As Long Dim P As Long, PI As Long, PL As Long, PS As Long, Ptr As Long ' Goto... Dim ReturnTo As Long ' has the array been initialized in the first place? P = Not Not SourceArray Debug.Assert App.hInstance If P Then ' must be zero base If LBound(SourceArray) Then Exit Function ' upper bound check... US = UBound(SourceArray) Select Case US ' must have at least one element! Case -1: Exit Function ' only one element? Case 0: JoinRev = SourceArray(0): Exit Function End Select ' calculate total length For J = 0 To US T = T + LenB(SourceArray(J)) Next J ' get delimiter length LD = LenB(Delimiter) ' because you can be crazy on optimizing performance... including rare special cases If T Then ' add delimiters' length to total length If LD Then T = T + LD * US ElseIf LD = 2 Then ' single character replicate JoinRev = String$(US, Delimiter) ElseIf LD Then ' half character or multicharacter replicate JoinRev = AllocString(0, LD * US) P = 1 ' join the first four bytes and until we have even length Do MidB$(JoinRev, P, LD) = Delimiter P = P + LD ' make also sure we do not run out of the string space Loop While (P <= LenB(JoinRev)) And ((P < 4) Or (P And 1) = 0) ' now use a faster replicate for the rest If P <= LenB(JoinRev) Then MidB$(JoinRev, P) = JoinRev End If ' so do we join? If T Then ' generic safe array hack If m_AP = 0 Then ' array variable pointer m_AP = ArrPtr(m_A) ' create a safe array header m_H(0) = vbLong: m_H(1) = &H800001: m_H(2) = 4: m_H(5) = &H7FFFFFFF ' header pointer m_HP = VarPtr(m_H(1)) End If ' set pointer to array PutLong m_AP, m_HP ' local safe array hack API1 = ArrPtr(I1) API2 = ArrPtr(I2) APL1 = ArrPtr(L1) APL2 = ArrPtr(L2) APL3 = ArrPtr(L3) APL4 = ArrPtr(L4) APS = ArrPtr(S) APSI = ArrPtr(SI) APSL = ArrPtr(SL) If HPS = 0 Then ' JoinRev string HI1(0) = vbInteger: HI1(1) = &H800001: HI1(2) = 2: HI1(5) = &H7FFFFFFF HI2(0) = vbInteger: HI2(1) = &H800001: HI2(2) = 2: HI2(5) = &H7FFFFFFF HL1(0) = vbLong: HL1(1) = &H800001: HL1(2) = 4: HL1(5) = &H3FFFFFFF HL2(0) = vbLong: HL2(1) = &H800001: HL2(2) = 4: HL2(5) = &H3FFFFFFF HL3(0) = vbLong: HL3(1) = &H800001: HL3(2) = 4: HL3(5) = &H3FFFFFFF HL4(0) = vbLong: HL4(1) = &H800001: HL4(2) = 4: HL4(5) = &H3FFFFFFF ' string pointers HS(0) = vbLong: HS(1) = &H800001: HS(2) = 4 ' SourceArray's current string HSI(0) = vbInteger: HSI(1) = &H800001: HSI(2) = 2: HSI(5) = &H7FFFFFFF HSL(0) = vbLong: HSL(1) = &H800001: HSL(2) = 4: HSL(5) = &H3FFFFFFF HPI1 = VarPtr(HI1(1)) HPI2 = VarPtr(HI2(1)) HPL1 = VarPtr(HL1(1)) HPL2 = VarPtr(HL2(1)) HPL3 = VarPtr(HL3(1)) HPL4 = VarPtr(HL4(1)) HPS = VarPtr(HS(1)) HPSI = VarPtr(HSI(1)) HPSL = VarPtr(HSL(1)) End If ' allocate string JoinRev = AllocString(0, T) Ptr = StrPtr(JoinRev) ' update S to point to SourceArray HS(4) = VarPtr(SourceArray(0)): HS(5) = US + 1 ' update array pointers HI1(4) = Ptr HI2(4) = Ptr + 1 HL1(4) = Ptr HL2(4) = Ptr + 1 HL3(4) = Ptr + 2 HL4(4) = Ptr + 3 ' start safe array hack for local arrays m_H(4) = API1: m_A(0) = HPI1 m_H(4) = API2: m_A(0) = HPI2 m_H(4) = APL1: m_A(0) = HPL1 m_H(4) = APL2: m_A(0) = HPL2 m_H(4) = APL3: m_A(0) = HPL3 m_H(4) = APL4: m_A(0) = HPL4 m_H(4) = APS: m_A(0) = HPS m_H(4) = APSI: m_A(0) = HPSI m_H(4) = APSL: m_A(0) = HPSL ' zero position P = T PD = StrPtr(Delimiter) ' delimiter length? Select Case LD Case Is > 16 GoTo Over8 ' optimized zero length join Case 0 ReturnTo = 0 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 0: End If Next J Case 1, 2 HSI(4) = PD DI1 = SI(0) ReturnTo = 1 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 1: End If ' update position P = P - LD ' copy delimiter PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = DI1 Case 1: I2(PI) = DI1 End Select Next J Case 3, 4 m_H(4) = PD DL1 = m_A(0) ReturnTo = 2 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 2: End If ' update position P = P - LD ' copy delimiter PL = P \ 4 Select Case P And 3 Case 0: L1(PL) = DL1 Case 2: L3(PL) = DL1 Case 1: L2(PL) = DL1 Case 3: L4(PL) = DL1 End Select Next J Case 5, 6 HSI(4) = PD DI1 = SI(0) m_H(4) = PD + 2 DL1 = m_A(0) ReturnTo = 3 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 3: End If ' update position P = P - LD ' copy delimiter PL = (P + 2) \ 4 Select Case P And 3 Case 2: L1(PL) = DL1 Case 0: L3(PL) = DL1 Case 3: L2(PL) = DL1 Case 1: L4(PL) = DL1 End Select PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = DI1 Case 1: I2(PI) = DI1 End Select Next J Case 7, 8 m_H(4) = PD DL1 = m_A(0) DL2 = m_A(1) ReturnTo = 4 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 4: End If ' update position P = P - LD ' copy delimiter PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 1) = DL2: L1(PL) = DL1 Case 2: L3(PL + 1) = DL2: L3(PL) = DL1 Case 1: L2(PL + 1) = DL2: L2(PL) = DL1 Case 3: L4(PL + 1) = DL2: L4(PL) = DL1 End Select Next J Case 9, 10 HSI(4) = PD DI1 = SI(0) m_H(4) = PD + 2 DL1 = m_A(0) DL2 = m_A(1) ReturnTo = 5 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 5: End If ' update position P = P - LD ' copy delimiter PL = (P + 2) \ 4 Select Case P And 3 Case 2: L1(PL + 1) = DL2: L1(PL) = DL1 Case 0: L3(PL + 1) = DL2: L3(PL) = DL1 Case 3: L2(PL + 1) = DL2: L2(PL) = DL1 Case 1: L4(PL + 1) = DL2: L4(PL) = DL1 End Select PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = DI1 Case 1: I2(PI) = DI1 End Select Next J Case 11, 12 m_H(4) = PD DL1 = m_A(0) DL2 = m_A(1) DL3 = m_A(2) ReturnTo = 6 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 6: End If ' update position P = P - LD ' copy delimiter PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 2) = DL3: L1(PL + 1) = DL2: L1(PL) = DL1 Case 2: L3(PL + 2) = DL3: L3(PL + 1) = DL2: L3(PL) = DL1 Case 1: L2(PL + 2) = DL3: L2(PL + 1) = DL2: L2(PL) = DL1 Case 3: L4(PL + 2) = DL3: L4(PL + 1) = DL2: L4(PL) = DL1 End Select Next J Case 13, 14 HSI(4) = PD DI1 = SI(0) m_H(4) = PD + 2 DL1 = m_A(0) DL2 = m_A(1) DL3 = m_A(2) ReturnTo = 7 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 7: End If ' update position P = P - LD ' copy delimiter PL = (P + 2) \ 4 Select Case P And 3 Case 2: L1(PL + 2) = DL3: L1(PL + 1) = DL2: L1(PL) = DL1 Case 0: L3(PL + 2) = DL3: L3(PL + 1) = DL2: L3(PL) = DL1 Case 3: L2(PL + 2) = DL3: L2(PL + 1) = DL2: L2(PL) = DL1 Case 1: L4(PL + 2) = DL3: L4(PL + 1) = DL2: L4(PL) = DL1 End Select PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = DI1 Case 1: I2(PI) = DI1 End Select Next J Case 15, 16 m_H(4) = PD DL1 = m_A(0) DL2 = m_A(1) DL3 = m_A(2) DL4 = m_A(3) ReturnTo = 8 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 8: End If ' update position P = P - LD ' copy delimiter PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 3) = DL4: L1(PL + 2) = DL3: L1(PL + 1) = DL2: L1(PL) = DL1 Case 2: L3(PL + 3) = DL4: L3(PL + 2) = DL3: L3(PL + 1) = DL2: L3(PL) = DL1 Case 1: L2(PL + 3) = DL4: L2(PL + 2) = DL3: L2(PL + 1) = DL2: L2(PL) = DL1 Case 3: L4(PL + 3) = DL4: L4(PL + 2) = DL3: L4(PL + 1) = DL2: L4(PL) = DL1 End Select Next J Case Else Over8: ReturnTo = 9 For J = US To 1 Step -1 ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ' copy from StringArray GoTo CopyRoutine 9: End If ' update position P = P - LD ' copy delimiter rtlMove Ptr + P, PD, LD Next J End Select ' current length L = LenB(SourceArray(J)) If L Then ' current pointer PC = S(J) ReturnTo = 10 ' copy from StringArray (last item) GoTo CopyRoutine 10: End If ' end safe array hacks m_H(4) = API1: m_A(0) = 0 m_H(4) = API2: m_A(0) = 0 m_H(4) = APL1: m_A(0) = 0 m_H(4) = APL2: m_A(0) = 0 m_H(4) = APL3: m_A(0) = 0 m_H(4) = APL4: m_A(0) = 0 m_H(4) = APS: m_A(0) = 0 m_H(4) = APSI: m_A(0) = 0 m_H(4) = APSL: m_A(0) = 0 m_H(4) = m_AP: m_A(0) = 0 End If End If Exit Function CopyRoutine: ' update position P = P - L Select Case L Case Is > 16 rtlMove Ptr + P, PC, L GoTo ReturnPoint Case 1, 2 HSI(4) = PC PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = SI(0) Case 1: I2(PI) = SI(0) End Select GoTo ReturnPoint Case 3, 4 HSL(4) = PC PL = P \ 4 Select Case P And 3 Case 0: L1(PL) = SL(0) Case 2: L3(PL) = SL(0) Case 1: L2(PL) = SL(0) Case 3: L4(PL) = SL(0) End Select GoTo ReturnPoint Case 5, 6 HSI(4) = PC PI = P \ 2 Select Case P And 1 Case 0: I1(PI + 2) = SI(2): I1(PI + 1) = SI(1): I1(PI) = SI(0) Case 1: I2(PI + 2) = SI(2): I2(PI + 1) = SI(1): I2(PI) = SI(0) End Select GoTo ReturnPoint Case 7, 8 HSL(4) = PC PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 1) = SL(1): L1(PL) = SL(0) Case 2: L3(PL + 1) = SL(1): L3(PL) = SL(0) Case 1: L2(PL + 1) = SL(1): L2(PL) = SL(0) Case 3: L4(PL + 1) = SL(1): L4(PL) = SL(0) End Select GoTo ReturnPoint Case 9, 10 HSL(4) = PC + 2 PL = (P + 2) \ 4 Select Case P And 3 Case 2: L1(PL + 1) = SL(1): L1(PL) = SL(0) Case 0: L3(PL + 1) = SL(1): L3(PL) = SL(0) Case 3: L2(PL + 1) = SL(1): L2(PL) = SL(0) Case 1: L4(PL + 1) = SL(1): L4(PL) = SL(0) End Select HSI(4) = PC PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = SI(0) Case 1: I2(PI) = SI(0) End Select GoTo ReturnPoint Case 11, 12 HSL(4) = PC PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 2) = SL(2): L1(PL + 1) = SL(1): L1(PL) = SL(0) Case 2: L3(PL + 2) = SL(2): L3(PL + 1) = SL(1): L3(PL) = SL(0) Case 1: L2(PL + 2) = SL(2): L2(PL + 1) = SL(1): L2(PL) = SL(0) Case 3: L4(PL + 2) = SL(2): L4(PL + 1) = SL(1): L4(PL) = SL(0) End Select GoTo ReturnPoint Case 13, 14 HSL(4) = PC + 2 PL = (P + 2) \ 4 Select Case P And 3 Case 2: L1(PL + 2) = SL(2): L1(PL + 1) = SL(1): L1(PL) = SL(0) Case 0: L3(PL + 2) = SL(2): L3(PL + 1) = SL(1): L3(PL) = SL(0) Case 3: L2(PL + 2) = SL(2): L2(PL + 1) = SL(1): L2(PL) = SL(0) Case 1: L4(PL + 2) = SL(2): L4(PL + 1) = SL(1): L4(PL) = SL(0) End Select HSI(4) = PC PI = P \ 2 Select Case P And 1 Case 0: I1(PI) = SI(0) Case 1: I2(PI) = SI(0) End Select GoTo ReturnPoint Case 15, 16 HSL(4) = PC PL = P \ 4 Select Case P And 3 Case 0: L1(PL + 3) = SL(3): L1(PL + 2) = SL(2): L1(PL + 1) = SL(1): L1(PL) = SL(0) Case 2: L3(PL + 3) = SL(3): L3(PL + 2) = SL(2): L3(PL + 1) = SL(1): L3(PL) = SL(0) Case 1: L2(PL + 3) = SL(3): L2(PL + 2) = SL(2): L2(PL + 1) = SL(1): L2(PL) = SL(0) Case 3: L4(PL + 3) = SL(3): L4(PL + 2) = SL(2): L4(PL + 1) = SL(1): L4(PL) = SL(0) End Select GoTo ReturnPoint End Select ReturnPoint: ' where we go back? Select Case ReturnTo Case 0: GoTo 0: Case 1: GoTo 1: Case 2: GoTo 2: Case 3: GoTo 3 Case 4: GoTo 4: Case 5: GoTo 5: Case 6: GoTo 6: Case 7: GoTo 7 Case 8: GoTo 8: Case 9: GoTo 9: Case 10: GoTo 10 End Select End Function