CB Repository

//Definitions
Const FB_CRASH_ON_ERROR = 1 'This should be 1 (=True) in developing or testing applications AND 0 (=False) in production applications!

Type FileBitDetail
	Field id
	Field f						'Pointer To file opened by OpenToXXX() Function.
	Field binary	As String	'Binary value of a Byte. Length varies from 0 To 8.
	Field index					'Bit index in current Byte. Used To Read bits.
EndType


//Test program
f = OpenToWrite("temp.txt")
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,1)
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,0)
WriteBit(f,1)
WriteBit(f,0)
FinishWriteBit(f)
CloseFileB(f)

f = OpenToRead("temp.txt")
For i = 1 To 16
	stri$ = stri + ReadBit(f)+" "
Next i
CloseFileB(f)

DeleteFile "temp.txt"
MakeError stri


//Public functions
'Functions you need to use are located here.

Function WriteBit(f, b)
	If b < 0 Or b > 1 Then
		If FB_CRASH_ON_ERROR Then MakeError "WriteBit("+f+", "+b+"): Illegal binary value!" Else Return False
	EndIf
	fbd_id = GetFileBitDetail(f)
	If fbd_id = False Then fbd_id = NewFileBitDetail(f)
	fbd.FileBitDetail	= ConvertToType(fbd_id)
	fbd\binary			= fbd\binary + Str(b)
	If Len(fbd\binary) = 8 Then Return FinishWriteBit(f) 'Current Byte is full, so Write it To the file
	Return True
EndFunction

Function ReadBit(f)
	fbd_id = GetFileBitDetail(f)
	If fbd_id = False Then fbd_id = NewFileBitDetail(f,Bin(ReadByte(f)))
	fbd.FileBitDetail = ConvertToType(fbd_id)
	fbd\index = fbd\index + 1
	If fbd\index > 8 Then
		Delete fbd
		Return ReadBit(f) 'Start over; this Byte has been completely Read.
	EndIf
	Return Int(Mid(fbd\binary, fbd\index,1))
EndFunction

Function FinishWriteBit(f)
	fbd_id = GetFileBitDetail(f)
	If fbd_id = False Then
		If FB_CRASH_ON_ERROR Then MakeError "FinishWriteBit("+f+"): Illegal file pointer!" Else Return False
	EndIf
	fbd.FileBitDetail = ConvertToType(fbd_id)
	If Len(fbd\binary) = 0 Then Return True 'There is nothing To Write so Return And act like succeeded.
	WriteByte f, BinToDec(fbd\binary) 'Should Write a value between 0 And 255
	fbd\binary = ""
	Return True
EndFunction

Function CloseFileB(f)
	fbd_id = GetFileBitDetail(f)
	If fbd_id = False Then
		If FB_CRASH_ON_ERROR Then MakeError "CloseFileB("+f+"): Illegal file pointer!" Else Return False
	EndIf
	If Not FinishWriteBit(f) Then Return False
	fbd.FileBitDetail = ConvertToType(fbd_id)
	Delete fbd
	CloseFile f
	Return True
EndFunction


//Private Functions
'It is not necessary to use these functions outside this library

Function GetFileBitDetail(f)
	For fbd.FileBitDetail = Each FileBitDetail
		If fbd\f = f Then Return fbd\id 'Found
	Next fbd
	Return False 'Not found
EndFunction

Function NewFileBitDetail(f,binary="")
	fbd.FileBitDetail	= New(FileBitDetail)
	fbd\id				= ConvertToInteger(fbd)
	fbd\f				= f
	fbd\binary			= binary
	Return fbd\id
EndFunction


//CBSDK functions
'Functions copied from CoolBasic Software Development Kit. The SDK does not currently have a public webpage, so please see http://www.coolbasic.com/phpBB3/ and write word CBSDK to the search engine for more information.

'BinToDec() - copied 20.6.2009 from cbMath.cb @ CBSDK
'Modifications: None
Function BinToDec(jono$) 'by Bagard
    For i = Len(jono$) To 1 Step -1
        arvo = Int(Mid(jono$, i, 1))
        If arvo = 1 Then
            luku = luku + 2 ^ (Len(jono$) - i)
        EndIf
    Next i
    Return luku
End Function