Multi Thread In VB.net

Multi Threading in VB.Net

imports system.threading
Dim ThreadObject As Thread
ThreadObject = New Thread(AddressOf ClassName.functioname)
ThreadObject.Start()

_________________________________________________________________


The Thread generally does not accept any argument. you can create a constructor of a class and pass the required argument to that constructor.

E.g.:

ClassObject = New Classname(arg1,arg2,arg3,[]) /* The Constructor will assign pass the argument /*
ThreadObject = New Thread(AddressOf ClassName.functioname)
ThreadObject .Start()

__________________________________________________________________

Thread can not update to the control of the window directly but you can update the control of window by means of Delegate.

Convert .vox to .wav

mdlconvertvox2wav.Convert(SourceFileName, destinationFileName)
_________________________________________________________________
Create a module
Module mdlconvertvox2wav
Dim WaveHeader() As Int32 = New Int32() {&H46464952, &HFFFFFFDB, &H45564157, &H20746D66, 16, &H10001, 6000, 12000, &H100002, &H61746164, -1}
Dim IndexShift() As Int16 = New Int16() {-1, -1, -1, -1, 2, 4, 6, 8}
Dim StepSize() As Int16 = New Int16() {16, 17, 19, 21, 23, 25, 28, 31, 34, 37, 41, 45, 50, 55, 60, 66, 73, 80, 88, 97, 107, 118, 130, 143, 157, 173, 190, 209, 230, 253, 279, 307, 337, 371, 408, 449, 494, 544, 598, 658, 724, 796, 876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066, 2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358, 5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899, 15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794}
Dim Nibble2Bit(,) As Int16 = New Int16(,) {{0, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 0}, {0, 0, 1, 1}, {0, 1, 0, 0}, {0, 1, 0, 1}, {0, 1, 1, 0}, {0, 1, 1, 1}, {1, 0, 0, 0}, {1, 0, 0, 1}, {1, 0, 1, 0}, {1, 0, 1, 1}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 1, 0}, {1, 1, 1, 1}}
Dim SignTable() As Int16 = New Int16() {1, -1}
Dim StepSizeIndex As Int16 = 0
Dim Signal As Int16 = -2
Dim AvgBuffer() As Int16 = New Int16() {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
Dim AvgIndex As Int16 = 0
Dim Total As Int32 = 0
Dim Length As Int32
Dim Offset As Int32
Dim nibble As Int16
Dim ReadBuffer(4096) As Byte
Dim WriteBuffer(8192) As Int16

Public Sub Convert(ByVal srcVOXFile As String, ByVal destWAVFile As String)
Dim strm As New IO.FileStream(srcVOXFile, IO.FileMode.Open, IO.FileAccess.Read)
FileOpen(2, destWAVFile, OpenMode.Binary, OpenAccess.Write, OpenShare.LockWrite)
FilePut(2, WaveHeader)
Length = 4096
While Length = 4096
Length = strm.Read(ReadBuffer, 0, 4096)
For Offset = 0 To Length - 1
nibble = 0
Signal += Decode(ReadBuffer(Offset) \ 16)
If (Signal > 2047 Or Signal < -2047) Then Truncate()
WriteBuffer(2 * Offset) = Signal
nibble = 1
Signal += Decode(ReadBuffer(Offset) Mod 16)
If (Signal > 2047 Or Signal < -2047) Then Truncate()
WriteBuffer(2 * Offset + 1) = Signal
Next
FilePut(2, WriteBuffer)
Total += Length
End While
strm.Close() : strm = Nothing
Total = 4 * Total
Length = Total + 36
FilePut(2, Length, 4 + 1)
FilePut(2, Total, 40 + 1)
FileClose(2)
End Sub

Public Function Decode(ByVal i As Byte) As Int16
Dim diff As Int16
Dim value As Int32
value = 2 * Total + 2 * Offset + nibble
diff = SignTable(Nibble2Bit(i, 0)) * (StepSize(StepSizeIndex) * Nibble2Bit(i, 1) + (StepSize(StepSizeIndex) / 2) * Nibble2Bit(i, 2) + (StepSize(StepSizeIndex) / 4) * Nibble2Bit(i, 3) + (StepSize(StepSizeIndex) / 8))
StepSizeIndex = StepSizeIndex + IndexShift(i Mod 8)
If StepSizeIndex < 0 Then StepSizeIndex = 0
If StepSizeIndex > 48 Then
StepSizeIndex = 48
End If
Return diff
End Function

Public Sub Truncate()
Dim value As Int32
value = 2 * Total + 2 * Offset + nibble
If Signal > 2047 Then Signal = 2047
If Signal < -2047 Then Signal = -2047
End Sub

End Module
_____________________________________________________________

Text to Speech

Step 1: Add a reference with com object Mocrosoft speech Object Library
St2p 2:Import Sppechlib

Code :

Dim voice As New SpVoice
___________________________________________________________
Read from the File

OpenFileDialog.Filter = "Text Files (*.txt)|*.txt"
If OpenFileDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
Dim fs As New System.IO.FileStream(Me.OpenFileDialog.FileName, IO.FileMode.Open, IO.FileAccess.Read)
Dim fr As New System.IO.StreamReader(fs)
Me.txttext.Text = fr.ReadToEnd
End If

___________________________________________________________

Some of the Property to be used

voice.Pause() ' For Pause
voice.resume() ' For Resume
voice.Rate = Val(txtrate.Text) 'speed
voice.Volume = Val(txtvolume.Text) ' volume

voice.Speak(Me.txttext.Text, SpeechVoiceSpeakFlags.SVSFlagsAsync) ' For Speek

________________________________________________________________

Save to a Wav File:
Dim cpFileStream As New SpeechLib.SpFileStream
Dim filename As String = "C:\rajiv.wav"
Try
SaveFileDialog.Filter = ".Wav File|*.wav"
If SaveFileDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
filename = SaveFileDialog.FileName
If File.Exists(filename) Then Kill(filename)
Dim oVoice As New SpeechLib.SpVoice
cpFileStream.Open(filename, SpeechLib.SpeechStreamFileMode.SSFMCreateForWrite, False)
oVoice.AudioOutputStream = cpFileStream
oVoice.Volume = Val(txtvolume.Text)
oVoice.Rate = Val(txtrate.Text)
oVoice.Speak(txttext.Text, SpeechLib.SpeechVoiceSpeakFlags.SVSFDefault)
oVoice = Nothing
cpFileStream.Close()
cpFileStream = Nothing
MsgBox("File Saved Successfully!!!!", vbInformation)
End If
_____________________________________________________________

Use of Delegate in c#


// Declare the Delegate
public delegate void Uploaddelegate();
// Create the object of Delegate
Uploaddelegate obj1 = new Uploaddelegate(ABC);


public static void ABC()
{
// Enter the Code to Do
}


Namespaces of .Net

System: Includes essential classes and base classes for commonly used data types, events, exceptions and so on
System.Collections: Includes classes and interfaces that define various collection of objects such as list, queues,
hash tables, arrays, etc
System.Data: Includes classes which lets us handle data from data sources
System.Data.OleDb: Includes classes that support the OLEDB .NET provider
System.Data.SqlClient: Includes classes that support the SQL Server .NET provider
System.Diagnostics: Includes classes that allow to debug our application and to step through our code
System.Drawing: Provides access to drawing methods
System.Globalization: Includes classes that specify culture-related information
System.IO: Includes classes for data access with Files
System.Net: Provides interface to protocols used on the internet
System.Reflection: Includes classes and interfaces that return information about types, methods and fields
System.Security: Includes classes to support the structure of common language runtime security system
System.Threading: Includes classes and interfaces to support multithreaded applications
System.Web: Includes classes and interfaces that support browser-server communication
System.Web.Services: Includes classes that let us build and use Web Services
System.Windows.Forms: Includes classes for creating Windows based forms
System.XML: Includes classes for XML support

Extract the icon From Exe

______________________ Class Definition_____________________




Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices

Public Class ClsExtractIcon

'=====================================================================================
' Enumerations
'=====================================================================================
Private Enum SHGFI
SmallIcon = &H1
LargeIcon = &H0
Icon = &H100
DisplayName = &H200
Typename = &H400
SysIconIndex = &H4000
UseFileAttributes = &H10
End Enum

Public Enum IconSize
SmallIcon = 1
LargeIcon = 0
End Enum

'=====================================================================================
' Structures
'=====================================================================================
_
Private Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
Public szDisplayName As String
Public szTypeName As String

Public Sub New(ByVal B As Boolean)
hIcon = IntPtr.Zero
iIcon = 0
dwAttributes = 0
szDisplayName = vbNullString
szTypeName = vbNullString
End Sub
End Structure

'=====================================================================================
' API Calls
'=====================================================================================
Private Declare Auto Function SHGetFileInfo Lib "shell32" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlagsn As SHGFI) As Integer

'=====================================================================================
' Functions and Procedures...
'=====================================================================================
Public Shared Function GetDefaultIcon(ByVal Path As String, Optional ByVal IconSize As IconSize = IconSize.SmallIcon, Optional ByVal SaveIconPath As String = "") As Icon
Dim info As New SHFILEINFO(True)
Dim cbSizeInfo As Integer = Marshal.SizeOf(info)
Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes
flags = flags + IconSize
SHGetFileInfo(Path, 256, info, cbSizeInfo, flags)
GetDefaultIcon = Icon.FromHandle(info.hIcon)
If SaveIconPath <> "" Then
Dim FileStream As New IO.FileStream(SaveIconPath, IO.FileMode.Create)
GetDefaultIcon.Save(FileStream)
FileStream.Close()
End If
End Function 'GetDefaultIcon(ByVal Path As String, Optional ByVal IconSize As IconSize = IconSize.SmallIcon, Optional ByVal SaveIconPath As String = "") As Icon

Public Shared Function GetDefaultImage(ByVal Path As String, Optional ByVal IconSize As IconSize = IconSize.SmallIcon) As Image
Dim info As New SHFILEINFO(True)
Dim cbSizeInfo As Integer = Marshal.SizeOf(info)
Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes
flags = flags + IconSize
SHGetFileInfo(Path, 256, info, cbSizeInfo, flags)
GetDefaultImage = Icon.FromHandle(info.hIcon).ToBitmap
End Function 'GetDefaultIcon(ByVal Path As String, Optional ByVal IconSize As IconSize = IconSize.SmallIcon, Optional ByVal SaveIconPath As String = "") As Icon

'=====================================================================================
Public Shared Function ImageToIcon(ByVal SourceImage As Image) As Icon
' converts an image into an icon
Dim TempBitmap As New Bitmap(SourceImage)
ImageToIcon = Icon.FromHandle(TempBitmap.GetHicon())
TempBitmap.Dispose()
End Function 'ImageToIcon(ByVal SourceImage As Image) As Icon
'=====================================================================================

End Class


_________________________ Class Definition End Here________________________

Now create an object of the class

Dim ObjGetIcon As New ClsExtractIcon
ContronName.Image = ObjGetIcon.GetDefaultImage("Path of Exe", ClsExtractIcon.IconSize.LargeIcon)

Programatically Open DSN Window in VB.Net

System.Diagnostics.Process.Start("ODBCad32")

Send SMS in VB.Net

For Sending a SMS

you have to purchase the SMS gateway and correspondingly you will get the url for that


Example URL= "http://.xyz/default.aspx/sendSMSusername=???password=????
Dim TempURL As String = URL
For Sending a SMS you have to purchase the SMS gateway and correspondingly you will get the url for that


________________________Code________________________________

Dim useMsg As String
Dim i As Integer
Dim c As String
Try
' Convert characters in the message text
useMsg = ""
For i = 1 To Len(URL)
c = Mid(URL, i, 1)
Select Case c
Case vbCrLf : c = "%0A"
Case vbLf : c = "%0D"
Case " " : c = "%20"
Case "+" : c = "%2B"
Case """" : c = "%22"
Case "#" : c = "%23"
Case "%" : c = "%25"
Case "&" : c = "%26"
Case "," : c = "%2C"
Case "." : c = "%2E"
Case "/" : c = "%2F"
Case ":" : c = "%3A"
Case ";" : c = "%3B"
Case "<" : c = "%3C"
Case "=" : c = "%3D"
Case ">" : c = "%3E"
Case "?" : c = "%3F"
Case "¡" : c = "%A1"
Case "£" : c = "%A3"
Case "#" : c = "%A4"
Case "¥" : c = "%A5"
Case "§" : c = "%A7"
Case "Ä" : c = "%C4"
Case "Å" : c = "%C5"
Case "à" : c = "%E0"
Case "ä" : c = "%E4"
Case "å" : c = "%E5"
Case "Æ" : c = "%C6"
Case "Ç" : c = "%C7"
Case "É" : c = "%C9"
Case "è" : c = "%E8"
Case "é" : c = "%E9"
Case "ì" : c = "%EC"
Case "Ñ" : c = "%D1"
Case "ñ" : c = "%F1"
Case "ò" : c = "%F2"
Case "ö" : c = "%F6"
Case "Ø" : c = "%D8"
Case "Ö" : c = "%D6"
Case "Ü" : c = "%DC"
Case "ù" : c = "%F9"
Case "ü" : c = "%FC"
Case "ß" : c = "%DF"
End Select
useMsg = useMsg + c
Next

Dim Query As String
Dim qLen As Integer
' Construct the HTTP query string
' qLen = Len(Query)
' Request and Response objects
Dim objReq As System.Net.HttpWebRequest
Dim objRes As System.Net.HttpWebResponse

Dim sr As System.IO.StreamReader
Dim sw As System.IO.StreamWriter
Dim ResultantString As String = ""
Dim ret As String = "1"
Dim MAXID As Long

objReq = System.Net.WebRequest.Create(URL)
objReq.Method = "POST"
objReq.ContentType = "application/x-www-form-urlencoded; charset=""utf-8"""
objReq.ContentLength = qLen

sw = New System.IO.StreamWriter(objReq.GetRequestStream())
sw.Write(Query)
sw.Close()
objRes = objReq.GetResponse()
sr = New System.IO.StreamReader(objRes.GetResponseStream())
ret = sr.ReadToEnd()
________________ End Here________________________________
And Finally you can store the responce either in Database or File

Check the table whether it exist or not

Private Function fcheckTable(ByVal sDatabaseName As String, ByVal Tablename As String) As Boolean
Try
fcheckTable = False
Dim sSQL As String = "show tables in " & sDatabaseName
objCmd = New OdbcCommand(sSQL, ObjCon)
Dim oRS As Odbc.OdbcDataReader = objCmd.ExecuteReader
Do While oRS.Read
If Trim(UCase(Tablename)) = Trim(UCase(oRS(0))) Then fcheckTable = True
Loop
oRS.Close()


Catch ex As Exception
MsgBox(Err.Description)
End Try
End Function

Get The Tables List From a database

Private Sub GetTables(ByVal sDatabaseName As String)
Try

Dim sSQL As String = "show tables in " & sDatabaseName
objCmd = New OdbcCommand(sSQL, ObjCon)
'Cmd = CN.CreateCommand
'Cmd.CommandText = sSQL

Dim oRS As Odbc.OdbcDataReader = objCmd.ExecuteReader
'Do While oRS.Read
cbotablename.Items.Add(oRS(0))
Loop
oRS.Close()


Catch ex As Exception
MsgBox(Err.Description)
End Try
End Sub

Mail Sending in VB.Net

*************************************************
Class Starts Here
_________________________________________



Imports System.Net
Imports System.Net.Mail
Imports System.Configuration
Imports System.Text.RegularExpressions



Public Class ClsMailSender
Public seting As SettingType
Private _MMsg As Net.Mail.MailMessage
Private _EServer As Net.Mail.SmtpClient
Private _Cred As NetworkCredential

Public Function fSendMail(ByVal FromEmailid As String, ByVal Password As String, ByVal ToEmailID As String, Optional ByVal EmailSubject As String = "", Optional ByVal BodyMessage As String = "", Optional ByVal UseHTMLFormatting As Boolean = False, Optional ByVal header As String = "", Optional ByVal signature As String = " ", Optional ByVal AttachmentFileName As String = "") As Boolean
Try
Dim tempstr As String
Dim str() As String
Dim ServerName As String = ""
Dim SMTPServerName As String = ""
Dim SSL As Boolean = False

fSendMail = False
Application.DoEvents()

ToEmailID = Replace(ToEmailID, ";", ",")
_MMsg = New Net.Mail.MailMessage(FromEmailid, ToEmailID)
With _MMsg
.Subject = EmailSubject
.Body = header & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & BodyMessage & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & signature
.IsBodyHtml = UseHTMLFormatting
If AttachmentFileName <> "" Then If Dir(AttachmentFileName) <> "" Then .Attachments.Add(New System.Net.Mail.Attachment(AttachmentFileName))
.Priority = MailPriority.High
End With


Select Case _MMsg.From.Host
Case "gmail.com"
_EServer = New Net.Mail.SmtpClient("smtp.gmail.com", 587)
_EServer.EnableSsl = True
Case "yahoo.com"
_EServer = New Net.Mail.SmtpClient("smtp.mail.yahoo.com")
Case "yahoo.co.in"
_EServer = New Net.Mail.SmtpClient("smtp.mail.yahoo.com")
Case Else
tempstr = fGetSMTPFromSetting(_MMsg.From.Host, seting.mail)
If Len(Trim(tempstr)) <= 0 Then
MsgBox("SMTP Server setting is not saved for " & _MMsg.From.Host & " web server", vbInformation)

frmSetting.Show()
SMTPServerName = frmSetting.txtsmtpserver.Text
SSL = frmSetting.chksslrequired.Checked
Else
str = Split(tempstr, "^")
SSL = str(1)
SMTPServerName = str(0)
End If

_EServer = New Net.Mail.SmtpClient(SMTPServerName)
_EServer.EnableSsl = SSL
End Select





_Cred = New Net.NetworkCredential(FromEmailid, Trim(Password))
_EServer.Credentials = _Cred
_EServer.Send(_MMsg)

_MMsg.Dispose()
fSendMail = True
' Else
' MsgBox("Enter the Valid Email ID", vbInformation)
' End If

' If GiniSetting.LogLevel > 4 Then MakeLog("Email Send Sucessfully To :" & ToEmailID & ", Subject :" & EmailSubject)
Catch ex As Exception
' MakeLog("Cannot Send E-Mail, Error Number :" & Err.Number & ", Description : ", 0, "NOT Defined", "Send Mail()")
MsgBox("Error Generated :" & Err.Description, MsgBoxStyle.Exclamation)
_MMsg.Dispose()
End Try
End Function
End Class






__________________________________________
Class end Here
*****************************************************

Dim ObjMailSender As New ClsMailSender


If ObjMailSender.fSendMail(txtFrom.Text, txtPassword.Text, txtto.Text, txtsubject.Text, txtBody.Text, False, txtHeader.Text, txtsignature.Text, txtattachment.Text) Then
MsgBox("Mail Has Been Sent ", vbInformation)
Else
MsgBox("Mail can't be sent right now ,Please Try Later")
End If

Export a list View to a file

Public Function exportListView(ByVal lvw As ListView, Optional ByVal Mtype As String = "") As System.Text.StringBuilder
Dim str As New System.Text.StringBuilder()
Dim st As String() = New String(lvw.Columns.Count - 1) {}
str.Append(vbTab & vbTab & " Viewer" & vbTab & vbTab & vbTab & vbTab & vbCrLf & vbCrLf & vbCrLf & vbCrLf)
For col As Integer = 0 To lvw.Columns.Count - 1
str.Append(vbTab & lvw.Columns(col).Text.ToString())
Next
Dim rowIndex As Integer = 1
Dim row As Integer = 0
Dim st1 As String = ""
For row = 0 To lvw.Items.Count - 1
If rowIndex <= lvw.Items.Count Then
rowIndex += 3
End If
st1 = vbLf
str.Append(vbLf)
For col As Integer = 0 To lvw.Columns.Count - 1
st1 = (st1 & vbTab) + lvw.Items(row).SubItems(col).Text.ToString()
str.Append(vbTab + lvw.Items(row).SubItems(col).Text.ToString())
Next
Next
If Trim(Mtype) = "" Then
Dim SaveFileDialog As New SaveFileDialog
SaveFileDialog.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyDocuments
SaveFileDialog.Filter = "Microsoft Word(*.doc)|*.doc"
If SaveFileDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
Dim FileName As String = SaveFileDialog.FileName
Dim sw As New StreamWriter(FileName, False)
sw.AutoFlush = True
sw.Write(str)
sw.Close()
Dim fil As New FileInfo(FileName)
If fil.Exists = True Then
MessageBox.Show("Process Completed", "Export to Word", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End If
Else
Return (str)
End If

End Function

Searching in a list view

Private Sub Searching(ByVal str As String, ByVal col As Integer, ByVal Lvws As ListView)

Dim i As Integer
Dim TotalCount As Long = 0
If Val(Lvws.Items.Count) > 0 Then
For Each itm As ListViewItem In Lvws.Items
For i = 0 To itm.SubItems.Count - 1
If UCase(Trim(itm.SubItems(i).Text)) Like "*" & UCase(Trim(str)) & "*" Then
' itm.SubItems(0).ForeColor = Color.Black
itm.SubItems(0).ForeColor = Color.Red
TotalCount += 1
lbintermediateWindow.Items.Add(str & ": Line No :" & itm.SubItems(0).Text)
Else
If chkignoreprevoiuscolor.Checked = True Then
If PreviouseColor = True Then
itm.SubItems(0).ForeColor = Color.Black
End If
End If
End If
Next
Next
End If
End Sub

Load all the children node of a node of app.config

Private Sub sloadSearchSetting()
Dim ary() As String
Dim icount As Integer
Dim doc As XmlDocument = loadConfigDocument()
Dim cnode As XmlNode
Dim KeyName As String
Dim KeyValue As String
Dim i As Integer
Dim XmlDoc As New XmlDocument()
XmlDoc.Load(AppDomain.CurrentDomain.SetupInformation.ConfigurationFile)
For Each xElement As XmlElement In XmlDoc.DocumentElement
If xElement.Name = "appSettings" Then
For Each xNode As XmlNode In xElement.ChildNodes
KeyName = xNode.Attributes(0).Value
KeyValue = xNode.Attributes(1).Value
grdSearchCenter.Rows.Insert(i, 1)
grdSearchCenter.Rows(i).Cells(0).Value = i + 1
grdSearchCenter.Rows(i).Cells(1).Value = KeyName
grdSearchCenter.Rows(i).Cells(2).Value = KeyValue
i += 1
Next
End If
Next

Read and write your custom Tag in app.config

Imports System
Imports System.Xml
Imports System.Configuration
Imports System.Reflection
Module ReadandWriteinappconfig

Public Function ReadSetting(ByVal key As String) As String
Return System.Configuration.ConfigurationSettings.AppSettings(key)
End Function

Public Sub WriteSetting(ByVal key As String, ByVal value As String, ByVal Settingvalue As String)
' load config document for current assembly
Dim doc As XmlDocument = loadConfigDocument()
Dim SettingType As String
If Val(Settingvalue) = 0 Then
SettingType = "mail"
ElseIf Val(Settingvalue) = 1 Then
SettingType = "app"
ElseIf Val(Settingvalue) = 2 Then
SettingType = "password"
End If
Dim node As XmlNode = doc.SelectSingleNode("//" & SettingType & "Settings")
If node Is Nothing Then
' Throw New InvalidOperationException("appSettings section not found in config file.")
Dim xmlEl As XmlElement = doc.CreateElement(SettingType & "Settings")
doc.DocumentElement.AppendChild(xmlEl)
node = doc.SelectSingleNode("//" & SettingType & "Settings")
End If

Try
' select the 'add' element that contains the key
Dim elem As XmlElement = DirectCast(node.SelectSingleNode(String.Format("//add[@key='{0}']", key)), XmlElement)

If elem IsNot Nothing Then
' add value for key
elem.SetAttribute("value", value)
Else
' key was not found so create the 'add' element
' and set it's key/value attributes
elem = doc.CreateElement("add")
elem.SetAttribute("key", key)
elem.SetAttribute("value", value)
node.AppendChild(elem)
End If
doc.Save(getConfigFilePath())
Catch
Throw
End Try
End Sub

Public Sub RemoveSetting(ByVal key As String, ByVal Settingvalue As String)
' load config document for current assembly
Dim doc As XmlDocument = loadConfigDocument()
Dim SettingType As String

' retrieve appSettings node
If Val(Settingvalue) = 0 Then
SettingType = "mail"
ElseIf Val(Settingvalue) = 1 Then
SettingType = "app"
End If
Dim node As XmlNode = doc.SelectSingleNode("//" & SettingType & "Settings")

'Dim node As XmlNode = doc.SelectSingleNode("//appSettings")



Try
If node Is Nothing Then
Throw New InvalidOperationException("appSettings section not found in config file.")
Else
' remove 'add' element with coresponding key
node.RemoveChild(node.SelectSingleNode(String.Format("//add[@key='{0}']", key)))
doc.Save(getConfigFilePath())
End If
Catch e As NullReferenceException
Throw New Exception(String.Format("The key {0} does not exist.", key), e)
End Try
End Sub

Public Function loadConfigDocument() As XmlDocument
Dim doc As XmlDocument = Nothing
Try
doc = New XmlDocument()
doc.Load(getConfigFilePath())
Return doc
Catch e As System.IO.FileNotFoundException
Throw New Exception("No configuration file found.", e)
End Try
End Function

Private Function getConfigFilePath() As String
Return Assembly.GetExecutingAssembly().Location & ".config"
End Function



Public Function fGetSetting(ByVal key As String, ByVal Settingvalue As String) As Boolean

Dim returnstring As Boolean = False
Dim doc As XmlDocument = loadConfigDocument()
Dim SettingType As String
If Val(Settingvalue) = 0 Then
SettingType = "mail"
ElseIf Val(Settingvalue) = 1 Then
SettingType = "app"
End If
Dim node As XmlNode = doc.SelectSingleNode("//" & SettingType & "Settings")
If node Is Nothing Then
'Throw New InvalidOperationException("appSettings section not found in config file.")
Dim xmlEl As XmlElement = doc.CreateElement(SettingType & "Settings")
doc.DocumentElement.AppendChild(xmlEl)
node = doc.SelectSingleNode("//" & SettingType & "Settings")
End If

Try
Dim elem As XmlElement = DirectCast(node.SelectSingleNode(String.Format("//add[@key='{0}']", key)), XmlElement)

If elem IsNot Nothing Then
returnstring = True
Else
returnstring = False
End If
Return returnstring
Catch
Throw
End Try
End Function

Public Function fGetPasswordFromSetting(ByVal key As String, ByVal Settingvalue As String) As String

Dim returnstring As String = ""
Dim doc As XmlDocument = loadConfigDocument()
Dim SettingType As String
If Val(Settingvalue) = 0 Then
SettingType = "mail"
ElseIf Val(Settingvalue) = 1 Then
SettingType = "app"
ElseIf Val(Settingvalue) = 2 Then
SettingType = "password"
End If
Dim node As XmlNode = doc.SelectSingleNode("//" & SettingType & "Settings")
If node Is Nothing Then
'Throw New InvalidOperationException("appSettings section not found in config file.")
Dim xmlEl As XmlElement = doc.CreateElement(SettingType & "Settings")
doc.DocumentElement.AppendChild(xmlEl)
node = doc.SelectSingleNode("//" & SettingType & "Settings")
End If

Try
Dim elem As XmlElement = DirectCast(node.SelectSingleNode(String.Format("//add[@key='{0}']", key)), XmlElement)

If elem IsNot Nothing Then
returnstring = elem.GetAttribute("value")
Else
returnstring = ""
End If
Return returnstring
Catch
Throw
End Try
End Function

Public Function fGetSMTPFromSetting(ByVal key As String, ByVal Settingvalue As String) As String

Dim returnstring As String = ""
Dim doc As XmlDocument = loadConfigDocument()
Dim SettingType As String
If Val(Settingvalue) = 0 Then
SettingType = "mail"
ElseIf Val(Settingvalue) = 1 Then
SettingType = "app"
ElseIf Val(Settingvalue) = 2 Then
SettingType = "password"
End If
Dim node As XmlNode = doc.SelectSingleNode("//" & SettingType & "Settings")
If node Is Nothing Then
'Throw New InvalidOperationException("appSettings section not found in config file.")
Dim xmlEl As XmlElement = doc.CreateElement(SettingType & "Settings")
doc.DocumentElement.AppendChild(xmlEl)
node = doc.SelectSingleNode("//" & SettingType & "Settings")
End If

Try
Dim elem As XmlElement = DirectCast(node.SelectSingleNode(String.Format("//add[@key='{0}']", key)), XmlElement)

If elem IsNot Nothing Then
returnstring = elem.GetAttribute("value")
Else
returnstring = ""
End If
Return returnstring
Catch
Throw
End Try
End Function

End Module

How to Create a Web Service

Imports System.Web
Imports System.Web.Services
Imports System.Web.Services.Protocols
Imports System.IO
Imports System.Data

WebService(Namespace:="http://aaaaa.com/")> _

_
Public Function GetMachineIPAddress() As String

Dim strHostName As String = ""
Dim strIPAddress As String = ""
Dim host As System.Net.IPHostEntry

strHostName = System.Net.Dns.GetHostName()
strIPAddress = System.Net.Dns.GetHostEntry(strHostName).HostName.ToString()

host = System.Net.Dns.GetHostEntry(strHostName)
Dim ip As System.Net.IPAddress
For Each ip In host.AddressList
Return ip.ToString()
Next

Return ""

End Function

Make an Exe as startup

Public Sub AutoStartup()
Try
Dim RegKey As RegistryKey
RegKey = Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
RegKey.SetValue("DBFT Client", Application.ExecutablePath)

Catch ex As Exception
MakeLog("Putting in Windods Auto Startup " & Application.ExecutablePath, Err.Number, Err.Description)
End Try
End Sub

How To Write an INI File

Module

#Region "APICalls"
' standard API declarations for INI access
Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Int32

Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Int32, _
ByVal lpFileName As String) As Int32

#End Region


Private Sub INIWrite(ByVal INIPath As String, ByVal SectionName As String, ByVal KeyName As String, ByVal TheValue As String)

Call WritePrivateProfileString(SectionName, KeyName, TheValue, INIPath)
End Sub

End Module

Read From INI File

#Region "APICalls"
' standard API declarations for INI access
Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Int32

Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Int32, _
ByVal lpFileName As String) As Int32

#End Region

Private Function INIRead(ByVal INIPath As String, ByVal SectionName As String, ByVal KeyName As String, ByVal DefaultValue As String) As String

' primary version of call gets single value given all parameters
Dim n As Int32
Dim sData As String
sData = Space$(1024) ' allocate some room

n = GetPrivateProfileString(SectionName, KeyName, DefaultValue, sData, sData.Length, INIPath)

If n > 0 Then ' return whatever it gave us
INIRead = sData.Substring(0, n)
Else
INIRead = ""
End If
End Function

List of Available DSN

Public Function fGetDSNList() As String()
Dim RegHandle As RegistryKey
Dim Reg As RegistryKey = Registry.LocalMachine
Dim conRegKey1 As String = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources\"
Try
RegHandle = Reg.OpenSubKey(conRegKey1)
Return RegHandle.GetValueNames
Catch err As Exception
Msgbox(err.description)
End Try
Exit Function
End Function