VBspeed / String / Replicate
VBspeed © 2000-10, updated: 29-Sep-2002
Replicate


The Definition
Function Replicate
Returns a pattern replicated in a string a specified number of times.
Comes down to an enhanced version of VB's native String$ function, that does not allow more than one character to be repeated.
Declaration:
Replicate(Number, Pattern)
Arguments:
NumberRequired. Number of replications desired.
PatternRequired. Character pattern to replicate.
Example:
Replicate(3, "abc") => "abcabcabc"
You may use this function (VB5/6-compatible) to verify the correctness of your code.


The Charts
Calls
 sRet = Replicate(Number, Pattern)
Call 1 Number = 10
Pattern = "abc"
Call 2 Number = 10000
Pattern = "abc"
Call 3 Number = 10
Pattern = Replicate(100, "abcdefhgij")   [=1000 chars]
Call 4 Number = 10000
Pattern = "a"   [you would normally do this job with String$, of course]

Note that the first versions of Replicate02/03/05 did not work correctly on this call under VB6 (only!). Below you find the revised versions.
 VB5
CodeAuthorDopingNotes
Replicate01 Donald  
Replicate02 Larry  
Replicate03 Larry  
Replicate04 GuidoTLB 
Replicate05 Donald  
Replicate06 DonaldTLB 
Replicate07 Peter  
Replicate08 NickAPI 
Replicate09 MikeAPI 
Replicate10 MarzoTLB 
Replicate11 DonaldAPI,TLB 
Replicate12 MarzoTLB 
Replicate13 PaulTLB 
Replicate14 MarzoTLB 
Call 1
122.250.670Ás
111.840.548Ás
91.780.529Ás
81.700.505Ás
41.290.384Ás
51.350.401Ás
71.390.413Ás
61.370.406Ás
1311.713.483Ás
101.780.531Ás
31.180.351Ás
21.080.322Ás
X1.010.300Ás
11.000.297Ás
Call 2
136.75540Ás
123.69295Ás
113.31265Ás
102.63211Ás
82.33187Ás
92.43194Ás
72.34187Ás
41.2399Ás
11.0080Ás
51.29103Ás
62.06165Ás
31.2197Ás
X0.5544Ás
21.2197Ás
Call 3
1012.3053.169Ás
1213.6659.084Ás
1313.7559.434Ás
1113.0756.504Ás
912.2953.148Ás
711.8151.068Ás
812.2853.092Ás
51.737.484Ás
62.9412.705Ás
41.436.164Ás
31.144.945Ás
21.024.409Ás
X1.054.542Ás
11.004.324Ás
Call 4
13123.15407.122Ás
81.053.473Ás
11.003.306Ás
1117.3957.479Ás
41.013.330Ás
1218.1660.031Ás
31.003.318Ás
92.387.853Ás
109.4231.150Ás
71.023.370Ás
51.003.322Ás
61.023.364Ás
X1.384.564Ás
21.003.313Ás
 VB6
CodeAuthorDopingNotes
Replicate01 Donald  
Replicate02 Larry  
Replicate03 Larry  
Replicate04 GuidoTLB 
Replicate05 Donald  
Replicate06 DonaldTLB 
Replicate07 Peter  
Replicate08 NickAPI 
Replicate09 MikeAPI 
Replicate10 MarzoTLB 
Replicate11 DonaldAPI,TLB 
Replicate12 MarzoTLB 
Replicate13 PaulTLB 
Replicate14 MarzoTLB 
Call 1
122.440.751Ás
101.840.567Ás
91.800.555Ás
71.380.424Ás
51.160.357Ás
41.060.327Ás
61.340.412Ás
81.420.436Ás
1311.433.524Ás
111.850.571Ás
21.030.316Ás
31.030.319Ás
X0.960.298Ás
11.000.308Ás
Call 2
1325.89657Ás
129.00228Ás
96.58167Ás
11.0025Ás
116.67169Ás
64.25108Ás
106.67169Ás
41.4236Ás
74.81122Ás
51.4437Ás
85.74146Ás
31.1128Ás
X3.5189Ás
21.1128Ás
Call 3
101.888.295Ás
112.8412.548Ás
122.8612.670Ás
41.044.579Ás
81.838.098Ás
21.004.437Ás
91.858.184Ás
71.707.496Ás
133.0513.476Ás
61.597.036Ás
51.114.908Ás
11.004.422Ás
X1.044.590Ás
31.014.445Ás
Call 4
13163.87545.473Ás
81.063.534Ás
21.003.324Ás
91.545.120Ás
11.003.329Ás
1210.4934.916Ás
31.013.346Ás
102.387.920Ás
119.4531.457Ás
61.043.446Ás
51.003.330Ás
41.013.353Ás
X1.374.576Ás
71.023.382Ás
Conclusions
  • A weird situation ... impossible to name an overall winner. Both the nature of the test call and the VB-version highly influence the results, and it's even hard to see a pattern in the distribution of the numbers. For example: Why is Replicate04 so extraordinarily good at Call 2 under VB6??? (under Win95 as well as XP!)
  • Note that, contrary to most other disciplines, VB6 looks very good here compared to VB5. Why??
