Encrypt and Decrypt an XML file

Question

The following code is for encrypting and decrypting, I would like to know the necessary corrections to do this to an XML file instead of an image file?

Mr.Monkeyboy- you helped me initially on this one for images, could you help out on this one for XML files?

Thanks, Pete

'---------------encrypt-----------------------
    Private Function EncryptFiles(ByRef UnencryptedFilePathName As String, ByVal EncryptedFilePathName As String) As String

        UnencryptedFilePathName = Form1.GlobalVariables.appData & "\Schematic Pro 2013\Config\" & "config.xml"
        Dim EncryptElement As New TripleDESCryptoServiceProvider
        EncryptElement.Key = {AscW("Z"c), AscW("4"c), AscW("P"c), AscW("6"c), AscW("C"c), AscW("9"c), AscW("K"c), AscW("7"c), AscW("T"c), AscW("8"c), AscW("C"c), AscW("7"c), AscW("S"c), AscW("8"c), AscW("J"c), AscW("1"c)} '128 bit Key
        EncryptElement.IV = {AscW("6"c), AscW("L"c), AscW("Q"c), AscW("D"c), AscW("5"c), AscW("3"c), AscW("G"c), AscW("Z"c)} ' 64 bit Initialization Vector

        Dim ReadFromFile As FileStream = File.Open(UnencryptedFilePathName, FileMode.Open, FileAccess.Read)
        Dim fStream As FileStream = File.Open(EncryptedFilePathName, FileMode.OpenOrCreate)
        Dim cStream As New CryptoStream(fStream, New TripleDESCryptoServiceProvider().CreateEncryptor(EncryptElement.Key, EncryptElement.IV), CryptoStreamMode.Write)

        Dim Bin(4096) As Byte
        Dim totlen As Long = ReadFromFile.Length
        Dim WriteBytes As Long = 0
        Dim length As Integer = 0

        While WriteBytes < totlen
            length = ReadFromFile.Read(Bin, 0, 4096)
            cStream.Write(Bin, 0, length)
            WriteBytes = Convert.ToInt32(WriteBytes + length)
        End While

        cStream.Close()
        fStream.Close()
        ReadFromFile.Close()


        Return Nothing
    End Function



    '---------------decrypt----------------------
    Private Function DecryptFiles(ByRef FilePathName As String) As String
        Dim DecryptElement As New TripleDESCryptoServiceProvider
        DecryptElement.Key = {AscW("Z"c), AscW("4"c), AscW("P"c), AscW("6"c), AscW("C"c), AscW("9"c), AscW("K"c), AscW("7"c), AscW("T"c), AscW("8"c), AscW("C"c), AscW("7"c), AscW("S"c), AscW("8"c), AscW("J"c), AscW("1"c)}
        DecryptElement.IV = {AscW("6"c), AscW("L"c), AscW("Q"c), AscW("D"c), AscW("5"c), AscW("3"c), AscW("G"c), AscW("Z"c)}

        Dim ImageMem As New IO.MemoryStream
        Dim fStream As FileStream = File.Open(FilePathName, FileMode.Open, FileAccess.Read)
        Dim cStream As New CryptoStream(fStream, New TripleDESCryptoServiceProvider().CreateDecryptor(DecryptElement.Key, DecryptElement.IV), CryptoStreamMode.Read)

        Dim Bin(CInt(fStream.Length)) As Byte
        Dim totlen As Integer = CInt(fStream.Length)
        Dim length As Integer = 0

        length = cStream.Read(Bin, 0, totlen)
        ImageMem.Write(Bin, 0, length)
        'PictureBox1.BackgroundImage = System.Drawing.Image.FromStream(ImageMem)
        fStream.Flush()
        fStream.Close()
        cStream.Close()
        ImageMem.Flush()
        ImageMem.Close()

        Return Nothing
    End Function

Where its notated out in the decryption function is where I believe I will have a problem.

Answer 1

Try this in place of the commented out picturebox line:

