Imports System.IO
Imports System.Text
Module Module1
Dim log As New StringBuilder
Dim counter As Integer = 0
Dim NonDestructive As Boolean = False
Dim OverWrite As Boolean = True
Private Extensions As New List(Of Ext)
Sub Main()
Dim maindir As String = System.Reflection.Assembly.GetExecutingAssembly().Location
maindir = System.IO.Path.GetDirectoryName(maindir)
Dim meh As String() = Environment.GetCommandLineArgs
If meh.Length < 2 Then
Console.WriteLine(vbCrLf & _
" ExtensionBySignature by TizzyT" & vbCrLf & vbCrLf & _
" Arguments:" & vbCrLf & _
vbTab & "/n , /N = NonDestructive (does not rename the file)" & vbCrLf & _
vbTab & "/o , /O = Do not overWrite log file (Create a new one)")
Else
Dim dire As String = maindir & "\\sig.txt"
If IO.File.Exists(dire) Then
Dim readExt() As String = IO.File.ReadAllLines(dire)
If readExt.Length = 0 Then GoTo missing
For Each e As String In readExt
Dim p() As String = e.Split(New String() {"="}, StringSplitOptions.RemoveEmptyEntries)
Dim signa As String = p(1).Replace(" ", "").Trim
Dim temp As Ext = New Ext(p(0), ReadHexStringToByte(signa))
If p.Length = 2 Then
If Not temp.Sig Is Nothing Then
Extensions.Add(temp)
Else
Console.WriteLine("Extension (" & p(0) & ") has an invalid signature")
log.AppendLine("Extension (" & p(0) & ") has an invalid signature")
End If
End If
Next
For Each Dir As String In meh
Select Case Dir.ToLower
Case "/n"
NonDestructive = True
Case "/o"
OverWrite = False
Case Else
Try
Dim files() As String = Directory.GetFiles(Dir, "*", SearchOption.AllDirectories)
RenameBySignature(files)
Catch ex As Exception
Console.WriteLine("Error on directory: " & Dir & vbCrLf & _
"Error: " & ex.Message)
End Try
End Select
Next
Console.WriteLine("Renamed " & counter & " Files")
log.AppendLine("Renamed " & counter & " Files")
Dim logging As String = maindir & "\\log.txt"
If Not OverWrite Then
Dim logint As Integer = 0
While File.Exists(logging)
logint += 1
logging = maindir & "\\log (" & logint & ").txt"
End While
End If
IO.File.WriteAllText(logging, log.ToString)
Else
missing: Console.WriteLine("ExtensionBySignature by TizzyT")
Console.WriteLine("Must define signatures in (sig.txt) file")
Console.WriteLine("Format example: zip=504B0304")
IO.File.WriteAllText(dire, String.Empty)
End If
End If
Console.ReadKey()
End Sub
Private Sub RenameBySignature(ByVal files() As String)
For Each f As String In files
Console.WriteLine("File: " & f)
log.AppendLine("File: " & f)
Try
Using sr As New FileStream(f, FileMode.Open, FileAccess.Read)
Dim n As Boolean = False
For i = 0 To Extensions.Count - 1
Dim sig() As Byte = Extensions(i).Sig
Dim newExt As String = Extensions(i).Ext
For t = 0 To sig.Length - 1
Dim r As Byte = sr.ReadByte
If Not sig(t) = r Then
sr.Position = 0
Exit For
Else
If t = sig.Length - 1 AndAlso sig(t) = r Then
If Not f.ToLower.EndsWith("." & newExt) Then
Dim newname As String = f
Dim count As Integer = 1
Dim newfile As String = f & "." & newExt
While IO.File.Exists(newfile)
newfile = f & " (" & count & ")." & newExt
End While
sr.Close()
Console.WriteLine("Renamed: " & newfile & vbCrLf)
log.AppendLine("Renamed: " & newfile & vbCrLf)
If Not NonDestructive Then IO.File.Move(f, newfile)
counter += 1
n = True
Else
Console.WriteLine( _
"File already has the correct extension (" & newExt & ")" & vbCrLf)
log.AppendLine( _
"File already has the correct extension (" & newExt & ")" & vbCrLf)
n = True
End If
ElseIf t = sig.Length - 1 Then
sr.Close()
End If
End If
Next
If n Then
Exit For
ElseIf i = Extensions.Count - 1 Then
Console.WriteLine("File Signature Undefined" & vbCrLf)
log.AppendLine("File Signature Undefined" & vbCrLf)
End If
Next
sr.Dispose()
End Using
Catch ex As Exception
Console.WriteLine("Failed: " & ex.Message & vbCrLf)
log.AppendLine("Failed: " & ex.Message & vbCrLf)
End Try
Next
End Sub
Public Structure Ext
Dim Ext As String
Dim Sig() As Byte
Sub New(ByVal ext As String, ByVal bytes() As Byte)
Me.Ext = ext
Sig = bytes
End Sub
End Structure
Public Function ReadHexStringToByte(ByVal Input As String) As Byte()
Dim ValidChar As String = "0123456789abcdef"
Dim FixedString As String = String.Empty
For Each character As Char In Input
If ValidChar.Contains(character.ToString.ToLower) Then FixedString &= character
Next
If Not FixedString.Length = 0 And FixedString.Length Mod 2 = 0 Then
Dim ResultBytes((FixedString.Length / 2) - 1) As Byte
Dim index As Integer = 0
For i = 0 To FixedString.Length - 1 Step 2
Dim hexString As String = FixedString(i) & FixedString(i + 1)
ResultBytes(index) = Convert.ToByte(hexString, 16)
index += 1
Next
Return ResultBytes
Else
Return Nothing
End If
End Function
End Module