Imports System.IO Imports System.Windows Imports System.Windows.Forms Public Class clsKeyGen Dim m_demomode As Boolean Property DemoMode As Boolean Get Return m_demomode End Get Set(value As Boolean) m_demomode = value End Set End Property Dim m_dms As Boolean Property DMS As Boolean Get Return m_dms End Get Set(value As Boolean) m_dms = value End Set End Property Dim m_delimiter As String Property Delimiter As String Get Return m_delimiter End Get Set(value As String) m_delimiter = value End Set End Property Dim m_cryptokey As String Property Cryptokey As String Get Return m_cryptokey End Get Set(value As String) m_cryptokey = value End Set End Property Dim m_lizenznehmer As String Property Lizenznahmer As String Get Return m_lizenznehmer End Get Set(value As String) m_lizenznehmer = value End Set End Property Dim m_seriennummer As String Property Seriennummer As String Get Return m_seriennummer End Get Set(value As String) m_seriennummer = value End Set End Property Dim m_Produktname As String Property Produktname As String Get Return m_Produktname End Get Set(value As String) m_Produktname = value End Set End Property Dim m_Gueltigbis As DateTime Property Gueltigbis As DateTime Get Return m_Gueltigbis End Get Set(value As DateTime) m_Gueltigbis = value End Set End Property Dim m_lizenzgeber As String Property Lizenzgeber As String Get Return m_lizenzgeber End Get Set(value As String) m_lizenzgeber = value End Set End Property Dim m_option1 As Boolean Dim m_option2 As Boolean Dim m_option3 As Boolean Dim m_option4 As Boolean Dim m_option5 As Boolean Dim m_option6 As Boolean Property Option1 As Boolean Get Return m_option1 End Get Set(value As Boolean) m_option1 = value End Set End Property Property Option2 As Boolean Get Return m_option2 End Get Set(value As Boolean) m_option2 = value End Set End Property Property Option3 As Boolean Get Return m_option3 End Get Set(value As Boolean) m_option3 = value End Set End Property Property Option4 As Boolean Get Return m_option4 End Get Set(value As Boolean) m_option4 = value If m_option4 = True Then Me.DMS = True End Set End Property Property Option5 As Boolean Get Return m_option5 End Get Set(value As Boolean) m_option5 = value End Set End Property Property Option6 As Boolean Get Return m_option6 End Get Set(value As Boolean) m_option6 = value If m_option6 = True Then Me.DemoMode = True End Set End Property Dim m_keycode As String Property KeyCode As String Get Return m_keycode End Get Set(value As String) m_keycode = value End Set End Property Dim m_status As String Property Status As String Get Return m_status End Get Set(value As String) m_status = value End Set End Property Dim tempkeycode As Object Dim rawkey As Object Dim binkey As Object Sub New(Optional Lizenznehmer As String = "", Optional Seriennummer As String = "", Optional Produktname As String = "", Optional Gueltigbis As String = "", Optional Lizenzgeber As String = "", Optional Delimiter As String = "", Optional Cryptostring As String = "") Try Me.Lizenznahmer = Lizenznehmer Me.Seriennummer = Seriennummer Me.Produktname = Produktname Me.Lizenzgeber = Lizenzgeber Me.Delimiter = Delimiter Me.Cryptokey = Cryptostring Me.Gueltigbis = Gueltigbis Catch End Try End Sub Sub GenNewKey() Try Dim FeatID As Long FeatID = 0 Dim UsernameT As String Dim ProdNameT As String 'Build bitmap from checkboxes If Me.Option1 Then FeatID = FeatID Or 1 If Me.Option2 Then FeatID = FeatID Or 2 If Me.Option3 Then FeatID = FeatID Or 4 If Me.Option4 Then FeatID = FeatID Or 8 If Me.Option5 Then FeatID = FeatID Or 16 If Me.Option6 Then FeatID = FeatID Or 32 UsernameT = Trim(Me.Lizenznahmer) ProdNameT = Trim(Me.Seriennummer) If Not (UsernameT = "") Or Not (ProdNameT = "") Then rawkey = GenKeyString(Trim(Lizenznahmer), Trim(Seriennummer) & Trim(Produktname), FeatID) 'rawkey = GenKeyString(UsernameT, ProdNameT & Me.txtProductName.Text + Me.DateTimePicker1.ToString, FeatID) binkey = HexStrToBinStr(rawkey) Me.KeyCode = FormatKeyCode(Base32Enc(binkey), 4) Me.Status = "Key generated" Else Me.KeyCode = "n.a." Me.Status = "Key generation error" End If Catch ex As Exception Me.Status = "Key generation error" End Try End Sub Sub Save_Licensefile() Try Dim sd As New SaveFileDialog sd.Filter = "Key-Files|*.key|All files|*.*" sd.FilterIndex = 0 If sd.ShowDialog <> DialogResult.OK Then Exit Sub End If Dim Cryptedstring = Me.Lizenznahmer + Me.Delimiter + Seriennummer + Delimiter + Me.Gueltigbis.ToShortDateString + Delimiter + Me.Lizenzgeber + Delimiter + Me.Produktname binkey = binkey + Delimiter + Cryptedstring binkey = Crypto.EncryptText(binkey, Cryptokey) Me.Status = "File: " + sd.FileName + " saved" Dim fs As System.IO.FileStream fs = New System.IO.FileStream(sd.FileName, System.IO.FileMode.Create) Dim b As Byte() b = UnicodeStringToBytes(binkey) fs.Write(b, 0, b.Length) fs.Close() sd.Dispose() Catch Me.Status = "Save file error" End Try End Sub Private Function UnicodeStringToBytes(ByVal str As String) As Byte() Return System.Text.Encoding.Unicode.GetBytes(str) End Function Private Function UnicodeBytesToString( ByVal bytes() As Byte) As String Return System.Text.Encoding.Unicode.GetString(bytes) End Function #Region "GetFile" Dim features As Object Public Sub Read_LicenseFile(ByVal Filename As String) Dim od As New OpenFileDialog If Filename = "" Then od.Filter = "Key-Files|*.key|All files|*.*" od.FilterIndex = 0 If od.ShowDialog <> DialogResult.OK Then Exit Sub End If Else If System.IO.File.Exists(Filename) Then od.FileName = Filename Else Me.Status = "KeyFile not found." Me.DemoMode = True Exit Sub End If End If Dim fInfo As New System.IO.FileInfo(od.FileName) Dim numBytes As Long = fInfo.Length Dim fs As New FileStream(od.FileName, FileMode.Open, FileAccess.Read) Dim br As New System.IO.BinaryReader(fs) Dim bytes As Byte() = br.ReadBytes(CInt(numBytes)) Dim s As String s = UnicodeBytesToString(bytes) s = Crypto.DecryptText(s, Me.Cryptokey) Dim splitter As String() splitter = s.Split(Me.Delimiter) Me.KeyCode = FormatKeyCode(Base32Enc(splitter(0)), 4) Me.Lizenznahmer = splitter(2) Me.Seriennummer = splitter(4) Me.Gueltigbis = splitter(6) Me.Lizenzgeber = splitter(8) Me.Produktname = splitter(10) If IsKeyValid(Me.KeyCode, Me.Lizenznahmer, Me.Seriennummer) Then features = GetKeyFeat(Me.KeyCode, Me.Lizenznahmer, Me.Seriennummer) DoCheckBoxes(features) Me.Status = "Fileread OK" Else Me.Status = "License is not valid." Me.DemoMode = True End If br.Close() fs.Close() od.Dispose() End Sub Private Function IsKeyValid(ByVal KeyCode As String, ByVal UserName As String, ByVal ProdName As String) As Boolean Dim BinKey As String Dim IsValid As Boolean Dim HexKey As String IsValid = False ' First, decode Base32 string into binary one ' Remove any dashes in input string BinKey = Base32Dec(RemoveDashes(KeyCode)) HexKey = BinStrToHexStr(BinKey) IsValid = ValidateKeyCode(HexKey, Me.Lizenznahmer, Me.Seriennummer & Me.Produktname) IsKeyValid = IsValid End Function Dim Isvalid As Boolean Private Function GetKeyFeat(ByVal KeyCode As String, UserName As String, ProdName As String) As Long Dim BinKey As String Dim FeatBMP As Long Dim HexKey As String Isvalid = False ' First, decode Base32 string into binary one ' Remove any dashes in input string BinKey = Base32Dec(RemoveDashes(KeyCode)) ' Check length of BinKey - must be 16 to be valid If Len(BinKey) = 16 Then HexKey = BinStrToHexStr(BinKey) FeatBMP = ExtractKeyFBits(HexKey, Me.Lizenznahmer, Me.Seriennummer & Me.Produktname) Else FeatBMP = 0 End If GetKeyFeat = FeatBMP End Function Private Sub DoCheckBoxes(ByVal ChkVal As Long) Me.Option1 = ChkVal And 1 Me.Option2 = (ChkVal And 2) / 2 Me.Option3 = (ChkVal And 4) / 4 Me.Option4 = (ChkVal And 8) / 8 Me.Option5 = (ChkVal And 16) / 16 Me.Option6 = (ChkVal And 32) / 32 End Sub #End Region End Class