How to replace text string in a text file - vb.net

I am new to vb.net and am trying to do something really simple. I have this code which reads certain line of text from .ini file.
Dim FilePath As String = Application.StartupPath & "\bin\userconfig.ini"
Dim text As String = IO.File.ReadAllText(FilePath)
Dim newText = text.Replace("UserName = ", TextBox_NewUser.Text)
IO.File.WriteAllText(FilePath, newText)
How do I make it replace that line of text after the "=" with something you type in TextBox_NewUser. As you can see with current code it just replaces the whole "UserName =" which I don't want.
That specific line of text in the .ini by default has this value:
"UserName = Unnamed"
So how do I make it replace just that "Unnamed" with something I type in TextBox_NewUser?
Any assistance will be most appreciated.

Dim newText = text.Replace("UserName = Unnamed", "UserName = " & TextBox_NewUser.Text)

Here is another way to go about this, there are additional assertions that could be done e.g. the code below assumes the lines don't begin with spaces and if they did you would first do a trim on each line before using StartsWith etc.
Config file
Role = Moderator
UserName = xxxx
Joined = 09/23/1006
Code
Public Class Form1
Private fileName As String =
IO.Path.Combine(
AppDomain.CurrentDomain.BaseDirectory, "userConfig.ini")
''' <summary>
''' assumes the file exist but does not assume there is text in
''' the text box.
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Not String.IsNullOrWhiteSpace(TextBox_NewUser.Text) Then
Dim lines As List(Of String) = IO.File.ReadAllLines(fileName).ToList
For index As Integer = 0 To lines.Count - 1
If lines(index).ToLower.StartsWith("username") Then
lines(index) = String.Concat("UserName = ", TextBox_NewUser.Text)
End If
Next
IO.File.WriteAllLines(fileName, lines.ToArray)
End If
End Sub
End Class
Sample project on Microsoft OneDrive, VS2013
https://onedrive.live.com/redir?resid=A3D5A9A9A28080D1!907&authkey=!AKQCanSTiCLP4mE&ithint=file%2czip

Related

Cycle through xml data in VB.Net

I posted a question about how to read the content of external xml files in VB.Net (find it here) and so far everything is going great, but I have no idea how to cycle through the data (they are all elements called savedPassword with a specific id number). Now, I know I am supposed to give a minimum of code, but I am just starting off in XML and VB.Net and I have no idea how much code I need to give for someone to help me out with a script, so here I am, giving a paragraph of code blocks...
I have the following code so far and it works amazingly well (so if no one could modify it, that would be amazing).
My module (Overview.vb):
' Dim values for directories and paths '
Public ReadOnly DirectoryHome As String = "C:\VelocityDK Codes"
Public ReadOnly DirectoryApp As String = "C:\VelocityDK Codes\Password Manager"
Public ReadOnly DataFile As String = "C:\VelocityDK Codes\Password Manager\appData.xml"
' Dim values for .xml file '
Public ReadOnly xmlRoot As String = "savedData"
My [general] form reading the data from my xml file (frmManager.vb):
Option Strict On
Imports System.IO
Imports System.Xml.Serialization
' Some unrelated code '
' This current line is not in the code, but I am disabling the error message with an "unused member" - which is refering to the xmlRoot value right below. '
#Disable Warning IDE0051 ' Remove unused private members
Private ReadOnly xmlRoot As String = "savedData"
#Enable Warning IDE0051 ' Remove unused private members
' Class to represent the xml file '
Public Class SavedData
<XmlElement("savedPassword")>
Public Property SavedPasswords As List(Of SavedPassword)
End Class
' Class to represent data from external xml file '
Public Class SavedPassword
<XmlAttribute("id")>
Public Property ID As Byte
<XmlElement("name")>
Public Property Name As String
<XmlElement("email")>
Public Property Email As String
<XmlElement("password")>
Public Property Password As String
End Class
' Read xml content at first load '
Private Sub FrmManager_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim filename = DataFile
Dim data As SavedData
Dim serializer As New XmlSerializer(GetType(SavedData))
Using sr = New StreamReader(filename)
data = CType(serializer.Deserialize(sr), SavedData)
End Using
For Each sp In data.SavedPasswords
txtID.Text = {sp.ID}.ToString
txtName.Text = {sp.Name}.ToString
txtEmail.Text = {sp.Email}.ToString
txtPassword.Text = {sp.Password}.ToString
Next
End Sub
Finally, my .xml file (appData.xml located in the directory C:\VelocityDK Codes\Password Manager) looks like this:
<?xml version="1.0" encoding="UTF-8"?>
<savedData>
<savedPassword id="01">
<name>Name 01</name>
<email>email01#mail.com<email>
<password>password01</password>
</savedPassword>
<savedPassword id="02">
<name>Name 02</name>
<email>email02#mail.com<email>
<password>password02</password>
</savedPassword>
<!-- Other sections like the aboves going from id's 03 to 06 -->
<savedPassword id="07">
<name>Name 07</name>
<email>email07#mail.com<email>
<password>password07</password>
</savedPassword>
</savedData>
In brief, I have two buttons (btnPrevious & btnNext) and I want to make it so that when I click on the btnPrevious button, it goes to the previous savedPassword (located in my xml file) and vice versa for the btnNext button. How can I do so?
First of all, make your form's load event look like this.
'Make this global
Dim data As SavedData
Private Sub FrmManager_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim filename = DataFile
Dim serializer As New XmlSerializer(GetType(SavedData))
Using sr = New StreamReader(filename)
data = CType(serializer.Deserialize(sr), SavedData)
End Using
'Remove for loop to display just the first record. .
txtID.Text = {data.SavedPasswords(0).ID}.ToString
txtName.Text = {data.SavedPasswords(0).Name}.ToString
txtEmail.Text = {data.SavedPasswords(0).Email}.ToString
txtPassword.Text = {data.SavedPasswords(0).Password}.ToString
End Sub
Next, keep an index somewhere in your program for cycling back and forth the list.
Dim data As SavedData
Dim currentIndex As Integer = 0
Next, Under the button click events, add the following code
'Next button
Public Sub BtnNext_Click(sender As Object, e As EventArgs)
If currentIndex < data.SavedPasswords.Count() Then
currentIndex += 1
Else
MessageBox.Show("End of data reached")
End If
txtID.Text = {data.SavedPasswords(currentIndex).ID}.ToString
txtName.Text = {data.SavedPasswords(currentIndex).Name}.ToString
txtEmail.Text = {data.SavedPasswords(currentIndex).Email}.ToString
txtPassword.Text = {data.SavedPasswords(currentIndex) .Password}
End Sub
'Previous button
Public Sub BtnPrevious_Click(sender As Object, e As EventArgs)
If currentIndex > 0 Then
currentIndex -= 1
Else
MessageBox.Show("This is the first record!")
End If
txtID.Text = {data.SavedPasswords(currentIndex).ID}.ToString
txtName.Text = {data.SavedPasswords(currentIndex).Name}.ToString
txtEmail.Text = {data.SavedPasswords(currentIndex).Email}.ToString
txtPassword.Text = {data.SavedPasswords(currentIndex).Password}
End Sub
I would do the following.
First, create some global variable which would keep the current saved password ID. Then the following procedure will search for the next ID. Note that the actual getting XML must be realized by you.
Private curr_id$ = "01" '//Global variable
'// The direction we're searching
Enum Direction
Forward
Backward
End Enum
'// Get the <savedPassword> element. The function returns Nothing,
'// if it doesn't find ID.
Function GetSavedPassword(direction As Direction) As XElement
Dim obj_xml =
<?xml version="1.0" encoding="UTF-8"?>
<savedData>
<savedPassword id="01">
<name>Name 01</name>
<email>email01#mail.com</email>
<password>password01</password>
</savedPassword>
<savedPassword id="02">
<name>Name 02</name>
<email>email02#mail.com</email>
<password>password02</password>
</savedPassword>
<!-- Other sections like the aboves going from id's 03 to 06 -->
<savedPassword id="07">
<name>Name 07</name>
<email>email07#mail.com</email>
<password>password07</password>
</savedPassword>
</savedData>
Dim next_id = -1 '//ID we're searching (initial state)
Dim curr_id_num = CInt(curr_id) '//Convert string to int
'// Get all IDs from XML
Dim ids = obj_xml.<savedData>.<savedPassword>.Select(Function(x) CInt(x.#id))
'// Next we compare the current ID with available IDs
If direction = Direction.Forward Then
'// If we need to go FORWARD,
'// we must get all IDs which are greater than current id
Dim next_ids = ids.Where(Function(id) id > curr_id_num)
'// Make sure we have found something -
'// in this case it's safe to call Min()
If next_ids.Any() Then next_id = next_ids.Min()
ElseIf direction = Direction.Backward
'// If we need to go BACKWARD,
'// we must get all IDs which are less than current id
Dim next_ids = ids.Where(Function(id) id < curr_id_num)
'// Make sure we have found something -
'//in this case it's safe to call Max()
If next_ids.Any() Then next_id = next_ids.Max()
End If
'// If we found id, it will be greater than 0
If next_id > 0 Then
Dim id_string = If(next_id <= 9, "0" & next_id, next_id)
Return obj_xml.<savedData>.<savedPassword>.
Where(Function(p) p.#id = id_string).
FirstOrDefault()
End If
End Function
'// Usage
Sub Main()
Dim saved_password As XElement = GetSavedPassword(Direction.Forward)
If saved_password IsNot Nothing Then
'// Update current id
curr_id = saved_password.#id
Dim name = saved_password.<name>(0)
Dim email = saved_password.<email>(0)
Dim password = saved_password.<password>(0)
'// Update state of the program
'// ....
End If
End Sub

Split text in group of "x" characters vb.net

I need to split some text, but i'm having trouble with some extra spaces.
The following image shows the usual output text.
I want to add the split values in a checkedlistbox and i have the following code:
Dim SEPARATED = TextBox1.Text.Split(vbCr, vbLf, vbTab, ">") '" "C
CheckedListBox1.Items.Clear()
For Each item In separated
If item <> "" Then CheckedListBox1.Items.Add(item)
Next
CheckedListBox1.Items.Remove("#")
CheckedListBox1.Items.Remove("PI")
Dim MODIFIED As String() = ANSWER.ToString.Split(" ")
buuuuuuut the extra spaces are giving me headaches. I don't know how to split the text in groups of twelve chars ( they're always 12, the spaces complete them) .
In conclusion, using the example, i want to only show "DEFAULT","EX W SPACE","POTATO" and "HELP PLS".
Thank you !
I used the GetOPString() function to return a string with your items in it (DEFAULT","EX W SPACE","POTATO" and "HELP PLS") with a padding of 12 characters. That function you do not need because your source string is already built like that.
I used the following logic
Split source string into lines
If there is a word with no space in front (EXAMPLE), It is some sort of title so I ignore it (you didn't want it in the final result)
Trim word to remove all spaces and starting ">" character if found
See the example below.
You can tweak it according to your need.
Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Dim Rawstring As String = GetOPString("DEFAULT","EX W SPACE","POTATO",">HELP PLS")
Dim SEPARATED As List(Of String) = GetListItems(Rawstring)
For Each Item As String In SEPARATED
CheckedListBox1.Items.Add(Item)
Next
End Sub
''' <summary>
''' Get a list of string by dividing Rawstring into 12 chars sequence.
''' Any space is trimmed and leading > character (if found) is removed.
''' </summary>
''' <param name="RawString"></param>
''' <returns></returns>
Private Function GetListItems(RawString As String) As IEnumerable(Of String)
Dim Output As New List(Of String)
For Each item In RawString.Split(vbCr)
If String.IsNullOrWhiteSpace(item) Then Continue For
Dim AssumeTitle As Boolean = Not String.IsNullOrWhiteSpace(item(0))
If AssumeTitle Then Continue For 'EXAMPLE is the title and we do not want it in the checkbox
item = item.Trim.TrimStart(">"c)
Output.Add(item)
Next
Return Output
End Function
''' <summary>
''' I used this function only to return the string you have in your post,
''' which is, words to be separated in 12 characters sequences.
''' </summary>
''' <returns></returns>
Private Function GetOPString(ByVal ParamArray Words As String()) As String
Dim Output As New Text.StringBuilder
Output.AppendLine("EXAMPLE")
Output.AppendLine()
For Each Item As String In Words
Output.Append(vbTab)
If Not Item.StartsWith(">") Then
Output.Append(" ")
End If
Output.AppendLine(Item.PadRight(12))
Next
Return Output.ToString
End Function