Dim fs As New System.IO.FileStream(filePathName, IO.FileMode.Create, IO.FileAccess.Write)
fs.Write(bin, 0, bin.Length)

Hope that helps!

Ray

Answer 2

Thanks, I will try that Ray, I know it has to change to a filepath to my XML and not an image file. I just wasnt sure what else would be affected in the code. Appreciate it.

Answer 3

Why would I get this?

It doesnt exist yet......

Answer 4

Most likely you have Vista, Windows 7, or Windows 8.  Starting in Vista, Microsoft started locking down access to the Program Files folder.  So just like it says, your user account does't have access to save the file.  You have 2 options, run the application as administrator, or go to the folder in explorer and give yourself or your application rights to write to the folder.

Answer 5

Thanks, I figured it was something like that, However I have unlocked all my files, including hidden in win7 ultimate. I will see about changing the read/write. Thanks Ray.....

Answer 6

WHy not just use a directory that you have access to ? Documents, Program Data come to mind.

Answer 7

I was trying to keep this file in the working directory of the whole program, and I see I am going to have issues with that. So, yeah, I think I'll bury my XML file in the Program Data\? (which is best to use for a serial and registration that is going to be encrypted? Roaming or Local?

Thanks Devon

Answer 8

I'm not sure what you're trying to do. So here's a program that encrypts a string (in this instance characters in a RichTextBox) to a file. And it can decrypt the file back to a string (in this case it uses a RichTextBox to place the characters in).

Encrypting and decrypting plain text, which is what I believe an XML file is, doesn't require the complexities of encrypting and decrypting files like an .exe or an image file.

As you can see in the 1st image RichTextBox1 is XML data to be encrypted. RichTextBox2 is the encrypted data from the encrypted file and RichTextBox3 is the decrypted data from the encrypted file.

Note that RichTextBox2 does not display the encrypted data in the same way notepad does in the bottom image. I suppose that's because RichTextBox2 is not set up with the same font style/formatting as notepad.

Imports System
Imports System.IO
Imports System.Security.Cryptography
Imports System.Text

'http://msdn.microsoft.com/en-us/library/system.security.cryptography.tripledescryptoserviceprovider.aspx


Public Class Form1

    Dim FileName As String = "C:\Users\John\Desktop\TestFile.txt"

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.CenterToScreen()
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        File.Delete(FileName)

        Dim EncryptElement As New TripleDESCryptoServiceProvider
        EncryptElement.Key = {AscW("B"c), AscW("A"c), AscW("1"c), AscW("R"c), AscW("3"c), AscW("9"c), AscW("G"c), AscW("V"c), AscW("5"c), AscW("S"c), AscW("P"c), AscW("0"c), AscW("L"c), AscW("Z"c), AscW("4"c), AscW("M"c)} '128 bit Key
        EncryptElement.IV = {AscW("N"c), AscW("B"c), AscW("5"c), AscW("3"c), AscW("G"c), AscW("L"c), AscW("2"c), AscW("Q"c)} ' 64 bit Initialization Vector

        Dim fStream As FileStream = File.Open(FileName, FileMode.OpenOrCreate)
        Dim cStream As New CryptoStream(fStream, New TripleDESCryptoServiceProvider().CreateEncryptor(EncryptElement.Key, EncryptElement.IV), CryptoStreamMode.Write)

        Dim sWriter As New StreamWriter(cStream)

        sWriter.WriteLine(RichTextBox1.Text)

        sWriter.Close()
        cStream.Close()
        fStream.Close()

        ' read the encrypted files text to RichTextBox2

        Dim ReadFile As StreamReader
        ReadFile = New StreamReader(FileName)
        RichTextBox2.Text = ReadFile.ReadToEnd
        ReadFile.Close()

    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

        RichTextBox3.Text = ""

        Dim DecryptElement As New TripleDESCryptoServiceProvider
        DecryptElement.Key = {AscW("B"c), AscW("A"c), AscW("1"c), AscW("R"c), AscW("3"c), AscW("9"c), AscW("G"c), AscW("V"c), AscW("5"c), AscW("S"c), AscW("P"c), AscW("0"c), AscW("L"c), AscW("Z"c), AscW("4"c), AscW("M"c)}
        DecryptElement.IV = {AscW("N"c), AscW("B"c), AscW("5"c), AscW("3"c), AscW("G"c), AscW("L"c), AscW("2"c), AscW("Q"c)}

        Dim fStream As FileStream = File.Open(FileName, FileMode.OpenOrCreate)

        Dim cStream As New CryptoStream(fStream, New TripleDESCryptoServiceProvider().CreateDecryptor(DecryptElement.Key, DecryptElement.IV), CryptoStreamMode.Read)

        Dim sReader As New StreamReader(cStream)

        Dim DecryptedData As String = ""

        DecryptedData = sReader.ReadToEnd

        RichTextBox3.Text = DecryptedData


        sReader.Close()
        cStream.Close()
        fStream.Close()

    End Sub