Mail your code! How to read all those numbers


The Code
Replicate01
submitted 05-Dec-2000 by Donald Lessau  
Doping: none
Public Function Replicate01(ByVal Number&, Pattern$) As String
' by Donald, donald@xbeat.net, 20001205
  Dim lenPattern As Long
  Dim posTarget As Long
  
  If Number > 0 Then
    lenPattern = Len(Pattern)
    If lenPattern Then
      Replicate01 = Space$(Number * lenPattern)
      For posTarget = 1 To Number * lenPattern Step lenPattern
        Mid$(Replicate01, posTarget) = Pattern
      Next
    End If
  End If

End Function
Author's comments:
Donald's comments:

top | charts


Replicate02
submitted 05-Dec-2000 by Larry Serflaten  
Doping: none
Public Function Replicate02(ByVal Number&, Pattern$) As String
' by Larry Serflaten, serflaten@usinternet.com, 20001205, rev 002
  
  If Number > 0 Then
    If Len(Pattern) = 1 Then
      Replicate02 = String$(Number, Pattern)
    Else
      Replicate02 = Pattern & Space$((Number - 1) * Len(Pattern))
      If Len(Replicate02) > Len(Pattern) Then
        Mid$(Replicate02, Len(Pattern) + 1) = Replicate02
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments: Highly interesting code! Watch it carefully and begin to wonder why this works (and it does work)...

top | charts


Replicate03
submitted 06-Dec-2000 by Larry Serflaten  
Doping: none
Public Function Replicate03(ByVal Number&, Pattern$) As String
' by Larry Serflaten, serflaten@usinternet.com, 20001206, rev 002

  ' Trying a variable for Len(Parameter) because it is used at least
  ' twice, possibly 3 times.
  Dim LP As Long
  
  If Number > 0 Then
    LP = Len(Pattern)
    If LP = 1 Then
      Replicate03 = String$(Number, Pattern)
    Else
      Replicate03 = Pattern & Space$((Number - 1) * LP)
      If Len(Replicate03) > LP Then
        Mid$(Replicate03, LP + 1) = Replicate03
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments:

top | charts


Replicate04
submitted 06-Dec-2000 by Guido Beckmann  
Doping: needs reference to typelib BStrAPI.tlb (by G.Beckmann) - Download BStrAPI.tlb (2KB zipped, VB5-compatible).
Public Function Replicate04(ByVal Number&, Pattern$) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20001206

    Dim c&, cChars&
    If Number > 0 Then
        c = Len(Pattern)
        If c Then
            cChars = c * Number
            Replicate04 = BStrAPI.SysAllocStringLen(vbNullString, cChars)
            Mid$(Replicate04, 1, c) = Pattern

            Do Until c >= cChars
                Mid$(Replicate04, c + 1, c) = Replicate04
                c = c + c
            Loop
        End If
    End If
End Function
Author's comments:
Donald's comments:

top | charts


Replicate05
submitted 06-Dec-2000 by Donald Lessau  
Doping: none
Public Function Replicate05(ByVal Number&, Pattern$) As String
' by Donald, donald@xbeat.net, 20001206, rev 002
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206

  Dim LP As Long
  
  If Number > 0 Then
    LP = Len(Pattern)
    Select Case LP
    Case Is > 1
      Replicate05 = Space$(Number * LP)
      Mid$(Replicate05, 1, LP) = Pattern
      If Number > 1 Then
        Mid$(Replicate05, LP + 1) = Replicate05
      End If
    Case 1
      Replicate05 = String$(Number, Pattern)
    End Select
  End If
  