Load Torrent in VB.NET with Monotorrent

im making a simply app to download torrent files, using MonoTorrent. But i cant load the torrent properly, and I've looked all available information.
That's the code im using:
Imports MonoTorrent.BEncoding
Imports MonoTorrent.Client
Imports MonoTorrent.Client.Tracker
Imports MonoTorrent.Common
Imports System.IO
Imports System.Net
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
End Class
Module BitTorrentAnnounceReader
Sub main()
'load Torrentfile
Dim TorrentFile As torrent = ("D:\youtorrent.torrent")
Console.WriteLine(TorrentFile.Name)
'generate annouce paramters
'since we simluate a BitTornado Client double check PeerID and Key Paramter
Dim AnnounceParameter As New AnnounceParameters
AnnounceParameter.BytesLeft = TorrentFile.Size
AnnounceParameter.BytesUploaded = 0
AnnounceParameter.BytesDownloaded = 0
AnnounceParameter.Port = 12224
AnnounceParameter.InfoHash = TorrentFile.InfoHash
AnnounceParameter.PeerId = "T03I-----" & GenerateTorrentClientKeys(11, 1)
AnnounceParameter.ClientEvent = TorrentEvent.Started
'a torrentfile can have more than one url, we use only the first one
'the url should have http to work for this example
Dim AnnounceUrl As String = TorrentFile.AnnounceUrls.Item(0).Item(0).ToString
Console.WriteLine(AnnounceUrl)
'the full announceurl that will fired to tracker
'we are simulating a BitTorando Client
Dim FullAnnounceUrl As String = CreateAnnounceString(AnnounceParameter, AnnounceUrl, GenerateTorrentClientKeys(6))
'building a webrequest for tracker request; some silly line look at comments on
'MonoTorrent.Client.Tracker.HTTPTracker.Announce
Dim req As HttpWebRequest = CType(WebRequest.Create(FullAnnounceUrl), HttpWebRequest)
req.KeepAlive = False
req.Proxy = New WebProxy
'we want to simulate a BitTornado Client, so http headers
req.UserAgent = "User-Agent: BitTornado/T-0.3.18"
'to simulate full client we need also gzip but for better usage we dont use it
' req.Headers.Add("Accept-Encoding", "gzip")
' If (resp.ContentEncoding.ToLower().Contains("gzip")) Then
' Str = New IO.Compression.GZipStream(Str, IO.Compression.CompressionMode.Decompress)
Dim response As HttpWebResponse = req.GetResponse
Dim fs As Stream = WebResponseToStream(response)
Dim peers As List(Of Peer) = AnnounceGetPeerList(fs)
Console.WriteLine("Tracker returned:" & peers.Count)
For Each PeerInfo As Peer In peers
Console.WriteLine(PeerInfo.ConnectionUri.Host & ":" & PeerInfo.ConnectionUri.Port)
Next
Console.ReadKey()
End Sub
''' <summary>
''' Generate a random key depending on which TorrentClient to simulate
''' </summary>
''' <param name="len"></param>
''' <param name="keys"></param>
''' <returns></returns>
''' <remarks></remarks>
Function GenerateTorrentClientKeys(ByVal len As Integer, Optional ByVal keys As Integer = 1) As String
Dim Chars() As String = {"abcdefghijklmnopqrstuvwxyz0123456789", "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"}
'Chars[0] = uTorrent Keys
'Chars[1] = BitTornado Keys
Dim str As String = ""
Dim r As New System.Random()
For i = 1 To len
str &= Chars(keys).Substring(r.Next(1, Chars(keys).Length), 1)
Next
Return str
End Function
''' <summary>
''' A simple way of parsing a bencoded peerlist. it will autodecode compact mode request
''' you can find the full announce parser in the orignal file:
'''
''' MonoTorrent.Client.Tracker.HTTPTracker.HandleAnnounce
''' http://anonsvn.mono-project.com/viewvc/trunk/bitsharp/src/MonoTorrent/MonoTorrent.Client/Tracker/HTTPTracker.cs
''' </summary>
''' <param name="fs"></param>
''' <returns></returns>
''' <remarks></remarks>
Function AnnounceGetPeerList(ByVal fs As Stream) As List(Of Peer)
'you can also use a file with a torrenrequest
'Dim reader As New RawReader(IO.File.Open("file.req", IO.FileMode.Open), False)
'decode the bencoded stream
Dim dictionary As BEncodedDictionary = BEncodedValue.Decode(Of BEncodedDictionary)(fs)
Dim peers As New List(Of Peer)
For Each keypair In dictionary
Select Case keypair.Key.ToString
Case "interval"
'MsgBox TimeSpan.FromSeconds(int.Parse(keypair.Value.ToString()));
'MsgBox(keypair.Value.ToString)
Case "peers"
If TypeOf keypair.Value Is BEncodedList Then
peers.AddRange(Peer.Decode(DirectCast(keypair.Value, BEncodedList)))
ElseIf TypeOf keypair.Value Is BEncodedString Then
peers.AddRange(Peer.Decode(DirectCast(keypair.Value, BEncodedString)))
End If
Case Else
'MsgBox("HttpTracker - Unknown announce tag received:" & keypair.Key.ToString() & keypair.Value.ToString())
End Select
Next
Return peers
End Function
''' <summary>
''' Original CreateAnnounceString is private only and we need to modify it a little bit; this the old one out of svn
''' they have created here a better function that uses UriQueryBuilder but its oversized here
'''
''' MonoTorrent.Client.Tracker.HTTPTracker.CreateAnnounceString
''' http://anonsvn.mono-project.com/viewvc/trunk/bitsharp/src/MonoTorrent/MonoTorrent.Client/Tracker/HTTPTracker.cs?revision=141866
''' </summary>
''' <param name="parameters"></param>
''' <param name="Uri">AnnounceURL of the TorrentFile</param>
''' <param name="Key">a radon key paramter</param>
''' <returns>url to use with a WebRequest</returns>
''' <remarks></remarks>
Private Function CreateAnnounceString(ByVal parameters As AnnounceParameters, ByVal Uri As String, ByVal Key As String) As String
Dim sb As New System.Text.StringBuilder(256)
'base.LastUpdated = DateTime.Now;
' FIXME: This method should be tidied up. I don't like the way it current works
sb.Append(Uri)
sb.Append(If(Uri.Contains("?"), "&"c, "?"c))
sb.Append("info_hash=")
sb.Append(parameters.InfoHash.UrlEncode())
sb.Append("&peer_id=")
sb.Append(parameters.PeerId)
sb.Append("&port=")
sb.Append(parameters.Port)
If parameters.SupportsEncryption Then
sb.Append("&supportcrypto=1")
End If
If parameters.RequireEncryption Then
sb.Append("&requirecrypto=1")
End If
sb.Append("&uploaded=")
sb.Append(parameters.BytesUploaded)
sb.Append("&downloaded=")
sb.Append(parameters.BytesDownloaded)
sb.Append("&left=")
sb.Append(parameters.BytesLeft)
sb.Append("&compact=1")
' Always use compact response
sb.Append("&numwant=")
sb.Append(100)
If Not Uri.Contains("&key=") AndAlso Not Uri.Contains("?key=") Then
sb.Append("&key=")
' The 'key' protocol, used as a kind of 'password'. Must be the same between announces
sb.Append(Key)
End If
If parameters.Ipaddress IsNot Nothing Then
sb.Append("&ip=")
sb.Append(parameters.Ipaddress)
End If
' If we have not successfully sent the started event to this tier, override the passed in started event
' Otherwise append the event if it is not "none"
'if (!parameters.Id.Tracker.Tier.SentStartedEvent)
'{
' sb.Append("&event=started");
' parameters.Id.Tracker.Tier.SendingStartedEvent = true;
'}
If parameters.ClientEvent <> TorrentEvent.None Then
sb.Append("&event=")
sb.Append(parameters.ClientEvent.ToString().ToLower())
End If
Return sb.ToString()
End Function
''' <summary>
''' HttpWebResponse and GetResponseStream dont gives use a full readable stream so we must convert it
'''
''' Look at: MonoTorrent.Client.Tracker.HTTPTracker.DecodeResponse
''' http://anonsvn.mono-project.com/viewvc/trunk/bitsharp/src/MonoTorrent/MonoTorrent.Client/Tracker/HTTPTracker.cs
''' or
''' http://bytes.com/topic/c-sharp/answers/232436-download-binary-file-http#post949811
''' </summary>
''' <param name="response"></param>
''' <returns></returns>
''' <remarks></remarks>
Function WebResponseToStream(ByVal response As HttpWebResponse) As Stream
Dim responseStream As Stream = response.GetResponseStream
Dim fs As MemoryStream = New MemoryStream(256)
Dim buffer As Byte() = New Byte(4095) {}
Dim length As Integer = responseStream.Read(buffer, 0, 4096)
While length > 0
fs.Write(buffer, 0, length)
length = responseStream.Read(buffer, 0, 4096)
End While
fs.Seek(0, SeekOrigin.Begin)
Return fs
End Function
End Module
The problem only appears in the load file .torrent part:
Dim TorrentFile As **torrent** = ("D:\youtorrent.torrent")
Vb.net throws me an error of "Type expected 'on the text torrent. there any solution? Thanks to all!
Try
Dim TorrentFile As torrent = Torrent.Load("D:\youtorrent.torrent")

