miércoles, 16 de mayo de 2012

visual basic.net y vb6.0

Como convertir números a letras

He visto muchas veces esta pregunta en los foros, si mal no recuerdo en el año 2000 alguien que no recuerdo su nombre envío el siguiente algoritmo para VB 6.0 para realizar dicha conversión.... ha sido unos de los mejores que he visto.. A continuación se los adjunto, espero que también les puedan servir.


Sirve tanto para VB 6.0, como para Visual Basic .NET


Public Function Num2Text(ByVal value As Double) As String
Select Case value
Case 0 : Num2Text = "CERO"
Case 1 : Num2Text = "UN"
Case 2 : Num2Text = "DOS"
Case 3 : Num2Text = "TRES"
Case 4 : Num2Text = "CUATRO"
Case 5 : Num2Text = "CINCO"
Case 6 : Num2Text = "SEIS"
Case 7 : Num2Text = "SIETE"
Case 8 : Num2Text = "OCHO"
Case 9 : Num2Text = "NUEVE"
Case 10 : Num2Text = "DIEZ"
Case 11 : Num2Text = "ONCE"
Case 12 : Num2Text = "DOCE"
Case 13 : Num2Text = "TRECE"
Case 14 : Num2Text = "CATORCE"
Case 15 : Num2Text = "QUINCE"
Case Is
Case 20 : Num2Text = "VEINTE"
Case Is
Case 30 : Num2Text = "TREINTA"
Case 40 : Num2Text = "CUARENTA"
Case 50 : Num2Text = "CINCUENTA"
Case 60 : Num2Text = "SESENTA"
Case 70 : Num2Text = "SETENTA"
Case 80 : Num2Text = "OCHENTA"
Case 90 : Num2Text = "NOVENTA"
Case Is
Case 100 : Num2Text = "CIEN"
Case Is
Case 200, 300, 400, 600, 800 : Num2Text = Num2Text(Int(value \ 100)) & "CIENTOS"
Case 500 : Num2Text = "QUINIENTOS"
Case 700 : Num2Text = "SETECIENTOS"
Case 900 : Num2Text = "NOVECIENTOS"
Case Is
Case 1000 : Num2Text = "MIL"
Case Is
Case Is
If value Mod 1000 Then Num2Text = Num2Text & " " & Num2Text(value Mod 1000)
Case 1000000 : Num2Text = "UN MILLON"
Case Is
Case Is
If (value - Int(value / 1000000) * 1000000) Then Num2Text = Num2Text & " " & Num2Text(value - Int(value / 1000000) * 1000000)
Case 1000000000000.0# : Num2Text = "UN BILLON"
Case Is
Case Else : Num2Text = Num2Text(Int(value / 1000000000000.0#)) & " BILLONES"
If (value - Int(value / 1000000000000.0#) * 1000000000000.0#) Then Num2Text = Num2Text & " " & Num2Text(value - Int(value / 1000000000000.0#) * 1000000000000.0#)
End Select


End Function

Como salir de la aplicación mediante un mensaje de texto previo
Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) HandlesMyBase.Closing

' Utilizamos la cancelación del método Closing

If MessageBox.Show("¿Desea Salir?", "Sistema", MessageBoxButtons.YesNo, MessageBoxIcon.Warning) = DialogResult.No Then

' Con el if, mandamos el messagebox y si la respuesta es un No, entonces cancela el método closing

e.Cancel = True

End If

End Sub
Modulo para copiar directorios (Backup de aplicaciones)
#Region "Imports"

Imports System.IO

Imports System.IO.File

#End Region

Module Module1

Public m_Destino As String

Sub Main()

Dim args() As String

args = Environment.GetCommandLineArgs()

If Environment.GetCommandLineArgs().Length >; 2 Then

Dim diSource As New DirectoryInfo(args(1).ToString)

Dim diDestiny As New DirectoryInfo(args(2).ToString & Date.Now.Year & "_" & Date.Now.Month & "_" & Date.Now.Day)

CopyFiles(diSource, diDestiny, True)

Else

Console.Write("No se ha definido el origen o el destino")

End If

End Sub

Private Sub CopyFiles(ByVal p_source As DirectoryInfo, ByVal p_destination As DirectoryInfo, _

ByVal blOverwrite As Boolean)

Dim diSourceSubDirectories() As DirectoryInfo

Dim fiSourceFiles() As FileInfo

fiSourceFiles = p_source.GetFiles()

diSourceSubDirectories = p_source.GetDirectories()

If Not p_destination.Exists Then p_destination.Create()

For Each diSourceSubDirectory As DirectoryInfo In diSourceSubDirectories

CopyFiles(diSourceSubDirectory, New DirectoryInfo(p_destination.FullName & "\" & _

diSourceSubDirectory.Name), blOverwrite)

Next

For Each fiSourceFile As FileInfo In fiSourceFiles

Console.Write("Copiando Fichero " & fiSourceFile.ToString & vbCrLf)

fiSourceFile.CopyTo(p_destination.FullName + "\" + fiSourceFile.Name, blOverwrite)

Next

End Sub

End Module

Para poder seleccionar toda la fila de un grid al hacer click encima utilizaremos la siguiente función:

Private Sub DgUrls_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles DgUrls.MouseUp Dim pt As System.Drawing.Point pt = New Point(e.X, e.Y) Dim hti As DataGridView.HitTestInfo hti = DgUrls.HitTest(e.X, e.Y) If hti.Type = DataGrid.HitTestType.Cell Then DgUrls.CurrentCell = DgUrls.Rows(hti.RowIndex).Cells(hti.ColumnIndex) DgUrls.Rows(hti.RowIndex).Selected = True End If End Sub


Para encriptar y desencriptar datos podemos utilizar las siguientes funciones:
Public Shared Function EncryptString(ByVal InputString As String, ByVal SecretKey As String, Optional ByVal CyphMode As CipherMode = CipherMode.ECB) As String
Try
Dim Des As New TripleDESCryptoServiceProvider
'Put the string into a byte array
Dim InputbyteArray() As Byte = Encoding.UTF8.GetBytes(InputString)
'Create the crypto objects, with the key, as passed in
Dim hashMD5 As New MD5CryptoServiceProvider
Des.Key = hashMD5.ComputeHash(ASCIIEncoding.ASCII.GetBytes(SecretKey))
Des.Mode = CyphMode
Dim ms As MemoryStream = New MemoryStream
Dim cs As CryptoStream = New CryptoStream(ms, Des.CreateEncryptor(), _
CryptoStreamMode.Write)
'Write the byte array into the crypto stream
'(It will end up in the memory stream)
cs.Write(InputbyteArray, 0, InputbyteArray.Length)
cs.FlushFinalBlock()
'Get the data back from the memory stream, and into a string
Dim ret As StringBuilder = New StringBuilder
Dim b() As Byte = ms.ToArray
ms.Close()
Dim I As Integer
For I = 0 To UBound(b)
'Format as hex
ret.AppendFormat("{0:X2}", b(I))
Next

Return ret.ToString()
Catch ex As System.Security.Cryptography.CryptographicException
ExceptionManager.Publish(ex)
Return ""
End Try

End Function

Public Shared Function DecryptString(ByVal InputString As String, ByVal SecretKey As String, Optional ByVal CyphMode As CipherMode = CipherMode.ECB) As String
If InputString = String.Empty Then
Return ""
Else
Dim Des As New TripleDESCryptoServiceProvider
'Put the string into a byte array
Dim InputbyteArray(CType(InputString.Length / 2 - 1, Integer)) As Byte '= Encoding.UTF8.GetBytes(InputString)
'Create the crypto objects, with the key, as passed in
Dim hashMD5 As New MD5CryptoServiceProvider

Des.Key = hashMD5.ComputeHash(ASCIIEncoding.ASCII.GetBytes(SecretKey))
Des.Mode = CyphMode
'Put the input string into the byte array

Dim X As Integer

For X = 0 To InputbyteArray.Length - 1
Dim IJ As Int32 = (Convert.ToInt32(InputString.Substring(X * 2, 2), 16))
Dim BT As New ByteConverter
InputbyteArray(X) = New Byte
InputbyteArray(X) = CType(BT.ConvertTo(IJ, GetType(Byte)), Byte)
Next

Dim ms As MemoryStream = New MemoryStream
Dim cs As CryptoStream = New CryptoStream(ms, Des.CreateDecryptor(), _
CryptoStreamMode.Write)

'Flush the data through the crypto stream into the memory stream
cs.Write(InputbyteArray, 0, InputbyteArray.Length)
cs.FlushFinalBlock()

'//Get the decrypted data back from the memory stream
Dim ret As StringBuilder = New StringBuilder
Dim B() As Byte = ms.ToArray

ms.Close()

Dim I As Integer

For I = 0 To UBound(B)
ret.Append(Chr(B(I)))
Next

Return ret.ToString()
End If
End Function

Crearemos una función llamada soloNumeros

Private Function soloNumeros(ByVal KCode As Int16) As Boolean

If (KCode >= 48 And KCode
Return False
Else
Return True
End If

End Function

En la caja de texto, en el evento KeyPress

Private Sub TextBox1_KeyPress(ByVal sender As Object _
, ByVal e As System.Windows.Forms.KeyPressEventArgs) _
Handles TextBox1.KeyPress

e.Handled = soloNumeros(System.Convert.ToInt16(Asc(e.KeyChar)))

End Sub

Cargar un data grid

Dim cn As SqlConnection
Dim cmd As SqlCommand
Dim ds As DataSet
Dim sqldad As SqlDataAdapter
Dim intRegistros As Integer
cn = New SqlConnection
Cn.ConnectionString ="conexion"
Cn.Open()
cmd = New SqlCommand("SELECT * FROM ...", cn)
sqldad = New SqlDataAdapter(cmd)
ds = New DataSet("MiDataSet")
sqldad.Fill(ds, "Publishers")
Me.GRD_LINKS.DataSource = ds

Validar numeros y letras


Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As _ System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
If e.KeyChar.IsLetter(e.KeyChar) Then
e.Handled = False
ElseIf e.KeyChar.IsControl(e.KeyChar) Then
e.Handled = False
ElseIf e.KeyChar.IsSeparator(e.KeyChar) Then
e.Handled = False
Else
e.Handled = True
End If
End Sub

Private Sub TextBox2_KeyPress(ByVal sender As Object, ByVal e As _ System.Windows.Forms.KeyPressEventArgs) Handles TextBox2.KeyPress
If e.KeyChar.IsDigit(e.KeyChar) Then
e.Handled = False
ElseIf e.KeyChar.IsControl(e.KeyChar) Then
e.Handled = False
Else
e.Handled = True
End If
End Sub

No hay comentarios: