[RESOLVED] Vb6 and DOS QuickBasic

[el84]

I am trying to write a small program that will read some old files made under QuickBasic.
I'm fine with Random access and also displaying text fields.
Where I am having problems is converting to VB6 from fields generated under various compressions such as MKI$ MKD$ and so on.
Anyone familiar with QuickBasic here?

[el84]

It's MKD$ Random Access file fields (8 bytes long) that I'd like to tackle in particular.
In QB the numeric amount is extracted with CVD.

[el84]

Got it! Simple.
The Vb6 function Cdbl() accurately reads QB MKD$ fields, provided the file field is shown as Double in the Type construct. Both languages = 8 bytes

[dilettante]

As far as I know a QuickBasic Double is a 64-bit value more or less identical to that in VB5 and VB6.

A difference is that QB can use those functions to dump Doubles to/from 8 bytes of String, but String has different semantics in QB, being basically a dumb run of bytes.

VB5/6 can of course have "byte characters" in a String if handled with care, but there is a high risk of distortion through conversions from Unicode to ANSI and back if you don't know what you are doing.

I'd probably avoid "Random I/O" and UDTs and instead rely on fully-random binary I/O of Byte arrays and from there GetMem8/PutMem8 calls.

[Elroy]

As far as I know a QuickBasic Double is a 64-bit value more or less identical to that in VB5 and VB6.

A difference is that QB can use those functions to dump Doubles to/from 8 bytes of String, but String has different semantics in QB, being basically a dumb run of bytes.

VB5/6 can of course have "byte characters" in a String if handled with care, but there is a high risk of distortion through conversions from Unicode to ANSI and back if you don't know what you are doing.

I'd probably avoid "Random I/O" and UDTs and instead rely on fully-random binary I/O of Byte arrays and from there GetMem8/PutMem8 calls.

Dil, that's not quite true. The MKD and CVD (and MKS and CVS) functions didn't use IEEE encoding. They used a Microsoft created encoding that was prior to the IEEE standard.