End Function
Author's comments: Note, how getting rid of that one string concatenation in Replicate03 brings 50% speed gain!
Donald's comments:

top | charts


Replicate06
submitted 06-Dec-2000 by Donald Lessau  
Doping: needs reference to typelib BStrAPI.tlb (by G.Beckmann) - Download BStrAPI.tlb (2KB zipped, VB5-compatible).
Public Function Replicate06(ByVal Number&, Pattern$) As String
' by Donald, donald@xbeat.net, 20001206
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206
'          Replicate04 by G.Beckmann, G.Beckmann@NikoCity.de, 20001206

  Dim LP As Long
  
  If Number > 0 Then
    LP = Len(Pattern)
    If LP Then
      Replicate06 = BStrAPI.SysAllocStringLen(vbNullString, Number * LP)
      Mid$(Replicate06, 1, LP) = Pattern
      If Number > 1 Then
        Mid$(Replicate06, LP + 1) = Replicate06
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments:

top | charts


Replicate07
submitted 06-Dec-2000 by Peter Weighill  
Doping: none
Public Function Replicate07(ByVal Number&, Pattern$) As String
' by Peter Weighill, pweighill@btinternet.com, 20001206
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206
'      and Replicate05 by Donald, donald@xbeat.net, 20001206

  Dim LP As Long

  If Number > 0 Then
    LP = Len(Pattern)
    If LP Then
      Replicate07 = String$(Number * LP, Pattern$)
      If LP > 1 Then
        Mid$(Replicate07, 1, LP) = Pattern
        If Number > 1 Then
          Mid$(Replicate07, LP + 1) = Replicate07
        End If
      End If
    End If
  End If

End Function
Author's comments:
Donald's comments: Geared up for the LP=1 occasion.

top | charts


Replicate08
submitted 06-Dec-2000 by Nick Paldino  
Doping: API
Private Declare Sub CopyMemLng Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
        ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Public Function Replicate08(ByVal Number As Long, ByRef Pattern As String) As String ' by Nick Paldino, nicholas.paldino@exisconsulting.com, 20001206, rev 001 20011123 ' Only Replicate if there is a desire to Replicate ' (the number of times is greater than zero). If (Number > 0) Then ' Get the length of the string (in bytes). Dim plngPatternLength As Long plngPatternLength = LenB(Pattern) ' Allocate the length of the string. Replicate08 = Space$(Number * Len(Pattern)) ''was: Replicate08 = Space(Number * Len(Pattern)) ' Store the bytes copied, as well as the bytes left. The current number of bytes left ' is the length of the string in bytes. Dim plngBytesCopied As Long, plngBytesLeft As Long plngBytesLeft = LenB(Replicate08) ' The pointer to the beginning of the source string, and the destination string. ' Also store a pointer to the beginning of the replicated string. This is where the ' already replicated string lies. Dim plngSourcePointer As Long, plngDestPointer As Long, plngOriginalDestPointer As Long plngSourcePointer = StrPtr(Pattern) plngOriginalDestPointer = StrPtr(Replicate08) plngDestPointer = plngOriginalDestPointer ' Copy the first section. CopyMemLng plngDestPointer, plngSourcePointer, plngPatternLength ' Increment and decrement for the first copy. plngBytesLeft = plngBytesLeft - plngPatternLength plngBytesCopied = plngPatternLength plngDestPointer = plngDestPointer + plngPatternLength ' Loop Do While (plngBytesCopied < plngBytesLeft) ' Copy the number of characters copied into the buffer at the next available space. CopyMemLng plngDestPointer, plngOriginalDestPointer, plngBytesCopied ' Reduce the characters left. plngBytesLeft = plngBytesLeft - plngBytesCopied ' Increment the destination pointer. plngDestPointer = plngDestPointer + plngBytesCopied ' Double the bytes copied. plngBytesCopied = plngBytesCopied * 2 Loop ' Copy for the last time. CopyMemLng plngDestPointer, plngOriginalDestPointer, plngBytesLeft End If ' That's all folks. End Function
