250 lines
7.3 KiB
Plaintext
250 lines
7.3 KiB
Plaintext
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
'''' -> 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 |