End Class

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 9

Hello MrMonkeyboy, you are saving the day again- I have been just frustrated with this xml encrypting. I was just about to pull out all my code and just let it fly as it was. I found out I cannot encrypt within the program directory due to Administrator privilages, so I think I can save the xml file in the ProgramData\Local..... without having admin privilage, do you agree? I have not tried it yet. Getting real tired of problems with that. I guess if the file is encrypted, it wont matter where it goes.

I was working with your serial key code- man I am starting to get real lost. I just have to slow down and digest it sloooowly.

Thanks AGAIN, Pete

 

EDIT: How do I reset the file to NOT "be in use by another program" - I always get that after I run it once and come back to it again, then I get "access denied....in use"? Its like VB2010 is not unlocking the file.

EDIT: What is the best way to create an XML that would have 1. Users First and last name, 2. Generated serial number, 3. Generated Machine ID number, and then when it gets activated, 4. Activation key. I'm not familiar with creating an XML file-I have read alot, but seem to have some problems with setting it up.

Thanks, Pete

Answer 10

"EDIT: How do I reset the file to NOT "be in use by another program" - I always get that after I run it once and come back to it again, then I get "access denied....in use"? Its like VB2010 is not unlocking the file."

Unfortunately I have zero idea what you are refering to.

Also I know nothing about XML formatting or how to do it, parse it to read it, etc.

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 11

MrMonkeyboy, How would I decrypt the file and save it back to the original xml file? Or should I use the richtextbox.text and turn it into the readable format. Why I need this is so I can append the file when I put in the appauthcode, for records? Thanks, Pete
One other question, is there a way to use all caps in your serial code:

