pngchunk/pngchunk/pngchunk.vb

336 lines
14 KiB
VB.net
Executable File

Module pngchunk
Sub Main()
If My.Application.CommandLineArgs.Count = 0 Then
Console.WriteLine("pngchunk - http://long-cat.net")
Console.WriteLine("Usage: pngchunk [options] file.png")
Console.WriteLine()
Console.WriteLine("Options:" & vbNewLine &
"-x extract embedded PNG files and non-PNG data")
Exit Sub
End If
Dim extract As Boolean
Dim filename As String = String.Empty
Dim pngcount, datcount As Integer
For Each opt In My.Application.CommandLineArgs
If opt = "-x" Or opt = "/x" Then
extract = True
Else
filename = opt
End If
Next
If Not FileIO.FileSystem.FileExists(filename) Then
Console.WriteLine("File {0} not found!", filename)
Exit Sub
End If
Dim fs As New IO.FileStream(filename, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read)
Dim fi As New IO.FileInfo(filename)
Dim sizedigits As Integer = Math.Ceiling(Math.Log10(fs.Length))
While Not fs.Position = fs.Length
Dim startposition As Long = fs.Position
FindHeader(fs)
If fs.Position - 8 <> startposition And fs.Position <> fs.Length Then
Console.WriteLine(">> Skipped {0} bytes of non-png data", fs.Position - 8 - startposition)
If extract Then
CopyPart(filename, fi.FullName & "." & datcount & ".dat", startposition, fs.Position - 8 - startposition)
datcount += 1
End If
ElseIf fs.Position = fs.Length Then
Console.WriteLine(">> Skipped {0} bytes of non-png data", fs.Position - startposition)
If extract Then
CopyPart(filename, fi.FullName & "." & datcount & ".dat", startposition, fs.Position - startposition)
datcount += 1
End If
End If
startposition = fs.Position - 8
If fs.Position = fs.Length Then
Console.WriteLine("End of file")
fs.Close()
Exit Sub
Else
Console.WriteLine("-- PNG header at {0}", fs.Position - 8)
End If
Dim lenbuf(3), nameanddatabuf(), databuf(), crcbuf(3) As Byte
Dim len As Integer
Dim chunklength As UInt32
Dim chunktype As String = String.Empty
While chunktype <> "IEND" AndAlso fs.Position <> fs.Length
Console.ForegroundColor = ConsoleColor.White
'read chunk length
len = fs.Read(lenbuf, 0, 4)
If len <> 4 Then
Console.WriteLine("Incomplete chunk length header")
Exit While
End If
'read and print chunk length and offset in the file
chunklength = BigEndianUInt32(lenbuf)
Console.Write("{0," & sizedigits & "} @ {1,-" & sizedigits & "}:", chunklength, fs.Position - 4)
'read in the chunk data and type
ReDim nameanddatabuf(chunklength + 3)
ReDim databuf(chunklength - 1)
len = fs.Read(nameanddatabuf, 0, chunklength + 4)
'rewind and read only the chunk data
fs.Seek(-chunklength, IO.SeekOrigin.Current)
fs.Read(databuf, 0, chunklength)
'check for incomplete reads
If len <> chunklength + 4 Then
Console.WriteLine("Incomplete chunk data")
Exit While
End If
'get chunk type as string
chunktype = System.Text.Encoding.ASCII.GetString(nameanddatabuf, 0, 4)
Console.Write(chunktype & " ")
'compute checksum of the chunk
Dim datachecksum As UInt32 = Crc32.ComputeChecksum(nameanddatabuf)
'read reported checksum and compare it to the file
len = fs.Read(crcbuf, 0, 4)
If len <> 4 Then
Console.WriteLine("Incomplete CRC data")
End If
Dim chunkchecksum As UInt32 = BigEndianUInt32(crcbuf)
If chunkchecksum = datachecksum Then
Console.Write("ok")
Else
Console.Write("INVALID CRC")
End If
Console.WriteLine()
'print info for some chunks
Console.ForegroundColor = ConsoleColor.Gray
PrintChunkInfo(chunktype, databuf)
End While
If extract Then
CopyPart(filename, fi.FullName & "." & pngcount & ".png", startposition, fs.Position - startposition)
pngcount += 1
End If
End While
fs.Close()
#If CONFIG = "Debug" Then
Console.ReadKey()
#End If
End Sub
Public Sub FindHeader(fs As IO.FileStream)
Dim header() As Byte = {&H89, &H50, &H4E, &H47, &HD, &HA, &H1A, &HA}
Dim i As Integer = 0
Dim startposition As Long = fs.Position
While i < 8
If fs.ReadByte = header(i) Then
i += 1
Else
i = 0
End If
If fs.Position = fs.Length Then
Exit Sub
End If
End While
End Sub
Private Function BigEndianUInt32(ByRef buf As Byte(), Optional offset As Integer = 0) As UInteger
Return &H1000000L * buf(0 + offset) + &H10000L * buf(1 + offset) + &H100L * buf(2 + offset) + buf(3 + offset)
End Function
Public Sub CopyPart(srcfile As String, destfile As String, offset As Long, bytes As Long)
Dim srcfs As New IO.FileStream(srcfile, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read)
Dim destfs As New IO.FileStream(destfile, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.Read)
srcfs.Seek(offset, IO.SeekOrigin.Begin)
Dim buf(bytes) As Byte
Dim len As Integer = srcfs.Read(buf, 0, bytes)
destfs.Write(buf, 0, len)
srcfs.Close()
destfs.Close()
End Sub
Private Sub PrintChunkInfo(chunktype As String, ByRef data As Byte())
Select Case chunktype
Case "IHDR"
'image width
Console.WriteLine("width: {0} px", BigEndianUInt32(data, 0))
'image height
Console.WriteLine("height: {0} px", BigEndianUInt32(data, 4))
'bit depth
Dim bitdepth As Byte = data(8)
If {1, 2, 4, 8, 16}.Contains(bitdepth) Then
Console.WriteLine("bit depth: {0} bits/sample", bitdepth)
Else
Console.WriteLine("bit depth: {0} bits/sample INVALID", bitdepth)
End If
'color types
Dim colortype As Byte = data(9)
Dim colortypename As String
Select Case colortype
Case 0
colortypename = "greyscale"
If Not {1, 2, 4, 8, 16}.Contains(bitdepth) Then
colortypename &= ", INVALID BIT DEPTH"
End If
Case 2
colortypename = "truecolor"
If Not {8, 16}.Contains(bitdepth) Then
colortypename &= ", INVALID BIT DEPTH"
End If
Case 3
colortypename = "indexed"
If Not {1, 2, 4, 8}.Contains(bitdepth) Then
colortypename &= ", INVALID BIT DEPTH"
End If
Case 4
colortypename = "greyscale with alpha"
If Not {8, 16}.Contains(bitdepth) Then
colortypename &= ", INVALID BIT DEPTH"
End If
Case 6
colortypename = "truecolor with alpha"
If Not {8, 16}.Contains(bitdepth) Then
colortypename &= ", INVALID BIT DEPTH"
End If
Case Else
colortypename = "UNKNOWN"
End Select
Console.WriteLine("color type: {0} ({1})", colortype, colortypename)
'compression method
If data(10) = 0 Then
Console.WriteLine("compression method: 0 (deflate)")
Else
Console.WriteLine("compression method: {0} (UNKNOWN)", data(10))
End If
'filter method
If data(11) = 0 Then
Console.WriteLine("filter method: 0 (adaptive)")
Else
Console.WriteLine("filter method: {0} (UNKNOWN)", data(11))
End If
'interlace method
If data(12) = 0 Then
Console.WriteLine("interlace method: 0 (no interlace)")
ElseIf data(12) = 1 Then
Console.WriteLine("interlace method: 1 (Adam7)")
Else
Console.WriteLine("interlace method: {0} (UNKNOWN)", data(12))
End If
'end IHDR
Case "pHYs"
Dim unitsaremetres As Boolean = (data(8) = 1)
If unitsaremetres Then
Console.WriteLine("pixels per unit, x: {0} px ({1:g} ppi)", BigEndianUInt32(data, 0), BigEndianUInt32(data, 0) * 0.0254)
Console.WriteLine("pixels per unit, y: {0} px ({1:g} ppi)", BigEndianUInt32(data, 4), BigEndianUInt32(data, 0) * 0.0254)
Else
Console.WriteLine("pixels per unit, x: {0} px", BigEndianUInt32(data, 0))
Console.WriteLine("pixels per unit, y: {0} px", BigEndianUInt32(data, 4))
End If
If data(8) = 0 Then
Console.WriteLine("units: 0 (unknown)")
ElseIf data(8) = 1 Then
Console.WriteLine("units: 1 (metre)")
Else
Console.WriteLine("units: {0} (UNKNOWN)", data(8))
End If
Case "tEXt"
Dim keywordlength As Integer = Array.FindIndex(data, Function(x) x = &H0)
Dim keyword(keywordlength - 1) As Byte
Dim textstring(data.Length - keywordlength - 1 - 1) As Byte
Array.Copy(data, 0, keyword, 0, keywordlength)
Array.Copy(data, keywordlength + 1, textstring, 0, data.Length - keywordlength - 1)
Console.WriteLine("keyword: {0}", System.Text.Encoding.GetEncoding("ISO-8859-1").GetString(keyword))
Console.WriteLine("value: {0}", System.Text.Encoding.GetEncoding("ISO-8859-1").GetString(textstring))
Case "iCCP"
Dim namelength As Integer = Array.FindIndex(data, Function(x) x = &H0)
Dim profilename(namelength - 1) As Byte
Array.Copy(data, 0, profilename, 0, namelength)
Console.WriteLine("profile name: {0}", System.Text.Encoding.GetEncoding("ISO-8859-1").GetString(profilename))
Case "cHRM"
Dim offset As Integer = 0
For Each pointname As String In {"white point", "red", "green ", "blue"}
Dim xcounts, ycounts As UInteger
Dim extrainfo As String = ""
xcounts = BigEndianUInt32(data, offset)
ycounts = BigEndianUInt32(data, offset + 4)
'Calculate color temperature of white point
If pointname = "white point" Then
Dim n As Double = ((xcounts / 100000.0) - 0.332) / ((ycounts / 100000.0) - 0.1858)
Dim cctapprox As Double = (-449 * n ^ 3) + (3525 * n ^ 2) - (6823.3 * n) + 5520.33
extrainfo = " (" & cctapprox.ToString("F0") & " K)"
End If
Console.WriteLine("{0}: x = {1:g} y = {2:g}{3}", pointname, xcounts / 100000.0, ycounts / 100000.0, extrainfo)
offset += 8
Next
Case "gAMA"
Dim gammacounts As UInteger = BigEndianUInt32(data)
Console.WriteLine("gamma: 1/{0:g5}", 1 / (gammacounts / 100000.0))
End Select
End Sub
Public Class Crc32
Shared table As UInteger()
Shared Sub New()
Dim poly As UInteger = &HEDB88320UI
table = New UInteger(255) {}
Dim temp As UInteger = 0
For i As UInteger = 0 To table.Length - 1
temp = i
For j As Integer = 8 To 1 Step -1
If (temp And 1) = 1 Then
temp = CUInt((temp >> 1) Xor poly)
Else
temp >>= 1
End If
Next
table(i) = temp
Next
End Sub
Public Shared Function ComputeChecksum(bytes As Byte()) As UInteger
Dim crc As UInteger = &HFFFFFFFFUI
For i As Integer = 0 To bytes.Length - 1
Dim index As Byte = CByte(((crc) And &HFF) Xor bytes(i))
crc = CUInt((crc >> 8) Xor table(index))
Next
Return Not crc
End Function
End Class
End Module