El84, I once wrote some "back and forth" functions for this back in the day so that I could leave the Microsoft encoding on disk while reading the data the data into VB6 (or probably more like VB4 or something, don't remember anymore), and then write it back out into the older data file.

After I finish breakfast and take care of a couple of chores, I'll dig around and see if I can find that code.

[Elroy]

Ok, here's some code I found. I'm going to stare at it a bit, but please keep in mind that the last time I really looked at this code was in the mid-90's. I think I pulled it out a few years ago for someone else, but I don't remember the details.

Attribute VB_Name = "modMKXCVX"
Option Explicit

' Substitutes for the old CV* and MK* functions
' from qbasic.
'
' Calling CV* functions with a string of the wrong length
' (ie. calling CVL with a 8 byte string instead of a 4
'  byte string) will cause an error.
'
'
'
' CVSMBF, CVDMBF, MKSMBF and MKDMBF Functions
' -------------------------------------------
'
' Microsoft Binary Format <-> IEEE floating point functions
' were converted from C source found on borland's ftp site.
'
' These routines (CVSMBF, CVDMBF, MKSMBF, MKDMBF) do not
' handle IEEE NAN's and infinites.  IEEE denormals are
' treated as 0's.
'
' Conversion of doubles can cause overflows when the numbers
' simply cannot be converted.  See the code and comments
' for more details.
'
'
' Single Precision Format:
'    MS Binary Format:
'    byte order =>    m3  |  m2  | m1 | exponent
'    m1 is the most significant byte => sbbb|bbbb
'    m3 is the least significant byte
'          m = mantissa byte
'          s = sign bit
'          b = bit
'
'    IEEE Format:
'        m3        m2        m1    exponent
'    mmmm|mmmm mmmm|mmmm emmm|mmmm seee|eeee
'          s = sign mit
'          e = exponent bit
'          m = mantissa bit
'
'
' Double Precision Format:
'    MS Binary Format:
'    byte order => m7 | m6 | m5 | m4 | m3 | m2 | m1 | exponent
'    m1 is the most significant byte => smmm|mmmm
'    m7 is the least significant byte
'          m = mantissa byte
'          s = sign bit
'          b = bit
'
'    IEEE Format:
'     byte 8    byte 7    byte 6    byte 5    byte 4   and so on
'    seee|eeee eeee|mmmm mmmm|mmmm mmmm|mmmm mmmm|mmmm ....
'          m = mantissa byte
'          s = sign bit
'          b = bit
'

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


Public Function CVDMBF(s As String) As Double
   Dim i As Integer
   Dim msbin(8) As Byte
   Dim ieee(8) As Byte
   Dim ieee_exp As Integer
   Dim dbl As Double

   If Len(s) <> 8 Then
      MsgBox "Invalid string in CVDMBF."
      CVDMBF = 0
      Exit Function
   End If

   ' copy s and to msbin
   Call CopyMemory(msbin(0), ByVal s, 8)

   ' Any msbin with an exponent of zero = zero
   If msbin(7) = 0 Then
      CVDMBF = 0
      Exit Function
   End If

   ' Set the sign bit
   ieee(7) = msbin(6) And &H80

   ' MBF is bias 128 and IEEE is bias 1023.  Also MBF places the
   ' decimal point before the assumed bit, while IEEE places the
   ' the decimal point after the assumed bit.
   ieee_exp = CInt(msbin(7)) + 894 ' Actually msbin(7)-128-1+1023

   ' The first 4 bits of the msbin exponent go into
   ' the last 4 bits of ieee(7)
   ieee(7) = ieee(7) Or CByte(ieee_exp \ 16)

   ' The last 4 bits of the msbin exponent go into
   ' the first 4 bits of ieee(6)
   ieee(6) = ieee(6) Or CByte((ieee_exp * 16) And &HF0)

   ' The msbin matissa must be shifted to the right 1 bit.
   ' Remember that the msbin number has its bytes reversed.
   For i = 6 To 1 Step -1
      msbin(i) = ((msbin(i) And &H7F) * 2) Or (msbin(i - 1) \ 128)
   Next i

   ' Now the mantissa is put into the ieee array starting in
   ' the middleof the second to last byte.
   For i = 6 To 1 Step -1
      ieee(i) = ieee(i) Or (msbin(i) \ 16)
      ieee(i - 1) = ieee(i - 1) Or ((msbin(i) And &HF) * 16)
   Next i

   ieee(0) = ieee(0) Or (msbin(0) \ 16)

   ' IEEE has a half byte less for its mantissa.  If the msbin
   ' number has anything in this last half byte, then the original
   ' source code reported an error.  I have chosen however simply
   ' to let it loose some precision instead.  Uncomment the
   ' following code section if you wish this condition to raise an
   ' error.

'   If (msbin(0) And &HF) > 0 Then
'      Err.Raise 1001, "CVDMBF", "Loss of precision converting MBF to IEEE."
'   End If

    Call CopyMemory(dbl, ieee(0), 8)
    CVDMBF = dbl
End Function

Public Function CVI(s As String) As Integer
   Dim i As Integer

   If Len(s) <> 2 Then
      CVI = 0
      MsgBox "Invalid string in CVI."
   Else
      CopyMemory i, ByVal s, 2
      CVI = i
   End If

End Function
Public Function CVL(s As String) As Long
   Dim i As Long

   If Len(s) <> 4 Then
      CVL = 0
      MsgBox "Invalid string in CVL."
   Else
      CopyMemory i, ByVal s, 4
      CVL = i
   End If
End Function
Public Function CVD(s As String) As Double
   Dim i As Double

   If Len(s) <> 8 Then
      CVD = 0
      MsgBox "Invalid string in CVD."
   Else
      CopyMemory i, ByVal s, 8
      CVD = i
   End If
End Function
Public Function CVS(s As String) As Single
   Dim i As Single

   If Len(s) <> 4 Then
      CVS = 0
      MsgBox "Invalid string in CVS."
   Else
      CopyMemory i, ByVal s, 4
      CVS = i
   End If
End Function
Public Function CVSMBF(ByVal s As String) As Single
   Dim i As Integer
   Dim msbin(4) As Byte
   Dim ieee(4) As Byte
   Dim ieee_exp As Byte
   Dim sng As Single

   If Len(s) <> 4 Then
      MsgBox "Invalid string in CVSMBF."
      CVSMBF = 0
      Exit Function
   End If

   ' copy s and to msbin
   Call CopyMemory(msbin(0), ByVal s, 4)


   ' Any msbin with an exponent of zero = 0
   If msbin(3) = 0 Then
      CVSMBF = 0
      Exit Function
   End If

   ieee(3) = msbin(2) And &H80

   ' MBF is bias 128 and IEEE is bias 127.  Also, MBF places
   ' the decimal point before the assumed bit, while IEEE
   ' places the decimal point after the assumed bit.
   ieee_exp = msbin(3) - 2   ' Actually ms_bin(3)-1-128+127

   ' The first 7 bits of the exponent in ieee(3)
   ieee(3) = ieee(3) Or (ieee_exp \ 2)

   ' The one remaining bit in the first bit of ieee(2)
   ieee(2) = ieee(2) Or ((ieee_exp And 1) * 128)

   ' mask out the msbin sign bit
   ieee(2) = ieee(2) Or (msbin(2) And &H7F)

   ieee(1) = msbin(1)
   ieee(0) = msbin(0)

   'Copy ieee to sng
   Call CopyMemory(sng, ieee(0), 4)

   CVSMBF = sng
End Function

Public Function MKI(ByVal i As Integer) As String
    Dim s As String

    s = SPACE$(2)
    CopyMemory ByVal s, i, 2

    MKI = s
End Function

Public Function MKL(ByVal i As Long) As String
    Dim s As String

    s = SPACE$(4)
    CopyMemory ByVal s, i, 4

    MKL = s
End Function

Public Function MKS(ByVal i As Single) As String
    Dim s As String

    s = SPACE$(4)
    CopyMemory ByVal s, i, 4

    MKS = s
End Function

Public Function MKD(ByVal i As Double) As String
    Dim s As String

    s = SPACE$(8)
    CopyMemory ByVal s, i, 8

    MKD = s
End Function
Public Function MKSMBF(sng As Single) As String
   Dim msbin(4) As Byte
   Dim ieee(4) As Byte
   Dim s As String
   Dim msbin_exp As Byte

   Call CopyMemory(ieee(0), sng, 4)

   'get the exponent
   msbin_exp = ((ieee(3) And &H7F) * 2) Or ((ieee(2) And &H80) \ 128)

   ' An ieee exponent of &HFE overflows in MBF
   If msbin_exp = &HFE Then
      MKSMBF = String$(4, Chr$(0))
      Exit Function
   End If

   msbin_exp = msbin_exp + 2  ' Actually -127 + 128 + 1
   msbin(3) = msbin_exp

   ' Get the sign
   msbin(2) = ieee(3) And &H80

   ' Copy the rest
   msbin(2) = msbin(2) Or (ieee(2) And &H7F)
   msbin(1) = ieee(1)
   msbin(0) = ieee(0)

   ' Convert the bytes to a string
   s = SPACE$(4)
   Call CopyMemory(ByVal s, msbin(0), 4)

   MKSMBF = s
End Function


Public Function MKDMBF(dbl As Double) As String
   Dim msbin(8) As Byte
   Dim ieee(8) As Byte
   Dim s As String
   Dim msbin_exp As Integer
   Dim any_on As Byte
   Dim i As Integer

   Call CopyMemory(ieee(0), dbl, 8)

   ' If all are zero in ieee then msbin should be 0
   For i = 0 To 7
      any_on = any_on Or ieee(i)
   Next i

   If any_on = 0 Then
      MKDMBF = String$(8, Chr$(0))
      Exit Function
   End If

   ' Get the sign
   msbin(6) = ieee(7) And &H80

   ' Get the exponent.
   msbin_exp = (CInt(ieee(7) And &H7F) * &H10) + CInt(ieee(6) \ 16)

   If msbin_exp - &H3FF > &H80 Then
      MKDMBF = String$(8, Chr$(0))
      Exit Function
   End If
   '
   Err = 0
   On Error Resume Next
   msbin(7) = CByte(msbin_exp - &H3FF + &H80 + 1)
   If Err <> 0 Then
       MKDMBF = String$(8, Chr$(0))
       Exit Function
   End If
   ' The IEEE mantissa must be shifted up 3 bits
   ieee(6) = ieee(6) And &HF 'mask out the exponent in the second byte

   For i = 6 To 1 Step -1
      msbin(i) = msbin(i) Or ((ieee(i) And &H1F) * 8) Or (ieee(i - 1) \ 32)
   Next i

   msbin(0) = msbin(0) Or ((ieee(0) And &H1F) * 8)

   ' Convert the bytes to a string
   s = SPACE$(8)
   Call CopyMemory(ByVal s, msbin(0), 8)

   MKDMBF = s
End Function

[Elroy]

Ok, I've stared at it and the historical brain cells are firing a bit.

It's the CVSMBF, CVDMBF, MKSMBF and MKDMBF four functions you want to use. There are also CVS, CVD, MKS, & MKD functions, but those do the same thing the original ones did. And, if you try and use those, you'll be trying to write an IEEE-float into a Microsoft-float (and/or vice-versa) which will just yield garbage.

Assuming you've got old Microsoft-float numbers in some file, and you wish to read those into VB6 IEEE-float numbers, you'll read them into strings, and then use CVSMBF (or CVDMBF) to get them into VB6 style numbers. Then, to write them back to disk as old Microsoft-float numbers, you'll use MKSMBF (or MKDMBF).

That's about all there is to it, other than the caveats listed in the comments of the above code.

ADDED: Also, just as an FYI, the "MBF" stands for "Microsoft Basic Format" (or maybe "Microsoft Basic Float"). It's a binary floating point encoding scheme that Microsoft came up with before the IEEE scheme became the standard (and even before floating point processors were in everything, as they all use the IEEE standard).

[Elroy]

After staring a bit more, I noticed that those functions put the numbers into Unicode strings (16 bytes/8 chars for Double, and 8 bytes/4 chars for Single). So, when reading/writing to/from disk, you'll need to make sure that whichever method you use does the ANSI-to-Unicode (and vice-versa) conversion, as most VB6 I/O methods do. Just wanted to be clear on that.

In fact, the more I stare, I'm not sure they'll work with VB6's Unicode strings. They may need a bit of tweaking to work correctly.

El84, is there any way you could get me a small data file to me with some MBF encoded numbers in it? I'll give you an email if you're willing to do this.

ADDED: Ok, nevermind on getting me a file. I've got GWBASIC up and running in a DOS emulator. I've already got a test.dat file created. Here's my GWBASIC code to create that file. I'll test the VB6 functions in a moment.

10 OPEN "test.dat" FOR RANDOM AS 1 LEN=12
20 FIELD #1, 4 AS F1$, 8 AS D1$
30 LSET F1$ = MKS$(123.4)
40 LSET D1$ = MKD$(5678.9)
50 PUT #1, 1
60 CLOSE 1
70 OPEN "test.dat" FOR RANDOM AS 1 LEN=12
80 FIELD #1, 4 AS F2$, 8 AS D2$
90 GET #1,1
100 PRINT CVS(F2$), CVD(D2$)
110 CLOSE 1

Took me a bit to remember how to code in GWBASIC, but I worked out enough to get this done.

[Elroy]

Ok, here's my VB6 test code on that test.dat data file:

Option Explicit

Private Type MyRecordType
    sf1 As String * 4
    sd1 As String * 8
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Sub Form_Load()
    Open "c:\Dos\test.dat" For Random As 1 Len = 12
    Dim rec As MyRecordType
    Get #1, 1, rec

    Dim f1 As Single
    Dim d1 As Double

    f1 = CVSMBF(rec.sf1)
    d1 = CVDMBF(rec.sd1)

    Debug.Print f1, d1



End Sub




Public Function CVDMBF(s As String) As Double
   Dim i As Integer
   Dim msbin(8) As Byte
   Dim ieee(8) As Byte
   Dim ieee_exp As Integer
   Dim dbl As Double

   If Len(s) <> 8 Then
      MsgBox "Invalid string in CVDMBF."
      CVDMBF = 0
      Exit Function
   End If

   ' copy s and to msbin
   Call CopyMemory(msbin(0), ByVal s, 8)

   ' Any msbin with an exponent of zero = zero
   If msbin(7) = 0 Then
      CVDMBF = 0
      Exit Function
   End If

   ' Set the sign bit
   ieee(7) = msbin(6) And &H80

   ' MBF is bias 128 and IEEE is bias 1023.  Also MBF places the
   ' decimal point before the assumed bit, while IEEE places the
   ' the decimal point after the assumed bit.
   ieee_exp = CInt(msbin(7)) + 894 ' Actually msbin(7)-128-1+1023

   ' The first 4 bits of the msbin exponent go into
   ' the last 4 bits of ieee(7)
   ieee(7) = ieee(7) Or CByte(ieee_exp \ 16)

   ' The last 4 bits of the msbin exponent go into
   ' the first 4 bits of ieee(6)
   ieee(6) = ieee(6) Or CByte((ieee_exp * 16) And &HF0)

   ' The msbin matissa must be shifted to the right 1 bit.
   ' Remember that the msbin number has its bytes reversed.
   For i = 6 To 1 Step -1
      msbin(i) = ((msbin(i) And &H7F) * 2) Or (msbin(i - 1) \ 128)
   Next i

   ' Now the mantissa is put into the ieee array starting in
   ' the middleof the second to last byte.
   For i = 6 To 1 Step -1
      ieee(i) = ieee(i) Or (msbin(i) \ 16)
      ieee(i - 1) = ieee(i - 1) Or ((msbin(i) And &HF) * 16)
   Next i

   ieee(0) = ieee(0) Or (msbin(0) \ 16)

   ' IEEE has a half byte less for its mantissa.  If the msbin
   ' number has anything in this last half byte, then the original
   ' source code reported an error.  I have chosen however simply
   ' to let it loose some precision instead.  Uncomment the
   ' following code section if you wish this condition to raise an
   ' error.

'   If (msbin(0) And &HF) > 0 Then
'      Err.Raise 1001, "CVDMBF", "Loss of precision converting MBF to IEEE."
'   End If

    Call CopyMemory(dbl, ieee(0), 8)
    CVDMBF = dbl
End Function

Public Function CVSMBF(ByVal s As String) As Single
   Dim i As Integer
   Dim msbin(4) As Byte
   Dim ieee(4) As Byte
   Dim ieee_exp As Byte
   Dim sng As Single

   If Len(s) <> 4 Then
      MsgBox "Invalid string in CVSMBF."
      CVSMBF = 0
      Exit Function
   End If

   ' copy s and to msbin
   Call CopyMemory(msbin(0), ByVal s, 4)


   ' Any msbin with an exponent of zero = 0
   If msbin(3) = 0 Then
      CVSMBF = 0
      Exit Function
   End If

   ieee(3) = msbin(2) And &H80

   ' MBF is bias 128 and IEEE is bias 127.  Also, MBF places
   ' the decimal point before the assumed bit, while IEEE
   ' places the decimal point after the assumed bit.
   ieee_exp = msbin(3) - 2   ' Actually ms_bin(3)-1-128+127

   ' The first 7 bits of the exponent in ieee(3)
   ieee(3) = ieee(3) Or (ieee_exp \ 2)

   ' The one remaining bit in the first bit of ieee(2)
   ieee(2) = ieee(2) Or ((ieee_exp And 1) * 128)

   ' mask out the msbin sign bit
   ieee(2) = ieee(2) Or (msbin(2) And &H7F)

   ieee(1) = msbin(1)
   ieee(0) = msbin(0)

   'Copy ieee to sng
   Call CopyMemory(sng, ieee(0), 4)

   CVSMBF = sng
End Function

Public Function MKSMBF(sng As Single) As String
   Dim msbin(4) As Byte
   Dim ieee(4) As Byte
   Dim s As String
   Dim msbin_exp As Byte

   Call CopyMemory(ieee(0), sng, 4)

   'get the exponent
   msbin_exp = ((ieee(3) And &H7F) * 2) Or ((ieee(2) And &H80) \ 128)

   ' An ieee exponent of &HFE overflows in MBF
   If msbin_exp = &HFE Then
      MKSMBF = String$(4, Chr$(0))
      Exit Function
   End If

   msbin_exp = msbin_exp + 2  ' Actually -127 + 128 + 1
   msbin(3) = msbin_exp

   ' Get the sign
   msbin(2) = ieee(3) And &H80

   ' Copy the rest
   msbin(2) = msbin(2) Or (ieee(2) And &H7F)
   msbin(1) = ieee(1)
   msbin(0) = ieee(0)

   ' Convert the bytes to a string
   s = Space$(4)
   Call CopyMemory(ByVal s, msbin(0), 4)

   MKSMBF = s
End Function

Public Function MKDMBF(dbl As Double) As String
   Dim msbin(8) As Byte
   Dim ieee(8) As Byte
   Dim s As String
   Dim msbin_exp As Integer
   Dim any_on As Byte
   Dim i As Integer

   Call CopyMemory(ieee(0), dbl, 8)

   ' If all are zero in ieee then msbin should be 0
   For i = 0 To 7
      any_on = any_on Or ieee(i)
   Next i

   If any_on = 0 Then
      MKDMBF = String$(8, Chr$(0))
      Exit Function
   End If

   ' Get the sign
   msbin(6) = ieee(7) And &H80

   ' Get the exponent.
   msbin_exp = (CInt(ieee(7) And &H7F) * &H10) + CInt(ieee(6) \ 16)

   If msbin_exp - &H3FF > &H80 Then
      MKDMBF = String$(8, Chr$(0))
      Exit Function
   End If
   '
   Err = 0
   On Error Resume Next
   msbin(7) = CByte(msbin_exp - &H3FF + &H80 + 1)
   If Err <> 0 Then
       MKDMBF = String$(8, Chr$(0))
       Exit Function
   End If
   ' The IEEE mantissa must be shifted up 3 bits
   ieee(6) = ieee(6) And &HF 'mask out the exponent in the second byte

   For i = 6 To 1 Step -1
      msbin(i) = msbin(i) Or ((ieee(i) And &H1F) * 8) Or (ieee(i - 1) \ 32)
   Next i

   msbin(0) = msbin(0) Or ((ieee(0) And &H1F) * 8)

   ' Convert the bytes to a string
   s = Space$(8)
   Call CopyMemory(ByVal s, msbin(0), 8)

   MKDMBF = s
End Function

And here's my output:

 123.4         5678.89990234375

So, things seem to work ok. I didn't try the MKDMBF and MKSMBF functions though. I'll leave that testing to you, but I suspect they work ok.

[Elroy]

I went ahead and tested the MK?MBF functions by putting a Form_Click event in the above code, like this:

Private Sub Form_Click()

    Dim f As Single
    Dim d As Double


    f = CVSMBF(MKSMBF(1234.56))
    d = CVDMBF(MKDMBF(445566.778899))

    Debug.Print f, d



End Sub

And things worked fine. Output same as input.

[divestnews]

It's the CVSMBF, CVDMBF, MKSMBF and MKDMBF four functions you want to use https://humanityidea.com/nba-byte/. There are also CVS, CVD, MKS, & MKD functions, but those do the same thing the original ones did.

[el84]

Thanks, but this was resolved a while ago