Edit a properties text file vb.net

I have a text file containing the properties for a virtual server running on my machine. I would like to be able to edit those properties from a GUI built with VB 2008. The Properties file is pre-generated with default values and I would like to change those values to fit my needs.
The Properties file is formatted as follows:
Item-One=ValueOne
Item-Two=ValueTwo
Item-Three=OtherLongValue
etc.
What I need is to be able to select the property based off it's name (Item-Two) and then remove the original value (which may be unknown) and place in my custom value. Values are String type.
I have already tried two suggestions, but neither achieve my goal.
Attempt1:
System.IO.File.WriteAllText(propName, System.IO.File.ReadAllText(propName).Replace("initial", "final"))
Attempt2:
Dim thefile As String = PropertyFileName
Dim lines() As String = System.IO.File.ReadAllLines(thefile)
lines(28) = "Item-Example=" + myValue
System.IO.File.WriteAllLines(thefile, lines)
Number One does not work because it requires me to know the original value, which I do not.
Number Two "works" but often adds new lines instead of replacing the old.
Here is a class I made. It is also documented which should help with inteliSense. Bellow I added some example of its usage.
SettingManager.vb
''' <summary>
''' Manages Settings which can be loaded and saved to a file specified
''' </summary>
''' <remarks></remarks>
Public Class SettingManager
Private filePath As String
Private prop As New Dictionary(Of String, String)
''' <summary>
''' Create a new SettingManager and loads settings from file specified.
''' If file specified doesnt exist, a new one is created upon save()
''' </summary>
''' <param name="filePath">Setting file to load</param>
''' <remarks></remarks>
Sub New(ByVal filePath As String)
Me.filePath = filePath
If (Not System.IO.File.Exists(filePath)) Then
Return
End If
Using reader As System.IO.StreamReader = New System.IO.StreamReader(filePath)
Dim line As String
line = reader.ReadLine()
'Loop through the lines and add each setting to the dictionary: prop
Do While (Not line Is Nothing)
'Spit the line into setting name and value
Dim tmp(2) As String
tmp = line.Split("=")
Me.AddSetting(tmp(0), tmp(1))
line = reader.ReadLine()
Loop
End Using
End Sub
''' <summary>
''' Get value of specified setting if exists.
''' If setting doesnt exist, KeyNotFound exception is thrown
''' </summary>
''' <param name="name">Name of setting</param>
''' <returns>Value of setting</returns>
Function GetSetting(ByVal name As String) As String
If (Not prop.ContainsKey(name)) Then
Throw New KeyNotFoundException("Setting: " + name + " not found")
End If
Return prop(name)
End Function
''' <summary>
''' Adds a new setting.
''' </summary>
''' <param name="name">Name of setting</param>
''' <param name="value">Value of setting</param>
''' <remarks>Save() function should be called to save changes</remarks>
Sub AddSetting(ByVal name As String, ByVal value As String)
If (prop.ContainsKey(name)) Then
prop(name) = value
Else
prop.Add(name, value)
End If
End Sub
''' <summary>
''' Saves settings to file. Any new settings added are also saved
''' </summary>
''' <remarks></remarks>
Sub Save()
Using writer As System.IO.StreamWriter = New System.IO.StreamWriter(filePath)
For Each kvp As KeyValuePair(Of String, String) In Me.prop
writer.WriteLine(kvp.Key + "=" + kvp.Value)
Next
End Using
End Sub
End Class
How to use:
Create a new file in your project called SettingManager.vb
Copy the code above into it
Example Usage
Dim sm As New SettingManager("settings.txt")
'Get Setting
Console.WriteLine(sm.GetSetting("Item-One")) 'Value-One
'Change setting
pm.AddSetting("Item-One", "different_value")
Console.WriteLine(sm.GetSetting("Item-One")) 'different_value
'Add new Setting
pm.AddSetting("name", "Krimson")
Console.WriteLine(sm.GetSetting("name")) 'Krimson
'Save any changes made
sm.Save()
Note: The code is not robust enough. For example if a value contains an =, errors might occur since there is no check implemented to prevent this. However, this should be a good starting point
A little Addition
Do While (Not line Is Nothing)
If line = Nothing OrElse line.Length = 0 OrElse line.StartsWith("#") Then
'Continue Do
Else
'Spit the line into setting name and value
Dim tmp(2) As String
tmp = line.Split("=")
Me.AddSetting(tmp(0), tmp(1))
End If
line = reader.ReadLine()
Loop

