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


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