unlzw.c code in gzip-1.2.4 (written ' by Peter Jannesen) and the original compress code. ' ' Based on implementation by Ronald Tschalr (ronald@innovation.ch). Class UncompressInputStream Inherits Stream ' Methods ' @param is the input stream to decompress Public Sub New(ByVal inputStream As Stream) Me._inputStream = inputStream Me.parse_header() End Sub ' New Private Sub fill() Me.got = Me._inputStream.Read(Me.data, Me.end, Me.data.Length - 1 - Me.end) If Me.got > 0 Then Me.end += Me.got End If End Sub ' fill Public Overrides Sub Flush() Throw New NotSupportedException End Sub ' Flush Private Const LZW_MAGIC As Integer = &H1F9D Private Const MAX_BITS As Integer = &H10 Private Const INIT_BITS As Integer = 9 Private Const HDR_MAXBITS As Integer = &H1F Private Const HDR_EXTENDED As Integer = &H20 Private Const HDR_FREE As Integer = &H40 Private Const HDR_BLOCK_MODE As Integer = &H80 Private Sub parse_header() ' read in and check magic number Dim t As Integer = Me.read_byte() If t < 0 Then Throw New Exception("Failed to read magic number") End If Dim magic As Integer = ((t And &HFF) << 8) t = Me.read_byte() If t < 0 Then Throw New Exception("Failed to read magic number") End If magic += (t And &HFF) If (magic <> LZW_MAGIC) Then Throw New IOException("Input not in compress format (read magic number 0x" & magic.ToString("x") & ")") End If ' read in header byte Dim header As Integer = Me.read_byte() If header < 0 Then Throw New Exception("Failed to read header") End If Me.block_mode = ((header And HDR_BLOCK_MODE) > 0) Me.maxbits = (header And HDR_MAXBITS) If Me.maxbits > MAX_BITS Then Throw New IOException( _ "Stream compressed with " & Me.maxbits.ToString() & _ " bits, but can only handle " & MAX_BITS.ToString() & " bits") End If If (header And HDR_EXTENDED) > 0 Then Throw New IOException("Header extension bit set") End If If (header And HDR_FREE) > 0 Then Throw New IOException("Header bit 6 set") End If ' initialize stuff Me.maxmaxcode = (CInt(1) << Me.maxbits) Me.n_bits = INIT_BITS Me.maxcode = (CInt(1) << Me.n_bits) - 1 Me.bitmask = Me.maxcode Me.oldcode = -1 Me.finchar = 0 Me.free_ent = CType(IIf(Me.block_mode, TBL_FIRST, &H100), Integer) Me.tab_prefix = New Integer((CInt(1) << Me.maxbits) - 1) {} Me.tab_suffix = New Byte((CInt(1) << Me.maxbits) - 1) {} Me.stack = New Byte((CInt(1) << Me.maxbits) - 1) {} Me.stackp = Me.stack.Length Dim idx As Integer = &HFF Do While idx >= 0 Me.tab_suffix(idx) = CByte(idx) idx -= 1 Loop End Sub ' parse_header Private one As Byte() = New Byte(1 - 1) {} Public Function read_byte() As Integer If Me._inputStream.Read(Me.one, 0, 1) = 1 Then Return (Me.one(0) And &HFF) End If Return -1 End Function ' read_byte Public Function read_internal(ByVal buf As Byte(), ByVal off As Integer, ByVal len As Integer) As Integer If Me.eof Then Return -1 End If Dim num As Integer Dim start As Integer = off Dim l_tab_prefix As Integer() = Me.tab_prefix Dim l_tab_suffix As Byte() = Me.tab_suffix Dim l_stack As Byte() = Me.stack Dim l_n_bits As Integer = Me.n_bits Dim l_maxcode As Integer = Me.maxcode Dim l_maxmaxcode As Integer = Me.maxmaxcode Dim l_bitmask As Integer = Me.bitmask Dim l_oldcode As Integer = Me.oldcode Dim l_finchar As Byte = Me.finchar Dim l_stackp As Integer = Me.stackp Dim l_free_ent As Integer = Me.free_ent Dim l_data As Byte() = Me.data Dim l_bit_pos As Integer = Me.bit_pos ' empty stack if stuff still left Dim s_size As Integer = (l_stack.Length - l_stackp) If s_size > 0 Then num = CType(IIf((s_size >= len), len, s_size), Integer) Array.Copy(l_stack, l_stackp, buf, off, num) off += num len -= num l_stackp += num End If If len = 0 Then Me.stackp = l_stackp Return (off - start) End If ' loop, filling local buffer until enough data has been decompressed main_loop: If Me.end < EXTRA Then Call Me.fill() End If Dim bit_in As Integer = CType(IIf(Me.got > 0, _ (Me.end - (Me.end Mod l_n_bits)) << 3, _ (Me.end << 3) - (l_n_bits - 1)), _ Integer) Do While l_bit_pos < bit_in Dim n_bytes As Integer ' check for code-width expansion If l_free_ent > l_maxcode Then n_bytes = (l_n_bits << 3) l_bit_pos = ((l_bit_pos - 1) + n_bytes - (l_bit_pos - 1 + n_bytes) Mod n_bytes) l_n_bits += 1 l_maxcode = CType(IIf(l_n_bits = Me.maxbits, _ l_maxmaxcode, _ ((CInt(1) << l_n_bits) - 1)), _ Integer) l_bitmask = ((CInt(1) << l_n_bits) - 1) l_bit_pos = Me.resetbuf(l_bit_pos) GoTo main_loop End If ' read next code Dim pos As Integer = (l_bit_pos >> 3) Dim code As Integer = _ (((l_data(pos) And &HFF) Or ((l_data(pos + 1) And &HFF) << 8) Or _ ((l_data(pos + 2) And &HFF) << &H10)) _ >> (l_bit_pos And 7)) And l_bitmask l_bit_pos += l_n_bits ' handle first iteration If (l_oldcode = -1) Then If (code >= &H100) Then Throw New IOException(("corrupt input: " & code & " > 255")) End If l_oldcode = code l_finchar = CByte(code) buf(off) = l_finchar off += 1 len -= 1 Continue Do End If ' handle CLEAR code If code = TBL_CLEAR AndAlso Me.block_mode Then Array.Copy(Me.zeros, 0, l_tab_prefix, 0, Me.zeros.Length) l_free_ent = TBL_FIRST - 1 n_bytes = (l_n_bits << 3) l_bit_pos = ((l_bit_pos - 1) + n_bytes - (l_bit_pos - 1 + n_bytes) Mod n_bytes) l_n_bits = INIT_BITS l_maxcode = ((CInt(1) << l_n_bits) - 1) l_bitmask = l_maxcode l_bit_pos = Me.resetbuf(l_bit_pos) GoTo main_loop End If ' setup Dim incode As Integer = code l_stackp = l_stack.Length ' Handle KwK case If code >= l_free_ent Then If code > l_free_ent Then Throw New IOException( _ "corrupt input: code=" & code.ToString() & _ ", free_ent=" & l_free_ent.ToString()) End If l_stackp -= 1 l_stack(l_stackp) = l_finchar code = l_oldcode End If ' Generate output characters in reverse order Do While (code >= &H100) l_stackp -= 1 l_stack(l_stackp) = l_tab_suffix(code) code = l_tab_prefix(code) Loop l_finchar = l_tab_suffix(code) buf(off) = l_finchar off += 1 len -= 1 ' And put them out in forward order s_size = (l_stack.Length - l_stackp) num = CType(IIf(s_size >= len, len, s_size), Integer) Array.Copy(l_stack, l_stackp, buf, off, num) off += num len -= num l_stackp += num ' generate new entry in table If l_free_ent < l_maxmaxcode Then l_tab_prefix(l_free_ent) = l_oldcode l_tab_suffix(l_free_ent) = l_finchar l_free_ent += 1 End If ' Remember previous code l_oldcode = incode ' if output buffer full, then return If len = 0 Then Me.n_bits = l_n_bits Me.maxcode = l_maxcode Me.bitmask = l_bitmask Me.oldcode = l_oldcode Me.finchar = l_finchar Me.stackp = l_stackp Me.free_ent = l_free_ent Me.bit_pos = l_bit_pos Return (off - start) End If Loop l_bit_pos = Me.resetbuf(l_bit_pos) If (Me.got > 0) Then GoTo main_loop End If Me.n_bits = l_n_bits Me.maxcode = l_maxcode Me.bitmask = l_bitmask Me.oldcode = l_oldcode Me.finchar = l_finchar Me.stackp = l_stackp Me.free_ent = l_free_ent Me.bit_pos = l_bit_pos Me.eof = True Return (off - start) End Function ' read_internal Public Overrides Function Read(ByVal buffer As Byte(), ByVal offset As Integer, ByVal count As Integer) As Integer Return Me.read_internal(buffer, offset, count) End Function ' Read ' Moves the unread data in the buffer to the beginning and resets ' the pointers. Private Function resetbuf(ByVal bit_pos As Integer) As Integer Dim pos As Integer = (bit_pos >> 3) Array.Copy(Me.data, pos, Me.data, 0, (Me.end - pos)) Me.end -= pos Return 0 End Function ' resetbuf Public Overrides Function Seek(ByVal offset As Long, ByVal origin As SeekOrigin) As Long Throw New NotSupportedException End Function ' Seek Public Overrides Sub SetLength(ByVal value As Long) Throw New NotSupportedException End Sub ' SetLength Public Overrides Sub Write(ByVal buffer As Byte(), ByVal offset As Integer, ByVal count As Integer) Throw New NotSupportedException End Sub ' Write ' Properties Public Overrides ReadOnly Property CanRead() As Boolean Get If Me.eof Then Return False End If Return Me._inputStream.CanRead End Get End Property ' CanRead Public Overrides ReadOnly Property CanSeek() As Boolean Get Return False End Get End Property ' CanSeek Public Overrides ReadOnly Property CanWrite() As Boolean Get Return False End Get End Property ' CanWrite Public Overrides ReadOnly Property Length() As Long Get Throw New NotSupportedException End Get End Property ' Length Public Overrides Property Position() As Long Get Throw New NotSupportedException End Get Set(ByVal value As Long) Throw New NotSupportedException End Set End Property ' Position ' Fields Private _inputStream As Stream = Nothing ' string table stuff Private Const TBL_CLEAR As Integer = &H100 Private Const TBL_FIRST As Integer = TBL_CLEAR + 1 Private tab_prefix As Integer() Private tab_suffix As Byte() Private zeros As Integer() = New Integer(&H100 - 1) {} Private stack As Byte() ' various state Private block_mode As Boolean Private n_bits As Integer Private maxbits As Integer Private maxmaxcode As Integer Private maxcode As Integer Private bitmask As Integer Private oldcode As Integer Private finchar As Byte Private stackp As Integer Private free_ent As Integer ' input buffer Private data As Byte() = New Byte(&H2710 - 1) {} Private bit_pos As Integer = 0 Private [end] As Integer = 0 Private got As Integer = 0 Private eof As Boolean = False Private Const EXTRA As Integer = &H40 End Class ' UncompressInputStream Public Class ScriptMain ' The execution engine calls this method when the task executes. ' To access the object model, use the Dts object. Connections, variables, events, ' and logging features are available as static members of the Dts class. ' Before returning from this method, set the value of Dts.TaskResult to indicate success or failure. ' ' To open Code and Text Editor Help, press F1. ' To open Object Browser, press Ctrl+Alt+J. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub Main() Dim result As Integer Dim fireAgain As Boolean Try Dim sourceFile As String = GetConnectionFile_(Me.SourceFile) Dim inStream As Stream = New UncompressInputStream(File.OpenRead(sourceFile)) Dim buf As Byte() = New Byte(&H1000 - 1) {} Dim targetFile As String = GetConnectionFile_(Me.TargetFile) Using outStream As Stream = File.Create(targetFile) Try Dim bytesRead As Integer = 0 Do While True bytesRead = inStream.Read(buf, 0, buf.Length) If bytesRead <= 0 Then Exit Do End If Call outStream.Write(buf, 0, bytesRead) Loop Call outStream.Flush() Catch ex As Exception ' Failed to uncompress. Remove target file. Call outStream.Close() Call File.Delete(targetFile) Throw End Try End Using Call Dts.Events.FireInformation( _ 0, _ String.Empty, _ String.Format("Uncompressed '{0}' to '{1}'.", sourceFile, targetFile), _ String.Empty, _ 0, _ fireAgain) result = Dts.Results.Success Catch ex As Exception result = Dts.Results.Failure Dts.Events.FireError(0, String.Empty, ex.Message, String.Empty, 0) End Try Dts.TaskResult = result End Sub ' Main #Region "Internals" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' SourceFile property. _ _ Public Property SourceFile() As String Get SourceFile = m_source End Get Set(ByVal value As String) m_source = value End Set End Property ' SourceFile ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' TargetFile property. _ _ Public Property TargetFile() As String Get TargetFile = m_target End Get Set(ByVal value As String) m_target = value End Set End Property ' TargetFile ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private ReadOnly Property FileConnectionType() As String Get FileConnectionType = "FILE" End Get End Property ' FileConnectionType ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Validate specified connection is the expected type. Private Function ValidateConnection_( _ ByVal managerName As String, _ ByVal expectedType As String) As Boolean Dim result As Boolean Dim manager As ConnectionManager If Not String.IsNullOrEmpty(managerName) Then manager = Dts.Connections(managerName) If manager.CreationName = expectedType Then result = True Else ' Doesn't match expected type. Dts.Events.FireError( _ 0, _ String.Empty, _ String.Format( _ "'{0}' connection is not '{1}' type.", _ managerName, _ expectedType), _ String.Empty, _ 0) End If End If ValidateConnection_ = result End Function ' ValidateConnection_ ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Retrieves file path from specified file connection manager. Private Function GetConnectionFile_(ByVal managerName As String) As String Dim result As String Dim manager As ConnectionManager Dim fileConnection As Object If ValidateConnection_(managerName, "FILE") Then manager = Dts.Connections(managerName) fileConnection = manager.AcquireConnection(Nothing) If Not fileConnection Is Nothing Then result = fileConnection.ToString() Else Dts.Events.FireError( _ 0, _ String.Empty, _ String.Format("''{0}' connection file doesn't exist.", managerName), _ String.Empty, _ 0) End If End If GetConnectionFile_ = result End Function ' GetConnectionFile_ #End Region ' Internals #Region "Attributes" Private m_source As String Private m_target As String #End Region ' Attributes End Class ' ScriptMain]]> ]]>