Open Parent Directory
' --------------------------------------------------------------------------------
' Code generated automatically by Code Architects' VB Migration Partner
' --------------------------------------------------------------------------------

Option Strict Off      ' Code migrated from VB6 has Option Strict disabled by default

Friend Module Mod_Reduce

	'This mode is not tested cause i couldn't find a file wich was reduced
	
	Friend Structure Data_Type
	
		Public Data() As Byte
		Public Pos As Integer
		Public BitPos As Short
	
	#Region "Clone method"
	
		Public Function Clone() As Data_Type
			Dim copy As Data_Type = Me
			copy.Data = Me.Data.Clone()
			Return copy
		End Function
	
	#End Region
	
	End Structure

	Private BitMask(15) As Integer
	
	Private Cdata As Mod_Reduce.Data_Type
	Private Udata As Mod_Reduce.Data_Type
	
	Public Function UnReduce(ByVal ByteArray() As Byte, ByVal Level As Short, ByVal UncompressedSize As Integer) As Short
		Dim S(256, 32) As Short
		Dim N(256) As Short
		Dim B(64) As Short
		Dim j As Short
		Dim i As Short
		Dim LastC As Short
		Dim State As Short
		Dim C As Byte
		Dim LN As Short
		Dim Dist As Short
		Dim Cnt As Short
		' UPGRADE_INFO (#0561): The 'Temp' symbol was defined without an explicit "As" clause.
		Dim Temp() As Object
		Dim X As Integer
		Temp = Array6(0, 1, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6)
		For X = 0 To 64
			B(X) = Temp(X)
		Next
		ReDim Udata.Data(UncompressedSize)
		Udata.Pos = 0
		Cdata.Data = ByteArray.Clone()
		Cdata.Pos = -1
		Cdata.BitPos = 0
		For X = 0 To 15
			BitMask(X) = 2 ^ X - 1
		Next
		Cnt = 0
		For j = 255 To 0 Step -1
			N(j) = GetBits(6)
			If N(j) > 32 Then 
				UnReduce = -1 'Follower set to large
				N(j) = 32
			End If
			For i = 0 To N(j) - 1
				S(j, i) = GetBits(8)
				Cnt += 1
			Next
		Next
		LastC = 0
		State = 0
		Do While Udata.Pos <= UncompressedSize
			If Not N(LastC) Then 
				C = GetBits(8)
			Else
				If GetBits(1) Then 
					C = GetBits(8)
				Else
					C = 0
					If N(LastC) <> 0 Then  C = GetBits(B(N(LastC)))
					C = S(LastC, C)
				End If
			End If
			LastC = C
			Select Case State
			Case 0
				If C <> 144 Then 
					Call PutByte(C)
				Else
					State = 1
				End If
			Case 1
				If C Then 
					X = 9 - Level
					Dist = Fix(C / 2 ^ X) * 256
					LN = (2 ^ X - 1) And C
					State = 3
					If LN = (2 ^ X - 1) Then  State = 2
				Else
					Call PutByte(144)
					State = 0
				End If
			Case 2
				LN += C
				State = 3
			Case 3
				Dist = Dist + (C + 1)
				LN += 3
				Do While LN
					Call PutByte(Udata.Data(Udata.Pos - Dist))
					LN -= 1
				Loop
				State = 0
			End Select
		Loop
		Return 0
	End Function

	Private Function GetBits(ByVal Numbits As Short) As Integer
		Dim NB As Short
		Dim Value As Integer
		If Numbits = 0 Then  Exit Function
		If Cdata.BitPos = 0 Then  Cdata.Pos += 1
		NB = 8 - Cdata.BitPos
		Value = Fix(Cdata.Data(Cdata.Pos) / (2 ^ Cdata.BitPos))
		Do While NB < Numbits
			Cdata.Pos += 1
			Value = Value + (Cdata.Data(Cdata.Pos) * (2 ^ NB))
			NB += 8
		Loop
		Cdata.BitPos = (Cdata.BitPos + Numbits) Mod 8
		Return Value And BitMask(Numbits)
	End Function

	Private Sub PutByte(ByVal [Char] As Byte)
		Udata.Data(Udata.Pos) = [Char]
		Udata.Pos += 1
	End Sub

End Module