Skip to content
Permalink
Browse files

UTF8Encode/Decode calls better mirror each other; StringToByteArr and…

… ByteArrToString to wrap locale-neutral conversions

* Fix numerous bugs with the "locale update" from before, including
  check revision not passing an NT string correctly to DLL.
* Sending and receiving of UTF-8 encoded text in "user text" fields of
  the protocol such as chat messages, user profiles, and game names are
  now more thoroughly encoded/decoded as per the Settings menu item.
* Also, remove a bunch of unused code in modParsing.
  • Loading branch information...
nmbook committed Mar 5, 2017
1 parent bd3ed1e commit 7614ff5dfae9483b6e9109bd207c8fc211ff6bff
@@ -45,15 +45,15 @@ Public Property Let Data(ByVal str As String)
If LenB(str) = 0 Then
Call Clear
Else
Call SetDataAsByteArr(StrConv(str, vbFromUnicode, 1033))
Call SetDataAsByteArr(StringToByteArr(str))
End If
End Property

Public Property Get Data() As String
If m_bufsize = 0 Then
Data = vbNullString
Else
Data = StrConv(GetDataAsByteArr(), vbUnicode, 1033)
Data = ByteArrToString(GetDataAsByteArr())
End If
End Property

@@ -101,7 +101,7 @@ End Function

Public Function InsertByteArr(ByRef Data() As Byte)
' resize buffer
ReDim Preserve m_buf(0 To (m_bufsize + (UBound(Data) + 1)))
ReDim Preserve m_buf(0 To (m_bufsize + (UBound(Data) + 2)))

' copy data to buffer
CopyMemory m_buf(m_bufsize), Data(0), (UBound(Data) + 1)
@@ -212,7 +212,7 @@ End Function
Public Function InsertNonNTString(ByVal Data As String)
Dim arrStr() As Byte

arrStr() = StrConv(Data, vbFromUnicode, 1033)
arrStr() = StringToByteArr(Data)

