Вопрос по функции CopyMemory

[VazNik]

Help! A need somebody...

Люди, подскажите, пожалуйста, что я делаю не так в этой вот функции (нечто вроде Mid$ и Replace в одном флаконе):

' Описание функции в модуле Main():
'Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
'        (pDest As Any, pSource As Any, ByVal ByteLen As Long)
' 32-символьная строка:
'Const sTablIdent As String = "0123456789ABCDEFGHIJKLMNOPQRSTUV"
'  Dim dTheartyTwo As Double
'  Dim lTwo As Long
'  lTwo = 2&
'  dTheartyTwo = 32#
Private Function IdentToStr(dPar As Double) As String
  Dim d1 As Double, d2 As Double
  Dim i As Integer, i1 As Integer
  Dim sWork As String
  Dim lAdrStr1 As Long, lAdrStr2 As Long, lOffSet1 As Long, lOffSet2 As Long
  sWork = Space(15)
  lAdrStr1 = StrPtr(sWork)
  lOffSet1 = 31&
  lAdrStr2 = StrPtr(sTablIdent)
  d1 = dPar
  For i = 1 To 15
    d2 = Int(d1 / dTheartyTwo)
    i1 = CInt(d1 - d2 * dTheartyTwo) + 1
    lOffSet2 = CLng(d1 - d2 * dTheartyTwo) * lTwo
    lOffSet1 = lOffSet1 - lTwo
    lAdrStr1 = lAdrStr1 + lOffSet1
    lAdrStr2 = lAdrStr2 + lOffSet2
    CopyMemory ByVal lAdrStr1, ByVal lAdrStr2, lTwo
    d1 = d2
  Next
Debug.Print "IdentToStr-dPar=" + Str(dPar)
Debug.Print "IdentToStr-sWork" + sWork
  IdentToStr = sWork
End Function
' Debug.Print выдает:  IdentToStr-dPar= <число>
'                      IdentToStr-Swork= <строка пробелов вместо нужной>

На выходе - та же сторка пробелов вместо нужной выборки из строки sTablIdent.

[leo]

    'lAdrStr1 = lAdrStr1 + lOffSet1 !!! адрес строки не должен изменяться
    'lAdrStr2 = lAdrStr2 + lOffSet2 !!!
    CopyMemory ByVal (lAdrStr1 + lOffSet1), ByVal (lAdrStr2 + lOffSet2), lTwo

[VazNik]

2 Ieo
Спасибо за подсказку! Как будто пелена с глаз упала... Заодно увидел и еще одну свою ошибку: lOffSet1 = 31& , а надо 30&...
Задача-то легко решаемая в функциях самого VB:

sWork = Space(0)
.  .  .  .
sWork = Mid$(sTablIdent, i1, 1) + sWork

Но когда формируешь таким образом более полутора миллионов строк, то начинаешь выгадывать каждую секунду.

Мой дед говорит:"Делай добро и бросай его в воду. Тогда оно само к тебе вернется."

[SCINER]

быстрый способ без CopyMemory

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Sub Form_Load()
  
  Dim Tmp As String
  Dim Buff As String
  Dim T As Long
  Dim i As Long
  Dim lPos As Long
  Dim dwLen As Long
  
  Me.AutoRedraw = True
 
  T = GetTickCount
  Buff = VBA.Space$(100)
  lPos = 1
 
  For i = 0 To 10000
    dwLen = 32
    Tmp = VBA.String(dwLen, "z")
    
    'быстрый способ
    If lPos + dwLen > Len(Buff) Then
      Buff = Buff & VBA.Space$(Len(Buff) + dwLen)
    End If
    Mid$(Buff, lPos, dwLen) = Tmp
 
    'обычная контакенация
    'Buff = Buff & Tmp
 
    lPos = lPos + dwLen
  Next
  
  Buff = VBA.Left$(Buff, lPos)
 
  T = GetTickCount - T
  Print VBA.Format$(T / 1000, "0.000")
 
  Print FormatNumber(Len(Buff), 0) & " == " & FormatNumber(lPos, 0)
 
End Sub