Option Explicit On
Imports System.Management
Public Class serialize






    Public MyAppsSpecificKey As String = Form1.GlobalVariables.Snum

    Public i As Integer
    Public x As Integer
    Public y As Integer

    Private Sub serialize_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
        Me.CenterToScreen()

        If My.Settings.HardwareId = "Nothing" Then
            My.Settings.HardwareId = BiosInfoConvert(BiosSerNr)
        End If

        If My.Settings.AppAuthCode = "Nothing" Then
            If My.Settings.HardwareId = BiosInfoConvert(BiosSerNr) Then
                My.Settings.AppAuthCode = MakeAuthCode(MyAppsSpecificKey, My.Settings.HardwareId)
            End If
        End If

        If My.Settings.UserAuthorization = "Nothing" Then
            Dialog10.ShowDialog()
        ElseIf My.Settings.UserAuthorization <> My.Settings.AppAuthCode Then
            MessageBox.Show("Your User Authorization does not match your Applications Authorization Code" & vbCrLf & "Contact Bambenek Auto LLC to correct this problem")
            Me.Close()
        End If

        Register.ComputerID.Text = My.Settings.HardwareId
        Register.SerialID.Text = MyAppsSpecificKey
        Me.Text = MyAppsSpecificKey & " ... " & My.Settings.HardwareId & " ... " & My.Settings.AppAuthCode & " ... " & My.Settings.UserAuthorization

    End Sub

    Private Function BiosSerNr() As String

        Dim query As New SelectQuery("Win32_bios")
        Dim search As New ManagementObjectSearcher(query)
        Dim info As ManagementObject

        Dim Temp() As String

        Dim BiosInfo As String = ""

        For Each info In search.Get()
            BiosInfo &= info("serialnumber").ToString & ","
        Next

        Temp = BiosInfo.Split(","c)

        BiosInfo = Temp(0)

        Return BiosInfo

    End Function

    Private Function BiosInfoConvert(ByRef Info As String) As String
        Dim Value As String
        Dim Ascii As String = ""
        Dim NewValue As String = ""
        While Info.Length > 0
            Value = Strings.Asc(Info.Substring(0, 1).ToString()).ToString
            Info = Info.Substring(1, Info.Length - 1)
            Ascii += Value 'Ascii & Value
        End While

        Dim AsciiInt As Decimal

        ' Below is used twice in a row in case Ascii is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If Ascii.Count > 20 Then
            AsciiInt = CDec(Ascii.Remove(20, Ascii.Count - 20))
            For x = 20 To Ascii.Count - 1
                AsciiInt += CDec(Ascii.Chars(x).ToString)
            Next
            Ascii = AsciiInt.ToString
        End If

        If Ascii.Count > 20 Then
            AsciiInt = CDec(Ascii.Remove(20, Ascii.Count - 20))
            For y = 20 To Ascii.Count - 1
                AsciiInt += CDec(Ascii.Chars(y).ToString)
            Next
            Ascii = AsciiInt.ToString
        End If

        ' ________________________________________________________________________________________________________________

        If Ascii.Count < 20 Then
            Ascii = Ascii.PadRight(20, "7"c)
        End If

        Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97}

        For i = 0 To Ascii.Length - 1
            NewValue &= Chr(CInt(Ascii.Chars(i).ToString) + IntToAdd(i))
        Next i

        Ascii = NewValue
        Ascii = Ascii.Insert(4, "-")
        Ascii = Ascii.Insert(9, "-")
        Ascii = Ascii.Insert(14, "-")
        Ascii = Ascii.Insert(19, "-")

        Return Ascii

    End Function

    Private Function MakeAuthCode(ByRef AppInfo As String, ByRef HardwareInfo As String) As String

        Dim Temp1() As String

        Temp1 = AppInfo.Split("-"c)

        Dim ASI As String = ""
        For i = 0 To Temp1.Count - 1
            ASI += Temp1(i)
        Next

        Dim Value1 As String = ""
        Dim Ascii1 As String = ""

        While ASI.Length > 0
            Value1 = Strings.Asc(ASI.Substring(0, 1).ToString()).ToString
            ASI = ASI.Substring(1, ASI.Length - 1)
            Ascii1 += Value1
        End While

        Dim ASIValue As String = ""

        For i = 0 To Ascii1.Length - 1
            ASIValue += CStr(CInt(Ascii1.Chars(i).ToString))
        Next

        Dim ASIIntValue As Decimal

        ' Below is used twice in a row in case ASIValue is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If ASIValue.Count > 20 Then
            ASIIntValue = CDec(ASIValue.Remove(20, ASIValue.Count - 20))
            For x = 20 To ASIValue.Count - 1
                ASIIntValue += CDec(ASIValue.Chars(x).ToString)
            Next
            ASIValue = ASIIntValue.ToString
        End If

        If ASIValue.Count > 20 Then
            ASIIntValue = CDec(ASIValue.Remove(20, ASIValue.Count - 20))
            For y = 20 To ASIValue.Count - 1
                ASIIntValue += CDec(ASIValue.Chars(y).ToString)
            Next
            ASIValue = ASIIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim Temp2() As String
        Temp2 = HardwareInfo.Split("-"c)

        Dim HID As String = ""
        For x = 0 To Temp2.Count - 1
            HID += Temp2(x)
        Next

        Dim Value2 As String = ""
        Dim Ascii2 As String = ""
        While HID.Length > 0
            Value2 = Strings.Asc(HID.Substring(0, 1).ToString()).ToString
            HID = HID.Substring(1, HID.Length - 1)
            Ascii2 += Value2
        End While

        Dim HIDValue As String = ""

        For i = 0 To Ascii2.Length - 1
            HIDValue += CStr(CInt(Ascii2.Chars(i).ToString))
        Next

        Dim HIDIntValue As Decimal

        ' Below is used twice in a row in case HIDValue is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If HIDValue.Count > 20 Then
            HIDIntValue = CDec(HIDValue.Remove(20, HIDValue.Count - 20))
            For x = 20 To HIDValue.Count - 1
                HIDIntValue += CDec(HIDValue.Chars(x).ToString)
            Next
            HIDValue = HIDIntValue.ToString
        End If

        If HIDValue.Count > 20 Then
            HIDIntValue = CDec(HIDValue.Remove(20, HIDValue.Count - 20))
            For x = 20 To HIDValue.Count - 1
                HIDIntValue += CDec(HIDValue.Chars(x).ToString)
            Next
            HIDValue = HIDIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim ASIDec As Decimal = CDec(ASIValue)
        Dim HIDDec As Decimal = CDec(HIDValue)

        Dim LastValue As String = (ASIDec + HIDDec).ToString

        Dim LastIntValue As Decimal

        ' Below is used twice in a row in case LastValue is still over 20 once the first if statement runs.
        ' This will probably never happen for LastValue but could I suppose.

        If LastValue.Count > 20 Then
            LastIntValue = CDec(LastValue.Remove(20, LastValue.Count - 20))
            For x = 20 To LastValue.Count - 1
                LastIntValue += CDec(LastValue.Chars(x).ToString)
            Next
            LastValue = LastIntValue.ToString
        End If

        If LastValue.Count > 20 Then
            LastIntValue = CDec(LastValue.Remove(20, LastValue.Count - 20))
            For x = 20 To LastValue.Count - 1
                LastIntValue += CDec(LastValue.Chars(x).ToString)
            Next
            LastValue = LastIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim NewValue As String = ""

        Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97}

        For i = 0 To LastValue.Length - 1
            NewValue &= Chr(CInt(LastValue.Chars(i).ToString) + IntToAdd(i))
        Next i

        NewValue = NewValue.Insert(4, "-")
        NewValue = NewValue.Insert(9, "-")
        NewValue = NewValue.Insert(14, "-")
        NewValue = NewValue.Insert(19, "-")

        Return NewValue

    End Function

