El blog de Miguel Díaz
Siguiente

RoboCAUpy

Copia eficiente de archivos, toda la potencia de robocopy con una interfaz sencilla y fácil de usar. Herramienta perfecta para migraciones de equipos y copia masiva de ficheros.Saber mas

Screenshot RoboCAUpy

mRemoto

Administra remotamente equipos, controlalos gráficamente o través de la línea de comandos, envía y recibe archivos, habla con el usuario y mucho mas sin ningún tipo de configuración previa.Saber mas

Screenshot mRemoto
screenshot mRemoto

DNSPropagationChecker

Controla la propagación DNS de cualquier dominio. Con un solo clic conocerás al instante si se ha propagado en los diferentes servidores DNS existentes.Saber mas

Acortador de nombres

Detecta ficheros con nombres largos, acortalos de forma masiva y reduce el tamaño de la ruta a la cantidad de carácteres que quieras.
Saber mas

screenshot Acortador Nombres
Anterior
Miércoles 23 de noviembre del 2011

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
  • Tweet

Acerca de Miguel Díaz

Informático, enamorado de la programación, diseño Web y el deporte.
Categorías: Acortador de nombres, Programación, Proyectos, Utilidades, Windows. Etiquetas: , , , , , .

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos necesarios están marcados *

*

Puedes usar las siguientes etiquetas y atributos HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong> <pre lang="" line="" escaped="" highlight="">

Blog de Miguel Díaz
Diseño Web por Miguel Díaz.