Blog de Miguel Díaz » Utilidades http://www.blogdemigueldiaz.com Blog sobre Informática, programación y diseño Web Fri, 14 Jun 2013 19:00:38 +0000 es-ES hourly 1 http://wordpress.org/?v=3.6.1 Curso de SQLmap a fondo – Parte 2 – Vulnerabilidades en variables POST, Cookies y obtención de información del usuario http://www.blogdemigueldiaz.com/2013/04/curso-de-sqlmap-a-fondo-parte-2-vulnerabilidades-en-variables-post-cookies-y-obtencion-de-informacion-del-usuario/?utm_source=rss&utm_medium=rss&utm_campaign=curso-de-sqlmap-a-fondo-parte-2-vulnerabilidades-en-variables-post-cookies-y-obtencion-de-informacion-del-usuario http://www.blogdemigueldiaz.com/2013/04/curso-de-sqlmap-a-fondo-parte-2-vulnerabilidades-en-variables-post-cookies-y-obtencion-de-informacion-del-usuario/#comments Sat, 13 Apr 2013 12:57:55 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=2182 Continuar leyendo ]]> mysqlSi habéis seguido el post inicial del curso os habréis dado cuenta de que SQLmap es una potente herramienta, mucho mas que un simple detector de SQLinjection es un potente framwork para la explotación de esta vulnerabilidad. En la pasada entrega aprendimos a buscar vulnerabilidades mediante las variables GET, a realizar consultas SQL y a volcar las bases de datos a nuestro disco duro, pero no debemos cerrarnos únicamente a las variables GET, ya que hay muchos apartados como buscadores, formularios de login que funcionan mediante las variables POST y Cookies lo cual supone cerca de un 70% de los “Inputs” de cualquier Web, por eso hoy veremos como buscar inyecciones de SQL en POST y Cookies. Además, aprenderemos a recolectar información acerca del usuario de la base de datos y sus permisos. Es muy importante tener en cuenta que para seguir este curso es necesario tener conocimientos de HTML y SQL Injection

Realizando un ataque hacia un formulario de login

Lo primero para esto es saber hacia que Web lanza la petición nuestro formulario, puesto que el lector de este curso tiene conocimientos de HTML no voy a reparar en explicar como saberlo, en nuestro caso la petición se hará contra checkuser.php, y los campos del formulario se llamarán inputUser e inputPassword

./sqlmap.py -u "http://ejemplo.com/checkuser.php" --data="inputUser=Admin&inputPassword=12345"

Como veis, igual que en los ejemplos anteriores introducimos la URL, pero despues añadimos el modificador --data, el cual define todos los datos que serán enviados mediante el método POST, las variables se separan con “&” igual que se hace en la cabecera.

Ahora imaginemos que solamente queremos analizar una variable y la otra queremos dejarla “fija”, para ello usaremos el modificador -p seguido de la variable que deseamos analizar, por ejemplo, en este caso sabemos que la variable inpuUser no es vulnerable, así que como no queremos perder tiempo vamos a realizar las pruebas únicamente con la variable inputPassword

./sqlmap.py -u "http://ejemplo.com/checkuser.php" --data="inputUser=Admin&inputPassword=12345" -p "inputPassword"

Hay que tener en cuenta que un formulario puede verificar otros campos como el nombre del botón que se ha pulsado para ser enviado, etc. Podemos ayudarnos de herramientas como Tamper Data, para obtener esta información o ver el código fuente de la página.

Si todo ha ido bien obtendremos una vulnerabilidad, si no podemos probar con el parametro --level=5 y --risk=3 para aumentar las posibilidades y complejidad de las consultas.

Captura

A continuación vamos a obtener toda la información posible del usuario actual, para ello en primer caso usaremos el modificador --current-user para averiguar qué usuario estamos utilizando.

./sqlmap.py -u "http://ejemplo.com/checkuser.php" --data="inputUser=Admin&inputPassword=12345" -p "inputPassword" --current-user
Captura

En este caso, al ser el usuario root sabremos que permisos tiene (todos) pero en caso de que sea un usuario diferente podemos saber que privilegios tiene usando el modificador --privileges

./sqlmap.py -u "http://ejemplo.com/checkuser.php" --data="inputUser=Admin&inputPassword=12345" -p "inputPassword" --privileges

Captura

Como vemos este usuario, al ser root tendría permiso a todo, desde consultas simples a ejecutar comandos o subir ficheros (cosas que aprenderemos en la siguiente entrega), también podriamos usar el comando --is-dba para ver si es administrador de la base de datos.

Lo último que explicaré hoy es cómo buscar vulnerabilidades de SQLinjection a través de las cookies, las cookies suelen ser un punto crítico en muchas páginas ya que los administradores muchas veces olvidan sanearlas ya que son ellos mismos quién las generan y olvidan que el usuario final puede modificarlas si quieren, por tanto es un punto a tener muy en cuenta a la hora de auditar una aplicación.

En nuestro ejemplo, usaremos un sitio que usa dos cookies, una llamada “sesion” y otra llamada “secreto”, el modificador a usar es --cookie=”id_cookie1=valor1&id_cookie2=valor2″

./sqlmap.py -u "http://ejemplo.com/web.php" --cookie="sesion=admin&secreto=prueba"
Captura

Y hasta aquí la entrega de hoy, en la próxima aprenderemos a leer ficheros locales del servidor vulnerado, ejecutar comandos y obtener una shell del sistema y subir ficheros

]]>
http://www.blogdemigueldiaz.com/2013/04/curso-de-sqlmap-a-fondo-parte-2-vulnerabilidades-en-variables-post-cookies-y-obtencion-de-informacion-del-usuario/feed/ 2
Nueva versión de mDrive 0.6.2.6 http://www.blogdemigueldiaz.com/2013/04/nueva-version-de-mdrive-sincronizacion-nube/?utm_source=rss&utm_medium=rss&utm_campaign=nueva-version-de-mdrive-sincronizacion-nube http://www.blogdemigueldiaz.com/2013/04/nueva-version-de-mdrive-sincronizacion-nube/#comments Wed, 10 Apr 2013 18:45:04 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=2133 Continuar leyendo ]]> 2222Hace unos días os presentaba mDrive, un nuevo proyecto que estoy realizando para  sincronziar ficheros entre dispositivos de forma automática. Hoy os traigo una actualización del programa que trae las siguientes mejoras:

screen

  • Sistema de actualizaciones: mDrive es capaz ahora de detectar nuevas versiones y e instalarlas.
  • Mejora de velocidad: Se ha aumentado un 100% la velocidad a la hora de detectar cambios en nuestros ficheros y reducido un 50% del código.
  • Disminución del ancho de banda: Se ha conseguido optimizar el proceso de sincronización de forma que ahora realiza comprobaciones del listado de directorio remoto de forma incremental lo que reduce considerablemente el uso de ancho de banda.
  • Añadida la opción de mostrar u ocultar notificaciones al actualizar un fichero.
  • Corrección de errores menores

Ahora mismo mDrive está en desarrollo pero puedes probarlo gratuitamente utilizando nuestros servidores creando una cuenta de prueba.

descargar

A continuación os dejo unas gráficas de diferencia de rendimiento entre versiones.

Captura

Actualmente mDrive se encuentra en versión beta y la parte del servidor será liberada al alcanzar la primera versión estable.

]]>
http://www.blogdemigueldiaz.com/2013/04/nueva-version-de-mdrive-sincronizacion-nube/feed/ 0
Nueva versión de DNS Propagation Checker http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-dns-propagation-checker/?utm_source=rss&utm_medium=rss&utm_campaign=nueva-version-de-dns-propagation-checker http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-dns-propagation-checker/#comments Mon, 26 Dec 2011 05:09:22 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=1370 Continuar leyendo ]]> Hoy os presento una actualización del comprobador de propagación DNS que he desarrollado. Esta nueva versión incluye varias mejoras principales entre las que podemos destacar:

  • Actualización en tiempo real de los DNS comprobados, antes nos mostraba el resultado una vez se había comprobado en todos los DNS, ahora irá mostrando el resultado conforme se vaya comprobando.
  • Capacidad de usar diferentes listados de servidores DNS: Podremos elegir entre distintos listados DNS personalizados, porejemplo uno con servidores nacionales o internos de una empresa, otro con servidores extranjeros, etc.

Además se ha mejorado el resultado del programa logrando hasta un 30% mayor de precisión.

A continuación, como viene siendo habitual os dejo el código fuente:

Form1.vb

Imports System
Imports System.IO
Imports System.Text.RegularExpressions
Public Class DNSPropagationChecker
    Dim hilo As Threading.Thread
    Public Sub cargaListas()
        cbSeleccionListado.Items.Clear()
        Dim Ini As CIniClass
        Ini = New CIniClass
        Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
        Dim contador As Integer = 1

