''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' -> Anwendungsaktivierung
'''' (c) 2007 Dennis Alexander Petrasch
'''' http://www.entwickler-zeitung.de
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Imports System.Security.Cryptography
Imports System.Security.Cryptography.Xml
Imports System.Management
Imports System.Net
Imports System.Xml
Imports System.IO
Imports System

Public Module ActivationProvider

    Dim Pfad As String = Globals.ApplicationPath & "licence.xml"

    '''
    ''' Private Funktion um auf das System.Management zuzugreifen
    '''
    ''' WMI-Klasse
    ''' WMI-Eigenschaft
    ''' Wert
    '''
    Private Function Identifier(ByVal wmiClass As String, ByVal wmiProperty As String) As String

        Dim Result As String = ""
        Dim mc As New System.Management.ManagementClass(wmiClass)
        Dim moc As System.Management.ManagementObjectCollection = mc.GetInstances
        Dim mo As System.Management.ManagementObject

        For Each mo In moc
            If Result = "" Then
                Try
                    Result = mo(wmiProperty).ToString
                    Exit For
                Catch ex As Exception
                End Try
            End If
        Next mo

        Return Result
    End Function


    '''
    ''' Erzeugt eine einmalige ID-Nummer des Computers
    '''
    ''' String
    '''
    Public Function GenerateUniqueComputerID() As String
        ' Prozessor-UniqueID
        Dim pID As String = Identifier("Win32_Processor", "UniqueId")

        ' Falls es keine UniqueID im Prozessor gibt, dann die ProzessorID
        If pID = "" Then
            pID = Identifier("Win32_Processor", "ProcessorId")
        End If

        ' Form aufbereiten & Festplattensignatur auslesen
        Return pID & "-" & Identifier("Win32_DiskDrive", "Signature")
    End Function


    '''
    ''' Überprüft, ob der Computer über eine aktive Internetverbindung verfügt
    '''
    ''' Boolean
    '''
    Public Function CheckOnLineStatus() As Boolean

        If My.Computer.Network.IsAvailable Then
            CheckOnLineStatus = My.Computer.Network.Ping("www.entwickler-zeitung.de")
        Else
            CheckOnLineStatus = False
        End If

        Return CheckOnLineStatus
    End Function


    '''
    ''' Sehr einfache Methode, ein Datum vom Server abzurufen
    '''
    ''' Benutzername
    ''' Seriennummer
    ''' Computer-ID
    ''' Datum
    '''
    Public Function DoHandshakeWithServer(ByVal Username As String, ByVal Password As String, ByVal ComputerID As String) As String
        ' Dies ist eine ziemlich unsichere Möglichkeit. Am besten wäre dafür ein WebService geeignet.
        Dim wc As New WebClient
        Dim Datum As Date
        Datum = Date.Parse(wc.DownloadString("http://www.entwickler-zeitung.de/activationtest.php?user=" & Username & "&pass=" & "&computerid=" & ComputerID))
        Return Datum
    End Function


    '''
    ''' Erzeugt eine Lizenzdatei
    '''
    ''' Benutzername
    ''' Seriennummer
    ''' ComputerID
    ''' Laufzeit
    ''' Boolean
    '''
    Public Function CreateLicenceFile(ByVal Username As String, ByVal Serial As String, ByVal ActivationID As String, ByVal Datum As Date) As Boolean
        Try
            Dim document As New XmlDocument()
            Dim Node As XmlNode
            Dim Benutzer, Zeit, Seriennummer, aID As XmlElement

            Node = document.CreateElement("Daten")
            Benutzer = document.CreateElement("Benutzername")
            Benutzer.InnerText = Username
            Node.AppendChild(Benutzer)

            Seriennummer = document.CreateElement("Seriennummer")
            Seriennummer.InnerText = Serial
            Node.AppendChild(Seriennummer)

            aID = document.CreateElement("ComputerID")
            aID.InnerText = ActivationID
            Node.AppendChild(aID)

            Zeit = document.CreateElement("Laufzeit")
            Zeit.InnerText = Datum
            Node.AppendChild(Zeit)

            document.AppendChild(Node)

            ' Create the SignedXml message.
            Dim signedXml As New SignedXml()
            Dim key As RSA = RSA.Create()
            signedXml.SigningKey = key

            ' Create a data object to hold the data to sign.
            Dim dataObject As New DataObject()
            dataObject.Data = document.ChildNodes
            dataObject.Id = "Aktivierungsdaten"

            ' Add the data object to the signature.
            signedXml.AddObject(dataObject)

            ' Create a reference to be able to package everything into the
            ' message.
            Dim reference As New Reference()
            reference.Uri = "#Aktivierungsdaten"

            ' Add it to the message.
            signedXml.AddReference(reference)

            ' Add a KeyInfo.
            Dim keyInfo As New KeyInfo()
            keyInfo.AddClause(New RSAKeyValue(key))
            signedXml.KeyInfo = keyInfo

            ' Compute the signature.
            signedXml.ComputeSignature()

            ' Get the XML representation of the signature.
            Dim xmlSignature As XmlElement = signedXml.GetXml()

            Using sw As New IO.StreamWriter(Pfad, False)
                sw.Write(xmlSignature.OuterXml)
            End Using
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function


    '''
    ''' Überprüft die Lizenz-Datei auf mögliche Veränderungen
    '''
    ''' Boolean
    '''
    Public Function CheckLicenceFile() As Boolean
        Try

            Dim signedXml As New SignedXml()
            Dim xmlDocument As New XmlDocument()
            xmlDocument.PreserveWhitespace = True
            xmlDocument.Load(New XmlTextReader(Pfad))

            Dim nodeList As XmlNodeList = xmlDocument.GetElementsByTagName("Signature")
            signedXml.LoadXml(CType(nodeList(0), XmlElement))

            If signedXml.CheckSignature() Then
                Return True
            Else
                Return False
            End If
        Catch ex As Exception
            Return False
        End Try

    End Function


    '''
    ''' Überprüft die Laufzeit
    '''
    ''' Boolean
    '''
    Public Function CheckLicenceDate() As Boolean

        If Not File.Exists(Pfad) Then
            Return False
        End If

        If CheckOnLineStatus() Then
            Dim wc As New WebClient
            Dim Heute As Date
            Heute = Date.Parse(wc.DownloadString("http://www.entwickler-zeitung.de/today.php"))

            Dim xmlDocument As New XmlDocument()
            xmlDocument.PreserveWhitespace = True
            xmlDocument.Load(New XmlTextReader(Pfad))

            Dim nodeList As XmlNodeList = xmlDocument.GetElementsByTagName("Laufzeit")
            Dim Datum As Date = nodeList(0).InnerText

            If Datum > Heute Then
                Return True
            Else
                Return False
            End If
        Else
            Dim xmlDocument As New XmlDocument()
            xmlDocument.PreserveWhitespace = True
            xmlDocument.Load(New XmlTextReader(Pfad))

            Dim nodeList As XmlNodeList = xmlDocument.GetElementsByTagName("Laufzeit")
            Dim Datum As Date = nodeList(0).InnerText

            If Datum > Now.Date Then
                Return True
            Else
                Return False
            End If
        End If

    End Function

End Module