Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - .NET

Страница: 1 |

 

  Вопрос: Сжатие Хаффмана в Visual Basic Net Добавлено: 29.10.08 01:46  

Автор вопроса:  Фeнягz | Web-сайт: atauenis.narod.ru
Кто знает, как корректно перевести это на vb net. Средство автоматического перевода vs2008 - не знает. А в vb6 работает просто отлично.

'Huffman Encoding/Decoding Class
'-------------------------------
'
'(c) 2000, Fredrik Qvarfort
'

Option Explicit

Private Type HUFFMANTREE
  ParentNode As Integer
  RightNode As Integer
  LeftNode As Integer
  Value As Integer
  Weight As Long
End Type

Private Type ByteArray
  Count As Byte
  Data() As Byte
End Type

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub CreateTree(Nodes() As HUFFMANTREE, NodesCount As Long, Char As Long, Bytes As ByteArray)

  Dim a As Integer
  Dim NodeIndex As Long
  
  NodeIndex = 0
  For a = 0 To (Bytes.Count - 1)
    If (Bytes.Data(a) = 0) Then
      'Left node
      If (Nodes(NodeIndex).LeftNode = -1) Then
        Nodes(NodeIndex).LeftNode = NodesCount
        Nodes(NodesCount).ParentNode = NodeIndex
        Nodes(NodesCount).LeftNode = -1
        Nodes(NodesCount).RightNode = -1
        Nodes(NodesCount).Value = -1
        NodesCount = NodesCount + 1
      End If
      NodeIndex = Nodes(NodeIndex).LeftNode
    ElseIf (Bytes.Data(a) = 1) Then
      'Right node
      If (Nodes(NodeIndex).RightNode = -1) Then
        Nodes(NodeIndex).RightNode = NodesCount
        Nodes(NodesCount).ParentNode = NodeIndex
        Nodes(NodesCount).LeftNode = -1
        Nodes(NodesCount).RightNode = -1
        Nodes(NodesCount).Value = -1
        NodesCount = NodesCount + 1
      End If
      NodeIndex = Nodes(NodeIndex).RightNode
    Else
      Stop
    End If
  Next
  
  Nodes(NodeIndex).Value = Char

