StrConv Alternative Function

[Swellow]

Hola amigos!

Does anyone could help me fixing this function? It works but fails with unicode chars.... Here it is:

Código [Seleccionar] Expandir

Public Function AltStrConv(Temp As Variant, Conversion As VbStrConv) As Variant
Dim i As Long, lLen As Long, bvHack(0) As Byte, lHackDelta As Long
Dim bArr() As Byte, sString As String

lHackDelta = VarPtr(bvHack(0))

If Conversion = vbFromUnicode Then
   sString = Temp
   lLen = Len(sString)
   ReDim bArr(0 To lLen - 1)
   For i = 0 To lLen - 1
       bvHack(VarPtr(bArr(0)) - lHackDelta + i) = bvHack(StrPtr(sString) - lHackDelta + (i * 2))
   Next i
   AltStrConv = bArr
ElseIf Conversion = vbUnicode Then
   bArr = Temp
   lLen = UBound(Temp) + 1
   sString = Space$(lLen)
   For i = 0 To lLen - 1
       bvHack(StrPtr(sString) - lHackDelta + (i * 2)) = bvHack(VarPtr(bArr(0)) - lHackDelta + i)
   Next i
   AltStrConv = sString
End If

End Function

Thanks A lot!

[Danyfirex]

aquí te la dejo como se me ocurrió. 

Código (vb) [Seleccionar] Expandir

Private Function AltStrConv(Temp As Variant, Conversion As VbStrConv) As Variant
Dim i As Long, lLen As Long
Dim bArr() As Byte, sString As String



If Conversion = vbFromUnicode Then
    sString = Temp
    lLen = Len(sString) - 1
    ReDim bArr(lLen)
    For i = 0 To lLen
       bArr(i) = Asc(Mid(Temp, (i + 1), 1))
       Next i
    AltStrConv = bArr
   
ElseIf Conversion = vbUnicode Then
    bArr = Temp
    lLen = UBound(Temp)
    sString = Space$(lLen + 1)
    For i = 0 To lLen
    sString = sString & Chr(bArr(i))
    Next i
    AltStrConv = sString
End If

End Function



saludos

[Swellow]

aquí te la dejo como se me ocurrió. 

Código (vb) [Seleccionar] Expandir

Private Function AltStrConv(Temp As Variant, Conversion As VbStrConv) As Variant
Dim i As Long, lLen As Long
Dim bArr() As Byte, sString As String



If Conversion = vbFromUnicode Then
    sString = Temp
    lLen = Len(sString) - 1
    ReDim bArr(lLen)
    For i = 0 To lLen
       bArr(i) = Asc(Mid(Temp, (i + 1), 1))
       Next i
    AltStrConv = bArr
   
ElseIf Conversion = vbUnicode Then
    bArr = Temp
    lLen = UBound(Temp)
    sString = Space$(lLen + 1)
    For i = 0 To lLen
    sString = sString & Chr(bArr(i))
    Next i
    AltStrConv = sString
End If

End Function



saludos

Yeah I know this one but it uses Asc/Mid/Space/Chr and this is not good, if anyone can mod it without using Mid at least. Thanks

[Danyfirex]

maybe using copymemory. Tomorrow I'll try to make something. 

[Karcrack]

I made a post in HH time ago where I put all the different methods I found... Ofc HH is down so I can't paste them here... Anyway I throw some ideas: MultiByteToWideChar() and __vbaStrToUnicode()...

@Danyfirex: Working with memory is the same as using the "bvHack()" thingy.

[Swellow]

I made a post in HH time ago where I put all the different methods I found... Ofc HH is down so I can't paste them here... Anyway I throw some ideas: MultiByteToWideChar() and __vbaStrToUnicode()...

@Danyfirex: Working with memory is the same as using the "bvHack()" thingy.

It's no problem if it use memory (bvHack) but do not use APIs..

[Danyfirex]

I made a post in HH time ago where I put all the different methods I found... Ofc HH is down so I can't paste them here... Anyway I throw some ideas: MultiByteToWideChar() and __vbaStrToUnicode()...



@Danyfirex: Working with memory is the same as using the "bvHack()" thingy.

si ya veo, es que no recordaba ese tema.

voy a mirar con bvHack().

[Danyfirex]

well before reading about Karcrack says , I notice that is necesary to remove array bounds checks and try out of Visual Basic IDE, it means Compiled, And work Correctly.

try it.

[Swellow]

well before reading about Karcrack says , I notice that is necesary to remove array bounds checks and try out of Visual Basic IDE, it means Compiled, And work Correctly.

try it.

Yes I already checked that but It's not the problem, the function works but fails with unicode chars, try using it on this function and then try encrypting a string you will realize that it does not work...

Código [Seleccionar] Expandir

Function ROTXDecrypt(ByVal strData As String, ByVal strKey As String)
    On Error Resume Next
    Dim bData() As Byte, bKey() As Byte
    bData = AltStrConv(strData, vbFromUnicode)
    bKey = AltStrConv(strKey, vbFromUnicode)
    For i = 0 To UBound(bData)
        If i <= UBound(bKey) Then
            bData(i) = bData(i) - bKey(i)
        Else
            bData(i) = bData(i) - bKey(i Mod UBound(bKey))
        End If
    Next i
    ROTXDecrypt = AltStrConv(bData, vbUnicode)
End Function

Function ROTXEncrypt(ByVal strData As String, ByVal strKey As String)
    On Error Resume Next
    Dim bData() As Byte
    Dim bKey() As Byte
    bData = StrConv(strData, vbFromUnicode)
    bKey = StrConv(strKey, vbFromUnicode)
    For i = 0 To UBound(bData)
        If i <= UBound(bKey) Then
            bData(i) = bData(i) + bKey(i)
        Else
            bData(i) = bData(i) + bKey(i Mod UBound(bKey))
        End If
    Next i
    ROTXEncrypt = StrConv(bData, vbUnicode)
End Function

[Danyfirex]

Maybe you're trying before compiling. because If you're running into vb IDE doesn't work. but if you compile work correctly. at least for me work correclty.