dcsimg
Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Advanced
Jan 1, 2003

WEBINAR:

On-Demand

Building the Right Environment to Support AI, Machine Learning and Deep Learning


RLEUncompress - Uncompress data compressed using RLECompress

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal Bytes As Long)


' Uncompress a block of data compressed with RLECompress
'
' Returns TRUE if successful (this version either returns True or raises an 
' error)
'
' ADDRESS points to the buffer that holds the compressed data
'      use StrPtr(s) if it's a string, VarPtr(arr(0)) if it's an array
' BYTES is the size of the compressed data
'      use LenB(s) if it's a string, N * LenB(arr(0)) if it's an array
' OUTBUFFER is an array of bytes that will receive the uncompressed data

Function RLEUncompress(ByVal address As Long, ByVal Bytes As Long, _
    outBuffer() As Byte) As Boolean
    Dim ItemSize As Integer
    Dim outBytes As Long
    Dim inIndex As Long
    Dim outIndex As Long
    Dim i As Long
    Dim prevValue As Currency
    Dim currValue As Currency
    Dim matchCount As Integer
    
    ' get the signature, exit if not matching
    CopyMemory ItemSize, ByVal address, 2
    If ItemSize <> &HABCD Then
        Err.Raise 5, , "This hasn't been compressed with RLECompress"
    End If
    ' get ItemSize, exit if invalid
    CopyMemory ItemSize, ByVal address + 2, 2
    If ItemSize <> 1 And ItemSize <> 2 And ItemSize <> 4 And ItemSize <> 8 Then
        Err.Raise 5, , "Wrong value for ItemSize"
    End If
    ' get the length of the uncompressed data
    CopyMemory outBytes, ByVal address + 4, 4
    
    ' prepare the output buffer
    ReDim outBuffer(0 To outBytes - 1) As Byte
    
    ' get the first value
    CopyMemory prevValue, ByVal address + 8, ItemSize
    address = address + 8 + ItemSize
    ' copy to the output buffer as-is
    CopyMemory outBuffer(0), prevValue, ItemSize
    outIndex = ItemSize
    
    ' repeat until the output buffer is full
    Do While outIndex < outBytes
        ' get the next value from the input buffer
        CopyMemory currValue, ByVal address, ItemSize
        address = address + ItemSize
        ' move to the output buffer
        CopyMemory outBuffer(outIndex), currValue, ItemSize
        outIndex = outIndex + ItemSize
        
        If prevValue = currValue Then
            ' two consecutive values are equal
            ' extract the matchCount value
            CopyMemory matchCount, ByVal address, 2
            address = address + 2
            ' replicate the value that number of times
            For i = 3 To matchCount
                ' move to the output buffer
                CopyMemory outBuffer(outIndex), currValue, ItemSize
                outIndex = outIndex + ItemSize
            Next
        Else
            prevValue = currValue
        End If
    Loop
    
    ' signal success
    RLEUncompress = True

End Function
Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date