martes, 21 de febrero de 2017

Código Visual Basic .NET que obtiene los procesos en ejecución (PID - Nombre)

    Private Sub bStart_Click(sender As Object, e As EventArgs) Handles bStart.Click
        Dim psList() As Process
        Try
            psList = Process.GetProcesses()
            For Each p As Process In psList
                Console.WriteLine(p.Id.ToString() + " " + p.ProcessName.ToString)
            Next p

        Catch ex As Exception
            Console.WriteLine(ex.Message)
        End Try
    End Sub

Clase Visual Basic .NET para grabar / leer un archivo de configuración o settings en XML (clave - valor)

Public Class clsSettings
    'http://www.tek-tips.com/faqs.cfm?fid=6320
 
    'ejemplo uso:
    'clsSettings.clsSetSetting("MyValue", "1234567890")
    'msgbox(clsSettings.GetSetting("MyValue"))

    'NOTA: Si queremos guardar un archivo de configuración diferente para cada usuario,
    'solo tenemos que cambiar Application.StartupPath por Application.LocalUserAppDataPath

    Public Shared Function GetSetting(ByVal Key As String) As String
        Dim sReturn As String = String.Empty
        Dim dsSettings As New DataSet
        If System.IO.File.Exists(Application.StartupPath & "\Settings.xml") Then
            dsSettings.ReadXml(Application.StartupPath & "\Settings.xml")
        Else
            dsSettings.Tables.Add("Settings")
            dsSettings.Tables(0).Columns.Add("Key", GetType(String))
            dsSettings.Tables(0).Columns.Add("Value", GetType(String))
        End If

        Dim dr() As DataRow = dsSettings.Tables("Settings").Select("Key = '" & Key & "'")
        If dr.Length = 1 Then sReturn = dr(0)("Value").ToString

        Return sReturn
    End Function

    Public Shared Sub SetSetting(ByVal Key As String, ByVal Value As String)
        Dim dsSettings As New DataSet
        If System.IO.File.Exists(Application.StartupPath & "\Settings.xml") Then
            dsSettings.ReadXml(Application.StartupPath & "\Settings.xml")
        Else
            dsSettings.Tables.Add("Settings")
            dsSettings.Tables(0).Columns.Add("Key", GetType(String))
            dsSettings.Tables(0).Columns.Add("Value", GetType(String))
        End If

        Dim dr() As DataRow = dsSettings.Tables(0).Select("Key = '" & Key & "'")
        If dr.Length = 1 Then
            dr(0)("Value") = Value
        Else
            Dim drSetting As DataRow = dsSettings.Tables("Settings").NewRow
            drSetting("Key") = Key
            drSetting("Value") = Value
            dsSettings.Tables("Settings").Rows.Add(drSetting)
        End If
        dsSettings.WriteXml(Application.StartupPath & "\Settings.xml")
    End Sub
End Class

Clase Visual Basic .NET para enviar correo con GMAIL. Este código también es válido para otros servidores de correo haciendo pequeños cambios.

Imports System.Net.Mail

'using a google account to send email if you got authentication error, you need to enable Allowing less secure apps or Sign in using App Passwords.
'https://www.youtube.com/watch?v=MOnyExcIPVY'
'
'NOTA: Aún habiendo activado el uso de aplicaciones de terceros para enviar a través del servidor de Gmail, Google también puede bloquear los envíos si el dispositivo no es de confianza. Aconsejo a identificarse en Gmail via web en el dispositivo que usará la aplicación para que sea reconocido como dispositivo de confianza.

Public Class clsMailSender
    Const GMAILUSER = "your_account@gmail.com"
    Const GMAILPASS = "your_password"
    Const GMAILSMTPHOST = "smtp.gmail.com"
    Const GMAILSMTPPORT = 587
    Const GMAILbEnableSSL = True
 
    'Si no funciona por el puerto SMTP 587, prueba con el 25

    Public Function SendEmailGMAIL(ByVal MailSubject As String, ByVal MessageBody As String, ByVal ToAddresses As String) As Boolean
        'SendEmailGMAIL("subject","messagebody","address1;address2;...")
        Try
            Dim Mail As New MailMessage()
            Mail.Subject = MailSubject
            Mail.From = New System.Net.Mail.MailAddress(GMAILUSER)
            For Each Address As String In Split(ToAddresses, ";")
                Mail.To.Add(Address)
            Next
            Mail.Body = MessageBody
            Dim SmtpServer As New SmtpClient()
            SmtpServer.Credentials = New Net.NetworkCredential(GMAILUSER, GMAILPASS)
            SmtpServer.Host = GMAILSMTPHOST
            SmtpServer.Port = GMAILSMTPPORT
            SmtpServer.EnableSsl = GMAILbEnableSSL
            SmtpServer.Send(Mail)

            Return True
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
    End Function

 End Class

