32.31 v.
Jare 14.3.2010 18:15
Funktiot yksittäisten bittien kirjoittamiseen tiedostoihin ja lukemiseen.
Koodia voi vilkaista tästä tai ladata tiedoston tuosta alempaa.
//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
MakeError stri
CloseFileB(f)
DeleteFile "temp.txt"
//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
198
257