DPM_PADM/DPMLizenzmanagement/SHUKeyGen/clsKeyGen.vb

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