Clase Visual Basic .NET para grabar / mostrar un archivo de texto (log)

Imports System.IO

Public Class clsLog
    Dim m_filename As String = ""
    Private m_sw As StreamWriter = Nothing
    Private m_bAppend As Boolean

    Public Sub New(ByVal strPathLogFile As String, Optional ByVal bAppend As Boolean = True)
        m_filename = strPathLogFile
        m_bAppend = bAppend
        Try
            m_sw = New StreamWriter(m_filename, bAppend)
            m_sw.Close()
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub Finalize()
        Dispose()
        MyBase.Finalize()
    End Sub

    Private Sub Dispose()
        Try
            m_sw = Nothing
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
        End Try
    End Sub

    Public Sub Log(strValue As String)
        Try
            m_sw = New StreamWriter(m_filename, m_bAppend)
            m_sw.WriteLine(strValue)
            m_sw.Flush()
            m_sw.Close()
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
        End Try
    End Sub

    Public Sub ShowLog()
        If System.IO.File.Exists(m_filename) Then
            Process.Start(m_filename)
        End If
    End Sub

End Class

Clase Visual Basic .NET con función para obtener datos GeoIP (Ip pública y localización) y función para obtener el nombre del host a partir de una IP

Imports System.Net

'http://www.vbforums.com/showthread.php?637319-VB-Net-Simple-function-to-get-external-IP-adress

Public Class clsExternalIPAddress
    Public Structure ExternalIPData
        Dim IP As String
        Dim CountryCode As String
        Dim CountryName As String
        Dim RegionCode As String
        Dim RegionName As String
        Dim City As String
        Dim TimeZone As String
        Dim Latitude As Double
        Dim Longitude As Double
    End Structure

    Public Function GeoIP(Optional IP As String = Nothing) As ExternalIPData
        Dim IPData As New ExternalIPData

        Using client = New WebClient()
            Try
                Dim strFile As String
                If IsNothing(IP) Then
                    strFile = client.DownloadString("http://freegeoip.net/xml")
                Else
                    strFile = client.DownloadString(String.Format("http://freegeoip.net/xml/{0}", IP))
                End If

                Dim response As XElement = XElement.Parse(strFile)

                With IPData
                    .IP = response.Element("IP").Value
                    .CountryCode = response.Element("CountryCode").Value
                    .CountryName = response.Element("CountryName").Value
                    .RegionCode = response.Element("RegionCode").Value
                    .RegionName = response.Element("RegionName").Value
                    .City = response.Element("City").Value
                    .TimeZone = response.Element("TimeZone").Value
                    .Latitude = CType(response.Element("Latitude").Value, Long)
                    .Longitude = CType(response.Element("Longitude").Value, Long)
                End With

            Catch ex As Exception
                Return Nothing
            End Try
        End Using

        Return IPData

    End Function

    Public Function GetExternalIP() As String
        Try
            Return GeoIP.IP
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return ""
        End Try

    End Function

    Public Function GetHostNameFromIP() As String
        Try
            Dim host As System.Net.IPHostEntry
            host = System.Net.Dns.GetHostEntry(GeoIP.IP)
            Return host.HostName
        Catch ex As Exception
            Return ""
        End Try

    End Function

End Class

Clase Visual Basic .NET comprueba si un puerto TCP está abierto

Public Class clsHostPort
    Private m_hostname As String
    Private m_port As Integer
    Private m_timeout As Integer
    Private m_bIsOpen As Boolean

    Sub New(ByVal HostName As String, ByVal Port As Integer, Optional ByVal timeout As Integer = 10)
        '127.0.0.1 is the local machine
        m_hostname = HostName
        m_port = Port
        m_timeout = timeout
        m_bIsOpen = False
    End Sub

    Public Function IsPortOpen() As Boolean
        'first check valid port value
        If m_port >= 0 And m_port < 65536 Then
        Else
            Return False
        End If

        Dim Client As System.Net.Sockets.TcpClient = Nothing
        Try
            Client = New System.Net.Sockets.TcpClient(m_hostname, m_port)
            Client.ReceiveTimeout = m_timeout
            m_bIsOpen = True
        Catch ex As System.Net.Sockets.SocketException
            Console.WriteLine(ex.Message)
            m_bIsOpen = False
        Finally
            If Not Client Is Nothing Then
                Client.Close()
            End If
            IsPortOpen = m_bIsOpen
        End Try
    End Function

End Class

Función Visual Basic .NET ejecuta cualquier instrucción SQL sin afectar a la base de datos SQL Server (SET FMTONLY ON)