End Class

Answer 12

"How would I decrypt the file and save it back to the original xml file? "

You need to explain what you're doing in order for me to comment on how you could go about doing it.

"One other question, is there a way to use all caps in your serial code:"

Yes there is. But what is the serial code? Also the key generator can be made to only use caps too. I've probably deleted all of the code I wrote already except for the key generator.

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 13

Good evening, how are you. I have all the code for the serialization: To make it caps only on the alpha characters.

Option Explicit On
Imports System.Management
Public Class serialize






    Public MyAppsSpecificKey As String = Form1.GlobalVariables.Snum

    Public i As Integer
    Public x As Integer
    Public y As Integer

    Private Sub serialize_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
        Me.CenterToScreen()

        If My.Settings.HardwareId = "Nothing" Then
            My.Settings.HardwareId = BiosInfoConvert(BiosSerNr)
        End If

        If My.Settings.AppAuthCode = "Nothing" Then
            If My.Settings.HardwareId = BiosInfoConvert(BiosSerNr) Then
                My.Settings.AppAuthCode = MakeAuthCode(MyAppsSpecificKey, My.Settings.HardwareId)
            End If
        End If

        If My.Settings.UserAuthorization = "Nothing" Then
            Dialog10.ShowDialog()
        ElseIf My.Settings.UserAuthorization <> My.Settings.AppAuthCode Then
            MessageBox.Show("Your User Authorization does not match your Applications Authorization Code" & vbCrLf & "Contact Bambenek Auto LLC to correct this problem")
            Me.Close()
        End If

        Register.ComputerID.Text = My.Settings.HardwareId
        Register.SerialID.Text = MyAppsSpecificKey
        Me.Text = MyAppsSpecificKey & " ... " & My.Settings.HardwareId & " ... " & My.Settings.AppAuthCode & " ... " & My.Settings.UserAuthorization

    End Sub

    Private Function BiosSerNr() As String

        Dim query As New SelectQuery("Win32_bios")
        Dim search As New ManagementObjectSearcher(query)
        Dim info As ManagementObject

        Dim Temp() As String

        Dim BiosInfo As String = ""

        For Each info In search.Get()
            BiosInfo &= info("serialnumber").ToString & ","
        Next

        Temp = BiosInfo.Split(","c)

        BiosInfo = Temp(0)

        Return BiosInfo

    End Function

    Private Function BiosInfoConvert(ByRef Info As String) As String
        Dim Value As String
        Dim Ascii As String = ""
        Dim NewValue As String = ""
        While Info.Length > 0
            Value = Strings.Asc(Info.Substring(0, 1).ToString()).ToString
            Info = Info.Substring(1, Info.Length - 1)
            Ascii += Value 'Ascii & Value
        End While

        Dim AsciiInt As Decimal

        ' Below is used twice in a row in case Ascii is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If Ascii.Count > 20 Then
            AsciiInt = CDec(Ascii.Remove(20, Ascii.Count - 20))
            For x = 20 To Ascii.Count - 1
                AsciiInt += CDec(Ascii.Chars(x).ToString)
            Next
            Ascii = AsciiInt.ToString
        End If

        If Ascii.Count > 20 Then
            AsciiInt = CDec(Ascii.Remove(20, Ascii.Count - 20))
            For y = 20 To Ascii.Count - 1
                AsciiInt += CDec(Ascii.Chars(y).ToString)
            Next
            Ascii = AsciiInt.ToString
        End If

        ' ________________________________________________________________________________________________________________

        If Ascii.Count < 20 Then
            Ascii = Ascii.PadRight(20, "7"c)
        End If

        Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97}

        For i = 0 To Ascii.Length - 1
            NewValue &= Chr(CInt(Ascii.Chars(i).ToString) + IntToAdd(i))
        Next i

        Ascii = NewValue
        Ascii = Ascii.Insert(4, "-")
        Ascii = Ascii.Insert(9, "-")
        Ascii = Ascii.Insert(14, "-")
        Ascii = Ascii.Insert(19, "-")

        Return Ascii

    End Function

    Private Function MakeAuthCode(ByRef AppInfo As String, ByRef HardwareInfo As String) As String

        Dim Temp1() As String

        Temp1 = AppInfo.Split("-"c)

        Dim ASI As String = ""
        For i = 0 To Temp1.Count - 1
            ASI += Temp1(i)
        Next

        Dim Value1 As String = ""
        Dim Ascii1 As String = ""

        While ASI.Length > 0
            Value1 = Strings.Asc(ASI.Substring(0, 1).ToString()).ToString
            ASI = ASI.Substring(1, ASI.Length - 1)
            Ascii1 += Value1
        End While

        Dim ASIValue As String = ""

        For i = 0 To Ascii1.Length - 1
            ASIValue += CStr(CInt(Ascii1.Chars(i).ToString))
        Next

        Dim ASIIntValue As Decimal

        ' Below is used twice in a row in case ASIValue is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If ASIValue.Count > 20 Then
            ASIIntValue = CDec(ASIValue.Remove(20, ASIValue.Count - 20))
            For x = 20 To ASIValue.Count - 1
                ASIIntValue += CDec(ASIValue.Chars(x).ToString)
            Next
            ASIValue = ASIIntValue.ToString
        End If

        If ASIValue.Count > 20 Then
            ASIIntValue = CDec(ASIValue.Remove(20, ASIValue.Count - 20))
            For y = 20 To ASIValue.Count - 1
                ASIIntValue += CDec(ASIValue.Chars(y).ToString)
            Next
            ASIValue = ASIIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim Temp2() As String
        Temp2 = HardwareInfo.Split("-"c)

        Dim HID As String = ""
        For x = 0 To Temp2.Count - 1
            HID += Temp2(x)
        Next

        Dim Value2 As String = ""
        Dim Ascii2 As String = ""
        While HID.Length > 0
            Value2 = Strings.Asc(HID.Substring(0, 1).ToString()).ToString
            HID = HID.Substring(1, HID.Length - 1)
            Ascii2 += Value2
        End While

        Dim HIDValue As String = ""

        For i = 0 To Ascii2.Length - 1
            HIDValue += CStr(CInt(Ascii2.Chars(i).ToString))
        Next

        Dim HIDIntValue As Decimal

        ' Below is used twice in a row in case HIDValue is still over 20 once the first if statement runs.
        ' This only happens if the code is all lower case c which is Ascii value of 99 (i.e. code = cccc-cccc-cccc-cccc-cccc)

        If HIDValue.Count > 20 Then
            HIDIntValue = CDec(HIDValue.Remove(20, HIDValue.Count - 20))
            For x = 20 To HIDValue.Count - 1
                HIDIntValue += CDec(HIDValue.Chars(x).ToString)
            Next
            HIDValue = HIDIntValue.ToString
        End If

        If HIDValue.Count > 20 Then
            HIDIntValue = CDec(HIDValue.Remove(20, HIDValue.Count - 20))
            For x = 20 To HIDValue.Count - 1
                HIDIntValue += CDec(HIDValue.Chars(x).ToString)
            Next
            HIDValue = HIDIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim ASIDec As Decimal = CDec(ASIValue)
        Dim HIDDec As Decimal = CDec(HIDValue)

        Dim LastValue As String = (ASIDec + HIDDec).ToString

        Dim LastIntValue As Decimal

        ' Below is used twice in a row in case LastValue is still over 20 once the first if statement runs.
        ' This will probably never happen for LastValue but could I suppose.

        If LastValue.Count > 20 Then
            LastIntValue = CDec(LastValue.Remove(20, LastValue.Count - 20))
            For x = 20 To LastValue.Count - 1
                LastIntValue += CDec(LastValue.Chars(x).ToString)
            Next
            LastValue = LastIntValue.ToString
        End If

        If LastValue.Count > 20 Then
            LastIntValue = CDec(LastValue.Remove(20, LastValue.Count - 20))
            For x = 20 To LastValue.Count - 1
                LastIntValue += CDec(LastValue.Chars(x).ToString)
            Next
            LastValue = LastIntValue.ToString
        End If

        ' ________________________________________________________________________________________________________________

        Dim NewValue As String = ""

        Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97}

        For i = 0 To LastValue.Length - 1
            NewValue &= Chr(CInt(LastValue.Chars(i).ToString) + IntToAdd(i))
        Next i

        NewValue = NewValue.Insert(4, "-")
        NewValue = NewValue.Insert(9, "-")
        NewValue = NewValue.Insert(14, "-")
        NewValue = NewValue.Insert(19, "-")

        Return NewValue

    End Function

