Alternative Replace & Right Functions

[Swellow]

Hey boys! I wondered if anyone would help coding an alternative Replace and Right functions as they could be/get detected. This is how I'm using them:

Código [Seleccionar] Expandir

strNewFile = Replace(strNewFile, Right(strFilePath, 4), ".txt")

Maybe we can use other functions to do the same thing or we can code alternative functions. I've found an alternative Replace function in my HDD but it uses Mid / Left / InStr so it's not really good.

Código [Seleccionar] Expandir

Function AltReplace(stExpression As String, stFind As String, stReplace As String) As String
Dim lnStart As Long, lnCount As Long
lnStart = Len(stFind)
AltReplace = stExpression
Do
lnCount = InStr(1, AltReplace, stFind)
If lnCount = 0 Then Exit Do
If lnStart = Len(stReplace) Then
     Mid(AltReplace, lnCount, lnStart) = stReplace
Else
     AltReplace = Left$(AltReplace, lnCount - 1) & stReplace & Mid$(AltReplace, lnCount + lnStart)
End If
Loop
End Function

It would be great if you could help coding alternative funcs using bytearray and it must not use any VB function (Len/Chr/Asc/Space are OK)

Thanks A lot !

[BlackZeroX]

Yo primero haria un do loop y CONTARIA cada coherencia con stFind cada offset de dicha coherencia la almacenaría en una cola o algún vector (simulando la cola), después al termino de este  pasaría a crear un buffer y por ultimo un while que copiaría a tramos cada bloque de caracteres: Esto se traduce en velocidad...

OJO: NO SE SI FUNCIONA puesto que lo escribí en el Block de Notas y estoy bajo Linux...

Código (vb) [Seleccionar] Expandir



Function AltReplace(stExpression As String, stFind As String, stReplace As String) As String
Dim offsetDst As long
Dim offsetSrc As long
dim listOffset() As long
dim listOffsetCount as long
dim listOffsetIndex as long
   
   if Len(stFind) == 0 then
       AltReplace = stExpression
       exit function
   end if
   
   '   // Match Count
   offsetSrc = 1
   Do
       offsetSrc = InStr(offsetSrc, stExpression, stFind)
       If lnCount <= offsetSrc Then Exit Do
       redim preserve listOffset(0 to listOffsetCount)
       listOffset(listOffsetCount) = offsetSrc
       listOffsetCount = (listOffsetCount + 1)
       offsetSrc = (offsetSrc + len(stFind))
   Loop
   
   if listOffsetCount == 0 then
       AltReplace = stExpression
       exit function
   end if
   
   '   //  Buffer
   AltReplace = space((stExpression - (Len(stFind) * listOffsetCount)) + (Len(stReplace) * listOffsetCount))
   
   '   // Copiamos por "bloques"
   while not (listOffsetIndex = listOffsetCount)
       if listOffset(listOffsetIndex) > 1 then
           offsetDst = (listOffset(listOffsetIndex - 1) + (len(stReplace) * listOffsetIndex))
           offsetSrc = (listOffset(listOffsetIndex - 1) + (len(stFind) * listOffsetIndex))
           mid$(AltReplace, _
                offsetDst, _
                (offsetDst - listOffset(listOffsetIndex))) = mid$(stExpression, _
                                                                  offsetSrc, _
                                                                  (offsetSrc - (listOffset(listOffsetIndex) - offsetSrc)))
       else
           mid$(AltReplace, 1, listOffset(listOffsetIndex)) = mid$(stExpression, _
                                                                   1, _
                                                                   listOffset(listOffsetIndex))
       end if
       mid$(AltReplace, listOffset(listOffsetIndex), len(stReplace)) = stReplace
       
       listOffsetIndex = (listOffsetIndex + 1)
       
   Wend
   
End Function



* En lugar de usar Mid$() seria bueno usar CopyMemory() o algun For Next, o si no quieres APIS usa mMemoryEx (Busca en el foro)

* Configuración de mMemoryEx y/o mMemory:
http://foro.elhacker.net/programacion_visual_basic/mmemory_writeprocessmemoryvbacopybytesrtlmovememory_replacement_noapi-t343343.0.html

* ejemplo mMemoryEx:
http://foro.elhacker.net/programacion_visual_basic/class_cstack_vb6-t365372.0.html;msg1760659#msg1760659

Código [Seleccionar] Expandir



Option Explicit