Continuación de Form1.vb

        Dim servidor As String = "-1"
        While servidor <> ""
            servidor = Ini.LeeIni("LISTADOS", "LISTADO" & contador)
            If servidor <> "" Then
                cbSeleccionListado.Items.Add(servidor)
            End If
            contador += 1
        End While
        cbSeleccionListado.Items.Add("Nuevo listado")
    End Sub
    Public Sub cargaListadoDNS(ByVal listado As String)
        lbServidoresDNS.Items.Clear()
        lbServidoresDNS.Items.Add("Todos")
        Dim Ini As CIniClass
        Ini = New CIniClass
        Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
        Dim contador As Integer = 1
        Dim servidor As String = "-1"
        While servidor <> ""
            servidor = Ini.LeeIni(listado, "SERVIDOR" & contador)
            If servidor <> "" Then
                lbServidoresDNS.Items.Add(servidor)
            End If
            contador += 1
        End While
        lbServidoresDNS.SelectedIndex = 0
    End Sub
    Private Sub btAñadir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAñadir.Click
        Form2.cantidadElementos = lbServidoresDNS.Items.Count()
        Form2.Show()
    End Sub
    'Esta funcion devueve true si la IP introducida es valida y false si no es valida
    Function compruebaIP(ByVal strFindin As String)
        Dim myRegex As New Regex("^(([01]?\d\d?|2[0-4]\d|25[0-5])\.){3}([01]?\d\d?|25[0-5]|2[0-4]\d)$")
        If myRegex.IsMatch(strFindin) Then
            compruebaIP = True
        Else
            compruebaIP = False
        End If
    End Function
    Private Sub DNSPropagationChecker_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Leave
        Try
            hilo.Abort()
        Catch ex As Exception
        End Try
    End Sub
    Private Sub DNSPropagationChecker_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CheckForIllegalCrossThreadCalls = False
        cbSeleccionListado.SelectedIndex = 0
        'Comprueba que el INI exista, si no existe lo crea con los servidores de Google de ejemplo.
        If System.IO.File.Exists(Application.StartupPath & "/dnspropagationchecker.ini") = False Then
            Dim Ini As CIniClass
            Ini = New CIniClass
            Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
            Ini.GrabaIni("LISTADOS", "LISTADO1", "Listado variado")
            Ini.GrabaIni("Listado variado", "SERVIDOR2", "8.8.4.4")
            Ini.GrabaIni("Listado variado", "SERVIDOR1", "8.8.8.8")
        End If
        Try
            cargaListas()
            cbSeleccionListado.SelectedIndex = 0
        Catch ex As Exception
            MsgBox("No se ha podido cargar dnspropagationchecker.ini")
            End
        End Try
    End Sub
    Private Sub btComprobar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btComprobar.Click
        'Desactiva los controles
        tbDominio.Enabled = False
        tbIP.Enabled = False
        btAñadir.Enabled = False
        lbIP.Enabled = False
        lbServidoresDNS.Enabled = False
        btComprobar.Text = "Comprobando..."
        btComprobar.Enabled = False
        lbDNSPropagados.Visible = True
        hilo = New Threading.Thread(AddressOf comprobar_propagacion)
        hilo.Start()
    End Sub
    Sub comprobar_propagacion()
        Dim cantidadDNS As Integer = 1
        Dim contador As Integer = 0
        'Comprueba que haya puesto un dominio
        tbDominio.Text = tbDominio.Text.Replace(" ", "")
        tbIP.Text = tbIP.Text.Replace(" ", "")
        lbIP.Items.Clear()
        If tbDominio.Text = "" Then
            MsgBox("Debe introducir un nombre de dominio", MsgBoxStyle.Information)
            rehabilitar_elementos()
            Exit Sub
        End If
        'Comprueba que haya puesto una IP valida
        If compruebaIP(tbIP.Text) = False Then
            MsgBox("Debe introducir una IP válida", MsgBoxStyle.Information)
            rehabilitar_elementos()
            Exit Sub
        End If
        'Si se ha elegido el servidor Todos, guarda en el array todos los DNS. Si solo elige uno
        'Crea un array valor 0 y mete el servidor DNS concreto
        If lbServidoresDNS.SelectedIndex = 0 Then
            cantidadDNS = lbServidoresDNS.Items.Count() - 1
        End If
        Dim arrayDNS(cantidadDNS - 1) As String
        If lbServidoresDNS.SelectedIndex = 0 Then
            While contador < lbServidoresDNS.Items.Count - 1
                arrayDNS(contador) = lbServidoresDNS.Items(contador + 1).ToString
                contador += 1
            End While
        Else
            arrayDNS(0) = lbServidoresDNS.Items(lbServidoresDNS.SelectedIndex).ToString
        End If
        lbDNSPropagados.Visible = True
        lbIP.Visible = True
        'Prepara el proceso nslookup para que no se muestre la ventana de DOS
        Dim proceso As New Process
        proceso.StartInfo.RedirectStandardOutput = True
        proceso.StartInfo.FileName = "nslookup.exe"
        proceso.StartInfo.UseShellExecute = False
        proceso.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
        proceso.StartInfo.CreateNoWindow = True
        'Lo lanza contra cada servidor DNS recorriendo el array
        contador = 0
        While contador < arrayDNS.Length
            proceso.StartInfo.Arguments = "-retry=1 -timeout=1 " & tbDominio.Text & " " & arrayDNS(contador)
            proceso.Start()
            Dim sr As IO.StreamReader = proceso.StandardOutput
            Dim sb As New System.Text.StringBuilder("")
            Dim sinput As String = ""
            Do Until sinput = "-1"
                Dim resultado As String = sr.ReadLine
                'En caso de que devuelva algo con la IP buena, lo declara propagado
                If InStr(resultado, tbIP.Text) Then
                    anadir_elementos_listbox(arrayDNS(contador))
                ElseIf InStr(resultado, "timeout") Then
                    sinput = "-1"
                    proceso.Close()
                Else
                    sinput = sr.Read()
                End If
            Loop
            contador += 1
        End While
        If lbIP.Items.Count = 0 Then
            lbIP.Items.Add("Aún no se ha propagado en ningun servidor DNS seleccionado")
        End If
        'Reactiva los controles
        rehabilitar_elementos()
    End Sub
    Delegate Sub anadir_elementos_listboxCallback(ByVal elemento As String)
    Private Sub anadir_elementos_listbox(ByVal elemento As String)
        Try
            If lbIP.InvokeRequired Then
                Dim d As New anadir_elementos_listboxCallback(AddressOf anadir_elementos_listbox)
                Me.Invoke(d, elemento)
            Else
                lbIP.Items.Add(elemento)
            End If
        Catch ex As Exception
        End Try
    End Sub
    Delegate Sub rehabilitar_elementosCallback()
    Private Sub rehabilitar_elementos()
        If lbIP.InvokeRequired Then
            Dim d As New rehabilitar_elementosCallback(AddressOf rehabilitar_elementos)
            Me.Invoke(d)
        Else
            tbDominio.Enabled = True
            lbIP.Enabled = True
            lbServidoresDNS.Enabled = True
            btComprobar.Text = "Comprobar propagacion"
            btComprobar.Enabled = True
            tbIP.Enabled = True
            btAñadir.Enabled = True
        End If
    End Sub
    Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        System.Diagnostics.Process.Start("http://www.blogdemigueldiaz.com/?proyecto=DNSPropagationChecker")
    End Sub
    Private Sub cbSeleccionListado_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cbSeleccionListado.SelectedIndexChanged
        If cbSeleccionListado.SelectedItem.ToString <> "" And cbSeleccionListado.SelectedIndex < cbSeleccionListado.Items.Count - 1 Then
            cargaListadoDNS(cbSeleccionListado.SelectedItem.ToString)
        Else
            formNuevoListado.Show()
        End If
    End Sub
End Class

Form2.vb

Public Class Form2
    Dim listadoActual As String = DNSPropagationChecker.cbSeleccionListado.SelectedItem.ToString
    Public cantidadElementos As Integer = 0
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'Guarda el DNS en el .ini
        If DNSPropagationChecker.compruebaIP(tbIPServidor.Text) = True Then
            Dim Ini As CIniClass
            Ini = New CIniClass
            Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
            Ini.GrabaIni(listadoActual, "SERVIDOR" & cantidadElementos, tbIPServidor.Text)
            DNSPropagationChecker.cargaListadoDNS(DNSPropagationChecker.cbSeleccionListado.SelectedItem.ToString)
            Me.Close()
        Else
            MsgBox("Esa no es una IP Valida", MsgBoxStyle.Information)
        End If
    End Sub
End Class

formNuevoListado.vb

Public Class formNuevoListado
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim cantidadElementos As Integer = DNSPropagationChecker.cbSeleccionListado.Items.Count
        If tbNombreListado.Text.Replace(" ", "") <> "" Then 'Si ha introducido algo en el cuadro de texto
            'Comprueba que no exista ya en el listado
            For contador As Integer = 0 To DNSPropagationChecker.cbSeleccionListado.Items.Count - 1 Step 1
                If DNSPropagationChecker.cbSeleccionListado.Items.Item(contador).ToString = tbNombreListado.Text Then
                    MsgBox("Ya existe un listado con ese nombre", MsgBoxStyle.Information)
                    Exit Sub
                End If
            Next
            Dim ini As New CIniClass
            ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
            ini.GrabaIni("LISTADOS", "LISTADO" & cantidadElementos, tbNombreListado.Text)
            DNSPropagationChecker.cargaListas()
            DNSPropagationChecker.cbSeleccionListado.SelectedIndex = DNSPropagationChecker.cbSeleccionListado.Items.Count - 2
        Else 'Si esta vacio
            MsgBox("Debes introducir un nombre para el listado", MsgBoxStyle.Information)
        End If
    End Sub