' resize buffer
ReDim Preserve m_buf(0 To (m_bufsize + UBound(arrStr) + 1))
@@ -231,25 +231,28 @@ Public Function InsertNTString(ByRef Data As String, _

Select Case (Encoding)
Case STRINGENCODING.ANSI
arrStr() = StrConv(Data, vbFromUnicode, 1033)
' convert from Unicode (VB6 string) to Byte()
arrStr() = StringToNTByteArr(Data)

Case STRINGENCODING.UTF8
' encode result as Unicode (encoded in UTF-8)
arrStr() = modUTF8.UTF8Encode(Data)

Case STRINGENCODING.UTF16
arrStr() = StrConv(Data, vbUnicode, 1033)
' use Unicode (VB6 string) as-is
arrStr() = Data
End Select

' resize buffer and include terminating null character
ReDim Preserve m_buf(0 To (m_bufsize + (UBound(arrStr) + 2)))
ReDim Preserve m_buf(0 To (m_bufsize + (UBound(arrStr) + 1)))

' copy data to buffer
If (Data <> vbNullString) Then
If (LenB(Data) > 0) Then
CopyMemory m_buf(m_bufsize), arrStr(0), (UBound(arrStr) + 1)
End If

' store buffer Length
m_bufsize = (m_bufsize + (UBound(arrStr) + 2))
m_bufsize = (m_bufsize + (UBound(arrStr) + 1))
End Function

Public Function GetString(Optional ByVal Encoding As STRINGENCODING = STRINGENCODING.ANSI, Optional Peek As Boolean = False) As String
@@ -262,27 +265,30 @@ Public Function GetString(Optional ByVal Encoding As STRINGENCODING = STRINGENCO
End If
Next i

' resize buffer and include terminating null character
ReDim arrStr(0 To i - m_bufpos)
If i = m_bufpos Then
GetString = vbNullString
If (Not Peek) Then m_bufpos = m_bufpos + 1
Exit Function
End If

' resize buffer and exclude terminating null character
ReDim arrStr(0 To i - m_bufpos - 1)

If (i < m_bufsize) Then
GetString = String$(i - m_bufpos, Chr$(0))

' copy data to buffer
CopyMemory arrStr(0), m_buf(m_bufpos), i - m_bufpos

If (Not Peek) Then m_bufpos = i + 1
End If

Select Case (Encoding)
Case STRINGENCODING.ANSI, STRINGENCODING.UTF8
' convert from CURRENT CODE PAGE to Unicode (VB6 string)
GetString = StrConv(arrStr(), vbUnicode, 1033)
GetString = KillNull(GetString)
Case STRINGENCODING.ANSI
' convert from Byte() to Unicode (VB6 string)
GetString = ByteArrToString(arrStr())

'Case STRINGENCODING.UTF8
Case STRINGENCODING.UTF8
' decode result as Unicode (encoded in UTF-8)
'GetString = UTF8Decode(arrStr())
GetString = modUTF8.UTF8Decode(arrStr())

Case STRINGENCODING.UTF16
' use Unicode (VB6 string) as-is
@@ -304,13 +310,13 @@ Public Function GetRaw(Optional ByVal length As Integer = -1, Optional Peek As B

GetRaw = String$(length, Chr$(0))

' resize buffer and include terminating null character
' resize buffer
ReDim arrStr(0 To length - 1)

' copy data to buffer
CopyMemory arrStr(0), m_buf(m_bufpos), length

GetRaw = StrConv(arrStr(), vbUnicode, 1033)
GetRaw = ByteArrToString(arrStr())

If (Not Peek) Then m_bufpos = m_bufpos + length
End Function ' end function GetString
@@ -77,7 +77,7 @@ Public Sub ParsePacket(ByVal PacketID As Long, ByVal pBuff As clsDataBuffer)
End If

' Location name
.Location = pBuff.GetString()
.Location = pBuff.GetString(UTF8)
End With

' Add to the internal list
@@ -118,7 +118,7 @@ Public Sub ParsePacket(ByVal PacketID As Long, ByVal pBuff As clsDataBuffer)
'End If

' Location name
.Location = pBuff.GetString()
.Location = pBuff.GetString(UTF8)

RaiseEvent FriendUpdate(.DisplayName, n)
End With
@@ -145,7 +145,7 @@ Public Sub ParsePacket(ByVal PacketID As Long, ByVal pBuff As clsDataBuffer)
End If

' Location name
.Location = pBuff.GetString()
.Location = pBuff.GetString(UTF8)

RaiseEvent FriendAdded(.DisplayName, .Game, .LocationID, .Status, .Location)
End With
@@ -58,7 +58,7 @@ Private Declare Function kd_isValid Lib "BNCSutil.dll" _
Private Declare Sub calcHashBuf Lib "BNCSutil.dll" _
(ByVal Data As Long, ByVal length As Long, ByVal Hash As Long)


Private m_ProductLookup As Dictionary

Private m_Result As Long ' The result of the decoder initialization
@@ -125,7 +125,7 @@ Public Property Get PrivateValue() As String
Call CopyMemory(arrStr(0), kd_val2(m_Handle), 4)
End If

sBuffer = StrConv(arrStr(), vbUnicode, 1033)
sBuffer = ByteArrToString(arrStr())

PrivateValue = sBuffer
End Property
@@ -171,9 +171,10 @@ Public Function CalculateHash(ByVal ClientToken As Long, ByVal ServerToken As Lo
Else
'm_Hash = String$(m_HashSize, vbNullChar)
Call kd_getHash(m_Handle, VarPtr(HashArr(0)))
m_Hash = StrConv(HashArr(), vbUnicode, 1033)
m_Hash = ByteArrToString(HashArr())
End If
Else
' XSHA1 for non-W3 keys
arrStr = .GetDataAsByteArr
Call calcHashBuf(VarPtr(arrStr(0)), Len(.Data), VarPtr(HashArr(0)))
End If
@@ -174,7 +174,7 @@ Public Property Get Srp_A() As String

nls_get_A m_NlsHandle, VarPtr(arrA(0))

Srp_A = StrConv(arrA(), vbUnicode, 1033)
Srp_A = ByteArrToString(arrA())

End Property

@@ -209,12 +209,12 @@ Public Property Get Srp_M1() As String
Exit Property
End If

arrB() = StrConv(m_B, vbFromUnicode, 1033)
arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033)
arrB() = StringToByteArr(m_B)
arrSalt() = StringToByteArr(m_Salt)

nls_get_M1 m_NlsHandle, VarPtr(arrM1(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0))

Srp_M1 = StrConv(arrM1(), vbUnicode, 1033)
Srp_M1 = ByteArrToString(arrM1())

End Property

@@ -231,12 +231,12 @@ Public Property Get Srp_S() As String
Exit Property
End If

arrB() = StrConv(m_B, vbFromUnicode, 1033)
arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033)
arrB() = StringToByteArr(m_B)
arrSalt() = StringToByteArr(m_Salt)

nls_get_S m_NlsHandle, VarPtr(arrS(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0))

Srp_S = StrConv(arrS(), vbUnicode, 1033)
Srp_S = ByteArrToString(arrS())

End Property

@@ -252,11 +252,11 @@ Public Property Get Srp_K() As String
Exit Property
End If

arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033)
arrSalt() = StringToByteArr(m_Salt)

nls_get_K m_NlsHandle, VarPtr(arrK(0)), VarPtr(arrSalt(0))

Srp_K = StrConv(arrK(), vbUnicode, 1033)
Srp_K = ByteArrToString(arrK())

End Property

@@ -274,9 +274,9 @@ Public Function SrpVerifyM2(ByVal M2 As String) As Boolean
Exit Function
End If

arrM2() = StrConv(M2, vbFromUnicode, 1033)
arrB() = StrConv(m_B, vbFromUnicode, 1033)
arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033)
arrM2() = StringToByteArr(M2)
arrB() = StringToByteArr(m_B)
arrSalt() = StringToByteArr(m_Salt)

