Code:
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Linq
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.IO
Module Compresslib
<DllImport("Plugins\compress.dll", CallingConvention:=CallingConvention.Cdecl)> _
Public Function lzo_decompress(<Out()> compressed_buffer As Byte(), compressed_size As UInteger, <[In]()> decompressed_buffer As Byte(), decompressed_size As UInteger, method As UInteger) As UInteger
End Function
<DllImport("Plugins\compress.dll", CallingConvention:=CallingConvention.Cdecl)> _
Public Function lzo_compress(<Out()> decompressed_buffer As Byte(), decompressed_size As UInteger, <[In]()> compressed_buffer As Byte(), compressed_size As UInteger, method As UInteger, compress_level As UInteger) As UInteger
End Function
Private bw As BinaryWriter
Private strb As New System.Text.StringBuilder
Private multiblocks As Boolean = False
Dim InputPath As String
Dim OutputPath As String
Dim endfile As Boolean = False
Dim Mem As Integer = 268435456
Dim calculatedblocks As Integer
Dim Lastblocksize As UInteger = 0
Dim Headersize As Integer = 0
Dim blockstartpos As String = &H0
Private Enum CompressionMethods
' decompressors
COMP_NONE = 0
' No compression
COMP_ZLIB
' RFC 1950
COMP_DEFLATE
' RFC 1951
COMP_LZO1
' LZO 1 Freeware
COMP_LZO1A
' LZO 1a Freeware
COMP_LZO1B
' LZO 1b (safe with overrun) Freeware
COMP_LZO1C
' LZO 1c (safe with overrun) Freeware
COMP_LZO1F
' LZO 1f (safe with overrun) Freeware
COMP_LZO1X
' LZO 1x (safe with overrun) Freeware
COMP_LZO1Y
' LZO 1y (safe with overrun) Freeware
COMP_LZO1Z
' LZO 1z (safe with overrun) Freeware
COMP_LZO2A
' LZO 2a (safe with overrun) Freeware
COMP_LZOPRO1X
' LZOPRO 1x (safe with overrun) Freeware
COMP_LZOPRO1Y
' LZOPRO 1y (safe with overrun) Freeware
' compressors
COMP_LZO1_COMPRESS
' LZO 1 Freeware
COMP_LZO1_99_COMPRESS
' better compression ratio at the cost of more memory and time
COMP_LZO1A_COMPRESS
' LZO 1a Freeware
COMP_LZO1A_99_COMPRESS
' better compression ratio at the cost of more memory and time
COMP_LZO1B_COMPRESS
' LZO 1b Freeware (Valid compression level: 1..9)
COMP_LZO1B_99_COMPRESS
' better compression ratio at the cost of more memory and time
COMP_LZO1B_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO1C_COMPRESS
' LZO 1c Freeware (Valid compression level: 1..9)
COMP_LZO1C_99_COMPRESS
' better compression ratio at the cost of more memory and time
COMP_LZO1C_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO1F_COMPRESS
' LZO 1f Freeware
COMP_LZO1F_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO1X_COMPRESS
' LZO 1x Freeware
COMP_LZO1X_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO1Y_COMPRESS
' LZO 1y Freeware
COMP_LZO1Y_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO1Z_COMPRESS
' LZO 1z Freeware
COMP_LZO1Z_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZO2A_COMPRESS
' LZO 2a Freeware
COMP_LZO2A_999_COMPRESS
' even better compression ratio at the cost of more memory and time
COMP_LZOPRO1X_COMPRESS
' LZOPRO 1x (Valid compression level: 1..10)
COMP_LZOPRO1Y_COMPRESS
' LZOPRO 1y (Valid compression level: 1..10)
End Enum
Sub Compressfile(CompressInputPath As String, CompressSavePath As String)
InputPath = CompressInputPath
OutputPath = CompressSavePath
Calculatefilecompression()
StartCompression()
'Verifyheader()
End Sub
#Region "Compress Methoden"
Private Function CompressionMethodsdecompress(p1 As Object, ByVal ReturnInt As Boolean) As Object
If ReturnInt Then
Select Case p1
Case "COMP_LZOPRO1X"
Return CompressionMethods.COMP_LZOPRO1X
Case "COMP_LZOPRO1Y"
Return CompressionMethods.COMP_LZOPRO1Y
Case "COMP_LZO2A"
Return CompressionMethods.COMP_LZO2A
Case "COMP_LZO1Z"
Return CompressionMethods.COMP_LZO1Z
Case "COMP_LZO1Y"
Return CompressionMethods.COMP_LZO1Y
Case "COMP_LZO1X"
Return CompressionMethods.COMP_LZO1X
Case "COMP_LZO1F"
Return CompressionMethods.COMP_LZO1F
Case "COMP_LZO1C"
Return CompressionMethods.COMP_LZO1C
Case "COMP_LZO1B"
Return CompressionMethods.COMP_LZO1B
Case "COMP_LZO1A"
Return CompressionMethods.COMP_LZO1A
Case "COMP_LZO1"
Return CompressionMethods.COMP_LZO1
Case "COMP_DEFLATE"
Return CompressionMethods.COMP_DEFLATE
Case "COMP_ZLIB"
Return CompressionMethods.COMP_ZLIB
Case "COMP_NONE"
Return CompressionMethods.COMP_NONE
Case Else
xb360Generic.RichTextBox1.AppendText("Wrong CompressionMethods" & xb360Generic.ComboBox1.Text.ToString)
Return False
End Select
End If
Return Nothing
End Function
Private Function CompressionMethodscompress(p1 As Object, ByVal ReturnInt As Boolean) As Object 'Compress
If ReturnInt Then
Select Case p1
Case "COMP_LZO1_COMPRESS"
Return CompressionMethods.COMP_LZO1_COMPRESS
Case "COMP_LZO1_99_COMPRESS"
Return CompressionMethods.COMP_LZO1_99_COMPRESS
Case "COMP_LZO1A_COMPRESS"
Return CompressionMethods.COMP_LZO1A_COMPRESS
Case "COMP_LZO1A_99_COMPRESS"
Return CompressionMethods.COMP_LZO1A_99_COMPRESS
Case "COMP_LZO1B_COMPRESS"
Return CompressionMethods.COMP_LZO1B_COMPRESS
Case "COMP_LZO1B_99_COMPRESS"
Return CompressionMethods.COMP_LZO1B_99_COMPRESS
Case "COMP_LZO1B_999_COMPRESS"
Return CompressionMethods.COMP_LZO1B_999_COMPRESS
Case "COMP_LZO1C_COMPRESS"
Return CompressionMethods.COMP_LZO1C_COMPRESS
Case "COMP_LZO1C_99_COMPRESS"
Return CompressionMethods.COMP_LZO1C_99_COMPRESS
Case "COMP_LZO1C_999_COMPRESS"
Return CompressionMethods.COMP_LZO1C_999_COMPRESS
Case "COMP_LZO1F_COMPRESS"
Return CompressionMethods.COMP_LZO1F_COMPRESS
Case "COMP_LZO1F_999_COMPRESS"
Return CompressionMethods.COMP_LZO1F_999_COMPRESS
Case "COMP_LZO1X_COMPRESS"
Return CompressionMethods.COMP_LZO1X_COMPRESS
Case "COMP_LZO1X_999_COMPRESS"
Return CompressionMethods.COMP_LZO1X_999_COMPRESS
Case "COMP_LZO1Y_COMPRESS"
Return CompressionMethods.COMP_LZO1Y_COMPRESS
Case "COMP_LZO1Y_999_COMPRESS"
Return CompressionMethods.COMP_LZO1Y_999_COMPRESS
Case "COMP_LZO1Z_COMPRESS"
Return CompressionMethods.COMP_LZO1Z_COMPRESS
Case "COMP_LZO1Z_999_COMPRESS"
Return CompressionMethods.COMP_LZO1Z_999_COMPRESS
Case "COMP_LZO2A_COMPRESS"
Return CompressionMethods.COMP_LZO2A_COMPRESS
Case "COMP_LZO2A_999_COMPRESS"
Return CompressionMethods.COMP_LZO2A_999_COMPRESS
Case "COMP_LZOPRO1X_COMPRESS"
Return CompressionMethods.COMP_LZOPRO1X_COMPRESS
Case "COMP_LZOPRO1Y_COMPRESS"
Return CompressionMethods.COMP_LZOPRO1Y_COMPRESS
Case Else
xb360Generic.RichTextBox1.AppendText("Wrong CompressionMethods" & xb360Generic.ComboBox1.Text.ToString)
Return False
End Select
End If
Return Nothing
End Function
#End Region
Private Sub Calculatefilecompression()
'/256MB
Dim L As String = FileSystem.FileLen(InputPath) '/File
strb.AppendLine()
strb.Append("Scan File......." & vbNewLine)
strb.Append(InputPath & vbNewLine)
strb.AppendLine()
strb.Append("Scan File.....done!" & vbNewLine)
strb.Append("Input:---> " & L & "(bytes)" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
If L < Mem Then
'/1Block
multiblocks = False
calculatedblocks = 1
Lastblocksize = L
Headersize = 0
blockstartpos = "&H0"
strb.Append("Calculated block:---> " & "(" & calculatedblocks & ")" & vbNewLine)
strb.Append("Use block size:---> " & "536870912(bytes)" & vbNewLine)
strb.Append("Header size:---> " & Headersize & "(bytes)" & vbNewLine)
strb.Append("1Block offset:---> " & blockstartpos & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
Else
'/Multi Blocks calculate
multiblocks = True
calculatedblocks = Math.Floor(CStr(L) / CDec(Mem))
'/verhinderung falscher block berechnung
Dim c1 As String = (CStr(calculatedblocks * 256) * CDec(1024) * CDec(1024))
Lastblocksize = (CStr(L) - CDec(c1)) '/bytes last block for compress
If Not Lastblocksize = 0 Then calculatedblocks += 1
Headersize = CStr(calculatedblocks * 4) + (CDec(6)) '/Header berechnen 1block hat 4 bytes für compressed size / 2bytes für blockzahl / 2bytes für block size in MB
blockstartpos = "&H" & CStr(Hex$(blockstartpos) + Hex$(Headersize))
strb.Append("Calculated block:---> " & "(" & calculatedblocks & ")" & vbNewLine)
strb.Append("Use block size:---> " & "536870912(bytes)" & vbNewLine)
strb.Append("Header size:---> " & Headersize & "(bytes)" & vbNewLine)
strb.Append("Block @ offset:---> " & blockstartpos & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
End If
End Sub
Dim positionheader As String = "&H0"
Dim sizeblock As UInteger = 0
Private _Maximum As Integer = 100
Private Percent As Integer = 0
Dim bytesRead As UInteger
Public Function ReadBufferBytes(Input As String, offset As String, sizeblock As UInteger) As Byte()
Dim buffer As Byte() = Nothing
Using fs As New FileStream(Input, FileMode.Open, FileAccess.Read, FileShare.Read)
strb.Append("Reade buffer bytes:---> " & sizeblock & "(bytes)" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
xb360Generic.ProgressBar1.Maximum = _Maximum
buffer = New Byte((sizeblock - 1)) {}
fs.Seek(offset, SeekOrigin.Begin)
strb.Append("Reade buffer bytes:---> " & Percent & "%" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
For i As Long = 0 To sizeblock
bytesRead = fs.Read(buffer, 0, CInt(sizeblock))
'/ update bei 1 Kb oder ende sizeblock
If i Mod 1024 = 0 Or i Mod sizeblock = 0 Then
fortschrittrb(i, sizeblock)
End If
Next
End Using
Return buffer
End Function
Private Function fortschrittrb(currentRead As UInteger, maxRead As UInteger)
Dim current As Integer
current = CDec(currentRead / maxRead * 100)
xb360Generic.RichTextBox2.Undo()'/Lazy clear last line from rtb
strb.Append("Progress:---> " & current & "%" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
Application.DoEvents()
Return Nothing
End Function
Private Sub StartCompression()
Dim messblocks As Integer = 1
If calculatedblocks = 1 Then sizeblock = Lastblocksize Else sizeblock = Mem
Dim offset As String = "&H0" '/Input file offset
Dim blockcouter As Integer = calculatedblocks
strb.AppendLine()
strb.Append("Compression start............" & blockstartpos & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
Do Until endfile = True
Dim MemBuffer As Byte()
MemBuffer = ReadBufferBytes(InputPath, offset, sizeblock)
Dim compressedbuffer As Byte() = New Byte(MemBuffer.Length) {}
Dim compressedsize As UInteger = 0
strb.Append("Compress block (" & messblocks & ")" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
strb.Append("Compress buffer bytes:---> " & "0%" & vbNewLine)
logMessage(strb.ToString)
strb.Clear()
'/ senden an Compressor
For i As Long = 0 To sizeblock
compressedsize = lzo_compress(MemBuffer, MemBuffer.Length, compressedbuffer, compressedbuffer.Length, _
CUInt(CompressionMethodscompress(xb360Generic.ComboBox2.Text, True)), xb360Generic.levelNum.Value)
'/ update bei 1 Kb oder ende sizeblock
If i Mod 1024 = 0 Or i Mod sizeblock = 0 Then
fortschrittrb(i, sizeblock)
End If
Next
strb.Append("Compressed block size: " & compressedsize & "(bytes)" & vbNewLine)
strb.Append("Clear Memory buffer: " & MemBuffer.Length & "(bytes)" & vbNewLine)
strb.AppendLine()
logMessage(strb.ToString)
strb.Clear()
'/Lösche memory array von Compressor
Array.Clear(MemBuffer, 0, MemBuffer.Length)
'/check ob es was zu schreiben gibt
WriteBufferBytes(OutputPath, offset, compressedbuffer, compressedsize)
'/Nach schreiben array löschen
Array.Clear(compressedbuffer, 0, compressedbuffer.Length)
'/offset für writer setzen next block
blockstartpos = "&H" & CStr(Hex$(blockstartpos) + Hex$(compressedsize))
'/offset für next block berechnen
offset = offset + CUInt(sizeblock)
offset = "&H" & Hex$(offset)
'/block counten
messblocks += 1
blockcouter -= 1
'/Check ob letzter block erreicht ist und loop ende
If blockcouter = 0 Then Exit Do : endfile = True
'/ o vor 1 verhindert das sizeblock berechnet wird bei nur 1 block
If blockcouter = 1 Then sizeblock = Lastblocksize
Loop
End Sub
Private Function WriteBufferBytes(OutputPath As String, offset As String, compressedbuffer As Byte(), compressedsize As UInteger)
strb.Append("Write Compressed block: " & compressedsize & "(bytes)" & vbNewLine)
strb.AppendLine()
logMessage(strb.ToString)
strb.Clear()
Using fs As New FileStream(OutputPath, FileMode.OpenOrCreate, FileAccess.Write, FileShare.Write)
'/check ob file header da ist
Dim headerbuffer As Byte() = New Byte(Headersize - 1) {}
bw = New BinaryWriter(fs)
'/ check ob header benötigt wird für multi blocks durch boolen wert
If multiblocks = True Then
If positionheader = "&H0" Then
strb.Append("Create Big File Header: " & Headersize & "(bytes)" & vbNewLine)
strb.AppendLine()
logMessage(strb.ToString)
strb.Clear()
'/erstelle header
fs.Seek(0, SeekOrigin.Begin)
fs.Write(headerbuffer, 0, headerbuffer.Length)
fs.Seek(0, SeekOrigin.Begin)
WriteInt16(calculatedblocks)
WriteInt16(CDec(512))
WriteInt16(Headersize) '/ siehe header structur
WriteUInt32(compressedsize)
Array.Clear(headerbuffer, 0, headerbuffer.Length)
positionheader = "&H" & CStr(Hex$(positionheader) + Hex$(10))
Else
strb.Append("Update Big File Header: offset " & positionheader & vbNewLine)
strb.AppendLine()
logMessage(strb.ToString)
strb.Clear()
'/ Update header
fs.Position = positionheader
WriteUInt32(compressedsize)
End If
End If
'/schreibe die daten
fs.Seek(blockstartpos, SeekOrigin.Begin)
fs.Write(compressedbuffer, 0, compressedsize)
End Using
Return Nothing
End Function
Private Sub logMessage(ByVal message As String)
With xb360Generic.RichTextBox2
.AppendText(message)
.Refresh()
.ScrollToCaret()
End With
End Sub
Private Enum Endian
Little = 0
Big = 1
End Enum
Public Sub Write(value As Byte)
bw.Write(value)
End Sub
Public Sub WriteInt16(value As Short)
bw.Write(value)
End Sub
Public Sub WriteInt16(value As Short, type As Integer)
Dim buffer As Byte() = BitConverter.GetBytes(value)
If type = Endian.Big Then
Array.Reverse(buffer)
End If
bw.Write(value)
End Sub
Public Sub WriteUInt16(value As UShort)
bw.Write(value)
End Sub
Public Sub WriteUInt16(value As UShort, type As Integer)
Dim buffer As Byte() = BitConverter.GetBytes(value)
If type = Endian.Big Then
Array.Reverse(buffer)
End If
bw.Write(value)
End Sub
Public Sub WriteInt32(value As Integer)
Dim buffer As Byte() = BitConverter.GetBytes(value)
bw.Write(buffer)
End Sub
Private Sub WriteInt32(value As Integer, type As Integer)
Dim buffer As Byte() = BitConverter.GetBytes(value)
If type = Endian.Big Then
Array.Reverse(buffer)
End If
bw.Write(buffer)
End Sub
Public Sub WriteUInt32(value As UInteger)
Dim buffer As Byte() = BitConverter.GetBytes(value)
bw.Write(buffer)
End Sub
Private Sub WriteUInt32(value As UInteger, type As Integer)
Dim buffer As Byte() = BitConverter.GetBytes(value)
If type = Endian.Big Then
Array.Reverse(buffer)
End If
bw.Write(buffer)
End Sub
End Module