End Class
]]>
http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-dns-propagation-checker/feed/ 0
Nueva versión de mRemoto 0.9.8 – Programa de control remoto http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-mremoto-0-9-8-programa-de-control-remoto/?utm_source=rss&utm_medium=rss&utm_campaign=nueva-version-de-mremoto-0-9-8-programa-de-control-remoto http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-mremoto-0-9-8-programa-de-control-remoto/#comments Thu, 08 Dec 2011 19:22:35 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=1136 Continuar leyendo ]]>
Los que me seguís en Twitter o Facebook sabréis que hace poco publicaron mRemoto en softonic. Llevaba tiempo queriendo publicar algunas de mis aplicaciones en este portal y para celebrarlo he añadido varias mejoras en mRemoto.
Ahora, además de todas las funcionalidades anteriores, respetando la portabilidad y el reducido tamaño de la aplicación he añadido la posibilidad de enviar ficheros a el equipo controlado, de esta forma si estamos realizando alguna actividad y necesitamos de algún programa o documento que no tenemos podemos enviarlo desde nuestro equipo.

Otra funcionalidad que pedía a gritos ser añadida ha sido la de bloquear el teclado y el mouse del equipo, así si estamos utilizándolo podemos hacer clic en el botón “Bloquear mouse” para evitar que otra persona intente trabajar en el equipo al mismo tiempo.

Descarga de portables y mas información disponible en la página de mRemoto

]]>
http://www.blogdemigueldiaz.com/2011/12/nueva-version-de-mremoto-0-9-8-programa-de-control-remoto/feed/ 1
Acortador de nombres de ficheros – Elimina los errores por nombres o rutas demasiado largas http://www.blogdemigueldiaz.com/2011/11/acortador-de-nombres-de-ficheros-elimina-los-errores-por-nombres-o-rutas-demasiado-largas/?utm_source=rss&utm_medium=rss&utm_campaign=acortador-de-nombres-de-ficheros-elimina-los-errores-por-nombres-o-rutas-demasiado-largas http://www.blogdemigueldiaz.com/2011/11/acortador-de-nombres-de-ficheros-elimina-los-errores-por-nombres-o-rutas-demasiado-largas/#comments Wed, 23 Nov 2011 00:29:47 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=1023 Continuar leyendo ]]> Os traigo lo último que he programado: Un acortador de nombres de ficheros masivo.

Windows tiene una limitación desde los primeros tiempos y es que si un fichero o una ruta está compuesta por mas de 260 carácteres puede dar problemas. No poder guardar un fichero, movero o copiarlo suele estar debidos a nombres demasiado largos.

Es útil en migraciones de información o para asegurarnos para evitar problemas al trabajar con nuestros archivos. 

El programa es capaz de detectar aquellos ficheros que contengan nombres o rutas demasiado largas y si lo deseamos lo acortará al tamaño que le hayamos establecido. Además nos creará un log (logRenombrador.txt) donde nos explicará cada cambio que se ha hecho.

Y a continuación como de costumbre el código fuente

Form1.vb

Imports System.IO
Imports System.Threading
Public Class Form1
    Dim hilo As Thread 'Hilo encargado de buscar los conflictos
'Funcion encargada de recorrer los ficheros
    Function GetFilesRecursive(ByVal initial As String) As List(Of String)
        ' Guarda los resultados
        Dim result As New List(Of String)
        ' Guarda los directorios procesados