End Class

Thankyou in advance.

We will do one thing at a time.

Answer 14

Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97}

The code above is what determines the final output of each "key". Each of the 20 numbers is used to represent an Ascii value.

From an Ascii tables decimal values of a character:

48 - 57 = 0 through 9
65 - 90 = A through Z
97 - 122 = a through z

So the program takes 20 digits (each digit being 0 to 9) which are in a string (like LastValue) and converts each one to an integer. It then adds them in order to the IntToAdd arrays integers. The result is then changed to a character represented by the Ascii value of the integer.

Example

LastValue = "19024787753924645982"

In order of adding Last Value (LV) characters converted to integers to IntToAdd (ITA) integers for the first four values of each.

LV  ITA
1 + 64 = 65 = Ascii character A
9 + 48 = 57 = Ascii character 9
0 + 106 = 106 = Ascii character j
2 + 112 = 114 = Ascii character r

So what you want to do is no longer use integers between 97 to 122 in the IntToAdd arrays.
Also don't use anything other than 48 for numbers because if you add, for example, 9 to 49 you would get 58 which is Ascii character ":".
And you must not use a number for letters larger than 9 less than the highest number of those letters range. For example A through Z is 65 to 90 so the highest number you could use is 81 because 81 + 9 = 90 = Z.

On another note I used 64 in the first location of IntToAdd even though that represents Ascii character "@". But the very first digit in the string LastValue would always be greater than Zero so that wouldn't matter.

