key
Moderator: Moderators
Visual Basic 6 LockToKey
Well here's my lock to key....as far as I know it doesn't produce any errors. It's been used by me so far about 250 times or so, because of my client, etc. n = 5 when dealing with client-client and client-hub.
The old post on lichlord was a nice reference...perhaps it can begin anew!
The old post on lichlord was a nice reference...perhaps it can begin anew!
Code: Select all
Public Function LockToKey(ByRef Lck As String, ByVal n As Long) As String
Dim h As Integer, j As Integer
'Code in part from ODC (http://sourceforge.net/projects/odc)
'n = 5 for hub and client locks
h = InStr(1, Lck, " ")
If h Then Lck = Left$(Lck, h - 1)
'The lock only continues to the first space (Pk= comes after)
'The first character is handled differently from the others
h = Asc(Lck) Xor Asc(Right$(Lck, 1)) Xor Asc(Right$(Lck, 2)) Xor n
h = (h \ 16) Xor (h * 16)
'Equivalent of Bit Shifting four to the right (\ 2^4) Xor four to the left (* 2^4)
'If h is greater than 255, we can't get a character out of it
Do While h > 255
h = h - 256
Loop
'Check for illegal characters
Select Case h
Case 0, 5, 36, 96, 124, 126
LockToKey = "/%DCN" & Right$("00" & h, 3) & "%/"
Case Else
LockToKey = Chr$(h)
End Select
n = Len(Lck)
'Now the rest of the characaters in the lock are handled the same
For j = 2 To n
h = Asc(Mid$(Lck, j, 1)) Xor Asc(Mid$(Lck, j - 1, 1))
h = (h \ 16) Xor (h * 16)
Do While h > 255
h = h - 256
Loop
'Check for illegal characters
Select Case h
Case 0, 5, 36, 96, 124, 126
LockToKey = LockToKey & "/%DCN" & Right$("00" & h, 3) & "%/"
Case Else
LockToKey = LockToKey & Chr$(h)
End Select
Next
End Function
Public Function DC1_Lock2Key(Lck$) As String
Dim pos%, K$, i%, T%
'Remade optimized and works with clients
pos = InStr(Lck, " ")
If pos Then 'If not, assume it was pre-parsed
Lck = Left(Lck, pos - 1)
End If
If Len(Lck) < 3 Then 'Too short!
DC1_Lock2Key = "Invalid Lock < 3 chars"
Exit Function
End If
K = ""
For i = 1 To Len(Lck)
T = Asc(Mid(Lck, i))
If i = 1 Then
T = T Xor 5
Else
T = T Xor Asc(Mid(Lck, i - 1))
End If
T = (T + ((T Mod 17) * 15))
'Can't just Mod 255 cuz if # /IS/ 255, we don't change
Do Until T <= 255
T = T - 255
Loop
Select Case T
Case 0, 5, 96, 124, 126, 36
K = K + "/%DCN" + Right("00" + CStr(T), 3) + "%/"
Case Else
K = K + Chr(T)
End Select
Next
Mid(K, 1, 1) = Chr(Asc(K) Xor Asc(Mid(K, Len(K))))
DC1_Lock2Key = K
End Function
Public Function DC1_Lock2KeyByte(Lck$)
'This one works under diff Locales
Dim pos%, K$, i%, T%, ret() As Byte
'Remade optimized and works with clients
pos = InStr(Lck, " ")
If pos Then 'If not, assume it was pre-parsed
Lck = Left(Lck, pos - 1)
End If
If Len(Lck) < 3 Then 'Too short!
DC1_Lock2KeyByte = "Invalid Lock < 3 chars"
Exit Function
End If
ReDim ret(4)
ret(0) = 36: ret(1) = 75: ret(2) = 101: ret(3) = 121: ret(4) = 32
For i = 1 To Len(Lck)
T = Asc(Mid(Lck, i))
If i = 1 Then
T = T Xor 5
Else
T = T Xor Asc(Mid(Lck, i - 1))
End If
T = (T + ((T Mod 17) * 15))
'Can't just Mod 255 cuz if # /IS/ 255, we don't change
Do Until T <= 255
T = T - 255
Loop
Select Case T
Case 0, 5, 96, 124, 126, 36
ReDim Preserve ret(UBound(ret) + 10)
ret(UBound(ret) - 9) = 47: ret(UBound(ret) - = 37
ret(UBound(ret) - 7) = 68: ret(UBound(ret) - 6) = 67
ret(UBound(ret) - 5) = 78: ret(UBound(ret) - 1) = 37
ret(UBound(ret)) = 47
ret(UBound(ret) - 4) = Asc(Left(Right("00" + CStr(T), 3), 1))
ret(UBound(ret) - 4) = Asc(Mid(Right("00" + CStr(T), 3), 2, 1))
ret(UBound(ret) - 4) = Asc(Right("00" + CStr(T), 3))
'K = K + "/%DCN" + Right("00" + CStr(T), 3) + "%/"
Case Else
ReDim Preserve ret(UBound(ret) + 1)
ret(UBound(ret)) = T
'K = K + Chr(T)
End Select
Next
'Mid(K, 1, 1) = Chr(Asc(K) Xor Asc(Mid(K, Len(K))))
ret(5) = (ret(5) Xor ret(UBound(ret)))
ReDim Preserve ret(UBound(ret) + 1)
ret(UBound(ret)) = 124
DC1_Lock2KeyByte = ret
End Function
Dim pos%, K$, i%, T%
'Remade optimized and works with clients
pos = InStr(Lck, " ")
If pos Then 'If not, assume it was pre-parsed
Lck = Left(Lck, pos - 1)
End If
If Len(Lck) < 3 Then 'Too short!
DC1_Lock2Key = "Invalid Lock < 3 chars"
Exit Function
End If
K = ""
For i = 1 To Len(Lck)
T = Asc(Mid(Lck, i))
If i = 1 Then
T = T Xor 5
Else
T = T Xor Asc(Mid(Lck, i - 1))
End If
T = (T + ((T Mod 17) * 15))
'Can't just Mod 255 cuz if # /IS/ 255, we don't change
Do Until T <= 255
T = T - 255
Loop
Select Case T
Case 0, 5, 96, 124, 126, 36
K = K + "/%DCN" + Right("00" + CStr(T), 3) + "%/"
Case Else
K = K + Chr(T)
End Select
Next
Mid(K, 1, 1) = Chr(Asc(K) Xor Asc(Mid(K, Len(K))))
DC1_Lock2Key = K
End Function
Public Function DC1_Lock2KeyByte(Lck$)
'This one works under diff Locales
Dim pos%, K$, i%, T%, ret() As Byte
'Remade optimized and works with clients
pos = InStr(Lck, " ")
If pos Then 'If not, assume it was pre-parsed
Lck = Left(Lck, pos - 1)
End If
If Len(Lck) < 3 Then 'Too short!
DC1_Lock2KeyByte = "Invalid Lock < 3 chars"
Exit Function
End If
ReDim ret(4)
ret(0) = 36: ret(1) = 75: ret(2) = 101: ret(3) = 121: ret(4) = 32
For i = 1 To Len(Lck)
T = Asc(Mid(Lck, i))
If i = 1 Then
T = T Xor 5
Else
T = T Xor Asc(Mid(Lck, i - 1))
End If
T = (T + ((T Mod 17) * 15))
'Can't just Mod 255 cuz if # /IS/ 255, we don't change
Do Until T <= 255
T = T - 255
Loop
Select Case T
Case 0, 5, 96, 124, 126, 36
ReDim Preserve ret(UBound(ret) + 10)
ret(UBound(ret) - 9) = 47: ret(UBound(ret) - = 37
ret(UBound(ret) - 7) = 68: ret(UBound(ret) - 6) = 67
ret(UBound(ret) - 5) = 78: ret(UBound(ret) - 1) = 37
ret(UBound(ret)) = 47
ret(UBound(ret) - 4) = Asc(Left(Right("00" + CStr(T), 3), 1))
ret(UBound(ret) - 4) = Asc(Mid(Right("00" + CStr(T), 3), 2, 1))
ret(UBound(ret) - 4) = Asc(Right("00" + CStr(T), 3))
'K = K + "/%DCN" + Right("00" + CStr(T), 3) + "%/"
Case Else
ReDim Preserve ret(UBound(ret) + 1)
ret(UBound(ret)) = T
'K = K + Chr(T)
End Select
Next
'Mid(K, 1, 1) = Chr(Asc(K) Xor Asc(Mid(K, Len(K))))
ret(5) = (ret(5) Xor ret(UBound(ret)))
ReDim Preserve ret(UBound(ret) + 1)
ret(UBound(ret)) = 124
DC1_Lock2KeyByte = ret
End Function
I know the thread is dead, but maybe someone will find this useful....I've speeded up my lock to key function by using a byte array....I think it's ~25-30% faster.
Code: Select all
Public Function LockToKey(ByRef Lck As String, ByVal n As Long) As String
Dim aByte() As Byte, h As Integer, j As Long, ub As Integer
'n = 5 for hub and client locks
h = InStr(1, Lck, " ")
If h Then Lck = Left$(Lck, h - 1)
'The lock only continues to the first space (Pk= comes after)
'Convert it to a byte array
ub = Len(Lck) - 1
ReDim aByte(ub) As Byte
aByte = StrConv(Lck, vbFromUnicode)
'The first character is handled differently from the others
h = aByte(0) Xor aByte(ub) Xor aByte(ub - 1) Xor n
h = (h \ 16) Xor (h * 16)
'Equivalent of bit shifting four to the right (\ 2^4) Xor four to the left (* 2^4)
'If h is greater than 255, we can't get a character out of it
Do While h > 255
h = h - 256
Loop
'Check for illegal characters
Select Case h
Case 0, 5, 36, 96, 124, 126
LockToKey = "/%DCN" & Right$("00" & h, 3) & "%/"
Case Else
LockToKey = Chr$(h)
End Select
'Now the rest of the characaters in the lock are handled the same
For j = 1 To ub
h = aByte(j) Xor aByte(j - 1)
h = (h \ 16) Xor (h * 16)
Do While h > 255
h = h - 256
Loop
Select Case h
Case 0, 5, 36, 96, 124, 126
LockToKey = LockToKey & "/%DCN" & Right$("00" & h, 3) & "%/"
Case Else
LockToKey = LockToKey & Chr$(h)
End Select
Next
End Function