Continuación de Form1.vb

        Dim stack As New Stack(Of String)
        ' Directorio inicial
        stack.Push(initial)
        ' Continua procesando
        Do While (stack.Count > 0)
            ' Obtiene el directorio superior
            Dim dir As String = stack.Pop
            'actualizar_label_fichero(dir)
            Try
                ' Todos los nombres de archivos
                result.AddRange(Directory.GetFiles(dir, "*.*"))
                ''result.AddRange(Directory.GetDirectories(dir))
                Dim directoryName As String
                For Each directoryName In Directory.GetDirectories(dir)
                    stack.Push(directoryName)
                Next
            Catch ex As Exception
            End Try
        Loop
        ' Devuelve la lista
        Return result
    End Function
    'Igual pero para directorios
    Public Shared Function GetDirectoriesRecursive(ByVal initial As String) As List(Of String)
        ' Guarda los resultados
        Dim result As New List(Of String)
        ' Guarda los directorios procesados
        Dim stack As New Stack(Of String)
        ' Directorio inicial
        stack.Push(initial)
        ' Continua procesando
        Do While (stack.Count > 0)
            ' Get top directory string
            Dim dir As String = stack.Pop
            Try
                ' Nombres de archivos
                result.AddRange(Directory.GetDirectories(dir, "*"))
                ' subdirectorios
                Dim directoryName As String
                For Each directoryName In Directory.GetDirectories(dir)
                    stack.Push(directoryName)
                Next
            Catch ex As Exception
            End Try
        Loop
        ' Devuelve la lista
        Return result
    End Function
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btDetectar.Click
        If tbDirectorio.Text.Length - tbDirectorio.Text.Replace("\", "").Length <> 1 Then
            tbDirectorio.Text = tbDirectorio.Text.TrimEnd("\")
        ElseIf tbDirectorio.Text.Length - tbDirectorio.Text.Replace("\", "").Length = 0 Then
            tbDirectorio.Text = tbDirectorio.Text & "\"
        End If
        btDetectar.Enabled = False
        ProgressBar1.Visible = True
        lbTituloUltimoFichero.Visible = True
        'lbUltimoFichero.Text = "Obteniendo el arbol..."
        lbCantidadConflictos.Text = ""
        btAcortar.Enabled = False
        cbAcortarRuta.Enabled = False
        tbDirectorio.Enabled = False
        numCaracteres.Enabled = False
        btExaminar.Enabled = False
        lbUltimoFichero.Visible = True
        ListBox1.Items.Clear()
        hilo = New Thread(AddressOf BuscarConflictos)
        Me.Size = New Size(841, 456)
        hilo.Start()
    End Sub
    Sub BuscarConflictos()
        Dim archivo As String = ""
        Dim cantidad_maxima_caracteres As Integer = numCaracteres.Value
        Dim directorio As String = tbDirectorio.Text
        'Detecta los directorios ncon nombres largos
        Dim lista_directorios As List(Of String) = GetDirectoriesRecursive(directorio)
        For Each archivo In lista_directorios
            If archivo.Length > 35 Then
                lbUltimoFichero.Text = "..." & archivo.Remove(0, archivo.Length - 35)
            Else
                lbUltimoFichero.Text = archivo
            End If
            If archivo.Length > cantidad_maxima_caracteres And rbRutaMasNombre.Checked = True Then
                ListBox1.Items.Add(archivo & "\") 'Añade la barra para luego identificar bien si es un directorio o un archivo
            ElseIf rbSoloNombre.Checked = True And archivo.Remove(0, archivo.LastIndexOf("\")).Length > cantidad_maxima_caracteres Then
                ListBox1.Items.Add(archivo & "\") 'Añade la barra para luego identificar bien si es un directorio o un archivo
            End If
        Next
        'Detecta los archivos con nombres largos
        Dim lista_archivos As List(Of String) = GetFilesRecursive(directorio)
        For Each archivo In lista_archivos
            If archivo.Length > 35 Then
                lbUltimoFichero.Text = "..." & archivo.Remove(0, archivo.Length - 35)
            Else
                lbUltimoFichero.Text = archivo
            End If
            If archivo.Length > cantidad_maxima_caracteres And rbRutaMasNombre.Checked = True Then
                ListBox1.Items.Add(archivo)
            ElseIf rbSoloNombre.Checked = True And archivo.Remove(0, archivo.LastIndexOf("\")).Length > cantidad_maxima_caracteres Then
                ListBox1.Items.Add(archivo)
            End If
        Next
        ProgressBar1.Visible = False
        btDetectar.Enabled = True
        lbTituloUltimoFichero.Visible = False
        lbUltimoFichero.Visible = False
        tbDirectorio.Enabled = True
        numCaracteres.Enabled = True
        btExaminar.Enabled = True
        If ListBox1.Items.Count > 0 Then
            lbCantidadConflictos.Text = "Se han encontrado " & ListBox1.Items.Count & " archivos. Puede acortar su nombre pulsando en acortar."
        Else
            lbCantidadConflictos.Text = "No se han encontrado nombres conflictivos."
        End If
        lbCantidadConflictos.Visible = True
        hacer_visible_panel_resultados()
    End Sub
    Delegate Sub hacer_visible_panel_resultadosCallback()
    Private Sub hacer_visible_panel_resultados()
        If btAcortar.InvokeRequired Then
            Dim d As New hacer_visible_panel_resultadosCallback(AddressOf hacer_visible_panel_resultados)
            Me.Invoke(d)
        Else
            pnResultados.Visible = True
            btAcortar.Enabled = True
            cbAcortarRuta.Enabled = True
        End If
    End Sub
    Delegate Sub actualizar_label_ficheroCallback(ByVal texto As String)
    Private Sub actualizar_label_fichero(ByVal texto As String)
        If btAcortar.InvokeRequired Then
            Dim d As New actualizar_label_ficheroCallback(AddressOf actualizar_label_fichero)
            Me.Invoke(d)
        Else
            lbUltimoFichero.Text = texto
        End If
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CheckForIllegalCrossThreadCalls = False
    End Sub
    Private Sub btResolver_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAcortar.Click
        Dim FicheroLog As String = My.Application.Info.DirectoryPath & "\logRenombrador.txt"
        Dim sw As New System.IO.StreamWriter(FicheroLog, True)
        sw.WriteLine("####################################################")
        sw.WriteLine("#### Información añadida el " & FormatDateTime(System.DateTime.Now, DateFormat.GeneralDate) & " ####")
        sw.WriteLine("####################################################")
        'Recorre el listbox cambiando el nombre a los ficheros.
        For contador As Integer = 0 To ListBox1.Items.Count - 1 Step 1
            Dim NombreNeto As String = ListBox1.Items.Item(contador).ToString.Remove(0, ListBox1.Items.Item(contador).ToString.LastIndexOf("\") + 1) 'Guarda el nombre sin el path ni la ext
            Dim path As String = ListBox1.Items.Item(contador).ToString.Remove(ListBox1.Items.Item(contador).ToString.LastIndexOf("\"), ListBox1.Items.Item(contador).ToString.Length - ListBox1.Items.Item(contador).ToString.LastIndexOf("\")) 'Almacena el path del archivo
            Try
                NombreNeto = NombreNeto.Remove(NombreNeto.LastIndexOf("."), NombreNeto.Length - NombreNeto.LastIndexOf("."))
            Catch ex As Exception
            End Try
            'NombreNeto = NombreNeto.Remove(NombreNeto.LastIndexOf("."), NombreNeto.Length - NombreNeto.LastIndexOf("."))
            Dim extension As String = ""
            Try
                extension = ListBox1.Items.Item(contador).ToString.Remove(0, ListBox1.Items.Item(contador).ToString.LastIndexOf("."))
            Catch ex As Exception
                extension = ""
            End Try
            Try
                If File.Exists(ListBox1.Items(contador).ToString) = True Then 'Si el archivo existe
                    Dim NuevoNombre As String = path & "\" & NombreNeto.Substring(0, 8) & extension
                    'Si ya existe un archivo con el mismo nuevo nombre se le añade un numero secuencial al final
                    Dim secuencial As Integer = 0
                    While File.Exists(NuevoNombre) = True
                        Try 'Fallará si no puede acortarse, es decir ya es de menos de 8 caracteres
                            NuevoNombre = path & "\" & NombreNeto.Substring(0, 8) & secuencial & extension
                        Catch ex As Exception
                            NuevoNombre = path & "\" & NombreNeto & extension
                        End Try
                        secuencial += 1
                    End While
                    sw.Write("Cambiando el nombre de " & ListBox1.Items.Item(contador).ToString & " a " & NuevoNombre & "...")
                    Rename(ListBox1.Items.Item(contador).ToString, NuevoNombre)
                    sw.WriteLine("OK")
                    'Comprueba si el nuevo nombre cumple las reglas o es necesario acortar tambien la ruta
                    If cbAcortarRuta.Checked = True And NuevoNombre.Length >= numCaracteres.Value Then
                        sw.WriteLine("La ruta continua siendo larga, se acortará...")
                        Dim rutaLimite As String = NuevoNombre.Remove(0, tbDirectorio.Text.Length + 1)
                        Dim cantidadNiveles As Integer = rutaLimite.Length - rutaLimite.Replace("\", "").Length
                        Dim parteRenombrada As String = NombreNeto & extension
                        For nivelesModificados As Integer = 0 To cantidadNiveles Step 1
                            Dim pathDirectorioRenombrar As String = ListBox1.Items.Item(contador).ToString.Remove(ListBox1.Items.Item(contador).ToString.Length - (parteRenombrada.Length + 1), parteRenombrada.Length + 1)
                            Dim nombreDirectorioRenombrar As String = pathDirectorioRenombrar.Substring(pathDirectorioRenombrar.LastIndexOf("\") + 1, pathDirectorioRenombrar.Length - (pathDirectorioRenombrar.LastIndexOf("\") + 1))
                            Dim ubicacionDirectorioRenombrar As String = pathDirectorioRenombrar.Substring(0, pathDirectorioRenombrar.Length - nombreDirectorioRenombrar.Length)
                            parteRenombrada = nombreDirectorioRenombrar & "\" & parteRenombrada
                            If nombreDirectorioRenombrar.Length > 8 Then
                                Dim secuencialDirectorio As Integer = 0
                                While Directory.Exists(ubicacionDirectorioRenombrar & nombreDirectorioRenombrar.Substring(0, 7) & secuencial) = True
                                    nombreDirectorioRenombrar = nombreDirectorioRenombrar.Substring(0, 7) & secuencialDirectorio
                                    secuencialDirectorio += 1
                                End While
                                sw.Write("   Se renombra " & ubicacionDirectorioRenombrar & nombreDirectorioRenombrar & " a " & ubicacionDirectorioRenombrar & nombreDirectorioRenombrar.Substring(0, 7) & secuencialDirectorio & "...")
                                Try
                                    Directory.Move(ubicacionDirectorioRenombrar & nombreDirectorioRenombrar, ubicacionDirectorioRenombrar & nombreDirectorioRenombrar.Substring(0, 7) & secuencialDirectorio)
                                    sw.WriteLine("OK")
                                    If (ubicacionDirectorioRenombrar & nombreDirectorioRenombrar.Substring(0, 7) & secuencialDirectorio & "\" & NombreNeto.Substring(0, 8) & secuencial & extension).Length - 1 <= numCaracteres.Value Then
                                        Exit For 'Si ya esta bien se sale del bucle
                                    End If
                                Catch ex As Exception
                                    sw.WriteLine(ex.Message)
                                End Try
                            End If
                            '
                        Next
                    End If
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Else ' Si el archivo no existe se añade la informacion al LOG
                    sw.WriteLine("No se cambiará el nombre a " & ListBox1.Items(contador).ToString & " ya que el archivo no existe o la ruta ha cambiado")
                End If
            Catch ex As Exception
                sw.WriteLine("ERROR: " & ex.Message)
            End Try
            'MsgBox(ListBox1.Items.Item(contador).ToString & "-")
        Next
        sw.Close()
        lbCantidadConflictos.Text = "Se ejecutaron las acciones necesarias. Buscando nuevos conflictos..."
        btDetectar.Enabled = False
        ProgressBar1.Visible = True
        lbTituloUltimoFichero.Visible = True
        lbUltimoFichero.Visible = True
        ListBox1.Items.Clear()
        hilo = New Thread(AddressOf BuscarConflictos)
        hilo.Start()
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btExaminar.Click
        If FolderBrowserDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            tbDirectorio.Text = FolderBrowserDialog1.SelectedPath
        End If
    End Sub
    Private Sub btDetectar_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles btDetectar.MouseDown
        btDetectar.Image = My.Resources.boton_push1
    End Sub
    Private Sub btDetectar_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles btDetectar.MouseHover
        btDetectar.Image = My.Resources.boton_hover
    End Sub
    Private Sub btDetectar_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles btDetectar.MouseLeave
        btDetectar.Image = My.Resources.boton_normal1
    End Sub
    Private Sub btAcortar_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles btAcortar.MouseDown
        btAcortar.Image = My.Resources.boton_push1
    End Sub
    Private Sub btAcortar_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles btAcortar.MouseHover
        btAcortar.Image = My.Resources.boton_hover
    End Sub
    Private Sub btAcortar_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles btAcortar.MouseLeave
        btAcortar.Image = My.Resources.boton_normal1
    End Sub
    Private Sub tbDirectorio_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbDirectorio.TextChanged
        'En caso de que se tenga en cuenta la ruta dela archivo para obtener la longitud establecerá un minimo de caracteres
        'igual a la ruta introducida para evitar que muestre todos los archivos.
        tbDirectorio.Text = tbDirectorio.Text.Replace("/", "\")
        If rbRutaMasNombre.Checked = True Then
            numCaracteres.Minimum = tbDirectorio.Text.Length + 10
        Else
            numCaracteres.Minimum = 10
        End If
    End Sub
    Private Sub lbAutor_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles lbAutor.LinkClicked
        Process.Start("http://www.blogdemigueldiaz.com/?proyecto=acortadorNombres")
    End Sub
End Class
]]>
http://www.blogdemigueldiaz.com/2011/11/acortador-de-nombres-de-ficheros-elimina-los-errores-por-nombres-o-rutas-demasiado-largas/feed/ 14
Nueva versión de RoboCAUpy – Interfaz de robocopy http://www.blogdemigueldiaz.com/2011/09/nueva-version-de-robocaupy-interfaz-de-robocopy/?utm_source=rss&utm_medium=rss&utm_campaign=nueva-version-de-robocaupy-interfaz-de-robocopy http://www.blogdemigueldiaz.com/2011/09/nueva-version-de-robocaupy-interfaz-de-robocopy/#comments Sun, 18 Sep 2011 23:05:38 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=652 Continuar leyendo ]]> He desarrollado una nueva versión de RoboCAUpy.

Para quien no lo conzoca RoboCAUpy es una interfaz sencilla de robocopy, programa que nos permite realizar copias de directorios completos (tanto locales como en red) evitando aquellos problemas que pudieran surgir por cosas como nombres largos, carácteres extraños, archivos en uso o microcortes de red.

Esta utilidad es muy común para realizar copias de seguridad, migraciones de equipos, o copias de gran cantidad de ficheros, por su fiabilidad y rapidez.

La nueva versión ha añadido la opción parScreenshot de robocaupya mantener los permisos originales de los ficheros o volver a escribirlos, ahora se puede ver el progreso individual de cada archivo al lado de su nombre y además lanza por un hilo independiente el proceso de copia de archivos de forma que la interfaz siga respondiendo aunque robocopy se encuentre pausado.

Puedes ver los cambios de código fuente (147 líneas) a continuación:

Form1.vb

 Imports System
Imports System.IO
Imports System.Collections
Imports System.Threading
Public Class Form1
    Dim proceso As New Process 'Crea el proceso
    Dim rutaRoboCopy As String 'Contendra la ruta a robocopy
    Dim hilo As Thread 'Hilo encargado de comprobar el estado de robocopy
    Private Sub EjecutarRoboCopy() 'Funcion encargada de ejecutar el robocopy
        'Desactiva los controles antes de iniciar la copia y muestra el textbox del log.
        ListBox1.Items.Clear()
        ListBox1.Visible = True
        ProgressBar1.Visible = True

Continuación de Form1.vb

        gbOpcionesError.Enabled = False
        gbOpcionesPermisos.Enabled = False
        btCopiar.Text = "Parar"
        btExaminarOrigen.Enabled = False
        btExaminarDestino.Enabled = False
        tbOrigen.Enabled = False
        tbDestino.Enabled = False
        Me.Size = New System.Drawing.Size(Me.Size.Width, Me.MaximumSize.Height)
        'Definicion del proceso robocopy
        proceso.StartInfo.FileName = rutaRoboCopy
        proceso.StartInfo.Arguments = """" & tbOrigen.Text.TrimEnd("\") & """ """ & tbDestino.Text.TrimEnd("\") & """ /E /R:" & nUDReintentar.Value & " /W:" & nUDSegundos.Value 'Parametros
        If rbNuevos.Checked = False Then
            proceso.StartInfo.Arguments &= " /SEC"
        End If
        proceso.StartInfo.RedirectStandardOutput = True 'Redirige la salida
        proceso.StartInfo.UseShellExecute = False 'No sale a ms-dos.
        proceso.StartInfo.CreateNoWindow = True 'No crea nueva ventana.
        proceso.Start() 'Lanza el proceso
        Try
            If hilo.IsAlive = True Then
                hilo.Abort()
            End If
        Catch ex As Exception
        End Try
        'Verifica el estado a través de un hilo
        hilo = New Thread(AddressOf comprobar_robocopy)
        hilo.Start()
        'Timer1.Enabled = True
    End Sub
    Sub comprobar_robocopy()
        'Encargado de ir mostrando en el ListBox la salida del proceso robocopy.exe, se hace mediante un timer en lugar de a tiempo real para no relentizar la aplicacion
        Dim linea As String = "algo"
        ListBox1.TopIndex = ListBox1.Items.Count
        Dim sr As IO.StreamReader = proceso.StandardOutput
        Dim sb As New System.Text.StringBuilder("")
        Dim sinput As String
        Do Until sinput = "-1"
            Dim bytes() As Byte = {sinput}
            linea = System.Text.Encoding.UTF8.GetString(bytes) & sr.ReadLine
            If linea.Contains("%") = True Then
                If linea.Substring(0, InStr(linea, "%") - 1) > 0 Then
                    Dim antiguoitem As String = ListBox1.Items(ListBox1.Items.Count - 2)
                    antiguoitem = antiguoitem.Remove(0, InStr(antiguoitem, "%"))
                    If InStr(ListBox1.Items(ListBox1.Items.Count - 1), "%") < 1 Then
                        ListBox1.Items(ListBox1.Items.Count - 1) = linea.Substring(0, InStr(linea, "%")) & ListBox1.Items(ListBox1.Items.Count - 1)
                    Else
                        ListBox1.Items(ListBox1.Items.Count - 1) = linea.Substring(0, InStr(linea, "%")) & antiguoitem
                    End If
                Else
                    ListBox1.Items.Add(linea)
                End If
            Else
                ListBox1.Items.Add(linea)
            End If
            ListBox1.SelectedIndex = ListBox1.Items.Count - 1
            sinput = sr.Read()
        Loop
        'Oculta la barra de progreso
        restablecer_controles()
    End Sub
    Delegate Sub restablecer_controlesCallBack()
    Private Sub restablecer_controles()
        ' InvokeRequired required compares the thread ID of the
        ' calling thread to the thread ID of the creating thread.
        ' If these threads are different, it returns true.
        ProgressBar1.Visible = False
        gbOpcionesError.Enabled = True
        btExaminarOrigen.Enabled = True
        btExaminarDestino.Enabled = True
        tbOrigen.Enabled = True
        tbDestino.Enabled = True
        ProgressBar1.Visible = False
        gbOpcionesPermisos.Enabled = True
        btCopiar.Text = "Copiar"
    End Sub
    Private Sub btCopiar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btCopiar.Click
        If btCopiar.Text = "Copiar" Then
            EjecutarRoboCopy() 'Ejecuta el robocopy
        Else 'Si en el boton no ponia Copiar quiere decir que ya se estaba ejecutando el robocopy por tanto para robocopy y reactiva los controles.
            proceso.Kill()
            restablecer_controles()
        End If
    End Sub
    Private Sub btExaminarOrigen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btExaminarOrigen.Click
        If oFDOrigen.ShowDialog = Windows.Forms.DialogResult.OK Then
            tbOrigen.Text = IO.Path.GetDirectoryName(oFDOrigen.FileName) 'Ruta de origen
        End If
    End Sub
    Private Sub btExaminarDestino_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btExaminarDestino.Click
        If oFDDestino.ShowDialog = Windows.Forms.DialogResult.OK Then
            tbDestino.Text = IO.Path.GetDirectoryName(oFDDestino.FileName) 'Ruta de destino
        End If
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Comprueba que exista el fichero system32/robocopy.exe, program files\Windows Resource Kits\Tools\robocopy.exe o ./robocopy.exe y si no finaliza
        If IO.File.Exists(Environment.SystemDirectory.ToString & "\robocopy.exe") = True Then
            rutaRoboCopy = Environment.SystemDirectory.ToString & "\robocopy.exe"
        ElseIf IO.File.Exists(System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Windows Resource Kits\Tools\robocopy.exe") = True Then
            rutaRoboCopy = System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Windows Resource Kits\Tools\robocopy.exe"
        ElseIf IO.File.Exists(IO.Path.GetDirectoryName(Application.ExecutablePath) & "\robocopy.exe") = True Then
            rutaRoboCopy = IO.Path.GetDirectoryName(Application.ExecutablePath) & "\robocopy.exe"
        Else
            MsgBox("No se ha encontrado robocopy.exe, asegurese de tenerlo instalado o una copia en el directorio local.")
            End
        End If
        CheckForIllegalCrossThreadCalls = False 'Realizar cambis en formulario desde otro hilo
    End Sub
End Class
]]>
http://www.blogdemigueldiaz.com/2011/09/nueva-version-de-robocaupy-interfaz-de-robocopy/feed/ 2
Comprobar el estado de la propagación DNS – DNSPropagationChecker http://www.blogdemigueldiaz.com/2011/08/comprobar-el-estado-de-la-propagacion-dns-dnspropagationchecker/?utm_source=rss&utm_medium=rss&utm_campaign=comprobar-el-estado-de-la-propagacion-dns-dnspropagationchecker http://www.blogdemigueldiaz.com/2011/08/comprobar-el-estado-de-la-propagacion-dns-dnspropagationchecker/#comments Sun, 21 Aug 2011 15:26:07 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=608 Continuar leyendo ]]> Recientemente he cambiado el servidor del blog y las DNS han tardado bastante mas de lo esperado en propagarse, realmente me sentia desconcertado tras las primeras 8 horas sin rastro de vida en el blog, no sabía si las IP se estaban propagando o no y realmente hacer un seguimiento con nslookup era un suplicio.

Por eso he programado DNS Propagation Checker, que básicamente nos servirá para comprobar el estado de la propagación DNS del dominio que queramos en un listado enorme (editable a través de un INI) de DNS.

La interfaz del programa es muy sencilla: introducimos el dominio y la IP a la que debe apuntar, damos a comprobar y  en unos segundos tendremos el listado de todas las DNS a donde se ha propagado.

Es importante que descomprimáis todo el contenido, ya que aparte del exe hay un .ini donde se guarda un listado importante de DNS.

Como siempre, os dejo el código fuente de la aplicación. Es necesario un proyecto con un Formulario (Form1) que contenga dos textbox (tbDominio, tbIP), dos ListBox (listDNSPropagados, lbServidoresDNS), dos botones (btComprobar, btAñadir), y otro formulario (Form2) con un textbox (TextBox1) y un boton (Button1).

Form1.vb

Imports System
Imports System.IO
Imports System.Text.RegularExpressions
'Lectura de archivos INI
Imports System.Runtime.InteropServices
Public Class DNSPropagationChecker
    'Esta funcion devueve true si la IP introducida es valida y false si no es valida
    Function compruebaIP(ByVal strFindin As String)


Continuación Form1.vb

        Dim myRegex As New Regex("^(([01]?\d\d?|2[0-4]\d|25[0-5])\.){3}([01]?\d\d?|25[0-5]|2[0-4]\d)$")
        If myRegex.IsMatch(strFindin) Then
            compruebaIP = True
        Else
            compruebaIP = False
        End If
    End Function
    Private Sub DNSPropagationChecker_Load() Handles MyBase.Load
        'Comprueba que el INI exista, si no existe lo crea con los servidores de Google de ejemplo.
        If System.IO.File.Exists(Application.StartupPath & "/dnspropagationchecker.ini") = False Then
            Dim Ini As CIniClass
            Ini = New CIniClass
            Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
            Ini.GrabaIni("DNS", "SERVIDOR1", "8.8.8.8")
            Ini.GrabaIni("DNS", "SERVIDOR2", "8.8.4.4")
        End If
        Try
            cargaListadoDNS()
        Catch ex As Exception
            MsgBox("No se ha podido cargar dnspropagationchecker.ini")
            End
        End Try
    End Sub
    Private Sub btComprobar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btComprobar.Click
        Dim cantidadDNS As Integer = 1
        Dim contador As Integer = 0
        'Comprueba que haya puesto un dominio
        tbDominio.Text = tbDominio.Text.Replace(" ", "")
        tbIP.Text = tbIP.Text.Replace(" ", "")
        listDNSPropagados.Items.Clear()
        If tbDominio.Text = "" Then
            MsgBox("Debe introducir un nombre de dominio", MsgBoxStyle.Information)
            Exit Sub
        End If
        'Comprueba que haya puesto una IP valida
        If compruebaIP(tbIP.Text) = False Then
            MsgBox("Debe introducir una IP válida", MsgBoxStyle.Information)
            Exit Sub
        End If
        'Si se ha elegido el servidor Todos, guarda en el array todos los DNS. Si solo elige uno
        'Crea un array valor 0 y mete el servidor DNS concreto
        If lbServidoresDNS.SelectedIndex = 0 Then
            cantidadDNS = lbServidoresDNS.Items.Count() - 1
        End If
        Dim arrayDNS(cantidadDNS - 1) As String
        If lbServidoresDNS.SelectedIndex = 0 Then
            While contador                 arrayDNS(contador) = lbServidoresDNS.Items(contador + 1).ToString
                contador += 1
            End While
        Else
            arrayDNS(0) = lbServidoresDNS.Items(lbServidoresDNS.SelectedIndex).ToString
        End If
        'Desactiva los controles
        tbDominio.Enabled = False
        lbIP.Enabled = False
        lbServidoresDNS.Enabled = False
        btComprobar.Text = "Comprobando..."
        btComprobar.Enabled = False
        lbDNSPropagados.Visible = True
        listDNSPropagados.Visible = True
        'Prepara el proceso nslookup para que no se muestre la ventana de DOS
        Dim proceso As New Process
        proceso.StartInfo.RedirectStandardOutput = True
        proceso.StartInfo.FileName = "nslookup.exe"
        proceso.StartInfo.UseShellExecute = False
        proceso.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
        proceso.StartInfo.CreateNoWindow = True
        'Lo lanza contra cada servidor DNS recorriendo el array
        contador = 0
        While contador < arrayDNS.Length             proceso.StartInfo.Arguments = "-retry=1 -timeout=1 " & tbDominio.Text & " " & arrayDNS(contador)             proceso.Start()             Dim sr As IO.StreamReader = proceso.StandardOutput             Dim sb As New System.Text.StringBuilder("")             Dim sinput As String = ""             Do Until sinput = "-1"                 Dim resultado As String = sr.ReadLine                 'En caso de que devuelva algo con la IP buena, lo declara propagado                 If InStr(resultado, tbIP.Text) Then                     listDNSPropagados.Items.Add(arrayDNS(contador))                 ElseIf InStr(resultado, "timeout") Then                     sinput = "-1"                     proceso.Close()                 Else                     sinput = sr.Read()                 End If             Loop             contador += 1         End While         If listDNSPropagados.Items.Count = 0 Then             listDNSPropagados.Items.Add("Aún no se ha propagado en ningun servidor DNS seleccionado")         End If         'Reactiva los controles         tbDominio.Enabled = True         lbIP.Enabled = True         lbServidoresDNS.Enabled = True         btComprobar.Text = "Comprobar propagacion"         btComprobar.Enabled = True     End Sub     'Esta funcion devueve true si la IP introducida es valida y false si no es valida     Function compruebaIP(ByVal strFindin As String)         Dim myRegex As New Regex("^(([01]?\d\d?|2[0-4]\d|25[0-5])\.){3}([01]?\d\d?|25[0-5]|2[0-4]\d)$")         If myRegex.IsMatch(strFindin) Then             compruebaIP = True         Else             compruebaIP = False         End If     End Function     Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked         System.Diagnostics.Process.Start("http://www.blogdemigueldiaz.com/?proyecto=DNSPropagationChecker")     End Sub     Public Class CIniClass         Private m_Ini As String         Private Declare Function GetPrivateProfileStringKey Lib "kernel32" Alias _         "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _         lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString _         As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer         Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _         "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _         lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer         Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer         Property Archivo() As String             Get                 Archivo = m_Ini             End Get             Set(ByVal value As String)                 m_Ini = value             End Set         End Property         'Leer una llave de un archivo .ini         Public Function LeeIni(ByVal Seccion As String, ByVal Llave As String) As String             Dim Est As String = New String(Chr(0), 255)             Dim i As Long = GetPrivateProfileString(Seccion, Llave, "", Est, Len(Est), Archivo)             If i > 0 Then
                LeeIni = Est.Split(Chr(0))(0)
            Else
                LeeIni = ""
            End If
        End Function
        Public Sub GrabaIni(ByVal Seccion As String, ByVal Llave As String, ByVal Valor As String)
            Dim lret As Long
            lret = WritePrivateProfileString(Seccion, Llave, Valor, m_Ini)
        End Sub
    End Class
    Private Sub btAñadir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAñadir.Click
        Form2.cantidadElementos = lbServidoresDNS.Items.Count()
        Form2.Show()
    End Sub
    Public Sub cargaListadoDNS()
        lbServidoresDNS.Items.Clear()
        lbServidoresDNS.Items.Add("Todos")
        Dim Ini As CIniClass
        Ini = New CIniClass
        Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
        Dim contador As Integer = 1
        Dim servidor As String = "-1"
        While servidor <> ""
            servidor = Ini.LeeIni("DNS", "SERVIDOR" & contador)
            If servidor <> "" Then
                lbServidoresDNS.Items.Add(servidor)
            End If
            contador += 1
        End While
        lbServidoresDNS.SelectedIndex = 0
    End Sub
End Class

Form2.vb

Public Class Form2
    Public cantidadElementos As Integer = 0
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
  'Guarda el DNS en el .ini
        If DNSPropagationChecker.compruebaIP(TextBox1.Text) = True Then
            Dim Ini As CIniClass
            Ini = New CIniClass
            Ini.Archivo = Application.StartupPath & "/dnspropagationchecker.ini"
            Ini.GrabaIni("DNS", "SERVIDOR" & cantidadElementos, TextBox1.Text)
            DNSPropagationChecker.cargaListadoDNS()
            Me.Close()
        Else
            MsgBox("Esa no es una IP Valida", MsgBoxStyle.Information)
        End If
    End Sub
    Public Class CIniClass
        Private m_Ini As String
        Private Declare Function GetPrivateProfileStringKey Lib "kernel32" Alias _
        "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _
        lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString _
        As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
        Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
        "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _
        lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
        Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
        Property Archivo() As String
            Get
                Archivo = m_Ini
            End Get
            Set(ByVal value As String)
                m_Ini = value
            End Set
        End Property
        'grabar una llave a un archivo ini
        Public Sub GrabaIni(ByVal Seccion As String, ByVal Llave As String, ByVal Valor As String)
            Dim lret As Long
            lret = WritePrivateProfileString(Seccion, Llave, Valor, m_Ini)
        End Sub
    End Class
End Class
]]>
http://www.blogdemigueldiaz.com/2011/08/comprobar-el-estado-de-la-propagacion-dns-dnspropagationchecker/feed/ 1
Autoarchivado por fecha en Outlook 2007 automaticamente mediante una extensión http://www.blogdemigueldiaz.com/2011/08/autoarchivado-por-fecha-en-outlook-mediante-una-extension/?utm_source=rss&utm_medium=rss&utm_campaign=autoarchivado-por-fecha-en-outlook-mediante-una-extension http://www.blogdemigueldiaz.com/2011/08/autoarchivado-por-fecha-en-outlook-mediante-una-extension/#comments Thu, 18 Aug 2011 18:34:42 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=566 Continuar leyendo ]]> Si hay una herramienta usada en el mundo empresarial es Microsoft Outlook, para bien o para mal cualquier persona pasa horas con ella al día, por esta aplicación pasa muchísima información diaria y por eso es muy importante tenerla siempre activa y funcionando sin problemas. Una caracteristica de Outlook muy usada es el autoarchivado, esta caracteristica descarga los correos del servidor y los guarda en un archivo en el disco duro local para liberar espacio en el servidor y ahorrar ancho de banda, esto es una gran solución pero conlleva un problema y es que si dicho archivo termina superando los 2GB de información Outlook se vuelve especialmente lento e inestable a la hora de trabajar con el, por eso he desarrollado un Addin (codigo fuente mas adelante) que genera un nuevo fichero de archivado cada año, de esta forma reducimos muy considerablemente el riesgo a sobrepasar ese limite y además nos ayuda a tener nuestras carpetas archivadas ordenadas según fechas.

El fichero PST creado  lo guarda en %AppData%/Local settings/Microsoft/Outlook/ y le da este nombre dinámico “archivePerfilAño.pst” donde Perfil seria el nombre de nuestro perfil de Outlook y año el año correspondiente a las carpetas archivadas.

Además, es posible exportar la configuración en un archivo (AutoArchiveByDate.cfg) e importarla con solo copiarla: ideal para instalaciones masivas. Para acceder a la ventana de configuración  debemos ir a un nuevo menú que aparecerá llamado AutoArchiveByDate.

Para los mas curiosos, aquí tenéis el código fuente, consta de un formulario (Form1, ventana de configuracion) que debe contener al menos dos NumericUpDown (nFrecuencia, nAnteriores) un ComboBox (cbFormatoTiempo), dos CheckBox (cbHabilitarAutoarchivado, cbPreguntar) y dos botones (Aceptar, Cancelar) y por otro lado la extensión:

ThisAddin.vb

Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices
Public Class ThisAddIn
    Private menuBar As Office.CommandBar
    Private newMenuBar As Office.CommandBarPopup
    Private buttonOne As Office.CommandBarButton
    Private menuTag As String = "A unique tag"
    Dim frecuencia_archivado As Integer 'Cada X tiempo se ejecuta
    Dim preguntar_archivado As Integer '0 no pregunta, 1 pregunta antes de archivar
    Dim elementos_anteriores As Integer 'Eliminar anteriores a X


Continuación de ThisAddin.vb

    Dim autoarchivado_habilitado As Integer '0 deshabilitado, 1 pregunta
    Dim formato_tiempo As Integer '0-Meses/1-Semanas/1-Dias
    Dim nombre_pst As String
    Private Sub ThisAddIn_Shutdown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shutdown
        'RemoveMenubar()
    End Sub
    Private Sub ThisAddIn_Startup() Handles Me.Startup
        'Conexion con la aplicación Outlook
        Dim olApp As Outlook.Application
        olApp = CreateObject("Outlook.Application")
        'Variables de configuración
        If System.IO.File.Exists(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\AutoArchiveByDate.cfg") = False Then 'Si no existe el archivo de configuracion lo crea
            Dim fichero_w As New System.IO.StreamWriter(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\AutoArchiveByDate.cfg")
            fichero_w.WriteLine("1,1,0,69,0,1")
            fichero_w.Close()
        End If
        Dim fichero_r As New System.IO.StreamReader(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\AutoArchiveByDate.cfg")
        Dim contenido_fichero() As String = fichero_r.ReadLine.Split(",")
        fichero_r.Close()
        autoarchivado_habilitado = contenido_fichero(0) '0 deshabilitado, 1 pregunta
        frecuencia_archivado = contenido_fichero(1) 'Cada X tiempo se ejecuta
        preguntar_archivado = contenido_fichero(2) '0 no pregunta, 1 pregunta antes de archivar
        elementos_anteriores = contenido_fichero(3) 'Eliminar anteriores a X
        formato_tiempo= contenido_fichero(4) '0-Meses/1-Semanas/1-Dias
        nombre_pst = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\archive" & olApp.Session.CurrentProfileName.ToString & My.Computer.Clock.LocalTime.Year & ".pst"     'El nombre del PST sera formato archiveNombrePerfilAño.pst
        Dim version_office As String = olApp.Version.Split(".")(0) & "." & olApp.Version.Split(".")(1)
        'Variable donde se guardan los datos de configuración de outlook
        Dim cadena_registro As String = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & version_office & "\Outlook\Preferences"
        Dim cadena_pst As String = "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & olApp.Session.CurrentProfileName.ToString & "\0a0d020000000000c000000000000046"
        'Habilita/Deshabilita el archivado
        My.Computer.Registry.SetValue(cadena_registro, "DoAging", autoarchivado_habilitado)
        'Establece la frecuencia
        My.Computer.Registry.SetValue(cadena_registro, "EveryDays", frecuencia_archivado)
        'Preguntar o no preguntar antes de archivar
        My.Computer.Registry.SetValue(cadena_registro, "PromptForAging", preguntar_archivado)
        'Elementos anteriores a
        My.Computer.Registry.SetValue(cadena_registro, "ArchivePeriod", elementos_anteriores)
        My.Computer.Registry.SetValue(cadena_registro, "ArchiveGranularity", formato_tiempo)
        'Establece el nombre de la PST
        My.Computer.Registry.SetValue(cadena_pst, "001" & Chr(90 + olApp.Version.Split(".")(0)) & "0324", nombre_pst)
        RemoveMenubar()
        AddMenuBar()
    End Sub
    Private Sub AddMenuBar()
        Try
            menuBar = Application.ActiveExplorer().CommandBars.ActiveMenuBar
            newMenuBar = menuBar.Controls.Add( _
                Office.MsoControlType.msoControlPopup, _
                Temporary:=False)
            If newMenuBar IsNot Nothing Then
                newMenuBar.Caption = "AutoArchiveByDate"
                newMenuBar.Tag = menuTag
                buttonOne = newMenuBar.Controls.Add( _
                    Office.MsoControlType.msoControlButton, _
                    Before:=1, Temporary:=True)
                With buttonOne
                    .Style = Office.MsoButtonStyle.msoButtonIconAndCaption
                    .Caption = "Configurar"
                    .FaceId = 65
                    .Tag = "c123"
                End With
                AddHandler buttonOne.Click, AddressOf ButtonOne_Click
                newMenuBar.Visible = True
            End If
        Catch Ex As Exception
            MsgBox(Ex.Message)
        End Try
    End Sub
    Public Sub ButtonOne_Click(ByVal buttonControl As Office. _
    CommandBarButton, ByRef Cancel As Boolean)
        Dim formulario As New Form1
        formulario.Show()
    End Sub
    Private Sub RemoveMenubar()
        Try
            ' If the menu already exists, remove it.
            Dim foundMenu As Office.CommandBarPopup = _
                Application.ActiveExplorer().CommandBars.ActiveMenuBar. _
                FindControl(Office.MsoControlType.msoControlPopup, _
                System.Type.Missing, menuTag, True, True)
            If foundMenu IsNot Nothing Then
                foundMenu.Delete(True)
            End If
        Catch Ex As Exception
            MsgBox(Ex.Message)
        End Try
    End Sub
End Class

Form1.vb

Public Class Form1
    Private Sub Cancelar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cancelar.Click
        Me.Close()
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim fichero_r As New System.IO.StreamReader(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\AutoArchiveByDate.cfg")
        Dim contenido_fichero() As String = fichero_r.ReadLine.Split(",")
        fichero_r.Close()
        Dim autoarchivado_habilitado As String = contenido_fichero(0) '0 deshabilitado, 1 pregunta
        Dim frecuencia_archivado As String = contenido_fichero(1) 'Cada X tiempo se ejecuta
        Dim preguntar_archivado As String = contenido_fichero(2) '0 no pregunta, 1 pregunta antes de archivar
        Dim elementos_anteriores As String = contenido_fichero(3) 'Eliminar anteriores a X
        Dim formato_tiempo As String = contenido_fichero(4) '0-Meses/1-Semanas/1-Dias
        If autoarchivado_habilitado = 1 Then
            cbHabilitarAutoarchivado.Checked = True
        End If
        nFrecuencia.Value = frecuencia_archivado
        If preguntar_archivado = 1 Then
            cbPreguntar.Checked = True
        End If
        nAnteriores.Value = elementos_anteriores
        cbFormatoTiempo.SelectedIndex = formato_tiempo
    End Sub
    Private Sub Aceptar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Aceptar.Click
        'Guarda las preferencias
        Dim preferencias As String
        If cbHabilitarAutoarchivado.Checked = True Then
            preferencias = "1,"
        Else
            preferencias = "0,"
        End If
        preferencias &= nFrecuencia.Value & ","
        If cbPreguntar.Checked = True Then
            preferencias &= "1,"
        Else
            preferencias &= "0,"
        End If
        preferencias &= nAnteriores.Value & "," & cbFormatoTiempo.SelectedIndex
        Dim fichero_w As New System.IO.StreamWriter(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\Microsoft\Outlook\AutoArchiveByDate.cfg")
        fichero_w.WriteLine(preferencias)
        fichero_w.Close()
        MsgBox("Debe reiniciar Microsoft Outlook para cargar que los cambios tengan efecto")
        Me.Close()
    End Sub
End Class
]]>
http://www.blogdemigueldiaz.com/2011/08/autoarchivado-por-fecha-en-outlook-mediante-una-extension/feed/ 1
Interfaz sencilla para Robocopy http://www.blogdemigueldiaz.com/2011/04/interfaz-sencilla-para-robocopy/?utm_source=rss&utm_medium=rss&utm_campaign=interfaz-sencilla-para-robocopy http://www.blogdemigueldiaz.com/2011/04/interfaz-sencilla-para-robocopy/#comments Wed, 06 Apr 2011 19:54:25 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=267 Continuar leyendo ]]> Una herramienta que me gusta mucho es robocopy, para quien no lo sepa es una herramienta de Microsoft para crear copias de directorios o unidades completas olvidándonos de problemas de nombres largos, carácteres extraños, etc.

El problema es que no tiene entorno gráfico y los que existen son demasiado tediosas por que el uso que solemos darle es simplemente elegir un directorio de origen y uno de destino. Por eso he desarrollado una interfaz con las opciones justas. Está programada en VB.Net y podéis descargar el ejecutable como el código fuente.

Le he dado el nombre de roboCAUpy haciendo un guiño a los departamentos de CAU ya que es muy usado para hacer las migraciones de los perfiles de usuario de un ordenador a otro y copias de seguridad.

A continuación tienes el código fuente (120 líneas) completamente comentado


Atención: Existe una nueva versión del código

Imports System
Imports System.IO
Imports System.Collections
Public Class Form1
    Dim proceso As New Process 'Crea el proceso
    Dim rutaRoboCopy As String 'Contendra la ruta a robocopy
    Private Sub EjecutarRoboCopy() 'Funcion encargada de ejecutar el robocopy con los parametros de la GUI
        'Desactiva los controles antes de iniciar la copia y muestra el textbox del log.
        ListBox1.Items.Clear()
        ListBox1.Visible = True
        ProgressBar1.Visible = True
        gbOpciones.Enabled = False
        btCopiar.Text = "Parar"
        btExaminarOrigen.Enabled = False
        btExaminarDestino.Enabled = False
        tbOrigen.Enabled = False
        tbDestino.Enabled = False
        Me.Size = New System.Drawing.Size(Me.Size.Width, Me.MaximumSize.Height)
        'Definicion del proceso robocopy
        proceso.StartInfo.FileName = rutaRoboCopy
        proceso.StartInfo.Arguments = """" & tbOrigen.Text.TrimEnd("\") & """ """ & tbDestino.Text.TrimEnd("\") & """ /E /R:" & nUDReintentar.Value & " /W:" & nUDSegundos.Value 'Parametros
        proceso.StartInfo.RedirectStandardOutput = True 'Redirige la salida
        proceso.StartInfo.UseShellExecute = False 'No sale a ms-dos.
        proceso.StartInfo.CreateNoWindow = True 'No crea nueva ventana.
        proceso.Start() 'Lanza el proceso
        'Verifica el estado por un timer ya que si no da la sensación de aplicación colgada
        Timer1.Enabled = True
    End Sub
    Private Sub btCopiar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btCopiar.Click
        If btCopiar.Text = "Copiar" Then
            EjecutarRoboCopy() 'Ejecuta el robocopy
        Else 'Si en el boton no ponia Copiar quiere decir que ya se estaba ejecutando el robocopy por tanto para robocopy y reactiva los controles.
            proceso.Kill()
            gbOpciones.Enabled = True
            btCopiar.Text = "Copiar"
            btExaminarOrigen.Enabled = True
            btExaminarDestino.Enabled = True
            tbOrigen.Enabled = True
            tbDestino.Enabled = True
            ProgressBar1.Visible = False
        End If
    End Sub
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        'Este timer es el encargado de ir mostrando en el ListBox la salida del proceso robocopy.exe, se hace mediante un timer en lugar de a tiempo real para no relentizar la aplicacion
        Dim linea As String = "algo"
        ListBox1.TopIndex = ListBox1.Items.Count
        If proceso.HasExited = False Then 'Si no ha finalizado escribe la ultima linea que devuelve el proceso en el TextBox
            ' Do While Not linea Is Nothing
            linea = proceso.StandardOutput.ReadLine
            ListBox1.Items.Add(linea)
            '    Loop
            ListBox1.SelectedIndex = ListBox1.Items.Count - 1
        Else 'Si ha finalizado escribe lo que queda y para el timer.
            Timer1.Enabled = False ' Para timer
            btCopiar.Text = "Copiar"
            'Copia lo que queda
            linea = proceso.StandardOutput.ReadLine
            Do While Not linea Is Nothing
                ListBox1.Items.Add(linea)
                linea = proceso.StandardOutput.ReadLine
            Loop
            ListBox1.SelectedIndex = ListBox1.Items.Count - 1
            'Oculta la barra de progreso
            ProgressBar1.Visible = False
            'Habilita los controles
            gbOpciones.Enabled = True
            btExaminarOrigen.Enabled = True
            btExaminarDestino.Enabled = True
            tbOrigen.Enabled = True
            tbDestino.Enabled = True
            ProgressBar1.Visible = False
        End If
    End Sub
    Private Sub btExaminarOrigen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btExaminarOrigen.Click
        If oFDOrigen.ShowDialog = Windows.Forms.DialogResult.OK Then
            tbOrigen.Text = IO.Path.GetDirectoryName(oFDOrigen.FileName) 'Ruta de origen
        End If
    End Sub
    Private Sub btExaminarDestino_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btExaminarDestino.Click
        If oFDDestino.ShowDialog = Windows.Forms.DialogResult.OK Then
            tbDestino.Text = IO.Path.GetDirectoryName(oFDDestino.FileName) 'Ruta de destino
        End If
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Comprueba que exista el fichero system32/robocopy.exe, program files\Windows Resource Kits\Tools\robocopy.exe o ./robocopy.exe y si no finaliza
        If IO.File.Exists(Environment.SystemDirectory.ToString & "\robocopy.exe") = True Then
            rutaRoboCopy = Environment.SystemDirectory.ToString & "\robocopy.exe"
        ElseIf IO.File.Exists(System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Windows Resource Kits\Tools\robocopy.exe") = True Then
            rutaRoboCopy = System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Windows Resource Kits\Tools\robocopy.exe"
        ElseIf IO.File.Exists(IO.Path.GetDirectoryName(Application.ExecutablePath) & "\robocopy.exe") = True Then
            rutaRoboCopy = IO.File.Exists(IO.Path.GetDirectoryName(Application.ExecutablePath) & "\robocopy.exe")
        Else
            MsgBox("No se ha encontrado robocopy.exe, asegurese de tenerlo instalado o una copia en el directorio local.")
            End
        End If
    End Sub
End Class

Para ejecutar correctamente roboCAUpy se recomienda tener el Windows Resource Kit Tools instalado o bien una copia de robocopy.exe en System32 o la misma carpeta del programa y .Net Framework 2.0 o superior.

Descargar Robocaupy, interfaz sencilla de robocopy

]]>
http://www.blogdemigueldiaz.com/2011/04/interfaz-sencilla-para-robocopy/feed/ 2
Anti-proxy, deshabilita el proxy temporalmente http://www.blogdemigueldiaz.com/2011/04/anti-proxy-deshabilita-el-proxy-temporalmente/?utm_source=rss&utm_medium=rss&utm_campaign=anti-proxy-deshabilita-el-proxy-temporalmente http://www.blogdemigueldiaz.com/2011/04/anti-proxy-deshabilita-el-proxy-temporalmente/#comments Sat, 02 Apr 2011 19:17:08 +0000 Miguel Díaz http://www.blogdemigueldiaz.com/?p=172 Continuar leyendo ]]> El viernes ocurrió un pequeño problema en el trabajo y es que cambiaron el cliente de VPN y la gente no se podía conectar, esto era por que tenían habilitado el proxy y al tratar de pasar la conexión por dentro del proxy sin estar conectados a la red corporativa los echaba para atrás. Si el usuario deshabilitaba el proxy en opciones de Internet conectaba sin problemas.

Aunque la solución fue permitir esta conexión en el proxy se me ocurrió una idea para deshabilitar el proxy temporalmente mientras se está ejecutando una aplicación, volviendolo a conectar en el momento que el programa se cierre, así que al llegar a casa me puse a programar. Viene bien si un usuario necesitara conectarse a una VPN externa a la de una empresa desde una red no corporativa, lo cual no es nada descabellado, imaginemos un trabajador que conecta a través de una 3G y debe enviar informes a una intranet de un cliente, por ejemplo. El programa tendrá deshabilitado el proxy mientras el programa encargado de la conexión VPN (Por ejemplo Cisco VPN Client) y lo volverá a habilitar una vez desconectado.

El programa es muy sencillo pero efectivo para estos casos ya que lo deshabilita de forma transparente para el usuario que no tiene por que notar nada raro.

El programa se compone de dos partes, antiProxy.exe y antiProxy.txt.

En el fichero antiProxy.txt debemos ubicar la ruta del ejecutable que se debe ejecutar sin usar la conexión del proxy.

A continuación os pongo la descarga del binario y el código fuente en VB.Net comentado.

Descarga el binario: antiProxy.zip

Sigue leyendo para ver el código fuente.

Código fuente

Imports System
Imports System.IO
Imports System.Collections
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim autoConfigURL As String 'Guardará la URL de scripts automaticas
        Dim proxyEnable As Boolean 'Guardará si está habilitado el proxy (la opcion de abajo en la ventana conexiones)
        Dim urlProceso As String 'Proceso a ejecutar sin el proxy
        'Lee el archivo de configuracion el cual contiene el path al ejecutable a lanzar
        Try
            Dim objReader As New StreamReader(".\antiProxy.txt")
            urlProceso = objReader.ReadLine
            If IO.File.Exists("""" & urlProceso & """") Or urlProceso.Replace(" ", "") = "" Then 'Si el ejecutable no existe
                MsgBox("El ejecutable definido en antiProxy.txt no existe")
                End
            End If
        Catch ex As Exception
            MsgBox("No existe el archivo de configuración antiProxy.txt") ' Si el fichero de configuracion no existe
            End
        End Try
        'Windows Script Host
        Dim MiObjeto As Object
        MiObjeto = CreateObject("Wscript.Shell")
        'Comprueba si existe URL de scripts automaticos y si es así la deshabilita
        Try
            autoConfigURL = MiObjeto.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL")
            MiObjeto.RegDelete("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL")
        Catch ex As Exception
            autoConfigURL = "0"
        End Try
        'Comprueba si el proxy está habilitado y si es así lo deshabilita
        Try
            If MiObjeto.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable") = 1 Then
                proxyEnable = True
                MiObjeto.RegDelete("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable")
            Else
                proxyEnable = False
            End If
        Catch ex As Exception
            proxyEnable = False
        End Try
        'Lanza el proceso y se mantiene a la espera
        Dim proceso As New Process
        proceso.StartInfo.FileName = """" & urlProceso.Trim & """"
        proceso.Start()
        proceso.WaitForExit()
        'Restaura los valores del proxy
        If autoConfigURL <> "0" Then
            MiObjeto.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL", autoConfigURL, "REG_SZ")
        End If
        If proxyEnable = True Then
            MiObjeto.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 1, "REG_DWORD")
        End If
        End
    End Sub
End Class
]]>
http://www.blogdemigueldiaz.com/2011/04/anti-proxy-deshabilita-el-proxy-temporalmente/feed/ 0