Author's comments:
Donald's comments: A large step for a programmer, a small step for the CPU ...

top | charts


Replicate09
submitted 10-Sep-2001 by Mike Peterson  
Doping: API
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function Replicate09(ByVal lNumber&, sPattern$) As String ' by Mike Peterson, mpeterson1200@yahoo.com, 20010910 '****************************************************************************** 'Replication Function By: Mike Peterson 'Approach: Use CopyMemory API in exponential increments, using recursion to handle (lNumber <> 2^n) 'Note: This function is fastest when lNumber is a power of 2. '****************************************************************************** If lNumber > 0 Then Dim i&, lPointer&, LP& 'Allocate String Buffer LP = Len(sPattern) Replicate09 = Space$(LP * lNumber) 'Do first CopyMem CopyMemory ByVal StrPtr(Replicate09), ByVal StrPtr(sPattern), LP * 2 '** Unicode=2 bytes lPointer = LP * 2: i = 1 'Count how many times we 've CopyMem'd 'Here comes my new approach......... 'CopyMem to buffer exponentially!!! While (2 ^ i) <= lNumber CopyMemory ByVal StrPtr(Replicate09) + lPointer, ByVal StrPtr(Replicate09), lPointer lPointer = lPointer + lPointer: i = i + 1 Wend i = i - 1 'If lNumber was not a power of 2, we'll have to recursively catch the rest. If (2 ^ i) <> lNumber Then Dim s$ s = Replicate09(lNumber - (2 ^ i), sPattern) 'Recursion... 'Last CopyMem CopyMemory ByVal StrPtr(Replicate09) + lPointer, ByVal StrPtr(s), LenB(s) End If End If End Function
Author's comments:
Donald's comments:

top | charts


Replicate10
submitted 27-May-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate11
submitted 27-May-2002 by Donald Lessau  
Doping: API, TLB (cf. Dope'n'Declarations)
Public Function Replicate11(ByVal Number As Long, ByRef Pattern As String) As String
' by Donald, donald@xbeat.net, 20020527
' flexible strategy approach
' partly based on Replicate08 by Nick Paldino
  Dim lenPattern As Long
  Dim ptrSrc As Long
  Dim ptrDst As Long

  If Number > 0 Then
    lenPattern = Len(Pattern)
    Select Case lenPattern
    Case 0
    Case 1
      ' good call 4: Replicate(10000, "a")
      Replicate11 = String$(Number, Pattern)
    Case Is < 256 '256 is just an arbitrary limit
      ' good call 1: Replicate(10, "abc")
      ' bad  call 2: Replicate(10000, "abc")
      Replicate11 = FastString.SysAllocStringLen(ByVal 0&, Number * lenPattern)
      Mid$(Replicate11, 1, lenPattern) = Pattern
      If Number > 1 Then
        Mid$(Replicate11, lenPattern + 1) = Replicate11
      End If
    Case Else
      ' good call 3: Replicate(10, "abcdefhgijabcdefhgij...abcdefhgijabcdefhgij" (1000))
      Replicate11 = FastString.SysAllocStringLen(ByVal 0&, Number * lenPattern)
      ptrSrc = StrPtr(Pattern)
      ptrDst = StrPtr(Replicate11)
      lenPattern = lenPattern * 2
      For ptrDst = ptrDst To ptrDst + (Number - 1) * lenPattern Step lenPattern
        CopyMemLng ptrDst, ptrSrc, lenPattern
      Next
    End Select
  End If
End Function
Author's comments:
Donald's comments:

top | charts


Replicate12
submitted 27-May-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
Class-wrapped. The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate13
submitted 10-Jun-2002 by Paul  
Doping: TLB (cf. Dope'n'Declarations)
  [29-Sep-2002] Note that the function fails with patterns containing upper unicode characters, for example Replicate13(1, ChrW$(8364)) will raise run-time error '9'.
Class-wrapped. The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate14
submitted 29-Sep-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
The code fills a rather large module (a single function with 337 lines, including comments, 25KB), have a look here.
Author's comments :
Donald's comments :

top | charts




VBspeed © 2000-10 by Donald Lessau