End Sub
Public Sub EncodeByte(ByteArray() As Byte, ByteLen As Long)
  
  Dim i As Long
  Dim j As Long
  Dim Char As Byte
  Dim BitPos As Byte
  Dim lNode1 As Long
  Dim lNode2 As Long
  Dim lNodes As Long
  Dim lLength As Long
  Dim Count As Integer
  Dim lWeight1 As Long
  Dim lWeight2 As Long
  Dim Result() As Byte
  Dim ByteValue As Byte
  Dim ResultLen As Long
  Dim Bytes As ByteArray
  Dim NodesCount As Integer
  Dim BitValue(0 To 7) As Byte
  Dim CharCount(0 To 255) As Long
  Dim Nodes(0 To 511) As HUFFMANTREE
  Dim CharValue(0 To 255) As ByteArray
  
  'If the source string is empty or contains
  'only one character we return it uncompressed
  'with the prefix string "HEO" & vbCr
  If (ByteLen = 0) Then
    ReDim Preserve ByteArray(ByteLen + 3)
    If (ByteLen > 0) Then
      Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
    End If
    ByteArray(0) = 72 '"H"
    ByteArray(1) = 69 '"E"
    ByteArray(2) = 48 '"0"
    ByteArray(3) = 13 'vbCr
    Exit Sub
  End If
  
  'Create the temporary result array and make
  'space for identifier, checksum, textlen and
  'the ASCII values inside the Huffman Tree
  ReDim Result(0 To 522)
  
  'Prefix the destination string with the
  '"HE3" & vbCr identification string
  Result(0) = 72
  Result(1) = 69
  Result(2) = 51
  Result(3) = 13
  ResultLen = 4
  
  'Count the frequency of each ASCII code
  For i = 0 To (ByteLen - 1)
    CharCount(ByteArray(i)) = CharCount(ByteArray(i)) + 1
  Next
  
  'Create a leaf for each character
  For i = 0 To 255
    If (CharCount(i) > 0) Then
      With Nodes(NodesCount)
        .Weight = CharCount(i)
        .Value = i
        .LeftNode = -1
        .RightNode = -1
        .ParentNode = -1
      End With
      NodesCount = NodesCount + 1
    End If
  Next
  
  'Create the Huffman Tree
  For lNodes = NodesCount To 2 Step -1
    'Get the two leafs with the smallest weights
    lNode1 = -1: lNode2 = -1
    For i = 0 To (NodesCount - 1)
      If (Nodes(i).ParentNode = -1) Then
        If (lNode1 = -1) Then
          lWeight1 = Nodes(i).Weight
          lNode1 = i
        ElseIf (lNode2 = -1) Then
          lWeight2 = Nodes(i).Weight
          lNode2 = i
        ElseIf (Nodes(i).Weight < lWeight1) Then
          If (Nodes(i).Weight < lWeight2) Then
            If (lWeight1 < lWeight2) Then
              lWeight2 = Nodes(i).Weight
              lNode2 = i
            Else
              lWeight1 = Nodes(i).Weight
              lNode1 = i
            End If
          Else
            lWeight1 = Nodes(i).Weight
            lNode1 = i
          End If
        ElseIf (Nodes(i).Weight < lWeight2) Then
          lWeight2 = Nodes(i).Weight
          lNode2 = i
        End If
      End If
    Next
    
    'Create a new leaf
    With Nodes(NodesCount)
      .Weight = lWeight1 + lWeight2
      .LeftNode = lNode1
      .RightNode = lNode2
      .ParentNode = -1
      .Value = -1
    End With
    
    'Set the parentnodes of the two leafs
    Nodes(lNode1).ParentNode = NodesCount
    Nodes(lNode2).ParentNode = NodesCount
    
    'Increase the node counter
    NodesCount = NodesCount + 1
  Next

  'Traverse the tree to get the bit sequence
  'for each character, make temporary room in
  'the data array to hold max theoretical size
  ReDim Bytes.Data(0 To 255)
  Call CreateBitSequences(Nodes(), NodesCount - 1, Bytes, CharValue)
  
  'Calculate the length of the destination
  'string after encoding
  For i = 0 To 255
    If (CharCount(i) > 0) Then
      lLength = lLength + CharValue(i).Count * CharCount(i)
    End If
  Next
  lLength = IIf(lLength Mod 8 = 0, lLength \ 8, lLength \ 8 + 1)
  
  'If the destination is larger than the source
  'string we leave it uncompressed and prefix
  'it with a 4 byte header ("HE0" & vbCr)
  If ((lLength = 0) Or (lLength > ByteLen)) Then
    Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
    ByteArray(0) = 72
    ByteArray(1) = 69
    ByteArray(2) = 48
    ByteArray(3) = 13
    Exit Sub
  End If
  
  'Add a simple checksum value to the result
  'header for corruption identification
  Char = 0
  For i = 0 To (ByteLen - 1)
    Char = Char Xor ByteArray(i)
  Next
  Result(ResultLen) = Char
  ResultLen = ResultLen + 1
  
  'Add the length of the source string to the
  'header for corruption identification
  Call CopyMem(Result(ResultLen), ByteLen, 4)
  ResultLen = ResultLen + 4
  
  'Create a small array to hold the bit values,
  'this is faster than calculating on-fly
  For i = 0 To 7
    BitValue(i) = 2 ^ i
  Next
  
  'Store the number of characters used
  Count = 0
  For i = 0 To 255
    If (CharValue(i).Count > 0) Then
      Count = Count + 1
    End If
  Next
  Call CopyMem(Result(ResultLen), Count, 2)
  ResultLen = ResultLen + 2
  
  'Store the used characters and the length
  'of their respective bit sequences
  Count = 0
  For i = 0 To 255
    If (CharValue(i).Count > 0) Then
      Result(ResultLen) = i
      ResultLen = ResultLen + 1
      Result(ResultLen) = CharValue(i).Count
      ResultLen = ResultLen + 1
      Count = Count + 16 + CharValue(i).Count
    End If
  Next
  
  'Make room for the Huffman Tree in the
  'destination byte array
  ReDim Preserve Result(ResultLen + Count \ 8)
  
  'Store the Huffman Tree into the result
  'converting the bit sequences into bytes
  BitPos = 0
  ByteValue = 0
  For i = 0 To 255
    With CharValue(i)
      If (.Count > 0) Then
        For j = 0 To (.Count - 1)
          If (.Data(j)) Then ByteValue = ByteValue + BitValue(BitPos)
          BitPos = BitPos + 1
          If (BitPos = 8) Then
            Result(ResultLen) = ByteValue
            ResultLen = ResultLen + 1
            ByteValue = 0
            BitPos = 0
          End If
        Next
      End If
    End With
  Next
  If (BitPos > 0) Then
    Result(ResultLen) = ByteValue
    ResultLen = ResultLen + 1
  End If
  
  'Resize the destination string to be able to
  'contain the encoded string
  ReDim Preserve Result(ResultLen - 1 + lLength)
  
  'Now we can encode the data by exchanging each
  'ASCII byte for its appropriate bit string.
  Char = 0
  BitPos = 0
  For i = 0 To (ByteLen - 1)
    With CharValue(ByteArray(i))
      For j = 0 To (.Count - 1)
        If (.Data(j) = 1) Then Char = Char + BitValue(BitPos)
        BitPos = BitPos + 1
        If (BitPos = 8) Then
          Result(ResultLen) = Char
          ResultLen = ResultLen + 1
          BitPos = 0
          Char = 0
        End If
      Next
    End With
  Next

  'Add the last byte
  If (BitPos > 0) Then
    Result(ResultLen) = Char
    ResultLen = ResultLen + 1
  End If
  
  'Return the destination in string format
  ReDim ByteArray(ResultLen - 1)
  Call CopyMem(ByteArray(0), Result(0), ResultLen)

End Sub