generating coupon code

I have five fields
1.CustomerID
2.BusinessID
3.OfferID
4.Day of Purchase
5.Month Of Purchase
Private Function MakeCouponCode(ByVal sn As Int16) As String
Dim a(16) As Char
Dim chk As Int16
Dim check, tDate, slNo, couponCode As String
'..............................setting customerID
If HFCustID.Value.Length = 1 Then
HFCustID.Value = "00" & HFCustID.Value
ElseIf HFCustID.Value.Length = 2 Then
HFCustID.Value = "0" & HFCustID.Value
End If
'..............................setting businessID
If HFBusiID.Value.Length = 1 Then
HFBusiID.Value = "0" & HFBusiID.Value
End If
'..............................setting offerID
If HFOfferID.Value.Length = 1 Then
HFOfferID.Value = "0" & HFOfferID.Value
End If
'..............................setting todays date as ddmm
If Today.Day.ToString.Length = 1 Then
tDate = "0" & Today.Day.ToString
Else
tDate = Today.Day.ToString
End If
If Today.Month.ToString.Length = 1 Then
tDate = tDate & "0" & Today.Month.ToString
Else
tDate = tDate & Today.Month.ToString
End If
'...............................calculating and setting the check digits
If sn < 10 Then
slNo = "0" & Convert.ToString(sn)
Else
slNo = Convert.ToString(sn)
End If
'...............................calculating and setting the check digits
chk = Convert.ToInt16(HFCustID.Value) + Convert.ToInt16(HFCustID.Value) + Convert.ToInt16(HFOfferID.Value) + Today.Day + Today.Month + sn
check = Convert.ToString(chk)
If check.Length = 1 Then
check = "00" & check
ElseIf check.Length = 2 Then
check = "0" & check
End If
'...............................concatenate all for coupon code
couponCode = HFCustID.Value & HFBusiID.Value & HFOfferID.Value & tDate & slNo & check
Return couponCode
End Function
I am using the above code to make a CouponCode...but somehow its not very hard to crack...Any idea how can i make a bullet proof coupon code in not more than 16 digits????
If I understand you correctly, you're generating a 16-digit coup code, and then to validate it, you're using a sort of checksum?
If anyone figures out your checksum algorithm, they're going to be able to generated unlimited coupons.
I think it's better to pre-generate a few thousand or hundred thousand (however many you need) coupon codes, and perhaps make them one-time use (by deleting them or checking if they're already used).
Of course...this depends on your needs. A lot of sites just have easy-to-remember unlimited use coupon codes just to trick people into thinking they're getting a deal.
If you don't want people to be able to generate or guess valid coupon codes, consider using a cryptographic hash function.
One option is to use a hash function. On wikipedia you can find a whole list of them for various hash sizes and uses. With 16 digits you are looking at a 64 bit hash function which I would not call bullet proof.
1.CustomerID i guess at least 3 digits
2.BusinessID maybe 2 digits
3.OfferID 2 digits?
4.Day of Purchase 2 digits
5.Month Of Purchase 2 digits
so in total 11 digits. only 5 remaining.
I would create a longer code and then split it up into 2 parts
1. part are all information that you listed. If you like you can pseudo encrypt them by doing some weird calculations. only important that you can still easily read them
2. part is an encrypted hash from the first part. (take first part, use a hash function, encrypt the result of that hash with a password that only you know)
If someone enters a coupon, you can read all fields without problem, and the remaining fields are used to verify that it is a valid coupon. calculate hash again and encrypt it, and check if your calculation gives the same result. I would use at least 5 digits for the verification.
Here are the functions I use for hash and encryption. Make sure to add the System.Security.Cryptography. You should add those Salt numbers, and store in your program the password. just make sure it will not be readable in any way by users.
Imports System.Security.Cryptography
Imports System.Security
Imports System.Net.Sockets
Imports System.Text
Imports System.IO
Imports System
Namespace Crypt
Module Hash
Function MD5hash(ByVal data() As Byte) As Byte()
' This is one implementation of the abstract class MD5.
Dim md5 As New MD5CryptoServiceProvider()
Dim result As Byte() = md5.ComputeHash(data)
Return result
End Function
' Hash an input string and return the hash as
' a 32 character hexadecimal string.
Function getMd5Hash(ByVal input As String) As String
' Create a new instance of the MD5CryptoServiceProvider object.
Dim md5Hasher As New MD5CryptoServiceProvider()
' Convert the input string to a byte array and compute the hash.
Dim data As Byte() = md5Hasher.ComputeHash(Encoding.Default.GetBytes(input))
' Create a new Stringbuilder to collect the bytes
' and create a string.
Dim sBuilder As New StringBuilder()
' Loop through each byte of the hashed data
' and format each one as a hexadecimal string.
Dim i As Integer
For i = 0 To data.Length - 1
sBuilder.Append(data(i).ToString("x2"))
Next i
' Return the hexadecimal string.
Return sBuilder.ToString()
End Function
' Verify a hash against a string.
Function verifyMd5Hash(ByVal input As String, ByVal hash As String) As Boolean
' Hash the input.
Dim hashOfInput As String = getMd5Hash(input)
' Create a StringComparer an compare the hashes.
Dim comparer As StringComparer = StringComparer.OrdinalIgnoreCase
If 0 = comparer.Compare(hashOfInput, hash) Then
Return True
Else
Return False
End If
End Function
End Module
Module Crypto
''' <summary>
''' Encrypts data with Hash from passToHash
''' </summary>
''' <param name="data"></param>
''' <param name="passToHash"></param>
''' <returns></returns>
''' <remarks></remarks>
Function EncryptWithHash(ByVal data As String, ByVal passToHash As String) As String
Dim _hash As String = getMd5Hash(passToHash)
Dim _result As String = Encrypt(data, _hash)
Return _result
End Function
''' <summary>
''' Decrypts data with Hash from passToHash
''' </summary>
''' <param name="data"></param>
''' <param name="passToHash"></param>
''' <returns>can throw exception</returns>
''' <remarks></remarks>
Function DecryptWithHash(ByVal data As String, ByVal passToHash As String) As String
Dim _hash As String = getMd5Hash(passToHash)
Dim _result As String = Encrypt(data, _hash)
Return _result
End Function
''' <summary>
''' Creates a hash and encrypts it
''' </summary>
''' <param name="data"></param>
''' <param name="password"></param>
''' <returns></returns>
''' <remarks></remarks>
Function SigCreate(ByVal data As String, ByVal password As String) As String
Dim _hash As String = getMd5Hash(data)
Dim _crypt As String = Encrypt(_hash, password)
Return _crypt
End Function
''' <summary>
''' Verifies, if the encrypted Hash is valid
''' </summary>
''' <param name="data"></param>
''' <param name="password"></param>
''' <param name="enc"></param>
''' <returns></returns>
''' <remarks></remarks>
Function SigCheck(ByVal data As String, ByVal password As String, ByVal enc As String) As Boolean
Try
Dim _dec As String = Decrypt(enc, password)
Return verifyMd5Hash(data, _dec)
Catch ex As Exception
End Try
Return False
End Function
Private Salt As Byte() = {51, 39, 204, 201, 190, 167, 217, 190, _
56, 110, 254, 186, 23, 56, 117, 222, _
214, 32, 28, 16, 27, 23, 31, 211, _
101, 92, 143, 234, 45, 63, 75, 82}
''' <summary>
''' Encrypts Data with the given password
''' </summary>
''' <param name="Data"></param>
''' <param name="Password"></param>
''' <returns></returns>
''' <remarks></remarks>
Function Encrypt(ByVal data As String, ByVal password As String) As String
Dim pdb As New Rfc2898DeriveBytes(password, Salt)
Dim alg As Rijndael = Rijndael.Create()
alg.Key = pdb.GetBytes(32)
alg.IV = pdb.GetBytes(16)
Dim ms As New IO.MemoryStream
Dim cs As New CryptoStream(ms, alg.CreateEncryptor, CryptoStreamMode.Write)
cs.Write(System.Text.Encoding.Default.GetBytes(data), 0, data.Length)
cs.Close()
ms.Close()
Return Convert.ToBase64String(ms.ToArray)
End Function
''' <summary>
''' Decrypts Data with the given password
''' </summary>
''' <param name="Data"></param>
''' <param name="Password"></param>
''' <returns></returns>
''' <remarks>can throw exception</remarks>
Function Decrypt(ByVal data As String, ByVal password As String) As String
Dim pdb As New Rfc2898DeriveBytes(password, Salt)
Dim alg As Rijndael = Rijndael.Create()
alg.Key = pdb.GetBytes(32)
alg.IV = pdb.GetBytes(16)
Dim ms As New IO.MemoryStream
Dim cs As New CryptoStream(ms, alg.CreateDecryptor, CryptoStreamMode.Write)
cs.Write(Convert.FromBase64String(data), 0, Convert.FromBase64String(data).Length)
cs.Close()
ms.Close()
Return System.Text.Encoding.Default.GetString(ms.ToArray)
End Function
End Module
End Namespace