Answered by:
Encrypt and Decrypt an XML file

-
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
Question
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
-
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
-
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 zSo 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 rSo 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.
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.
- Edited by Mr. Monkeyboy Saturday, August 24, 2013 2:55 AM 5555
- Marked as answer by Pete - Saturday, August 24, 2013 3:06 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.
- Edited by Mr. Monkeyboy Saturday, August 24, 2013 3:09 AM 5555
- Marked as answer by Pete - Saturday, August 24, 2013 3:21 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
-
-
-
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.
-
-
-
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
-
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
-
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
-
"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.
-
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
-
"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.
-
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
-
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 zSo 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 rSo 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.
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.
- Edited by Mr. Monkeyboy Saturday, August 24, 2013 2:55 AM 5555
- Marked as answer by Pete - Saturday, August 24, 2013 3:06 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
-
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.
- Edited by Mr. Monkeyboy Saturday, August 24, 2013 3:09 AM 5555
- Marked as answer by Pete - Saturday, August 24, 2013 3:21 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.
-
-
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