Public Function DecodeByte(ByteArray() As Byte, ByteLen As Long)
  
  Dim i As Long
  Dim j As Long
  Dim Pos As Long
  Dim Char As Byte
  Dim CurrPos As Long
  Dim Count As Integer
  Dim CheckSum As Byte
  Dim Result() As Byte
  Dim BitPos As Integer
  Dim NodeIndex As Long
  Dim ByteValue As Byte
  Dim ResultLen As Long
  Dim NodesCount As Long
  Dim lResultLen As Long
  Dim BitValue(0 To 7) As Byte
  Dim Nodes(0 To 511) As HUFFMANTREE
  Dim CharValue(0 To 255) As ByteArray
  
  If (ByteArray(0) <> 72) Or (ByteArray(1) <> 69) Or (ByteArray(3) <> 13) Then
    'The source did not contain the identification
    'string "HE?" & vbCr where ? is undefined at
    'the moment (does not matter)
  ElseIf (ByteArray(2) = 48) Then
    'The text is uncompressed, return the substring
    'Decode = Mid$(Text, 5)
    Call CopyMem(ByteArray(0), ByteArray(4), ByteLen - 4)
    ReDim Preserve ByteArray(ByteLen - 5)
    Exit Function
  ElseIf (ByteArray(2) <> 51) Then
    'This is not a Huffman encoded string
    Err.Raise vbObjectError, "HuffmanDecode()", "The data either was not compressed with HE3 or is corrupt (identification string not found)"
    Exit Function
  End If
  
  CurrPos = 5
    
  'Extract the checksum
  CheckSum = ByteArray(CurrPos - 1)
  CurrPos = CurrPos + 1
  
  'Extract the length of the original string
  Call CopyMem(ResultLen, ByteArray(CurrPos - 1), 4)
  CurrPos = CurrPos + 4
  lResultLen = ResultLen
  
  'If the compressed string is empty we can
  'skip the function right here
  If (ResultLen = 0) Then Exit Function
  
  'Create the result array
  ReDim Result(ResultLen - 1)
  
  'Get the number of characters used
  Call CopyMem(Count, ByteArray(CurrPos - 1), 2)
  CurrPos = CurrPos + 2
  
  'Get the used characters and their
  'respective bit sequence lengths
  For i = 1 To Count
    With CharValue(ByteArray(CurrPos - 1))
      CurrPos = CurrPos + 1
      .Count = ByteArray(CurrPos - 1)
      CurrPos = CurrPos + 1
      ReDim .Data(.Count - 1)
    End With
  Next
  
  'Create a small array to hold the bit values,
  'this is (still) faster than calculating on-fly
  For i = 0 To 7
    BitValue(i) = 2 ^ i
  Next
  
  'Extract the Huffman Tree, converting the
  'byte sequence to bit sequences
  ByteValue = ByteArray(CurrPos - 1)
  CurrPos = CurrPos + 1
  BitPos = 0
  For i = 0 To 255
    With CharValue(i)
      If (.Count > 0) Then
        For j = 0 To (.Count - 1)
          If (ByteValue And BitValue(BitPos)) Then .Data(j) = 1
          BitPos = BitPos + 1
          If (BitPos = 8) Then
            ByteValue = ByteArray(CurrPos - 1)
            CurrPos = CurrPos + 1
            BitPos = 0
          End If
        Next
      End If
    End With
  Next
  If (BitPos = 0) Then CurrPos = CurrPos - 1
  
  'Create the Huffman Tree
  NodesCount = 1
  Nodes(0).LeftNode = -1
  Nodes(0).RightNode = -1
  Nodes(0).ParentNode = -1
  Nodes(0).Value = -1
  For i = 0 To 255
    Call CreateTree(Nodes(), NodesCount, i, CharValue(i))
  Next
  
  'Decode the actual data
  ResultLen = 0
  For CurrPos = CurrPos To ByteLen
    ByteValue = ByteArray(CurrPos - 1)
    For BitPos = 0 To 7
      If (ByteValue And BitValue(BitPos)) Then
        NodeIndex = Nodes(NodeIndex).RightNode
      Else
        NodeIndex = Nodes(NodeIndex).LeftNode
      End If
      If (Nodes(NodeIndex).Value > -1) Then
        Result(ResultLen) = Nodes(NodeIndex).Value
        ResultLen = ResultLen + 1
        If (ResultLen = lResultLen) Then GoTo DecodeFinished
        NodeIndex = 0
      End If
    Next
  Next
DecodeFinished:

  'Verify data to check for corruption.
  Char = 0
  For i = 0 To (ResultLen - 1)
    Char = Char Xor Result(i)
  Next
  If (Char <> CheckSum) Then
    Err.Raise vbObjectError, "clsHuffman.Decode()", "The data might be corrupted (checksum did not match expected value)"
  End If

  'Return the uncompressed string
  ReDim ByteArray(ResultLen - 1)
  Call CopyMem(ByteArray(0), Result(0), ResultLen - 1)
  
End Function
Private Sub CreateBitSequences(Nodes() As HUFFMANTREE, ByVal NodeIndex As Integer, Bytes As ByteArray, CharValue() As ByteArray)

  Dim NewBytes As ByteArray
  
  'If this is a leaf we set the characters bit
  'sequence in the CharValue array
  If (Nodes(NodeIndex).Value > -1) Then
    CharValue(Nodes(NodeIndex).Value) = Bytes
    Exit Sub
  End If
  
  'Traverse the left child
  If (Nodes(NodeIndex).LeftNode > -1) Then
    NewBytes = Bytes
    NewBytes.Data(NewBytes.Count) = 0
    NewBytes.Count = NewBytes.Count + 1
    Call CreateBitSequences(Nodes(), Nodes(NodeIndex).LeftNode, NewBytes, CharValue)
  End If
  
  'Traverse the right child
  If (Nodes(NodeIndex).RightNode > -1) Then
    NewBytes = Bytes
    NewBytes.Data(NewBytes.Count) = 1
    NewBytes.Count = NewBytes.Count + 1
    Call CreateBitSequences(Nodes(), Nodes(NodeIndex).RightNode, NewBytes, CharValue)
  End If
  
