Concatenar Strings Super Rapido (StringBuilder)

[seba123neo]

aca les paso la clase que yo decia, que es mucho mas rapida que la de vbaccelerator y la que estoy usando actualmente.

Código: [Seleccionar]

Option Explicit
Option Compare Binary

Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Long, src As Long, ByVal nBytes&)
Private Declare Function SysAllocStringByteLen& Lib "oleaut32" (ByVal oleStr&, ByVal BLen&)

Private plngStringLen As Long
Private plngBufferLen As Long
Private pstrBuffer As String

Public Sub Append(Text As String)
  Dim lngText As Long
  Dim strTemp As String
  Dim lngVPointr As Long
 
  lngText = LenB(Text) \ 2&

  If lngText > 0& Then
    If (plngStringLen + lngText) > plngBufferLen Then
      plngBufferLen = (plngStringLen + lngText) * 2&
     
      '*** alternative strTemp = Space$(plngBufferLen)
      RtlMoveMemory ByVal VarPtr(strTemp), SysAllocStringByteLen(0&, plngBufferLen + plngBufferLen), 4&
      'strTemp = AllocString04(plngBufferLen)
     
      '*** alternative Mid$(strTemp, 1&) = pstrBuffer
      RtlMoveMemory ByVal (StrPtr(strTemp)), ByVal (StrPtr(pstrBuffer)), LenB(pstrBuffer)

      '*** alternative pstrBuffer = strTemp
      '*** (switch pointers)
      lngVPointr = StrPtr(pstrBuffer)
      RtlMoveMemory ByVal VarPtr(pstrBuffer), ByVal VarPtr(strTemp), 4&
      RtlMoveMemory ByVal VarPtr(strTemp), lngVPointr, 4&

      Debug.Print "plngBufferLen: " & plngBufferLen
    End If

    '*** Alternative Mid$(pstrBuffer, plngStringLen + 1&) = Text
    RtlMoveMemory ByVal (StrPtr(pstrBuffer) + plngStringLen + plngStringLen), _
                  ByVal (StrPtr(Text)), lngText + lngText
   
    plngStringLen = plngStringLen + lngText
  End If
End Sub

Public Function Value() As String
  '*** alternative Value = Left$(pstrBuffer, plngStringLen)
  RtlMoveMemory ByVal VarPtr(Value), SysAllocStringByteLen(0&, plngStringLen + plngStringLen), 4&
  RtlMoveMemory ByVal (StrPtr(Value)), _
                ByVal (StrPtr(pstrBuffer)), plngStringLen + plngStringLen
End Function

Private Function AllocString04(ByVal lSize As Long) As String
  ' http://www.xbeat.net/vbspeed/
  ' by Jory, jory@joryanick.com, 20011023
  RtlMoveMemory ByVal VarPtr(AllocString04), SysAllocStringByteLen(0&, lSize + lSize), 4&
End Function

Public Sub Clear()
  '*** do not clear the buffer to save allocation time
  '*** if you use the function multiple times
  '*** and you have plenty of RAM.
  plngStringLen = 0&
End Sub

Public Sub ClearBuffer()
  '*** free memory
  plngStringLen = 0&
  plngBufferLen = 0& 'clear the buffer
  pstrBuffer = vbNullString 'clear the buffer
End Sub

Private Sub Class_Initialize()
  '*** paranoid
  ClearBuffer
End Sub
la he comparado compilado con la tuya Psyke1, y es hasta 20 veces mas rapida, en un bucle de 100 mil iteraciones (con una cadena bastante larga) la tuya tarda mas de 2 segundos, mientras esta tarda 0.1 segundos

saludos.

[R@MI]

naaaaaaa....
Lo prouebo y edito

[Psyke1]

@seba123neo
Aún se me ocurre como optimizarla más...
Se agradece que pongas todo esto, ayuda mucho.

EDIT:
Por cierto, creo que no hiciste las pruebas con mi nueva clase, mira, te dejo un test que hice con 100.000 vueltas y una cadena larga.

