none
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.
    • Edited by Pete - Monday, August 19, 2013 8:10 PM
    Monday, August 19, 2013 8:10 PM

Answers

  • 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

    • Marked as answer by Pete - Tuesday, August 20, 2013 12:43 PM
    Monday, August 19, 2013 8:55 PM
  • 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.

    • Marked as answer by Pete - Tuesday, August 20, 2013 12:42 PM
    Tuesday, August 20, 2013 3:15 AM
  • 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.



    Saturday, August 24, 2013 2:50 AM
  • 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.



    Saturday, August 24, 2013 3:05 AM

All replies

  • 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

    • Marked as answer by Pete - Tuesday, August 20, 2013 12:43 PM
    Monday, August 19, 2013 8:55 PM
  • 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.
    • Edited by Pete - Monday, August 19, 2013 8:58 PM
    Monday, August 19, 2013 8:58 PM
  • Why would I get this?

    It doesnt exist yet......
    • Edited by Pete - Monday, August 19, 2013 10:32 PM
    Monday, August 19, 2013 10:31 PM
  • 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.
    Monday, August 19, 2013 10:35 PM
  • 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.....
    • Edited by Pete - Monday, August 19, 2013 11:28 PM
    Monday, August 19, 2013 11:27 PM
  • WHy not just use a directory that you have access to ? Documents, Program Data come to mind.
    Tuesday, August 20, 2013 1:09 AM
  • 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


    • Edited by Pete - Tuesday, August 20, 2013 2:07 AM
    Tuesday, August 20, 2013 2:07 AM
  • 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.

    • Marked as answer by Pete - Tuesday, August 20, 2013 12:42 PM
    Tuesday, August 20, 2013 3:15 AM
  • 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



    • Edited by Pete - Tuesday, August 20, 2013 4:33 AM
    Tuesday, August 20, 2013 3:39 AM
  • "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.

    Tuesday, August 20, 2013 7:21 AM
  • 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
    • Edited by Pete - Saturday, August 24, 2013 12:49 AM
    Saturday, August 24, 2013 12:45 AM
  • "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.

    Saturday, August 24, 2013 1:39 AM
  • 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.


    • Edited by Pete - Saturday, August 24, 2013 1:44 AM
    Saturday, August 24, 2013 1:43 AM
  • 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.



    Saturday, August 24, 2013 2:50 AM
  • 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
    • Edited by Pete - Saturday, August 24, 2013 3:02 AM
    Saturday, August 24, 2013 3:01 AM
  • 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.



    Saturday, August 24, 2013 3:05 AM
  • 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
    • Edited by Pete - Saturday, August 24, 2013 3:21 AM
    Saturday, August 24, 2013 3:20 AM
  • 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.

    Saturday, August 24, 2013 3:22 AM
  • 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
    • Edited by Pete - Saturday, August 24, 2013 3:25 AM
    Saturday, August 24, 2013 3:24 AM
  • 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
    Saturday, August 24, 2013 3:27 AM