Blog do Melo: 2016

quarta-feira, 23 de novembro de 2016

Transferir itens selecionados de um listbox para outro e limpar o original vb.net aspx

Protected Sub btnIncluir_Click(sender As Object, e As EventArgs) Handles btnIncluir.Click

'Transfere os itens selecionados do listbox origem para o listbox destino
For Each Item In lstOrigem.Items
If Item.selected = True Then
lstDestino.Items.Add(Item)
End If
Next

'Remove os itens selecionados do listbox origem
For Each Item In lstOrigem.GetSelectedIndices
lstOrigem.Items.Remove(lstOrigem.SelectedItem)
Next

End Sub

sexta-feira, 5 de fevereiro de 2016

Referenciar um Formulário pelo Nome em VB.Net

Function PegaFormPeloNome(ByVal FormName As String) As Form

    Dim T As Type = Type.GetType(FormName, False)
    If T Is Nothing Then
      Dim Fullname As String = Application.ProductName & "." & FormName
      T = Type.GetType(Fullname, True, True)
    End If
    Return CType(Activator.CreateInstance(T), Form)
End Function

Disparar Ping em computador remoto em VB.Net

Public Function PingaIp(ByVal endIp As String) As Integer

    Dim sRetorno As String
    Dim lTempoPing As Long
    Try
      Dim pingSender As New System.Net.NetworkInformation.Ping
      Dim opcoes As New System.Net.NetworkInformation.PingOptions
      opcoes.DontFragment = True
      Dim dados As String = "XXXXXXXXXXXXXXXXXXXXXX"
      Dim buffer As Byte() = Encoding.ASCII.GetBytes(dados)
      Dim timeout As Integer = 120
      Dim resposta As PingReply = pingSender.Send(endIp, timeout, buffer, opcoes)
      If resposta.Status = IPStatus.Success Then
        lTempoPing = resposta.RoundtripTime + 1
        sRetorno = lTempoPing.ToString
      Else
        sRetorno = "0"
      End If
      Return CInt(sRetorno)
    Catch ex As Exception
      Return -1
    End Try
End Function

Executar comandos do Sistema e pegar o retorno em VB.Net

Public Function ExecutaComandoMSDOS(ByVal pComando As String, ByVal pParametros As String) As String

    Dim _ret As String = ""
    Dim procShell As New Process()
    'Seu comando vai aqui.
    procShell.StartInfo.FileName = pComando
    'Os argumentos, aqui.
    procShell.StartInfo.Arguments = pParametros
    procShell.StartInfo.CreateNoWindow = True
    procShell.StartInfo.RedirectStandardOutput = True
    procShell.StartInfo.UseShellExecute = False
    procShell.StartInfo.RedirectStandardError = True
    procShell.Start()

    Dim streamReader As System.IO.StreamReader
    streamReader = New System.IO.StreamReader(procShell.StandardOutput.BaseStream, procShell.StandardOutput.CurrentEncoding)
    Do
      Dim _line As String = streamReader.ReadLine()
      If (IsNothing(_line)) Then Exit Do
      _ret = _ret & _line & " "
    Loop
    streamReader.Close()
    Return _ret
End Function

Gravar Log de erros em VB.Net

Public Sub GravaLog(ByVal Arquivo As String, ByVal Texto As String)

    Try
      Dim Escritor As System.IO.FileStream
      Dim EscritorTexto As System.IO.StreamWriter
      Dim Pasta As System.IO.DirectoryInfo
     Pasta = System.IO.Directory.GetParent(Arquivo)
      If Not Directory.Exists(Pasta.ToString) Then
        System.IO.Directory.CreateDirectory(Pasta.ToString)
      End If
      If System.IO.File.Exists(Arquivo) Then
        Escritor = New System.IO.FileStream(Arquivo, IO.FileMode.Append, IO.FileAccess.Write)
      Else
        Escritor = New System.IO.FileStream(Arquivo, IO.FileMode.CreateNew, IO.FileAccess.Write)
      End If

EscritorTexto = New System.IO.StreamWriter(Escritor)

      EscritorTexto.WriteLine(System.DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss") & "-" & Texto)
      EscritorTexto.Close()
    Catch ex As Exception
      MessageBox.Show("Método GravaArq - " & ex.Message, "Erro", MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Try
End Sub

Listar todos os arquivos em uma pasta com VB.Net

Public Function GetFiles(ByVal pathFolder As String) As ArrayList

    Dim returnFiles As ArrayList = New ArrayList
    Dim dirInfo As DirectoryInfo = New DirectoryInfo(pathFolder)
    If dirInfo.Exists Then
      Dim filesInfo As FileSystemInfo() = dirInfo.GetFileSystemInfos
      For Each fil As FileSystemInfo In filesInfo
        If (fil.Attributes = System.IO.FileAttributes.Directory) = False Then
          returnFiles.Add(fil.FullName)
        Else
          If fil.Attributes = FileAttributes.Directory Then
            returnFiles.AddRange(GetFiles(fil.FullName))
          End If
        End If
      Next
    End If
    Return returnFiles
End Function

Manipulação de arquivo XML usando VB.Net

1) Ler o arquivo

O nome do arquivo é "Configuracao.xml" , ele será lido do disco e colocado em um DataGridViw chamado dtgEmail no evento Click do Botão btnLerArquivo.

Arquivo configuracao.xml:



         usuario1@dominio.com


          usuario1@dominio.com


          usuario1@dominio.com


          usuario1@dominio.com


          usuario1@dominio.com


          usuario1@dominio.com


          usuario1@dominio.com

Private Sub btnLerArquivo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLerArquivo.Click

    Dim ds As New DataSet
    ds.ReadXml("Configuracao.xml")
    dtgEmail.DataSource = ds.Tables(0)
    dtgEmail.AutoResizeColumns()
End Sub

2) Gravar o arquivo:

