Version 20180904

2018-09-08 22:59:18 +02:00
parent d74444b027
commit e92be16b24
838 changed files with 395696 additions and 0 deletions
--- a/DPMLizenzmanagement/SHUKeyGen/clsKeyGen.vb
+++ b/DPMLizenzmanagement/SHUKeyGen/clsKeyGen.vb
@@ -0,0 +1,367 @@
+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_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
+        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