data.bas

来自「VB6, paralell port, I2C, parse intel HEX」· BAS 代码 · 共 183 行

Attribute VB_Name = "FileData"
Option Explicit

Public fnum As Long
Public fpath As String
Public fLen As Long
Public bytesArr() As Byte
Public Blen As Long
Public stringArr(1000) As String
Public bufBtPos As Long
Public bufStrPos As Long

Type ByteArray
    bytes() As Byte
End Type



Public Function DirExists(ByRef aDir As String) As Boolean
Dim sResult As String
On Error Resume Next
sResult = Dir(aDir, vbDirectory)
DirExists = sResult <> ""
End Function

Public Function ClearFile(ByVal strpath As String) As Boolean
On Error GoTo greska
    fnum = FreeFile(0)
    Open strpath For Output As #fnum
    Close #fnum
ClearFile = True
Exit Function
greska:
ClearFile = False
MsgBox "ClearFile: " & Err.Number & Err.Description
End Function

Public Function BinaryReadData(ByVal FlName As String) As Boolean
On Error GoTo greska:
Dim fnum As Long
        
        fnum = FreeFile(0)
        Open FlName For Binary Access Read As #fnum
        fLen = LOF(fnum) - 1
        If fLen < 0 Then
        BinaryReadData = False
        Close #fnum
        Exit Function
        End If
        ReDim bytesArr(0 To fLen)
        Get #fnum, , bytesArr()
        Close #fnum
        
        Blen = fLen
        
BinaryReadData = True
Exit Function
greska:
BinaryReadData = False
MsgBox "BinaryReadData: " & Err.Number & Err.Description
End Function

Public Function BinarySaveData(ByVal FlName As String, strType As String) As Boolean
On Error GoTo greska:

Dim fnum As Long
Dim fname As String

        fnum = FreeFile(0)
        fname = FlName + "." + strType
        Open fname For Binary Access Write As #fnum
        Put #fnum, , bytesArr()
        Close #fnum
BinarySaveData = True
Exit Function
greska:
BinarySaveData = False
MsgBox "BinarySaveData: " & Err.Number & Err.Description
End Function

Public Function BinarySaveDataR(ByVal FlName As String, strType As String) As Boolean
On Error GoTo greska:

Dim fnum As Long
Dim fname As String

        fnum = FreeFile(0)
        fname = FlName + "." + strType
        Open fname For Binary Access Write As #fnum
        Put #fnum, , BufArr()
        Close #fnum
BinarySaveDataR = True
Exit Function
greska:
BinarySaveDataR = False
MsgBox "BinarySaveData: " & Err.Number & Err.Description
End Function

Public Function StringReadData(ByVal FlName As String) As Boolean
On Error GoTo greska:
Dim fnum As Long
        
        fnum = FreeFile(0)
        Open FlName For Input As fnum
        bufStrPos = 0
        While Not (EOF(fnum))
        Input #fnum, stringArr(bufStrPos)
        bufStrPos = bufStrPos + 1
        Wend
        Close #fnum
        bufStrPos = bufStrPos - 1
If bufStrPos < 2 Then
StringReadData = False
Exit Function
End If
StringReadData = True
Exit Function
greska:
StringReadData = False
MsgBox "StringReadData: " & Err.Number & Err.Description
End Function
Public Function OutputSaveDataStr(ByVal strpath As String, ByVal str As String) As Boolean
On Error GoTo greska
    fnum = FreeFile(0)
    Open strpath For Output As #fnum
    Print #fnum, str
    Close #fnum
OutputSaveDataStr = True
Exit Function
greska:
OutputSaveDataStr = False
MsgBox "OutputSaveDataStr: " & Err.Number & Err.Description
End Function

Public Function OutputSaveDataArr(ByVal strpath As String) As Boolean
On Error GoTo greska
Dim i As Long
    fnum = FreeFile(0)
    Open strpath For Output As #fnum
    For i = 0 To Blen
    Print #fnum, Chr(BufArr(i))
    Next i
    Close #fnum
OutputSaveDataArr = True
Exit Function
greska:
OutputSaveDataArr = False
MsgBox "OutputSaveDataArr: " & Err.Number & Err.Description
End Function

Public Function ApendDataStr(ByVal strpath As String, ByVal str As String) As Boolean
On Error GoTo greska
    fnum = FreeFile(0)
    Open strpath For Append As #fnum
    Print #fnum, str
    Close #fnum
ApendDataStr = True
Exit Function
greska:
ApendDataStr = False
MsgBox "ApendDataStr: " & Err.Number & Err.Description
End Function

Public Function ApendDataArr(ByVal strpath As String) As Boolean
On Error GoTo greska
Dim i As Long
    fnum = FreeFile(0)
    Open strpath For Append As #fnum
    For i = 0 To bufBtPos - 1
    Print #fnum, BufArr(i)
    Next i
    Close #fnum
ApendDataArr = True
Exit Function
greska:
ApendDataArr = False
MsgBox "ApendDataArr: " & Err.Number & Err.Description
End Function