SrpVerifyM2 = nls_check_M2(m_NlsHandle, VarPtr(arrM2(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0)))

@@ -303,8 +303,9 @@ Public Sub GenerateSaltAndVerifier()
Next i

nls_get_v m_NlsHandle, VarPtr(arrV(0)), VarPtr(arrSalt(0))
m_Salt = StrConv(arrSalt(), vbUnicode, 1033)
m_v = StrConv(arrV(), vbUnicode, 1033)

m_Salt = ByteArrToString(arrSalt())
m_v = ByteArrToString(arrV())

m_Generated = True

@@ -406,7 +407,7 @@ Public Function VerifyServerSignature(ByVal IPAddress As String, ByVal Signature
Dim arrSig() As Byte

lngAddr = inet_addr(IPAddress)
arrSig() = StrConv(Signature, vbFromUnicode, 1033)
arrSig() = StringToByteArr(Signature)

VerifyServerSignature = nls_check_signature(lngAddr, VarPtr(arrSig(0)))

@@ -865,7 +865,7 @@ Private Sub ParseDiabloII()
CharacterName = Values(1)

If (UBound(Values) >= 2) Then
MakeArr Values(2), charData
charData() = StringToByteArr(Values(2))

If (UBound(charData) >= 13) Then
CharacterClassID = charData(13)
@@ -1008,10 +1008,6 @@ Private Function WarCraftIII_ToString() As String
WarCraftIII_ToString = buf
End Function

Private Sub MakeArr(ByVal str As String, ByRef arr() As Byte)
arr() = StrConv(str, vbFromUnicode, 1033)
End Sub

Private Function MakeRomanNum(ByVal Num As Integer) As String
Select Case (Num)
Case 1: MakeRomanNum = "I"

0 comments on commit 7614ff5

Please sign in to comment.
You can’t perform that action at this time.