'Puede ser util si quieres comprobar si una instrucción sql se ejecutará correctamente sin afectar a la base de datos.
    Private Function CheckSql(ByVal nOrden As Integer, ByVal Sql As String, ByVal cnStr As String) As String
        Dim report As String = ""
        Dim SqlNoExec As String = "SET FMTONLY ON"
        Dim cn As SqlClient.SqlConnection
        Dim value As Integer

        Try
            cn = New SqlClient.SqlConnection(cnStr)
            cn.Open()

            'lanzamos instruccion contra el servidor SQL para evitar cualquier cambio
            Dim cmd As New SqlClient.SqlCommand(SqlNoExec, cn)
            'ejecutamos SET FMTONLY ON en la base de datos
            value = cmd.ExecuteNonQuery()

            If value = -1 Then
               'a partir de este momento lo que ejecutemos no tendra efecto sobre la base de datos
                cmd.CommandText = Sql
                value = cmd.ExecuteNonQuery()
            End If

            cmd.Dispose()
            cmd = Nothing
            'en este punto el comando SET FMONLY ON ya no afecta, pues esta ligado a la vida del objeto cmd

            report = String.Format("{0,-8} {1,-12} {2} {3}", "OK", "Orden: " & nOrden, " SQL: " & Sql, vbTab & " ConnString: " & cnStr)
        Catch ex As Exception
            report = String.Format("{0,-8} {1,-12} {2} {3} {4}", "ERROR", "Orden: " & nOrden, " SQL: " & Sql, vbTab & " ConnString: " & cnStr, vbCrLf & ex.Message)
        End Try

        Return report
    End Function

Función Visual Basic .NET para contar los registros de una tabla pasando como parámetro la instrucción SQL select count(*) from nombre_tabla

    Public Function RegCountTable(ByVal Sql As String, ByVal ConnectionString As String) As Int32
       'ejemplo parámetro Sql = "select count(*) from nombre_tabla"
       Dim res As Int32 = -1

        Try
            Dim cn As New SqlConnection(ConnectionString)
            cn.Open()

            Dim cmd As New SqlCommand(Sql, cn)
            res = Convert.ToInt32(cmd.ExecuteScalar())

            cn.Close()
            cn = Nothing

        Catch ex As Exception
            Debug.WriteLine(Sql & " " & ex.Message)
        End Try

        Return res
    End Function

Funciones en Visual Basic .NET para obtener la lista de tablas de una base de datos Access o una base de datos SQL Server

Imports System.Data.SqlClient
Imports ADODB

....


    Private Function GetTableListSQLServerDB(ByVal cnStr As String) As List(Of String)
        Dim lstTables As New List(Of String)

        If Not cnStr.ToLower.Contains("provider") Then
            cnStr = "Provider = sqloledb;" & cnStr
        End If

        Try
            Dim cn As New ADODB.Connection()
            cn.ConnectionString = cnStr
            cn.Open()

            Dim rs As New ADODB.Recordset()
            rs = cn.OpenSchema(SchemaEnum.adSchemaTables)
            Do While Not rs.EOF
                If rs.Fields("TABLE_TYPE").Value.ToString = "TABLE" Then
                    lstTables.Add(rs.Fields("TABLE_NAME").Value)
                End If
                rs.MoveNext()
            Loop
            rs.Close()
            cn.Close()
            rs = Nothing
            cn = Nothing

        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine(ex.Message)
        End Try

        Return lstTables

    End Function


    Private Function GetTableListAccess(strPathNameAccessDB As String) As List(Of String)
        Dim lstTables As New List(Of String)

        Try
            Dim cnStr As String = "Provider = Microsoft.ACE.OLEDB.12.0; data source= " & strPathNameAccessDB

            Dim cn As New ADODB.Connection()
            cn.ConnectionString = cnStr
            cn.Open()

            Dim rs As New ADODB.Recordset()
            rs = cn.OpenSchema(SchemaEnum.adSchemaTables)
            Do While Not rs.EOF
                If rs.Fields("TABLE_TYPE").Value.ToString = "TABLE" Then
                    lstTables.Add(rs.Fields("TABLE_NAME").Value.ToString)
                End If
                rs.MoveNext()
            Loop
            rs.Close()
            cn.Close()
            rs = Nothing
            cn = Nothing

        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine(ex.Message)
        End Try

        Return lstTables

    End Function

Clase en Visual Basic .NET que crea un cronometro conectado a una etiqueta (stopwach)

