' by Paul, wpsjr1@syix.com, 20020610
Option Explicit

Private sCache(255) As String ' waste 128K to speed things up


Private Sub Class_Initialize()
  Dim i As Long
  
  i = 255
  
  Do
    sCache(i) = String$(512, i)
    i = i - 1
  Loop While i >= 0
End Sub


Friend Function Replicate13(ByVal Number As Long, ByRef Pattern As String) As String
' by Paul, wpsjr1@syix.com, 20020610
' based on code by Donald
' requires FastString type library
  
  Dim lenPattern    As Long
  Dim ptrDst        As Long
  Dim ptrSrc        As Long
  Dim lTotal        As Long
  Dim lPattern      As Long

  lenPattern = Len(Pattern)
  lTotal = Number * lenPattern
  
  If lTotal > 0 Then
    ptrSrc = FastString.SysAllocStringLenPtr(ByVal 0&, lTotal * 2) ' bytes
    ptrDst = ptrSrc
    lPattern = AscW(Pattern)
      
    If lenPattern = 1 Then
      If lTotal >= 512 Then
        lenPattern = 1024
      Else
        lenPattern = lTotal * 2
      End If
      FastString.VB6.vbaCopyBytesStr lenPattern, ByVal ptrDst, sCache(lPattern)
    Else
       lenPattern = lenPattern * 2
       FastString.VB6.vbaCopyBytesStr lenPattern, ByVal ptrDst, Pattern
    End If
    ptrDst = ptrDst + lenPattern
      
    If lenPattern <= lTotal Then
      Do 'http://mathforum.org/dr.math/faq/faq.doubling.pennies.html
        FastString.VB6.vbaCopyBytes lenPattern, ByVal ptrDst, ByVal ptrSrc
        ptrDst = ptrDst + lenPattern
        lenPattern = lenPattern * 2
      Loop While lenPattern <= lTotal
    End If
          
    lTotal = lTotal * 2
    lenPattern = lTotal - lenPattern ' fill-in remaining bytes, does nothing if lenPattern = 0
    FastString.VB6.vbaCopyBytes lenPattern, ByVal ptrDst, ByVal ptrSrc
         
    FastString.RtlMoveMemory Replicate13, ptrSrc ' give the function our pointer
  End If
End Function


Friend Function Join13(sArray() As String, Optional Delimiter As String = " ") As String
' by Paul, wpsjr1@syix.com, 20020610
' requires FastString type library
  Static lLengths()   As Long
  Static lPrevLen     As Long
  Dim lTotalLen       As Long
  Dim lNumItems       As Long
  Dim lDelimLen       As Long
  Dim lLength         As Long
  Dim lLbound         As Long
  Dim lUbound         As Long
  Dim ptrSrc          As Long
  Dim ptrDst          As Long
  Dim lElementLen     As Long
  Dim i               As Long
    
  lLbound = LBound(sArray)
  lUbound = UBound(sArray)
  lDelimLen = LenB(Delimiter)
  lNumItems = lUbound - lLbound + 1
  If lNumItems <> lPrevLen Then ReDim lLengths(lLbound To lUbound)
  lPrevLen = lNumItems
    
  If lLbound = 0 Then
    i = lUbound
    Do
      lLength = LenB(sArray(i)) ' its a tiny bit faster to cache the lengths, but almost not worth the trouble
      lLengths(i) = lLength
      lTotalLen = lTotalLen + lLength + lDelimLen
      i = i - 1
    Loop While i >= 0
  Else ' non 0 based array  EWWW!
    For i = lLbound To lUbound
      lLength = LenB(sArray(i))
      lLengths(i) = lLength
      lTotalLen = lTotalLen + lLength + lDelimLen
    Next i
  End If
    
  lTotalLen = lTotalLen - lDelimLen   ' remove the trailing delimiter, if any
  lTotalLen = lTotalLen \ 2           ' adjust to chars
    
  If lDelimLen Then
     Join13 = String$(lTotalLen, Delimiter) ' this function is just hard to beat.  SysAllocStringLenPtr and RtlFillMemoryUlong comes close.
     ptrDst = StrPtr(Join13)
  Else
    ptrDst = FastString.SysAllocStringLenPtr(ByVal 0, lTotalLen * 2)
  End If
    
  i = lLbound
  ptrSrc = ptrDst ' save the beginning
   
  Do
    lElementLen = lLengths(i)
    FastString.VB6.vbaCopyBytesStr lElementLen, ByVal ptrDst, sArray(i)
    i = i + 1
    ptrDst = ptrDst + lElementLen + lDelimLen
  Loop While i <= lUbound
    
  FastString.RtlMoveMemory Join13, ptrSrc
End Function