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