End Sub

Ответить

  Ответы Всего ответов: 7  

Номер ответа: 1
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
  Профиль | | #1 Добавлено: 29.10.08 03:01
http://www.codeproject.com/info/search.aspx?artkw=Huffman

Ответить

Номер ответа: 2
Автор ответа:
 Фeнягz



Вопросов: 2
Ответов: 62
  Web-сайт: atauenis.narod.ru
 Профиль | | #2 		Добавлено: 29.10.08 07:34
Там кстати c\++\# реализации, а нужна на vb net.

Есть одна, но ориентирована на xml-данные, и реализована с точки зрения скорости не лучшим образом. Даже в среде vb6 приведенный пример намного шустрее.

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=3900&lngWId=10

Ответить

Номер ответа: 3
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
  Профиль | | #3 Добавлено: 29.10.08 08:17
ЯЯЯ пишет:
Там кстати c\++\# реализации, а нужна на vb net.

Ну а кто мешает скомпилировать библитоеку и подключить ее к существующему VB .NET проекту?

Ответить

Номер ответа: 4
Автор ответа:
 Фeнягz



Вопросов: 2
Ответов: 62
  Web-сайт: atauenis.narod.ru
 Профиль | | #4 		Добавлено: 29.10.08 09:00
Замысел мешаетю Не будет же моя библиотека таскать за собой какието левые DLL. Ну, разве что, Net Framework.

Ладно, переведу - отпишусь.

Ответить

Номер ответа: 5
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
  Профиль | | #5 Добавлено: 29.10.08 09:35
Перевести код с C# на VB .NET будет гораздо проще чем с VB6 на VB .NET

Ответить

Номер ответа: 6
Автор ответа:
 Фeнягz



Вопросов: 2
Ответов: 62
  Web-сайт: atauenis.narod.ru
 Профиль | | #6 		Добавлено: 30.10.08 01:32
Уже позно. C# отдыхает. :D

Сам vb6 исходник взят отсюда

http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=11000&lngWId=1

