Working with binary data in VBA

Working with binary data – VBA Visual Basic for Applications (Microsoft)

Function b2h(bstr)
'convert binary string to hex string
    cnvarr = Array("0000", "0001", "0010", "0011", _
             "0100", "0101", "0110", "0111", "1000", _
             "1001", "1010", "1011", "1100", "1101", _
             "1110", "1111")
'find number of HEX digits
    a = Len(bstr)
    ndgt = a / 4
    If (a Mod 4 > 0) Then
        MsgBox ("must be integer multiple of 4Bits")
        Exit Function
    End If
    hstr = ""
    For i = 1 To ndgt
        dgt = Mid(bstr, (i * 4) - 3, 4)
        For k = 0 To 15
            If (dgt = cnvarr(k)) Then
                ix = k
            End If
        Next
        hstr = hstr & Hex(ix)
    Next
    b2h = hstr
End Function

 

Function h2b(hstr)
'convert hex string to binary string
    cnvarr = Array("0000", "0001", "0010", "0011", _
             "0100", "0101", "0110", "0111", "1000", _
             "1001", "1010", "1011", "1100", "1101", _
             "1110", "1111")
    bstr = ""
    For i = 1 To Len(hstr)
        hdgt = Mid(hstr, i, 1)
        cix = CInt("&H" & hdgt)
        bstr = bstr & cnvarr(cix)
    Next
    h2b = bstr
End Function

 

Function b2d(bstr)
'convert binary string to decimal number
    numbits = Len(bstr)
    asum = 0
    For i = 1 To numbits
        asum = asum + Mid(bstr, i, 1) * 2 ^ (numbits - i)
    Next
    b2d = asum
End Function

 

Function i3efp(num_in)
    s = 0
    If num_in < 0 Then s = 1     For e = 0 To 255         If 2 * 2 ^ (e - 127) > Abs(num_in) Then Exit For
    Next
    If e = 0 Then GoSub toosmall
    If e = 255 Then GoSub toobig
    f = (Abs(num_in) / (2 ^ (e - 127))) - 1
    f = 1 * Right(f, Len(f) - 2)
    f = (f * 10 ^ -Len(f)) / 2 ^ -23
    eh = Hex(e)
    If Len(eh) < 2 Then eh = "0" & eh
    fh = Hex(f)
    i3eb = s & h2b(eh)  '9 bits
    fb = Right(h2b(fh), 23)
    If Len(fb) < 23 Then fb = String(23 - Len(fb), "0") & fb
    i3eb = i3eb & fb    '32 bits
    i3efp = b2h(i3eb)
    Exit Function
toobig:
    i3efp = String(8, "F")
    Exit Function
toosmall:
    i3efp = String(8, "0")
    Exit Function
End Function

 

Function i3e2d(hstr)
    If Len(hstr) <> 8 Then
        i3e2d = "invalid input"
        Exit Function
    End If
    bstr = h2b(hstr)
    sgnbit = Left(bstr, 1)
    s = (-1) ^ sgnbit
    expnt = Mid(bstr, 2, 8)
    e = b2d(expnt) - 127
    mntss = Right(bstr, 23)
    f = b2d(mntss)
    f = (f * 2 ^ -23) / 10 ^ -Len(f)
    i = InStr(1, f, ".")
    If i > 0 Then f = Left(f, i - 1)
    f = 1 * ("0." & Trim(Str(f))) + 1
    i3e2d = s * 2 ^ e * f
End Function

 

Open filename For Binary As #1
     . . .
a1 = Asc(Input(1, #1))
h1 = Hex(a1)
If Len(h1) < 2 Then
  h1 = "0" & h1
End If
     . . .
close #1

 

Open filename & ".asc" For Output As #1
Open filename & ".bin" For Binary As #2
      . . .
'for example, building a hex string from cells
    For rw = 2 To ActiveSheet.UsedRange.Rows.Count
        If (Cells(rw, 2) = "") Then Exit For
        wrd = Cells(rw, 5) & Cells(rw, 6) & Cells(rw, 7) _
              & Cells(rw, 8) & "00000"
        Print #1, wrd
        GoSub bin_out
    Next
    Close #1
    Close #2
    Exit Sub
bin_out:
        wrdlen = Len(wrd)
        For bix = 1 To wrdlen - 1 Step 2
            bnum = Mid(wrd, bix, 2)
            bnum2 = b2d(h2b(bnum))
            uvar$ = Chr(bnum2)
            Put #2, , uvar$
        Next
        Return

 

Function twoscomp(hs)
    bs = h2b(hs)
    If Left(bs, 1) = "1" Then
        bcs = Replace(bs, "1", "q")
        bcs = Replace(bs, "0", "1")
        bcs = Replace(bs, "q", "0")
        twoscomp = -1 * (CLng("&H" & b2h(bs)) + 1)
    Else
        twoscomp = CLng("&H" & hs)
    End If
End Function

 


											
This entry was posted in Uncategorized. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s