Hola amigos!
Does anyone could help me fixing this function? It works but fails with unicode chars.... Here it is:
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!
aquí te la dejo como se me ocurrió. ;D
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
Cita de: Danyfirex en 7 Octubre 2012, 22:09 PM
aquí te la dejo como se me ocurrió. ;D
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
maybe using copymemory. Tomorrow I'll try to make something. :)
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.
Cita de: Karcrack en 8 Octubre 2012, 13:51 PM
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..
Cita de: Karcrack en 8 Octubre 2012, 13:51 PM
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().
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.
(http://www.techrepublic.com/i/tr/cms/contentPics/u00220020311adm02_01.gif)
Cita de: Danyfirex en 8 Octubre 2012, 17:38 PM
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.
(http://www.techrepublic.com/i/tr/cms/contentPics/u00220020311adm02_01.gif)
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...
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
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.
Cita de: Danyfirex en 8 Octubre 2012, 18:07 PM
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.
Did you try using the StrConv alt I posted with the ROTXDecrypt? I do use Karcrack's memory funcs since a while now and I can tell you that the problem is not because of what you think. Just encrypt a string with ROTXEncrypt then use StrConv Alternative on the decrypt function and see if it gives a result, it won't... Now use StrConv normal and it'll work, that is because the Alt function does not work with unicode chars.
Put some example that doesn't work to you, I don't got it :huh:
I'm trying this and work correctly
Dim str As String
Dim str2 As String
'Dim str3() As Byte
str = ROTXEncrypt("Work", "pass")
MsgBox (str)
MsgBox (ROTXDecrypt(str, "pass"))
Ok try this and make sure to compile:
http://www.xup.in/dl,15300297/Desktop.rar/ (http://www.xup.in/dl,15300297/Desktop.rar/)
for me it doesn't work with alternative "AltStrConv" neither StrConv.
now I have to go out. I'll come back later.
Paste the ROTxEncrypt() function please.
Cita de: Karcrack en 9 Octubre 2012, 00:32 AM
Paste the ROTxEncrypt() function please.
Es esta:
Private Sub Form_Load()
Dim str As String
Dim str2 As String
str = ROTXEncrypt("-978ç___#{~#{~#'é(-è", "pass")
MsgBox (str)
MsgBox (ROTXDecrypt(str, "pass"))
End Sub
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
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
Some chars cannot be encrypted using ROTX cause it is a poor encryption but u can see a big difference when u decrypt using original StrConv and AltStrConv... This is because it doesnt support unicode chars, Karcrack I count on you :P
Remove "On error resume next" and learn to debug your own codes. You are getting overflow.
Cita de: Karcrack en 9 Octubre 2012, 14:24 PM
Remove "On error resume next" and learn to debug your own codes. You are getting overflow.
Yeah now use StrConv normal you won't get overflow.
Cita de: Swellow en 9 Octubre 2012, 14:27 PM
Yeah now use StrConv normal you won't get overflow.
False.
On ROTXEncrypt yes but that's no problem, just use On Error Resume Next but remove it on ROTXDecrypt you won't get overflow, then use AltStrConv and u will get overflow..
the error is byte array are in range 0 y 255. so ROTXEncrypt try to put over 255 making overflow. so, for that Can't Encrypt/Decrypt extended character over chr(143).
Cita de: Danyfirex en 9 Octubre 2012, 18:28 PM
the error is byte array are in range 0 y 255. so ROTXEncrypt try to put over 255 making overflow. so, for that Can't Encrypt/Decrypt extended character over chr(143).
I can tell you that the problem does not come from the encryption, I'm using it since a long time. Nobody enough skilled to fix this Alt StrConv func dude? :(
Hello mate! :D
I've done this function some years ago, I don't know if it works... actually, I don't remember if it came to work. :silbar:
I can't test it because in this PC I have only installed Ubuntu... :-\
Option Explicit
'// kernel32.dll
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
'// Const
Private Const CP_UTF8 As Long = &HFDE9 '65001
'// Enum
Public Enum CONV_TYPE
Unicode = vbUnicode
UTF8 = vbFromUnicode
End Enum
'// Function
Public Function StrConversion(ByRef vEntry As Variant, eConv As CONV_TYPE) As Variant
Dim lRet As Long
Dim lLen As Long
Dim lBuffer As Long
Dim sBuffer As String
Dim bvOutput() As Byte
On Error GoTo Exit_
If eConv = Unicode Then
lLen = LenB(vEntry) \ 2
If lLen Then
lBuffer = lLen + lLen + lLen + 1
ReDim bvOutput(lBuffer - 1) As Byte
lRet = WideCharToMultiByte(CP_UTF8, 0, StrPtr(vEntry), lLen, bvOutput(0), lBuffer, vbNullString, 0)
If lRet Then
ReDim Preserve bvOutput(lRet - 1) As Byte
StrConversion = bvOutput
End If
End If
Else
lLen = UBound(vEntry) + 1
If lLen > 1 Then
lBuffer = lLen + lLen
sBuffer = Space$(lBuffer)
lRet = MultiByteToWideChar(CP_UTF8, 0, vEntry(0), lLen, StrPtr(sBuffer), lBuffer)
If lRet Then
StrConversion = Left$(sBuffer, lRet)
End If
End If
End If
Exit_:
End Function
I hope it works, or at least it helps you to make your own function.
Good luck! ;)
DoEvents! :P
@Psyke1
Thanks for this mate I'll try it tonight but it use two APIs which is not a good thing, possible to remove/replace them?
Cita de: Swellow en 12 Octubre 2012, 16:07 PM
Thanks for this mate I'll try it tonight but it use two APIs which is not a good thing, possible to remove/replace them?
Yes I think it's possible. :rolleyes:
May be loading an array of the unicode numbers and using
CharUpperBuffW() and
CharUpperBuffA() apis.
Here are some examples:
vbspeed (http://www.xbeat.net/vbspeed/).
DoEvents! :P
Cita de: Swellow en 12 Octubre 2012, 14:06 PM
I can tell you that the problem does not come from the encryption, I'm using it since a long time. Nobody enough skilled to fix this Alt StrConv func dude? :(
I'm sure yes.
Cita de: Psyke1 en 12 Octubre 2012, 17:49 PM
Yes I think it's possible. :rolleyes:
May be loading an array of the unicode numbers and using CharUpperBuffW() and CharUpperBuffA() apis.
Here are some examples: vbspeed (http://www.xbeat.net/vbspeed/).
DoEvents! :P
I've tried your alternative function and it doesn't work, dunno what part is wrong...
Cita de: Danyfirex en 12 Octubre 2012, 17:50 PM
I'm sure yes.
You sure it's from the encryption? Well, in another project I'm using hamavb's StrConv alternative which use MSVBVM60 APIs and the encryption works perfectly with it... The problem comes from the AltStrConv, even author said that there were a problem with unicode characters but I never found a fix...