::: Area #155 (comp.sys.acorn.networking)
Message: #32225 (Read 7 times, has 0 replies, 6280 bytes)
Date   : Sun May 24 20:07:36 1998
From   : Jonathan Graham Harston of fidonet#2:254/27
To     : All
Subject: Using BBCBasic Data Files in VisualBasic

Usual warnings!!!  I haven't tested this **AT ALL** as the office is
closed, and even if it was open, we don't have VisualBasic installed.  I
suppose I'd better spend a couple of hours one day installing it.

Feel free to fix any mistakes and mail the results back to me.


Somewhere in your program, do:
eg:
filename$="DATAFILE.BBC"
filenumber=1

Open filename$ For Binary As #filenumber

... and then you can use:

<...> = BBC_ReadFromFile (filenumber)
to read the data in, and

BBC_WriteToFile(filenumber, variable, vartype)
to write the data, set vartype to &00 (string), &40 (integer), &FF (real).


The functions are:

Function BBC_ReadFromFile (File_Channel)    ' Returns a Variant value
  Dim Data_Integer As Long                  ' 4-byte integer
  Dim Data_Byte As String * 1               ' 1-byte single byte
  Dim Data_Real As Double                   ' 8-byte floating real

  Get #File_Channel, , Data_Byte            ' What's the next data type?

  Select Case Data_Byte
    Case 0                                  ' String
      ' Format: 00, len, reversed string

      Data_Length = Input$(1, File_Channel) ' Get string length
      Data_String$ = ""                     ' Initialise string
      If Data_Length > 0 Then
	 For Loop = 1 To Data_Length         ' Read in the reversed string
	   Data_String$ = Input$(1, File_Channel) + Data_String$
	 Next Loop
	 BBC_ReadFromFile = Data_String      ' Assign return value
      End If

    Case 1, 64                              ' 32-bit Integer
      ' Format: 01 or 40, b3, b2, b1, b0 - integer &b3b2b1b0

      ' I *think* that VB stores ints as b0,b1,b2,b3, so need to read
      ' bytes in manually

      Data_Integer = 0

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Byte * &h1000000  ' But this might overflow?

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Integer Or (Data_Byte * &h10000)

      Get #file_Channel, , Data_Byte
      Data_Integer = Data_Integer Or (Data_Byte * &h100)

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Integer Or Data_Byte

      BBC_ReadFromFile = Data_Integer

    Case 255                               ' 40-bit Real
      ' Format: FF, m0, m1, m2, m3, ex - exponent ex, mantissa &m3m2m1m0

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Byte

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Integer Or (Data_Byte * &h100)

      Get #File_Channel, , Data_Byte
      Data_Integer = Data_Integer Or (Data_Byte * &h10000)

      Get #File_Channel, , Data_Byte
      Minus = (Data_Byte > 127)
      Data_Byte = Data_Byte And 127
      Data_Integer = Data_Integer Or (Data_Byte * &h1000000)

      Get #File_Channel, , Data_Byte

      If Data_Integer = 0 And Data_Byte = 0 And Not Minus Then
	 BBC_ReadFromFile = 0
      Else
	 Data_Real = Data_Integer + 2147483648
	 Data_Real = Data_Real * 2 ^ (Data_Byte - &hA0)
	 If Minus Then Data_Real = -Data_Real
	 BBC_ReadFromFile = Data_Real

    Case Else
      BBC_ReadFromFile = 0                 ' Unrecognised - return zero
  End Select

End Function


Function BBC_WriteToFile (File_Channel, Data_Var, Data_Type)
  Dim Data_Integer As Long                  ' 4-byte integer
  Dim Data_Byte As String * 1               ' Single byte
  Dim Data_Real As Double                   ' 8-byte float

  Data_Byte = Data_Type
  Put #File_Channel, , Data_Byte            ' Write out the data type

  Select Case Data_Type
    Case 0                                  ' String
      ' Format: 00, len, reversed string

      Data_Byte = Len(Data_Var)
      Put #File_Channel, , Data_Byte
      If Data_Byte > 0 Then
	 For Loop = Data_Byte To 1 Step -1   ' Read in the reversed string
	   Data_Byte = Mid$( Data_Var, Loop, 1)
	   Put #File_Channel, , Data_Byte
	 Next Loop
      End If

    Case 1, 64                              ' 32-bit Integer
      ' Format: 01 or 40, b3, b2, b1, b0 - integer &b3b2b1b0

      ' I *think* that VB stores ints as b0,b1,b2,b3, so need to read
      ' bytes in manually

      Data_Integer = Data_Var

      Data_Byte = (Data_Integer And &hFF000000) Div &h1000000
      Put #File_Channel, , Data_Byte

      Data_Byte = (Data_Integer And &hFF0000) Div &h10000
      Put #File_Channel, , Data_Byte

      Data_Byte = (Data_Integer And &hFF00) Div &h100
      Put #File_Channel, , Data_Byte

      Data_Byte = Data_Integer And &hFF
      Put #File_Channel, , Data_Byte

    Case 255                               ' 40-bit Real
      ' Format: FF, m0, m1, m2, m3, ex - exponent ex, mantissa &m3m2m1m0

      Data_Real = Data_Var
      Minus = Data_Real < 0
      Data_Real = Abs (Data_Real)

      Data_Exponent = 1 + Int (Ln (Data_Real) / Ln (2) )
      Data_Real = Data_Real / ( 2 ^ (Data_Exponent - 32))
      Data_Real = Data_Real - 2147483648

      Data_Integer = Data_Real
      Data_Byte = Data_Integer And &hFF
      Put #File_Channel, , Data_Byte

      Data_Byte = (Data_Integer And &hFF00) Div &h100
      Put #File_Channel, , Data_Byte

      Data_Byte = (Data_Integer And &hFF0000) Div &h10000
      Put #File_Channel, , Data_Byte

      Data_Byte = (Data_Integer And &hFF000000) Div &h1000000
      If Minus Then Data_Byte = Data_Byte Or &h80
      Put #File_Channel, , Data_Byte

      Data_Byte = Data_Exponent + &hA0
      Put #File_Channel, , Data_Byte

  End Select

End Function

<fx: Clarkson> Arrgh!!!, horrible, horrible, horrible microsoft.  "Let's
try to be as helpful as possible by throwing things at the programmer and
hiding what the code /actually/ does."  Gimmie a BGet and a BPut.  And
memory indirections.  And cleaner interfaces.  Hell, give me an Acorn.

--
J.G.Harston (JGH BBC PD Library) 70 Camm Street, Walkley, SHEFFIELD S6 3TR
BBC+Master / Z80+6502 / CoPro+Tubes / Econet+SJ / Devolution / Transport /
Planning / Highways    http://homepages.nildram.co.uk/~amilton/walkley.htm
jgh@arcade.demon.co.uk   (( Anti-UCE address added by Arcade, not by me ))
--- ARCbbs RISC OS [1.64á32c]
 * Origin: Via The Arcade BBS Usenet News Gateway +44 181 655 4412 (2:254/27)