Imports System.IO
Imports System.Text.RegularExpressions
 
Module DlsRename
 
    'Beispiel:
    '"test.doku.divx.www.webseite.info.-.2.2a_.DAT" wird zu "Test - 2.2a.dat"
 
    Sub Main()
        Dim oFolder As String = "D:\Downloads\test"
        Dim FSI As FileSystemInfo
        Dim sFSI As FileSystemInfo() = New DirectoryInfo( _
          oFolder).GetFileSystemInfos
        For Each FSI In sFSI
            Dim oName As String = FSI.Name
            If TypeOf FSI Is FileInfo Then oName = _
              Path.GetFileNameWithoutExtension(FSI.Name)
 
            'Url's entfernen
            Dim pattern As String = ".*?((?:www\.|http://|http://www\.)[\S]+?(" & _
              "?:\.to|de|com|info)).*"
            Dim regex As New Regex(pattern, RegexOptions.IgnoreCase)
            For Each m As Match In regex.Matches(oName)
                oName = regex.Replace(oName, pattern, "")
            Next
 
            'Zwischenzeichen entfernen
            Dim dString As String = "german,divx,[,],(" & _
              ",),<,>,dtv,.ws,-RSG,-nva,-XC,omp-,dokumentation,doku,-TSCC,FS"
            oName = cRemove(oName, dString)
 
            'Start- & Endzeichen entfernen
            For i As Integer = 1 To Len(oName)
                If WrongStartEndChar(Mid(oName, 1, 1)) Then
                    oName = Mid(oName, 2)
                ElseIf WrongStartEndChar(Mid(oName, Len(oName) - 1, 1)) Then
                    oName = Mid(oName, 1, Len(oName) - 1)
                Else
                    Exit For
                End If
            Next
 
            'TrennPunkte behandeln
            For i As Integer = 1 To Len(oName)
                If Mid(oName, i, 1) = "." Then
                    If Not IsNum(Mid(oName, i - 1, 1) & Mid(oName, i + 1, 1)) _
                      Then oName = Mid(oName, 1, i - 1) & " " & Mid(oName, i + _
                      1)
                End If
            Next
 
            'Zwischenzeichen ersetzen
            Dim rString As String = "_, ,ö,oe,ä,ae,ü,ue"
            oName = cReplace(oName, rString)
 
            'Erstes Zeichen groß schreiben
            oName = Mid(oName, 1, 1).ToUpper & Mid(oName, 2)
 
            'Dateierweiterung wieder anhängen
            If TypeOf FSI Is FileInfo Then oName = oName & FSI.Extension.ToLower
 
            'Prüfen & ggf. durchführen der Änderung
            If FSI.Name <> oName Then
                MsgBox("Ändern:" & vbNewLine & FSI.Name & vbNewLine & oName)
            End If
        Next
    End Sub
 
    Private Function IsNum(ByVal Number As String) As Boolean
        Dim rNumber As String = ""
        Try
            rNumber = Integer.TryParse(Number, rNumber)
            If Number = rNumber Then IsNum = True
        Catch ex As Exception
            IsNum = False
        End Try
    End Function
 
    Private Function cRemove(ByVal Text As String, ByVal ToRemoveString As _
      String) As String
        cRemove = Text
        Dim aRemove() As String = Split(ToRemoveString, ",")
        For i As Integer = 0 To aRemove.Length - 1
            cRemove = cRemove.Replace(aRemove(i), "")
        Next
    End Function
 
    Private Function cReplace(ByVal Text As String, ByVal ReplaceString As _
      String) As String
        cReplace = Text
        Dim aReplace() As String = Split(ReplaceString, ",")
        For i As Integer = 0 To aReplace.Length - 1 Step 2
            cReplace = cReplace.Replace(aReplace(i), aReplace(i + 1))
        Next
    End Function
 
    Private Function WrongStartEndChar(ByVal SingleChar As String) As Boolean
        WrongStartEndChar = False
        Dim aChars() As String = Split(".,-,_,#, ,'", ",")
        For i As Integer = 0 To aChars.Length - 1
            If aChars(i) = SingleChar Then WrongStartEndChar = True
        Next
    End Function
 
End Module