Public Const PAGE_EXECUTE_READWRITE As Long = &H40
Public Const PAGE_EXECUTE_WRITECOPY As Long = &H80
Public Const PAGE_EXECUTE_READ As Long = &H20
Public Const PAGE_EXECUTE As Long = &H10
Public Const PAGE_READONLY As Long = 2
Public Const PAGE_WRITECOPY As Long = &H8
Public Const PAGE_NOACCESS As Long = 1
Public Const PAGE_READWRITE As Long = &H4

Declare Function VarPtrArr Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, ByVal lpflOldProtect As Long) As Long

Private bvHack(0)               As Byte
Private lHackDelta              As Long
Private bInitialized            As Boolean

Public Function initialize() As Boolean ' By KarCrack
   On Error GoTo Error_Handle

   bvHack(-1) = bvHack(-1) 'Error check
   lHackDelta = VarPtr(bvHack(0))

   initialize = True
   bInitialized = initialize
   Exit Function
Error_Handle:
   If Err.Number = 9 Then Debug.Print "Remember to tick 'Remove array boundary check' and compile before using"
'    End
End Function

Public Function getByte(ByVal lptr As Long) As Byte ' By KarCrack
   If bInitialized Then getByte = bvHack(lptr - lHackDelta)
End Function

Public Function getWord(ByVal lptr As Long) As Integer ' By KarCrack
   If bInitialized Then getWord = makeWord(getByte(lptr + &H0), getByte(lptr + &H1))
End Function

Public Function getDWord(ByVal lptr As Long) As Long ' By KarCrack
   If bInitialized Then getDWord = makeDWord(getWord(lptr + &H0), getWord(lptr + &H2))
End Function

Public Sub putByte(ByVal lptr As Long, ByVal bByte As Byte) ' By KarCrack
   If bInitialized Then bvHack(lptr - lHackDelta) = bByte
End Sub

Public Sub putWord(ByVal lptr As Long, ByVal iWord As Integer) ' By KarCrack
   If bInitialized Then Call putByte(lptr + &H0, iWord And &HFF): Call putByte(lptr + &H1, (iWord And &HFF00&) / &H100)
End Sub

Public Sub putDWord(ByVal lptr As Long, ByVal lDWord As Long) ' By KarCrack
   If bInitialized Then Call putWord(lptr + &H0, IIf(lDWord And &H8000&, lDWord Or &HFFFF0000, lDWord And &HFFFF&)): Call putWord(lptr + &H2, (lDWord And &HFFFF0000) / &H10000)
End Sub

Public Function makeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long '[http://www.xbeat.net/vbspeed/c_MakeDWord.htm#MakeDWord05]
   makeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function

'   //  Funciones agregadas...

Function makeWord(ByVal lByte As Byte, ByVal hByte As Byte) As Integer ' By BlackZeroX
   makeWord = (((hByte And &H7F) * &H100&) Or lByte)
   If hByte And &H80 Then makeWord = makeWord Or &H8000
End Function