So you'll note that for each value returned as a Code from those functions the character ranges will only be 10 variations for each position in the IntToAdd array. In other words 72 (index 4 of IntToArray) will always return between H and Q. Because it can only have between 0 and 9 added to it. 72 = H and 72 + 9 = 81 = Q.

And every string returned by the function will always have a letter or number in the same position as every other string ever returned by the function. So I would jumble the letter integers so no two ranges are similar if possible or next to each other in a similar range at least.

But you need twenty so you figure how you want to do it. I.e. ltr, nr, ltr, ltr, nr, nr, ltr, nr, ltr, ltr, nr, ltr, nr, nr, ltr, ltr, ltr, nr, ltr, nr and then your output will always look like A0RT-19Y7-LV9N-90FH-A3U2 or something like that depending on what range you provide each letter position.

That may not be the best way to do it but it's the only way I could figure out how to do it with my experience level.

http://www.asciitable.com/

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 15

Very well explained, thankyou so much, now I can understand it better. If you could tell me in the settings of the project you had me put in a string named "HardwareId", now that I have run the project a few times, it seems to always know what the value is when running the program on first load- even though no code has been run to create it, Is this something that is retained in the project and/or will it always store the value on first run on a users machine? Thanks - much appreciated, Pete

Answer 16

Also I don't believe that Dim IntToAdd() As Integer = {64, 48, 106, 112, 72, 48, 100, 68, 48, 81, 74, 48, 102, 48, 98, 80, 78, 48, 74, 97} has to be the same in the function BiosInfoConvert or MakeAuthCode. In case you want each of them to produce a differently arranged series of characters.