ПРИМЕР ТЕСТОВОЙ VBNET ПРОГРАММЫ

  1. Private Sub btnCompress_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCompress.Click
  2.    Dim stmin As New IO.FileStream("c:\1.txt", IO.FileMode.Open, IO.FileAccess.Read)
  3.    Dim stmout As New IO.FileStream("c:\2.txt", IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
  4.    Dim hc As New HuffmanCompressor(stmin, stmout)
  5.    Call hc.Compress()
  6.    stmin.Close()
  7.    stmout.Close()
  8.    Beep()
  9. End Sub
  10.  
  11. Private Sub btnDecompress_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDecompress.Click
  12.    Dim stmin As New IO.FileStream("c:\2.txt", IO.FileMode.Open, IO.FileAccess.Read)
  13.    Dim stmout As New IO.FileStream("c:\3.txt", IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
  14.    Dim hc As New HuffmanCompressor(stmin, stmout)
  15.    Call hc.Decompress()
  16.    stmin.Close()
  17.    stmout.Close()
  18.    Beep()
  19. End Sub


ПЕРЕВОД

  1. 'vb6 Static Huffman Encoding/Decoding Class
  2. '-------------------------------
  3. '(c) 2000, Fredrik Qvarfort
  4.  
  5. 'vb9 translating by Igor Ananyev (c) 2008
  6.  
  7. Option Explicit On
  8. Option Infer On
  9. Option Strict Off
  10.  
  11. ' Сжатие-распаковка по Хаффману со статическим источником
  12.  
  13. Public Class HuffmanCompressor
  14.  
  15. Private Structure HuffmanTree
  16.    Dim ParentNode As Int16
  17.    Dim RightNode As Int16
  18.    Dim LeftNode As Int16
  19.    Dim Value As Int16
  20.    Dim Weight As Int32
  21. End Structure
  22.  
  23. Private Structure ByteArray
  24.    Dim Count As Byte  
  25.    Dim Data() As Byte
  26. End Structure
  27.  
  28. Private instream As IO.Stream
  29. Private outstream As IO.Stream
  30.  
  31. Public Sub New(ByRef [in] As IO.Stream, ByRef out As IO.Stream)
  32.    MyBase.New()
  33.    Me.instream = [in]
  34.    Me.outstream = out
  35. End Sub
  36.  
  37.  
  38. Public Sub Compress()
  39.  
  40.   Dim i As Int32
  41.   Dim j As Int32
  42.   Dim Value As Byte
  43.   Dim BitPos As Byte
  44.   Dim lNode1 As Int32
  45.   Dim lNode2 As Int32
  46.   Dim lNodes As Int32
  47.   Dim lLength As Int32
  48.   Dim Count As Int16
  49.   Dim lWeight1 As Int32
  50.   Dim lWeight2 As Int32
  51.   Dim Result() As Byte
  52.   Dim ByteValue As Byte
  53.   Dim ResultLen As UInt32
  54.   Dim Bytes As ByteArray
  55.   Dim NodesCount As Int16
  56.   Dim BitValue(0 To 7) As Byte
  57.   Dim ValueCount(0 To 255) As Int16
  58.   Dim Nodes(0 To 511) As HuffmanTree
  59.   Dim Values(0 To 255) As ByteArray
  60.   Dim ByteLen As UInt32
  61.   Dim ByteArray() As Byte
  62.  
  63.   ByteLen = instream.Length
  64.   ReDim ByteArray(ByteLen - 1)
  65.   Call instream.Seek(0, IO.SeekOrigin.Begin)
  66.   Call instream.Read(ByteArray, 0, ByteLen)
  67.  
  68.   'If the source string is empty or contains
  69.   'only one character we return it uncompressed
  70.   'with the prefix string "HEO" & vbCr
  71.   If (ByteLen <= 1) Then
  72.     ReDim Preserve ByteArray(ByteLen + 3)
  73.     If (ByteLen > 0) Then
  74.       ByteArray(4) = ByteArray(0)
  75.       'Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
  76.     End If
  77.     ByteArray(0) = 72 '"H"
  78.     ByteArray(1) = 69 '"E"
  79.     ByteArray(2) = 48 '"0"
  80.     ByteArray(3) = 13 'vbCr
  81.     Exit Sub
  82.   End If
  83.  
  84.   'Create the temporary result array and make
  85.   'space for identifier, checksum, textlen and
  86.   'the ASCII values inside the Huffman Tree
  87.   ReDim Result(0 To 522)
  88.  
  89.   'Prefix the destination string with the
  90.   '"HE3" & vbCr identification string
  91.   Result(0) = 72
  92.   Result(1) = 69
  93.   Result(2) = 51
  94.   Result(3) = 13
  95.   ResultLen = 4
  96.  
  97.   'Count the frequency of each ASCII code
  98.   For i = 0 To (ByteLen - 1)
  99.     ValueCount(ByteArray(i)) += 1
  100.   Next
  101.  
  102.   'Create a leaf for each character
  103.   For i = 0 To 255
  104.     If (ValueCount(i) > 0) Then
  105.       With Nodes(NodesCount)
  106.         .Weight = ValueCount(i)
  107.         .Value = i
  108.         .LeftNode = -1
  109.         .RightNode = -1
  110.         .ParentNode = -1
  111.       End With
  112.       NodesCount += 1
  113.     End If
  114.   Next
  115.  
  116.   'Create the Huffman Tree
  117.   For lNodes = NodesCount To 2 Step -1
  118.     'Get the two leafs with the smallest weights
  119.     lNode1 = -1 : lNode2 = -1
  120.     For i = 0 To (NodesCount - 1)
  121.       If (Nodes(i).ParentNode = -1) Then
  122.         If (lNode1 = -1) Then
  123.           lWeight1 = Nodes(i).Weight
  124.           lNode1 = i
  125.         ElseIf (lNode2 = -1) Then
  126.           lWeight2 = Nodes(i).Weight
  127.           lNode2 = i
  128.         ElseIf (Nodes(i).Weight < lWeight1) Then
  129.           If (Nodes(i).Weight < lWeight2) Then
  130.             If (lWeight1 < lWeight2) Then
  131.               lWeight2 = Nodes(i).Weight
  132.               lNode2 = i
  133.             Else
  134.               lWeight1 = Nodes(i).Weight
  135.               lNode1 = i
  136.             End If
  137.           Else
  138.             lWeight1 = Nodes(i).Weight
  139.             lNode1 = i
  140.           End If
  141.         ElseIf (Nodes(i).Weight < lWeight2) Then
  142.           lWeight2 = Nodes(i).Weight
  143.           lNode2 = i
  144.         End If
  145.       End If
  146.     Next
  147.  
  148.     'Create a new leaf
  149.     With Nodes(NodesCount)
  150.       .Weight = lWeight1 + lWeight2
  151.       .LeftNode = lNode1
  152.       .RightNode = lNode2
  153.       .ParentNode = -1
  154.       .Value = -1
  155.     End With
  156.  
  157.     'Set the parentnodes of the two leafs
  158.     Nodes(lNode1).ParentNode = NodesCount
  159.     Nodes(lNode2).ParentNode = NodesCount
  160.  
  161.     'Increase the node counter
  162.     NodesCount += 1
  163.   Next
  164.  
  165.   'Traverse the tree to get the bit sequence
  166.   'for each character, make temporary room in
  167.   'the data array to hold max theoretical size
  168.   ReDim Bytes.Data(0 To 255)
  169.   Call CreateBitSequences(Nodes, NodesCount - 1, Bytes, Values)
  170.  
  171.   'Calculate the length of the destination
  172.   'string after encoding
  173.   For i = 0 To 255
  174.     If (ValueCount(i) > 0) Then
  175.       lLength = lLength + Values(i).Count * ValueCount(i)
  176.     End If
  177.   Next
  178.   lLength = IIf(lLength Mod 8 = 0, lLength \ 8, lLength \ 8 + 1)
  179.  
  180.   'If the destination is larger than the source
  181.   'string we leave it uncompressed and prefix
  182.   'it with a 4 byte header ("HE0" & vbCr)
  183.   If ((lLength = 0) OrElse (lLength > ByteLen)) Then
  184.     ReDim Preserve ByteArray(ByteLen + 3)
  185.     Call Array.Copy(ByteArray, 0, ByteArray, 4, ByteLen)
  186.     'Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
  187.     ByteArray(0) = 72
  188.     ByteArray(1) = 69
  189.     ByteArray(2) = 48
  190.     ByteArray(3) = 13
  191.     Exit Sub
  192.   End If
  193.  
  194.   'Add a simple checksum value to the result
  195.   'header for corruption identification
  196.   Value = 0
  197.   For i = 0 To (ByteLen - 1)
  198.     Value = Value Xor ByteArray(i)
  199.   Next
  200.   Result(ResultLen) = Value
  201.   ResultLen += 1
  202.  
  203.   'Add the length of the source string to the
  204.   'header for corruption identification
  205.  
  206.   ' 4 байта (UInt32)
  207.   Call Array.Copy(BitConverter.GetBytes(ByteLen), 0, Result, ResultLen, 4)
  208.   'Call CopyMem(Result(ResultLen), ByteLen, 4)
  209.   ResultLen += 4
  210.  
  211.   'Create a small array to hold the bit values,
  212.   'this is faster than calculating on-fly
  213.   For i = 0 To 7
  214.     BitValue(i) = 2 ^ i
  215.   Next
  216.  
  217.   'Store the number of characters used
  218.   Count = 0
  219.   For i = 0 To 255
  220.     If (Values(i).Count > 0) Then
  221.       Count += 1
  222.     End If
  223.   Next
  224.  
  225.   ' 2 байта (Int16)
  226.   Call Array.Copy(BitConverter.GetBytes(Count), 0, Result, ResultLen, 2)
  227.   'Call CopyMem(Result(ResultLen), Count, 2)
  228.   ResultLen += 2
  229.  
  230.   'Store the used characters and the length
  231.   'of their respective bit sequences
  232.   Count = 0
  233.   For i = 0 To 255
  234.     If (Values(i).Count > 0) Then
  235.       Result(ResultLen) = i
  236.       ResultLen += 1
  237.       Result(ResultLen) = Values(i).Count
  238.       ResultLen += 1
  239.       Count += (16 + Values(i).Count)
  240.     End If
  241.   Next
  242.  
  243.   'Make room for the Huffman Tree in the
  244.   'destination byte array
  245.   ReDim Preserve Result(ResultLen + Count \ 8)
  246.  
  247.   'Store the Huffman Tree into the result
  248.   'converting the bit sequences into bytes
  249.   BitPos = 0
  250.   ByteValue = 0
  251.   For i = 0 To 255
  252.     With Values(i)
  253.       If (.Count > 0) Then
  254.         For j = 0 To (.Count - 1)
  255.           If (.Data(j)) Then ByteValue = ByteValue + BitValue(BitPos)
  256.           BitPos += 1
  257.           If (BitPos = 8) Then
  258.             Result(ResultLen) = ByteValue
  259.             ResultLen += 1
  260.             ByteValue = 0
  261.             BitPos = 0
  262.           End If
  263.         Next
  264.       End If
  265.     End With
  266.   Next
  267.   If (BitPos > 0) Then
  268.     Result(ResultLen) = ByteValue
  269.     ResultLen += 1
  270.   End If
  271.  
  272.   'Resize the destination string to be able to
  273.   'contain the encoded string
  274.   ReDim Preserve Result(ResultLen - 1 + lLength)
  275.  
  276.   'Now we can encode the data by exchanging each
  277.   'ASCII byte for its appropriate bit string.
  278.   Value = 0
  279.   BitPos = 0
  280.   For i = 0 To (ByteLen - 1)
  281.     With Values(ByteArray(i))
  282.       For j = 0 To (.Count - 1)
  283.         If (.Data(j) = 1) Then Value = Value + BitValue(BitPos)
  284.         BitPos += 1
  285.         If (BitPos = 8) Then
  286.           Result(ResultLen) = Value
  287.           ResultLen += 1
  288.           BitPos = 0
  289.           Value = 0
  290.         End If
  291.       Next
  292.     End With
  293.   Next
  294.  
  295.   'Add the last byte
  296.   If (BitPos > 0) Then
  297.     Result(ResultLen) = Value
  298.     ResultLen += 1
  299.   End If
  300.  
  301.   'Return the destination in string format
  302.   'ReDim ByteArray(ResultLen - 1)
  303.  
  304.   'Call Array.Copy(Result, 0, ByteArray, 0, ResultLen)
  305.   'Call CopyMem(ByteArray(0), Result(0), ResultLen)
  306.  
  307.   Call outstream.Write(Result, 0, ResultLen)
  308.  
  309. End Sub
  310.  
  311.  
  312. Public Sub Decompress()
  313.  
  314.   Dim i As Int32
  315.   Dim j As Int32
  316.   Dim Value As Byte
  317.   Dim CurrPos As Int32
  318.   Dim Count As Int16
  319.   Dim CheckSum As Byte
  320.   Dim Result() As Byte
  321.   Dim BitPos As Int16
  322.   Dim NodeIndex As Int32
  323.   Dim ByteValue As Byte
  324.   Dim ResultLen As UInt32
  325.   Dim NodesCount As Int32
  326.   Dim lResultLen As Int32
  327.   Dim BitValue(0 To 7) As Byte
  328.   Dim Nodes(0 To 511) As HuffmanTree
  329.   Dim Values(0 To 255) As ByteArray
  330.  
  331.   Dim ByteLen As UInt32
  332.   Dim ByteArray() As Byte
  333.  
  334.   ByteLen = instream.Length
  335.   ReDim ByteArray(ByteLen - 1)
  336.   Call instream.Seek(0, IO.SeekOrigin.Begin)
  337.   Call instream.Read(ByteArray, 0, ByteLen)
  338.  
  339.  
  340.   If (ByteArray(0) <> 72) Or (ByteArray(1) <> 69) Or (ByteArray(3) <> 13) Then
  341.     'The source did not contain the identification
  342.     'string "HE?" & vbCr where ? is undefined at
  343.     'the moment (does not matter)
  344.   ElseIf (ByteArray(2) = 48) Then
  345.     'The text is uncompressed, return the substring
  346.     'Decode = Mid$(Text, 5)
  347.  
  348.     Call Array.Copy(ByteArray, 4, ByteArray, 0, ByteLen - 4)
  349.     'Call CopyMem(ByteArray(0), ByteArray(4), ByteLen - 4)
  350.     ReDim Preserve ByteArray(0 To ByteLen - 5)
  351.     Exit Sub
  352.   ElseIf (ByteArray(2) <> 51) Then
  353.     'This is not a Huffman encoded string
  354.     Throw New Exception("HuffmanDecompress(), The data either was not compressed with HE3 or is corrupt (identification string not found)")
  355.     'Err.Raise(vbObjectError, "HuffmanDecode()", "The data either was not compressed with HE3 or is corrupt (identification string not found)")
  356.     Exit Sub
  357.   End If
  358.  
  359.   CurrPos = 5
  360.  
  361.   'Extract the checksum
  362.   CheckSum = ByteArray(CurrPos - 1)
  363.   CurrPos += 1
  364.  
  365.   'Extract the length of the original string
  366.  
  367.   ResultLen = BitConverter.ToUInt32(ByteArray, CurrPos - 1)
  368.   'Call CopyMem(ResultLen, ByteArray(CurrPos - 1), 4)
  369.   CurrPos += 4
  370.   lResultLen = ResultLen
  371.  
  372.   'If the compressed string is empty we can
  373.   'skip the function right here
  374.   If (ResultLen = 0) Then Exit Sub
  375.  
  376.   'Create the result array
  377.   ReDim Result(0 To ResultLen - 1)
  378.  
  379.   'Get the number of characters used
  380.  
  381.   Count = BitConverter.ToInt16(ByteArray, CurrPos - 1)
  382.   'Call CopyMem(Count, ByteArray(CurrPos - 1), 2)
  383.   CurrPos += 2
  384.  
  385.   'Get the used characters and their
  386.   'respective bit sequence lengths
  387.   For i = 1 To Count
  388.     With Values(ByteArray(CurrPos - 1))
  389.       CurrPos += 1
  390.       .Count = ByteArray(CurrPos - 1)
  391.       CurrPos += 1
  392.       ReDim .Data(0 To .Count - 1)
  393.     End With
  394.   Next
  395.  
  396.   'Create a small array to hold the bit values,
  397.   'this is (still) faster than calculating on-fly
  398.   For i = 0 To 7
  399.     BitValue(i) = 2 ^ i
  400.   Next
  401.  
  402.   'Extract the Huffman Tree, converting the
  403.   'byte sequence to bit sequences
  404.   ByteValue = ByteArray(CurrPos - 1)
  405.   CurrPos += 1
  406.   BitPos = 0
  407.   For i = 0 To 255
  408.     With Values(i)
  409.       If (.Count > 0) Then
  410.         For j = 0 To (.Count - 1)
  411.           If (ByteValue And BitValue(BitPos)) Then .Data(j) = 1
  412.           BitPos += 1
  413.           If (BitPos = 8) Then
  414.             ByteValue = ByteArray(CurrPos - 1)
  415.             CurrPos += 1
  416.             BitPos = 0
  417.           End If
  418.         Next
  419.       End If
  420.     End With
  421.   Next
  422.   If (BitPos = 0) Then CurrPos -= 1
  423.  
  424.   'Create the Huffman Tree
  425.   NodesCount = 1
  426.   Nodes(0).LeftNode = -1
  427.   Nodes(0).RightNode = -1
  428.   Nodes(0).ParentNode = -1
  429.   Nodes(0).Value = -1
  430.   For i = 0 To 255
  431.     Call CreateTree(Nodes, NodesCount, i, Values(i))
  432.   Next
  433.  
  434.   'Decode the actual data
  435.   ResultLen = 0
  436.   For CurrPos = CurrPos To ByteLen
  437.     ByteValue = ByteArray(CurrPos - 1)
  438.     For BitPos = 0 To 7
  439.       If (ByteValue And BitValue(BitPos)) Then
  440.         NodeIndex = Nodes(NodeIndex).RightNode
  441.       Else
  442.         NodeIndex = Nodes(NodeIndex).LeftNode
  443.       End If
  444.       If (Nodes(NodeIndex).Value > -1) Then
  445.         Result(ResultLen) = Nodes(NodeIndex).Value
  446.         ResultLen += 1
  447.         If (ResultLen = lResultLen) Then GoTo DecodeFinished
  448.         NodeIndex = 0
  449.       End If
  450.     Next
  451.   Next
  452. DecodeFinished:
  453.  
  454.   'Verify data to check for corruption.
  455.   Value = 0
  456.   For i = 0 To (ResultLen - 1)
  457.     Value = Value Xor Result(i)
  458.   Next
  459.   If (Value <> CheckSum) Then
  460.      Throw New Exception("clsHuffman.Decompress(), The data might be corrupted (checksum did not match expected value)")
  461.     'Err.Raise(vbObjectError, "clsHuffman.Decode()", "The data might be corrupted (checksum did not match expected value)")
  462.   End If
  463.  
  464.   'Return the uncompressed string
  465.   'ReDim ByteArray(0 To ResultLen - 1)
  466.  
  467.   'Call Array.Copy(Result, 0, ByteArray, 0, ResultLen)
  468.   'Call CopyMem(ByteArray(0), Result(0), ResultLen)
  469.  
  470.   Call outstream.Write(Result, 0, ResultLen)
  471.  
  472. End Sub
  473.  
  474.  
  475. Private Sub CreateTree(ByRef Nodes As HuffmanTree(), ByRef NodesCount As Int32, ByRef Value As Int32, ByRef Bytes As ByteArray)
  476.  
  477.   Dim NodeIndex As Int32 = 0
  478.  
  479.   For a As Int16 = 0 To (Bytes.Count - 1)
  480.     If (Bytes.Data(a) = 0) Then
  481.       'Left node
  482.       If (Nodes(NodeIndex).LeftNode = -1) Then
  483.         Nodes(NodeIndex).LeftNode = NodesCount
  484.         Nodes(NodesCount).ParentNode = NodeIndex
  485.         Nodes(NodesCount).LeftNode = -1
  486.         Nodes(NodesCount).RightNode = -1
  487.         Nodes(NodesCount).Value = -1
  488.         NodesCount += 1
  489.       End If
  490.       NodeIndex = Nodes(NodeIndex).LeftNode
  491.     ElseIf (Bytes.Data(a) = 1) Then
  492.       'Right node
  493.       If (Nodes(NodeIndex).RightNode = -1) Then
  494.         Nodes(NodeIndex).RightNode = NodesCount
  495.         Nodes(NodesCount).ParentNode = NodeIndex
  496.         Nodes(NodesCount).LeftNode = -1
  497.         Nodes(NodesCount).RightNode = -1
  498.         Nodes(NodesCount).Value = -1
  499.         NodesCount += 1
  500.       End If
  501.       NodeIndex = Nodes(NodeIndex).RightNode
  502.     Else
  503.       Stop
  504.     End If
  505.   Next
  506.  
  507.   Nodes(NodeIndex).Value = Value
  508.  
  509. End Sub
  510.  
  511. Private Sub CreateBitSequences(ByRef Nodes As HuffmanTree(), ByVal NodeIndex As Int16, ByRef Bytes As ByteArray, ByRef Values As ByteArray())
  512.  
  513.   Dim NewBytes As ByteArray
  514.  
  515.   'If this is a leaf we set the characters bit
  516.   'sequence in the CharValue array
  517.   If (Nodes(NodeIndex).Value > -1) Then
  518.     Values(Nodes(NodeIndex).Value) = New ByteArray
  519.     Values(Nodes(NodeIndex).Value).Count = Bytes.Count
  520.     Values(Nodes(NodeIndex).Value).Data = Bytes.Data.Clone
  521.     Exit Sub
  522.   End If
  523.  
  524.   'Traverse the left child
  525.   If (Nodes(NodeIndex).LeftNode > -1) Then
  526.     'NewBytes = Bytes ' - не годится!
  527.     NewBytes.Count = Bytes.Count
  528.     NewBytes.Data = Bytes.Data.Clone ' обязательно! (в vb6 массивы структурного типа, в net - ссылочного)
  529.     NewBytes.Data(NewBytes.Count) = 0
  530.     NewBytes.Count += 1
  531.     Call CreateBitSequences(Nodes, Nodes(NodeIndex).LeftNode, NewBytes, Values)
  532.   End If
  533.  
  534.   'Traverse the right child
  535.   If (Nodes(NodeIndex).RightNode > -1) Then
  536.  
  537.     'NewBytes = Bytes ' - не годится!
  538.     NewBytes.Count = Bytes.Count
  539.     NewBytes.Data = Bytes.Data.Clone ' обязательно! (в vb6 массивы структурного типа, в net - ссылочного)
  540.  
  541.     NewBytes.Data(NewBytes.Count) = 1
  542.     NewBytes.Count += 1
  543.     Call CreateBitSequences(Nodes, Nodes(NodeIndex).RightNode, NewBytes, Values)
  544.   End If
  545.  
  546. End Sub
  547.  
  548.  
  549. End Class

Ответить

Номер ответа: 7
Автор ответа:
 Фeнягz



Вопросов: 2
Ответов: 62
  Web-сайт: atauenis.narod.ru
 Профиль | | #7 		Добавлено: 30.10.08 02:47
БАГГИ

За строками #80 и #190 добавить

  1. outstream.write(ByteArray, 0, ByteArray.Length)


Случаи если менее двух символов (#80), или сжатые данные превышают несжатые (#190).

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам