sábado, 8 de diciembre de 2012

Encriptar y desencriptar cadenas de texto con MD5. Visual Basic .NET

'Clase para encriptar y desencriptar cadenas de texto
'Fuente codigo: http://kellyschronicles.wordpress.com/2008/11/12/encryption-and-decryption-of-strings-with-vb-net/
'Fuente recomendada: http://jorgepedraza.wordpress.com/2011/01/29/funcion-cifrado-net/

Imports System.IO
Imports System.Text
Imports System.Security.Cryptography

'Ejemplo uso de la clase: Crypto.Encrypt(TextoOrigen,ClaveEncriptacion), Crypto.Decrypt(TextoEncriptado,ClaveEncriptacion)
Public Class Crypto
    Private Shared DES As New TripleDESCryptoServiceProvider
    Private Shared MD5 As New MD5CryptoServiceProvider
    Private Shared Function MD5Hash(ByVal value As String) As Byte()
        Return MD5.ComputeHash(ASCIIEncoding.ASCII.GetBytes(value))
    End Function

    Public Shared Function Encrypt(ByVal stringToEncrypt As String, ByVal key As String) As String
        DES.Key = Crypto.MD5Hash(key)
        DES.Mode = CipherMode.ECB
        Dim Buffer As Byte() = ASCIIEncoding.ASCII.GetBytes(stringToEncrypt)
        Return Convert.ToBase64String(DES.CreateEncryptor().TransformFinalBlock(Buffer, 0, Buffer.Length))
    End Function

    Public Shared Function Decrypt(ByVal encryptedString As String, ByVal key As String) As String
        Try
            DES.Key = Crypto.MD5Hash(key)
            DES.Mode = CipherMode.ECB
            Dim Buffer As Byte() = Convert.FromBase64String(encryptedString)
            Return ASCIIEncoding.ASCII.GetString(DES.CreateDecryptor().TransformFinalBlock(Buffer, 0, Buffer.Length))
        Catch ex As Exception
            MessageBox.Show("Invalid Key", "Decryption Failed", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Return ""
        End Try
    End Function
End Class

viernes, 16 de noviembre de 2012

Función SetCulture. Símbolo decimal en números y moneda, Formato Fecha. Visual Basic .NET

    Private Sub SetCulture()
        'Sobreescribe la configuración regional (formato fecha, símbolo decimal, ...)
        'Si la llamada se hace en el evento Load del primer formulario, los demás formularios seguirán esta misma configuración
        System.Threading.Thread.CurrentThread.CurrentCulture = New System.Globalization.CultureInfo("es-Es")
        System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat.ShortDatePattern = "dd/MM/yyyy"
        System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.CurrencyDecimalSeparator = ","
        System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.CurrencyGroupSeparator = "."
        System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.NumberDecimalSeparator = ","
        System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.NumberGroupSeparator = "."
    End Sub

sábado, 13 de octubre de 2012

Funciones GetDataSet, SetDataSet, ExecuteSQL. Visual Basic .NET. Base de datos SQL Server.

        Private m_CadenaConexion As String = "Data Source=.\SQLEXPRESS;" _
                           & "Initial Catalog=futbol;" _
                           & "Integrated Security=SSPI;" _
                           & "Connect TimeOut=30"

        Private Function DimeCadenaConexion() As String
            DimeCadenaConexion = m_CadenaConexion
        End Function

        Private Sub OpenConexionDB(ByVal cn As SqlConnection)
            cn.ConnectionString = DimeCadenaConexion()
            cn.Open()
        End Sub

        Private Sub CloseConexionDB(ByVal cn As SqlConnection)
            cn.Close()
            cn.Dispose()
        End Sub

'-------------------------------------------------------------------------------------------------------------------------

        Public Function ExecuteSql(ByVal Sql As String) As Integer
            Dim cn As New SqlConnection
            Try
                OpenConexionDB(cn)
                Dim SqlCmd As New SqlCommand(Sql, cn)
                Dim res As Integer = SqlCmd.ExecuteNonQuery()
                CloseConexionDB(cn)
                ExecuteSql = res
            Catch ex As Exception
                MsgBox(ex.Message)
                ExecuteSql = -1
            End Try
        End Function

        Public Function GetDataSet(ByVal Sql As String, ByVal sTableName As String) As DataSet
            Dim cn As New SqlConnection
            Dim da As SqlDataAdapter
            Dim ds As New DataSet
            Dim dt As New DataTable
            Try
                OpenConexionDB(cn)
                da = New SqlDataAdapter(Sql, cn)
                da.Fill(dt)
                dt.TableName = sTableName
                ds.Tables.Add(dt)
                GetDataSet = ds
                CloseConexionDB(cn)
            Catch ex As Exception
                MsgBox(ex.Message)
                GetDataSet = Nothing
            End Try
        End Function

        Public Sub SetDataSet(ByVal sTableName As String, ByVal ds As DataSet)
            Dim cn As New SqlConnection
            Dim da As SqlDataAdapter
            Dim cb As SqlCommandBuilder
            Try
                OpenConexionDB(cn)
                Dim Sql As String = "SELECT TOP 0 * FROM " & sTableName
                da = New SqlDataAdapter(Sql, cn)
                cb = New SqlCommandBuilder(da)
                da.Update(ds, sTableName)
                CloseConexionDB(cn)
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try
        End Sub

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 ...