'/////////////////////
Public Function allocMem(ByVal lSize As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  Retorna la Dirrecion de un SafeArray.
Dim pBuff()     As Byte
   If (lSize <= &H0) Then Exit Function
   ReDim pBuff(0 To (lSize - 1))
   allocMem = getDWord(VarPtrArr(pBuff))
   putDWord VarPtrArr(pBuff), 0
End Function

Public Function reallocMem(ByVal lptr As Long, ByVal lSize As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  Retorna la Dirrecion de un SafeArray que se retorno en allocMem()/reallocMem().
Dim pBuff()     As Byte
   putDWord VarPtrArr(pBuff), lptr
   If Not (lSize = &H0) Then
       ReDim Preserve pBuff(0 To (lSize - 1))
   Else
       Erase pBuff
   End If
   reallocMem = getDWord(VarPtrArr(pBuff))
   putDWord VarPtrArr(pBuff), 0
End Function

Public Function getMemData(ByVal lptr As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  lPtr debe ser el valor (Address) que retorno en allocMem()/reallocMem().
'   //  Esta funcion retorna la Dirrecion de memoria EDITABLE de lPtr (Dirrecion de un SafeArray).
'   //  Referencias.
'   //  http://msdn.microsoft.com/en-us/library/aa908603.aspx
   If (lptr = &H0) Then Exit Function
   getMemData = getDWord(lptr + &HC)    '   //  obtenemos pvData
End Function

Public Sub releaseMem(ByVal lptr As Long)
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  lPtr debe ser la Dirrecion que retorno en allocMem()/reallocMem().
Dim pBuff()     As Byte
   putDWord VarPtrArr(pBuff), lptr
End Sub

Public Sub releaseMemStr(ByVal lptr As Long)
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  lPtr debe ser la Dirrecion que retorno en cloneString().
Dim sStr        As String
   putDWord VarPtr(sStr), lptr
End Sub

Public Sub swapVarPtr(ByVal lpVar1 As Long, ByVal lpVar2 As Long)
'   //  By BlackZeroX (Thanks to Karcrack).
Dim lAux    As Long
   lAux = getDWord(lpVar1)
   Call putDWord(lpVar1, getDWord(lpVar2))
   Call putDWord(lpVar2, lAux)
End Sub

Public Function cloneString(ByVal lpStrDst As Long, ByVal sStrSrc As String) As Long
'   //  By BlackZeroX (Thanks to Karcrack).
'   //  lPtr -> Puntero a una variable destino (Preferiblemente String).
'   //  sStr -> Cadena Clonada ( gracias a Byval ).
Dim lpStrSrc        As Long
   If Not (lpStrDst = &H0) And (mMemoryEx.initialize = True) Then
       Call mMemoryEx.swapVarPtr(lpStrDst, VarPtr(sStrSrc))
       Call mMemoryEx.swapVarPtr(VarPtr(cloneString), VarPtr(sStrSrc))
   End If
End Function

Public Function copyMemory(ByVal lpDst As Long, ByVal lpSrc As Long, ByVal lLn As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack).
Dim i       As Long
   If (lpSrc = &H0) Or (lpDst = &H0) Or (lLn = &H0) Then Exit Function
 
   i = (lLn Mod 4)
   If ((i And &H2) = &H2) Then
       Call putWord(lpDst, getWord(lpSrc))
       lpDst = (lpDst + 2)
       lpSrc = (lpSrc + 2)
       copyMemory = (copyMemory + 2)
       lLn = (lLn - 2)
   End If
   If ((i And &H1) = &H1) Then
       Call putByte(lpDst, getByte(lpSrc))
       lpDst = (lpDst + 1)
       lpSrc = (lpSrc + 1)
       copyMemory = (copyMemory + 1)
       lLn = (lLn - 1)
   End If
   For i = 0 To (lLn - 1) Step 4
       Call putDWord(lpDst + i, getDWord(lpSrc + i))
   Next
   copyMemory = (copyMemory + lLn)
 
End Function



Dulces Lunas!¡.

[Swellow]

Thanks for your help mate!! Ive tried your code and it seems to work perfectly! The only problem is that the code is pretty big but thats not big problem (if u can reduce its awesome). I don't know how to work with that mMemory so it would be awesome if you could help coding that Mid alt. Ive already done one with my friend sometimes ago i'll try to find it back but as I remember it wasn't working perfectly..

Also, if you could remove InStr and Space would be great..

[BlackZeroX]

Como dije ya no trabajo con vb6, las funciones que quieras reemplazar te tocaran codificarlas usando de For next y los if then primero fíjate como trabajan (Objetivo de la función) y después re-créala no es difícil.

Dulces Lunas!¡.

[BlackZeroX]

mmm ya que recuerdo tengo unos algoritmos en C ( Son cuando estaba aprendiendo dicho lenguaje ya de lleno ).
http://foro.elhacker.net/programacion_cc/ansi_c_split_strlen_mid_instr_strcpy-t316599.0.html

Muchas alternativas ya creadas por varios usuarios de este foro (Nos dio por hacer "retos")...
http://foro.elhacker.net/programacion_visual_basic/recopilacion_de_retos_vbclassic_por_79137913-t360748.0.html

P.D.: Revisa los temas con chincheta (Pegados).

Dulces Lunas!¡.

[Swellow]

Ive just tried your code again and it doesnt work infact..

Código [Seleccionar] Expandir

AltReplace(AltReplace("GetTheFuckOutOfThere", "Fuck", "Puss"), "OutOf", "In")

Your code looks good, I would only need the code fixed and Mid removed. Ive found InStr alt on the link you gave and it works fine. Sorry I'm not that good in spanish can't understand everything you said..

[Swellow]

So people? Nobody able to code Alternative functions? :/