O arquivo será gravado através do evenco Click do botão btnGravar.
Private Sub btnGravar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGravar.Click
    Dim i As Integer
    Dim sAux(0) As String
    Dim ds As New DataSet
    Dim dt As New DataTable("copia")
    Dim dr As DataRow

dt.Columns.Add("email")

    'Apaga o arquivo de entrada se ele existir
    If System.IO.File.Exists("Configuracao.xml") Then
      System.IO.File.Delete("Configuracao.xml")
    End If

'Percorre todo o grid

    For i = 0 To dtgEmail.Rows.Count - 2
      If dtgEmail.Rows(i).Cells(0).Value.ToString <> "" Then
        dr = dt.NewRow
        sAux(0) = dtgEmail.Rows(i).Cells(0).Value.ToString
        dt.Rows.Add(sAux)
      End If
    Next
    ds.Tables.Add(dt)
    ds.WriteXml("Configuracao.xml")
    Me.Close()
End Sub

quinta-feira, 4 de fevereiro de 2016

Funções usadas no evento KeyPress de um textbox para fazer consistência de dados

Public Function SoNumeroEPonto(ByVal CaracterASCII As Integer) As String
     If (CaracterASCII < 48) Or (CaracterASCII > 57) Then
        If (CaracterASCII <> 46) And (CaracterASCII <> 8) Then
            Return ""
        End If
     End If
     Return Chr(CaracterASCII)
End Function

Public Function SoNumero(ByVal CaracterASCII As Integer) As String
     If (CaracterASCII < 48) Or (CaracterASCII > 57) Then
         If (CaracterASCII <> 8) And (CaracterASCII <> 46) Then
             Return ""
         End If
     End If
     Return Chr(CaracterASCII)
End Function

Public Function SoLetra(ByVal CaracterASCII As Integer) As String
     If (CaracterASCII < 65 Or CaracterASCII > 90) Then
         If (CaracterASCII < 95 Or CaracterASCII > 122) Then
             If CaracterASCII <> 8 Then
                 Return ""
             End If
         End If
     End If
     Return Chr(CaracterASCII)
End Function

Função para Gerar Código Hash em VB.Net

Imports System.Security.Cryptography
Imports System.Text
Public Function GeraHash(ByVal sTexto As String) As String
     Dim sSenha As String
     Dim SHA1hashValue() As Byte
     Dim b As Byte
     Dim UE As New UnicodeEncoding
     Dim MessageBytes As Byte() = UE.GetBytes(sTexto)
     Dim SHHash As New SHA1Managed

     SHA1hashValue = SHHash.ComputeHash(MessageBytes)
     sSenha = ""

    For Each b In SHA1hashValue
        sSenha &= b
    Next
    Return sSenha
End Function

Funções para manipular Banco de dados em VB.Net

Imports System.Data
Imports System.Data.SqlClient
Public Function LeBanco(ByVal strConexao As String, ByVal sSql As String) As DataSet
     Dim dataAdapter As SqlDataAdapter
     Dim DataSet As New DataSet
     Dim Conexao As SqlConnection
     Try
         Conexao = New SqlConnection(strConexao)
         Conexao.Open()
         dataAdapter = New SqlDataAdapter(sSql, Conexao)
         dataAdapter.Fill(DataSet, "Dados")

         Conexao.Close()
         Return DataSet

     Catch ex As Exception
         Return Nothing
     End Try
End Function

Public Function ExecutaBanco(ByVal strConexao As String, ByVal sSql As String, Optional ByVal InserirTransacao As Boolean = True) As Boolean
     Dim sAux As String
     Dim Conexao As SqlConnection = New SqlConnection(strConexao)
     Try
         'Define a transação
         If InserirTransacao = True Then
             sAux = "BEGIN TRAN " & sSql & " COMMIT TRAN"
         Else
             sAux = sSql
         End If
         Dim Comando As SqlCommand = New SqlCommand(sAux, Conexao)
         Conexao.Open()
         Comando.ExecuteNonQuery()
         Conexao.Close()
         Return True
     Catch ex As Exception
         Return False
     End Try
End Function

Blog do Melo