copyright 1999 - 2017 by heinz prelle - hannover  - lenbachstraße 42 - www.visual-basic5.de | impressum
'Beispiel: VB .Net - WindowsXP - CD Key aus der Registrierdatenbank auslesen - 2
'
'
Option Explicit On
Option Strict On

Imports Microsoft.Win32

Public Class Form1

    Private WithEvents prnDocument As New Printing.PrintDocument()

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If IsWindowsXP() Then
            TextBox1.Text = "Windows XP"
            Dim Result As String = GetCDKeyFromWindowsXP.ReturnProductKey()
            If Not Result = Nothing Then
                Me.TextBox2.Text = Result
            End If
        End If
    End Sub

    Private Function IsWindowsXP() As Boolean
        Dim OS As OperatingSystem = Environment.OSVersion
        Dim Result As Boolean = OS.Platform = PlatformID.Win32NT AndAlso _
           ((OS.Version.Major = 5 AndAlso _
           OS.Version.Minor >= 1) OrElse _
           OS.Version.Major > 5)
        If Result Then
            Return True
        Else
            Return False
        End If
    End Function

    Private Sub TextBox2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.Click
        TextBox2.SelectAll()
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TextBox2.ForeColor = Color.Navy
        Me.Text = "WindowsXP - Product Key"
    End Sub

    Private Sub CopyToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles CopyToolStripMenuItem.Click
        'Copy to clipboard
        Clipboard.SetText(Me.TextBox2.Text, TextDataFormat.Text)

        Dim [IDataObject] As IDataObject = Clipboard.GetDataObject()
        If (CBool([IDataObject].GetFormats().Length)) And _
            ([IDataObject].GetDataPresent(DataFormats.StringFormat)) Then
            Me.Text = "Product Key wurde in die Zwischenablage kopiert."
            Application.DoEvents()
            System.Threading.Thread.Sleep(250)
            Me.Text = "WindowsXP - Product Key"
        End If
    End Sub

    Private Sub SaveToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles SaveToolStripMenuItem.Click
        'Save to file
        Dim sfd As SaveFileDialog = New SaveFileDialog
        sfd.Title = "Save WinXP Product Key"
        sfd.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.Desktop
        sfd.Filter = "Text-Datei (*.txt)|*.txt"
        sfd.DefaultExt = "*.txt"
        sfd.FileName = "productkey"
        If sfd.ShowDialog = Windows.Forms.DialogResult.OK Then
            Try
                Dim sw As New IO.StreamWriter(IO.File.OpenWrite(sfd.FileName))
                sw.Write(TextBox2.Text)
                sw.Close()
            Catch ex As Exception
                MessageBox.Show(ex.Message.ToString(), "Info")
            End Try
        End If
    End Sub

    Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, _
            ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click
        'Exit
        Application.Exit()
    End Sub

    Private Sub PrintToolStripMenuItem_Click(ByVal sender As System.Object, _
            ByVal e As System.EventArgs) Handles PrintToolStripMenuItem.Click
        'Print
        Call ShowStandardPrinterDlg()
    End Sub

    Private Sub PrintPage(ByVal FontName As String, ByVal FontSize As Integer, _
            ByVal e As System.Drawing.Printing.PrintPageEventArgs, _
            ByVal PrintingString As String)

        Dim AreaWidth As Integer
        Dim AreaHeight As Integer
        Dim x As Integer
        Dim y As Integer
        Try
            With prnDocument.DefaultPageSettings
                AreaHeight = .PaperSize.Height - .Margins.Top - .Margins.Bottom
                AreaWidth = .PaperSize.Width - .Margins.Left - .Margins.Right
                x = .Margins.Left
                y = .Margins.Top
            End With

            Dim NewStringFormat As New StringFormat(StringFormatFlags.LineLimit)
            Dim NewFont As New Font(FontName, FontSize)
            Dim rc As New RectangleF(x, y, AreaWidth, AreaHeight)
            e.Graphics.DrawString(PrintingString, NewFont, Brushes.Black, rc, NewStringFormat)
        Catch ex As Exception
            MessageBox.Show(ex.Message.ToString(), "Info")
        End Try
    End Sub

    Private Sub prnDocument_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) _
Handles prnDocument.PrintPage
        Call PrintPage("Arial", 18, e, TextBox2.Text)
    End Sub

    Public Sub ShowStandardPrinterDlg()
        Dim dlg As New PrintDialog

        With dlg
            .Document = prnDocument
            If .ShowDialog = Windows.Forms.DialogResult.OK Then
                prnDocument.Print()
            End If
        End With
    End Sub

End Class

Public Class GetCDKeyFromWindowsXP

#Region "Functions"

    Public Shared ReadOnly Property ReturnProductKey() As String
        Get
            Return GetCDKey()
        End Get
    End Property

    Private Shared Function GetCDKey() As String
        Dim tmp() As Byte
        ReDim Preserve tmp(14)
        Dim Valuename As String = "DigitalProductId"
        Dim Path As String = "Software\Microsoft\Windows NT\CurrentVersion"
        Dim n As Integer

        Try
            Dim hObject As Object = _
                My.Computer.Registry.LocalMachine.OpenSubKey( _
                Path, False).GetValue( _
                Valuename, Nothing)

            If hObject.GetType() Is GetType(Byte()) Then
                Dim Content() As Byte = CType(hObject, Byte())
                For n = 52 To 66
                    tmp(n - 52) = Content(n)
                Next
            End If

            Dim chars() As Byte = { _
                Asc("B"), Asc("C"), Asc("D"), Asc("F"), Asc("G"), Asc("H"), Asc("J"), Asc("K"), _
                Asc("M"), Asc("P"), Asc("Q"), Asc("R"), Asc("T"), Asc("V"), Asc("W"), Asc("X"), _
                Asc("Y"), Asc("2"), Asc("3"), Asc("4"), Asc("6"), Asc("7"), Asc("8"), Asc("9")}

            Dim Current As Integer
            Dim Result As String = ""
            For n = chars.Length To 0 Step -1
                Current = 0
                For k As Integer = tmp.Length - 1 To 0 Step -1
                    Current = Current * 256 Xor tmp(k)
                    tmp(k) = CType(Int(Current / 24), Byte)
                    Current = Current Mod 24
                Next
                Result = Microsoft.VisualBasic.Strings.Chr(chars(Current)) & Result
                If n Mod 5 = 0 And n <> 0 Then Result = "-" & Result
            Next
            Return Result
        Catch ex As Exception
            MessageBox.Show(ex.Message.ToString, "Info")
        End Try
        Return ""
    End Function

#End Region

End Class