Public Class clsTimerSW
    Private m_timer As Timer
    Private m_sw As Stopwatch
    Private m_lbl As Label = Nothing

    Sub New(ByVal msInterval As Integer, Optional ByRef lbl As Label = Nothing)
        m_lbl = lbl

        m_timer = New Timer()
        m_timer.Interval = msInterval
        AddHandler m_timer.Tick, AddressOf m_timer_Tick

        m_sw = New Stopwatch()
    End Sub

    Public Sub StartTimerSW()
        If Not m_lbl Is Nothing Then m_lbl.Text = ""
        m_sw.Start()
        m_timer.Enabled = True

    End Sub

    Public Sub StopTimerSW()
        m_sw.Stop()
        m_timer.Enabled = False
    End Sub

    Public Sub ResetTimerSW()
        m_sw.Restart()
        If Not m_lbl Is Nothing Then
            m_lbl.Text = GetElapsedTime()
        End If
    End Sub

    Public Sub SetInterval(ByVal ms As Integer)
        m_timer.Interval = ms
    End Sub

    Public Function IsEnabled() As Boolean
        Return m_timer.Enabled
    End Function

    Public Function GetElapsedTime() As String
        Return String.Format("{0}:{1}:{2}", _
                m_sw.Elapsed.Hours.ToString("00"), _
                m_sw.Elapsed.Minutes.ToString("00"), _
                m_sw.Elapsed.Seconds.ToString("00"))
    End Function

    Private Sub m_timer_Tick(sender As Object, e As EventArgs)
        If Not m_lbl Is Nothing Then
            m_lbl.Text = GetElapsedTime()
            m_lbl.Refresh()
        End If
    End Sub

End Class

Clase en Visual Basic .NET para crear una base de datos access ACCDB, crear tablas e insertar registros

Imports Microsoft.Office.Interop.Access.Dao

Public Class clsAccessCreator

    Public Function CreateAccessFile(ByVal strPathFile As String) As Boolean
        Dim res As Boolean = True

        Try
            Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
            Dim AccessDatabase As Microsoft.Office.Interop.Access.Dao.Database
            AccessDatabase = AccessDatabaseEngine.CreateDatabase(strPathFile, LanguageConstants.dbLangGeneral, DatabaseTypeEnum.dbVersion120)
            AccessDatabase.Close()
 
            Using conn As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "  Data Source=" & strPathFile & ";Persist Security Info=False;")

                'Create tables
                Using cmd As New OleDb.OleDbCommand("CREATE TABLE Conexiones ( " & _
                    "Id int NOT NULL," & _
                    "Orden int NOT NULL," & _
                    "BasedeDatos NVarchar(255) NOT NULL," & _
                    "CadenaConexion text NOT NULL," & _
                    "CONSTRAINT Id_PK PRIMARY KEY(Id)) ", conn)
                    conn.Open()
                    Try
                        cmd.ExecuteNonQuery()
                    Catch ex As Exception
                        Debug.WriteLine(ex.Message)
                    End Try
                End Using

                Using cmd As New OleDb.OleDbCommand("CREATE TABLE Tablas ( " & _
                    "Id int NOT NULL ," & _
                    "Orden int NOT NULL," & _
                    "BasedeDatos NVarchar(255) NOT NULL," & _
                    "NombreTabla NVarchar(255) NOT NULL," & _
                    "Condicion Text," & _
                    "CONSTRAINT Id_PK PRIMARY KEY(Id)) ", conn)
                    Try
                        cmd.ExecuteNonQuery()
                    Catch ex As Exception
                        Debug.WriteLine(ex.Message)
                    End Try
                End Using

                'Insert values
                Try
                    'Conexiones
                    Dim Sql As String
                    Sql = "INSERT INTO Conexiones(Id,Orden,BasedeDatos,CadenaConexion) VALUES(1, 1,'Cont','Data Source=.\;Initial Catalog=Cont;Integrated Security=SSPI;');"
                    Dim cmdI As New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()
                    Sql = "INSERT INTO Conexiones(Id,Orden,BasedeDatos,CadenaConexion) VALUES(2, 2,'Gest','Data Source=.\;Initial Catalog=Gest;User ID=sa;Password=1234;');"
                    cmdI = New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()

                    'Operaciones
                    Sql = "INSERT INTO Tablas(Id,Orden,BasedeDatos,NombreTabla,Condicion) VALUES(1, 1,'Cont','Table_1',NULL);"
                    cmdI = New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()
                    Sql = "INSERT INTO Tablas(Id,Orden,BasedeDatos,NombreTabla,Condicion) VALUES(2, 2,'Cont','Table_2',NULL);"
                    cmdI = New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()
                    Sql = "INSERT INTO Tablas(Id,Orden,BasedeDatos,NombreTabla,Condicion) VALUES(3, 3,'Gest','Table_1',NULL);"
                    cmdI = New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()
                    Sql = "INSERT INTO Tablas(Id,Orden,BasedeDatos,NombreTabla,Condicion) VALUES(4, 4,'Gest','Table_2',NULL);"
                    cmdI = New OleDb.OleDbCommand(Sql, conn)
                    cmdI.ExecuteNonQuery()

                Catch ex As Exception
                    Debug.WriteLine(ex.Message)
                End Try
            End Using


        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine(ex.Message)
        End Try

        Return res

    End Function

End Class

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...