Un test preciso con CTiming.cls:

Código: (vb) [Seleccionar]

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()
Const LOOPS         As Long = 100000
Dim sTest           As String
Dim cConc           As New cConcatenator
Dim cSBldr          As New cStringBuilder '// Es la nueva clase que pusiste, a pesar de que no cambié el nombre.
Dim t               As New CTiming
Dim x               As Long
Dim s               As String
   
    If App.LogMode = 0 Then End

    sTest = String$(1000, "p")
   
    Me.AutoRedraw = True
    Me.Print "Test adding string"; LOOPS; "times:"

    t.Reset
    For x = 1 To LOOPS
        cSBldr.Append sTest
    Next
    Me.Print "cStringBuilder - ", t.sElapsed
   
    Sleep 100
   
    t.Reset
    For x = 1 To LOOPS
        cConc.AddStr sTest
    Next
    Me.Print "cConcatenator  - ", t.sElapsed
 
Set cSBldr = Nothing
Set cConc = Nothing
Set t = Nothing

End Sub
Compilado, me devuelve esto:


DoEvents!

[R@MI]

me fijo ahora..........

@Psyke1: Usas Win 98?

[seba123neo]

mira he probado ese eejmplo y saltan errores en ambas clases, y tengo todas las clases puestas, salta error en memoria insuficiente, es mejor subir los proyectos en estos casos, yo voy a subir el que probe hoy.

[seba123neo]

aca subi el ejemplo, fijate la diferencia que hay.

http://www.mediafire.com/download.php?ydrkfay0xj67j8e

saludos.

[Psyke1]

Dios mio, esto lo añadiré a mis Expedientes X.

-Descargo el proyecto
-Compilo
-Ejecuto
-Doy primero a el botón cStringBuilder y después al cConcatenator.

Me devuelve esto:


(Resultados similares en pruebas posteriores)

Sería bueno que la gente suba sus pruebas para salir de dudas.
Por cierto, se me acaba de ocurrir una manera un poco más compleja, pero segurísimo mucho más rápida que las expuestas hasta ahora.

DoEvents!

[seba123neo]

es raro, en la otra pc que era un windows xp, dual core, nada raro, la tuyas tarda mas de 2 segundos compilado..pero en serio...

ahora acabo de probar en mi PC que es una I7, con windows 7 64 bits, arroja lo que vos mostras, pero es aleatorio, o sea si apretas varias veces, a veces tarda mas una que la otra, pero basicamente tardan lo mismo.

me gustaria saber si a alguno les pasa que le tarda "segundos" como me paso a mi.

saludos.

[coco]

mi resultado:


probe aproximadamente 20 veces, sin cuelgues...

[raul338]

en el orden de los botones
dual core (de las primeras a 1.6ghz) con 2gb ram

[seba123neo]

raul me podes decir el resultado con el bucle en 1 millon ?

[E N T E R]

De acuerdo al orden del botón



el cConcatenador siempre un promedio de 80.

Win7 64Bits Intel i7 3.06 4 GB de RAM DDR3-2000 Corsair

[coco]

hice otras pruebas, variando la comprobacion de limites del array (en propiedades de compilacion), pero los resultados son muy similares.
tambien probe poner en prioridad tiempo real, y es interesante lo que pasa:


los primeros 2 items, son del primer test, en prioridad normal.
los demases, en prioridad Tiempo Real (el sistema se colgaba hasta que terminase la funcion)

PC: AMD Athlon 5600 x2 2.9GHz, 4GB DDR2 800MHz dual channel, W7 x64

[seba123neo]

coco me podes decir cuanto tarda si pones 1 millon en el bucle ? o sea bajas el ejemplo que subi, le cambias a 1 millon y compilas.

[coco]

@seba:
con el codigo que propones vos (reemplazando el de la clase de psyke), tenemos lo siguiente:
1millon de copias

1861,7903296 <- string builder
4341,2279696 <- concatenator