Version 20180904
This commit is contained in:
256
DPMLizenzmanagement/SHUKeyGen/KeyCode.vb
Normal file
256
DPMLizenzmanagement/SHUKeyGen/KeyCode.vb
Normal file
@@ -0,0 +1,256 @@
|
||||
Module KeyCode
|
||||
'Attribute VB_Name = "KeyCode"
|
||||
' *
|
||||
' * KeyCodeGen Module
|
||||
' * Copyright (C) 2007 John Mazza.
|
||||
' *
|
||||
' * Written by John Mazza <maz@mgcworks.com>
|
||||
' *
|
||||
' * This library is free software; you can redistribute it and/or
|
||||
' * modify it under the terms of the GNU Lesser General Public
|
||||
' * License Version 2.1 as published by the Free Software Foundation.
|
||||
' *
|
||||
' * This library is distributed in the hope that it will be useful,
|
||||
' * but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
' * Lesser General Public License for more details.
|
||||
' *
|
||||
' * You should have received a copy of the GNU Lesser General Public
|
||||
' * License along with this library; if not, write to the Free Software
|
||||
' * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
' ****************************************************************************
|
||||
'
|
||||
'
|
||||
' PURPOSE
|
||||
' Generate a licening key code that encodes product features into the
|
||||
' "keycode" string securely.
|
||||
'
|
||||
' LANGUAGE
|
||||
' Visual Basic 6.0 or VBA6
|
||||
' Should work in VB.NET as well
|
||||
'
|
||||
' DEPENDENCIES:
|
||||
' Requires 'Visual Basic MD5 Implementation' by
|
||||
' Robert Hubley and David Midkiff (mdj2023@hotmail.com) and
|
||||
' StrFuncs module by John Mazza
|
||||
'
|
||||
|
||||
|
||||
' GenKeyString() generates the actual keycode string based on
|
||||
' modified MD5 hashes of Username, Product, and licensed "features"
|
||||
|
||||
Public Function GenKeyString(ByVal UserName As String, ProdName As String, F_Code As Long) As String
|
||||
|
||||
Dim TempStr As String
|
||||
Dim KeyStr As String
|
||||
Dim KeyVal As String
|
||||
Dim CodeVal As Long
|
||||
Dim CodeLow As Byte
|
||||
Dim CodeHigh As Byte
|
||||
Dim KeyLowV1 As Byte
|
||||
Dim KeyLowV2 As Byte
|
||||
Dim KeyLow1 As Object
|
||||
Dim KeyLow2 As Object
|
||||
Dim ChrV1 As Char
|
||||
Dim ChrV2 As Char
|
||||
Dim RawChk As Object
|
||||
Dim RC1 As Object
|
||||
Dim RC2 As Object
|
||||
Dim StubStr As String
|
||||
|
||||
|
||||
|
||||
' Make sure we're not case-sensitive since that is a pain for end users
|
||||
|
||||
TempStr = LCase(UserName) & LCase(ProdName)
|
||||
KeyStr = DigestStrToHexStr(TempStr)
|
||||
KeyVal = HexStrToBinStr(KeyStr)
|
||||
|
||||
' Mask off low order 16 bits from F_Code
|
||||
CodeVal = F_Code And &HFFFF
|
||||
CodeLow = CodeVal And &HFF
|
||||
CodeHigh = (((CodeVal And &HFF00) / 256) And &HFF)
|
||||
|
||||
KeyLow1 = Mid(KeyVal, Len(KeyVal), 1)
|
||||
KeyLow2 = Mid(KeyVal, Len(KeyVal) - 1, 1)
|
||||
|
||||
KeyLowV1 = Asc(KeyLow1)
|
||||
KeyLowV2 = Asc(KeyLow2)
|
||||
|
||||
KeyLowV1 = (KeyLowV1 Xor CodeLow)
|
||||
KeyLowV2 = (KeyLowV2 Xor CodeHigh)
|
||||
|
||||
'KeyLowV1 = KeyLowV1 Xor KeyLowV2
|
||||
ChrV1 = Chr(KeyLowV1)
|
||||
ChrV2 = Chr(KeyLowV2)
|
||||
|
||||
' Cut original first 2 bytes from KeyVal string
|
||||
KeyVal = Mid(KeyVal, 1, Len(KeyVal) - 2)
|
||||
|
||||
' Now append modified bytes
|
||||
KeyVal = KeyVal & ChrV2 & ChrV1
|
||||
'KeyVal = KeyVal & ChrV1
|
||||
|
||||
' Now we get sneaky and modify the KeyVal by replacing the first 2 bytes
|
||||
' of KeyVal with the first and last bytes of the MD5 of KeyVal minus first 2 bytes
|
||||
|
||||
KeyVal = Mid(KeyVal, 3, Len(KeyVal) - 2)
|
||||
|
||||
RawChk = DigestStrToHexStr(KeyVal)
|
||||
|
||||
RC1 = Mid(RawChk, 1, 2)
|
||||
RC2 = Mid(RawChk, Len(RawChk) - 1, 2)
|
||||
|
||||
StubStr = BinStrToHexStr(KeyVal)
|
||||
|
||||
GenKeyString = RC1 & RC2 & StubStr
|
||||
|
||||
End Function
|
||||
|
||||
' ValidateKeyCode() validates that a keycode is valid.
|
||||
' Basically it is the inverse of GenKeyString()
|
||||
|
||||
Public Function ValidateKeyCode(ByVal KeyCode As String, UserName As String, ProjName As String) As Boolean
|
||||
Dim ActiveBytes As String
|
||||
Dim LUNameHash As String
|
||||
Dim LUName As String
|
||||
Dim ValidKey As Boolean
|
||||
Dim KeyMD5 As String
|
||||
Dim KeySig As String
|
||||
|
||||
Dim BinKeyCode As Object
|
||||
Dim ValidSig As Object
|
||||
|
||||
ValidKey = False
|
||||
|
||||
' Key must be 32 bytes long - otherwise reject immediately
|
||||
|
||||
If Len(KeyCode) = 32 Then
|
||||
BinKeyCode = HexStrToBinStr(KeyCode)
|
||||
ActiveBytes = Right(BinKeyCode, 14)
|
||||
KeyMD5 = DigestStrToHexStr(ActiveBytes)
|
||||
ValidSig = Left(KeyMD5, 2) & Right(KeyMD5, 2)
|
||||
KeySig = Left(KeyCode, 4)
|
||||
|
||||
If KeySig = ValidSig Then
|
||||
ValidKey = True
|
||||
Else
|
||||
ValidKey = False
|
||||
End If
|
||||
|
||||
If ValidKey Then
|
||||
LUName = LCase(UserName) & LCase(ProjName)
|
||||
LUNameHash = DigestStrToHexStr(LUName)
|
||||
|
||||
ActiveBytes = Mid(KeyCode, 5, 24)
|
||||
LUNameHash = Mid(LUNameHash, 5, 24)
|
||||
|
||||
If ActiveBytes = LUNameHash Then
|
||||
ValidKey = True
|
||||
Else
|
||||
ValidKey = False
|
||||
End If
|
||||
End If
|
||||
|
||||
Else
|
||||
ValidKey = False
|
||||
End If
|
||||
|
||||
ValidateKeyCode = ValidKey
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
' ExtractKeyFBits() returns the bitmap originally passed as F_Code
|
||||
' when a key is created with GenKeyString()
|
||||
' Note: it will return zero (0) if an invalid keycode is passed or if
|
||||
' username or projectname are not a match.
|
||||
|
||||
Public Function ExtractKeyFBits(ByVal KeyCode As String, UserName As String, ProjName As String)
|
||||
Dim PermVal As Long
|
||||
Dim RealHash As String
|
||||
Dim LUser As String
|
||||
Dim Perms As Long
|
||||
Dim BinCodePerm As String
|
||||
Dim BinUHashPerm As String
|
||||
Dim HiCodePerm As Byte
|
||||
Dim HIUMask As Byte
|
||||
Dim LoUMask As Byte
|
||||
Dim HiPerm As Long
|
||||
Dim LoPerm As Long
|
||||
|
||||
Dim UserHash As Object
|
||||
Dim KCodedPerm As Object
|
||||
Dim UHashPerm As Object
|
||||
Dim LoCodePerm As Object
|
||||
PermVal = 0
|
||||
|
||||
If ValidateKeyCode(KeyCode, UserName, ProjName) Then
|
||||
|
||||
LUser = LCase(UserName) & LCase(ProjName)
|
||||
UserHash = DigestStrToHexStr(LUser)
|
||||
KCodedPerm = Right(KeyCode, 4)
|
||||
UHashPerm = Right(UserHash, 4)
|
||||
|
||||
BinCodePerm = HexStrToBinStr(KCodedPerm)
|
||||
BinUHashPerm = HexStrToBinStr(UHashPerm)
|
||||
|
||||
HiCodePerm = Asc(Mid(BinCodePerm, 1, 1))
|
||||
LoCodePerm = Asc(Mid(BinCodePerm, 2, 1))
|
||||
|
||||
HIUMask = Asc(Mid(BinUHashPerm, 1, 1))
|
||||
LoUMask = Asc(Mid(BinUHashPerm, 2, 1))
|
||||
|
||||
HiPerm = HiCodePerm Xor HIUMask
|
||||
LoPerm = LoCodePerm Xor LoUMask
|
||||
PermVal = (HiPerm * 256) Or LoPerm
|
||||
|
||||
Else
|
||||
PermVal = 0
|
||||
End If
|
||||
|
||||
ExtractKeyFBits = PermVal
|
||||
|
||||
End Function
|
||||
|
||||
Public Function FormatKeyCode(ByVal StrIn As String, ByVal GrpLen As Long) As String
|
||||
Dim StrLen As Long
|
||||
Dim CurGrp As Long
|
||||
Dim OutStr As String
|
||||
Dim GrpStr As String
|
||||
Dim GrpStart As Long
|
||||
|
||||
Dim StrGroups As Object
|
||||
Dim StrLeftOver As Object
|
||||
StrLen = Len(StrIn)
|
||||
|
||||
StrGroups = Int(StrLen / GrpLen)
|
||||
StrLeftOver = StrLen Mod GrpLen
|
||||
|
||||
' Run loop to add dashes into StrIn
|
||||
|
||||
For CurGrp = 0 To (StrGroups - 1)
|
||||
GrpStart = (CurGrp * GrpLen) + 1
|
||||
GrpStr = Mid(StrIn, GrpStart, GrpLen)
|
||||
|
||||
If CurGrp > 0 Then
|
||||
OutStr = OutStr & "-" & GrpStr
|
||||
Else
|
||||
OutStr = OutStr & GrpStr
|
||||
End If
|
||||
|
||||
Next CurGrp
|
||||
|
||||
' Append a final group if any leftover charaters
|
||||
' exist in StrIn
|
||||
|
||||
If StrLeftOver > 0 Then
|
||||
OutStr = OutStr & "-" & Right(StrIn, StrLeftOver)
|
||||
End If
|
||||
|
||||
FormatKeyCode = OutStr
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
End Module
|
||||
Reference in New Issue
Block a user