But if you're using the program "BAM Auto User Code Authorizer" I believe you will need to change it so its IntToAdd matches the MakeAuthCode functions IntToAdd list of integers. Or it will not make the same auth code as the program you posted will make. Which means if you use it to give a customer a "key" it will never match the "key" their code already created. So their program will never run.

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 17

Thats good to know, because I will be using that "BAM Auto User Code Authorizer" . I am going to try to get that to run on my website in the background. Thankyou Mr.Monkey

Answer 18

Thats good to know, because I will be using that "BAM Auto User Code Authorizer" . I am going to try to get that to run on my website in the background. Thankyou Mr.Monkey

That's Mr. Monkeyboy to you Pete. And you're welcome.

---

Please BEWARE that I have NO EXPERIENCE and NO EXPERTISE and probably onset of DEMENTIA which may affect my answers! Also, I've been told by an expert, that when you post an image it clutters up the thread and mysteriously, over time, the link to the image will somehow become "unstable" or something to that effect. :) I can only surmise that is due to Global Warming of the threads.

Answer 19

Sh***t, This keyboard and my brain are getting drained today- so sorry about that. It would be easier to use your first name, but I understand if not. Thanks for all your great help, Pete

Answer 20

If you could tell me in the settings of the project you had me put in a string named "HardwareId", now that I have run the project a few times, it seems to always know what the value is when running the program on first load- even though no code has been run to create it, Is this something that is retained in the project and/or will it always store the value on first run on a users machine? Thanks - much appreciated, Pete