clsfile.cls

串口编程-云台镜头控制系统 内有VB源代码.是本人从网上下载 做为交换 放到此处

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'#######################################################################
'程序由迎风飘扬编写,供大家参考.有什么意见可以在我的qq:5488700上给我留言.
'#######################################################################

Option Explicit
'***********************************************
'声明：
'***********************************************
'定义API函数中要用到的常量
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000

Const FILE_ATTRIBUTE_NORMAL = &H80
Const CREATE_ALWAYS = 2
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1
'本类所操纵的文件句柄
Private fHandle As Long
'本类所操纵的文件名
Private fName As String

'文件名的最大长度
Const MAX_PATH = 260

'WIN32_FIND_DATA中关于时间表示的结构
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

'查找文件时所用的结构，其中存储由FindFirstFile返回的详细文件信息
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

'**********************************************
'声明对API函数的引用
'**********************************************
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
        lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
        lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) _
        As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As Long) As Long

Private Declare Function WriteFile Lib "kernel32" ( _
        ByVal hFile As Long, lpBuffer As Any, _
        ByVal nNumberOfBytesToWrite As Long, _
        lpNumberOfBytesWritten As Long, ByVal lpOverlapped As _
        Long) As Long

Private Declare Function CreateFile Lib "kernel32" _
        Alias "CreateFileA" (ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
        ByVal lpSecurityAttributes As Long, _
        ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile _
        As Long) As Long

Private Declare Function FlushFileBuffers Lib "kernel32" ( _
        ByVal hFile As Long) As Long
        
Private Declare Function GetFileSize Lib "kernel32" ( _
        ByVal hFile As Long, ByVal lpFileSizeHigh As Long) As Long

Private Declare Function DeleteFile Lib "kernel32" ( _
        ByVal lpFileName As String) As Boolean
        
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
        ByVal lpFileName As String, _
        ByRef lpFindFileData As WIN32_FIND_DATA) As Long
'***********************************************
'声明结束
'***********************************************

'***********************************************
'检测文件是否存在
'***********************************************
Public Function IsFileExist(ByVal lpFileName As String) As Boolean
    Dim shHandle As Long
    Dim dt As WIN32_FIND_DATA

    shHandle = FindFirstFile(lpFileName, dt)
   
    If shHandle = INVALID_HANDLE_VALUE Then
        IsFileExist = False
    Else
        IsFileExist = True
    End If
End Function
        
'***********************************************
'功能：删除文件
'参数：lpFileName：存放文件的绝对路径
'***********************************************
Public Function DeleteFileEx(lpFileName As String) As Boolean
    On Error Resume Next
    Call DeleteFile(lpFileName)
End Function
'***********************************************
'功能：获得当前打开文件的长度
'***********************************************
Public Function GetLength() As Long
    GetLength = GetFileSize(fHandle, 0)
End Function
'***********************************************
'功能：打开文件
'参数：lpFileName：存放文件的绝对路径
'***********************************************
Public Function OpenFile(FileName As String) As Boolean
    Dim fSuccess As Long
    fName = FileName
    '取 Fname 的句柄
    fHandle = CreateFile(fName, GENERIC_WRITE Or GENERIC_READ, _
            0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    'CreateFile 失败的话返回 INVALID_HANDLE_VALUE
    If fHandle = INVALID_HANDLE_VALUE Then
        OpenFile = False
    Else
        OpenFile = True
    End If
End Function

'***********************************************
'功能：关闭文件
'***********************************************
Public Sub CloseFile()
    CloseHandle (fHandle)
End Sub

'***********************************************
'功能：从文件中读取一个字节型的一维数组
'参数：anArray用来存放读取得到的数据
'***********************************************
Public Sub ReadArray(anArray() As Byte)
    Dim fSuccess As Long
    Dim lBytesRead As Long
    Dim BytesToRead As Long

    '取数据大小
    BytesToRead = (UBound(anArray) + 1) * LenB(anArray(0))
        fSuccess = ReadFile(fHandle, anArray(LBound(anArray)), _
        BytesToRead, lBytesRead, 0)
        'ReadFile 成功后返回一个非 0 值
End Sub

'***********************************************
'功能：从文件中读取一个字节型的二维数组
'参数：anArray用来存放读取得到的数据
'      Dim1:数组第一维的长度
'      Dim2:数组第二维的长度
'***********************************************
Public Sub ReadArray2Dim(anArray() As Byte, Dim1 As Integer, Dim2 As Integer)
    Dim fSuccess As Long
    Dim lBytesRead As Long
    Dim BytesToRead As Long

    '取数据大小
    BytesToRead = Dim1 * Dim2 * LenB(anArray(0, 0))
        fSuccess = ReadFile(fHandle, anArray(0, 0), _
        BytesToRead, lBytesRead, 0)
        'ReadFile 成功后返回一个非 0 值
End Sub

'***********************************************
'功能：从文件中读取一个字节
'参数：Data用来存放读取得到的数据
'***********************************************
Public Sub ReadByte(ByRef Data As Byte)
    Dim fSuccess As Long
    Dim lBytesRead As Long
    Dim BytesToRead As Long

    '取数据大小
    BytesToRead = LenB(Data)
        fSuccess = ReadFile(fHandle, Data, _
        BytesToRead, lBytesRead, 0)
        'ReadFile 成功后返回一个非 0 值
End Sub
'***********************************************
'功能：从文件中读取一个长整型的值
'参数：Data用来存放读取得到的数据
'***********************************************
Public Sub ReadLong(ByRef Data As Long)
    Dim fSuccess As Long
    Dim lBytesRead As Long
    Dim BytesToRead As Long

    '取数据大小
    BytesToRead = LenB(Data)
        fSuccess = ReadFile(fHandle, Data, _
        BytesToRead, lBytesRead, 0)
        'ReadFile 成功后返回一个非 0 值
End Sub
'***********************************************
'功能：从文件中读取一个Single型的数据
'参数：Data用来存放读取得到的数据
'***********************************************
Public Sub ReadSingle(ByRef Data As Single)
    Dim fSuccess As Long
    Dim lBytesRead As Long
    Dim BytesToRead As Long

    '取数据大小
    BytesToRead = LenB(Data)
        fSuccess = ReadFile(fHandle, Data, _
        BytesToRead, lBytesRead, 0)
        'ReadFile 成功后返回一个非 0 值
End Sub
'***********************************************
'功能：写一个Single型的数据到文件
'参数：Data用来存放被写入的数据
'***********************************************
Public Sub WriteSingle(ByVal Data As Single)
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    Dim BytesToWrite As Long
    '取数据大小
    BytesToWrite = LenB(Data)
    If fHandle <> INVALID_HANDLE_VALUE Then
        fSuccess = WriteFile(fHandle, Data, _
        BytesToWrite, lBytesWritten, 0)
        'WriteFile 成功后返回一个非 0 值
        If fSuccess <> 0 Then
            '刷新文件缓冲， 马上写入数据
            fSuccess = FlushFileBuffers(fHandle)
        End If
    End If
End Sub
'***********************************************
'功能：写一个字节型的数据到文件
'参数：Data用来存放被写入的数据
'***********************************************
Public Sub WriteByte(ByVal Data As Byte)
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    Dim BytesToWrite As Long
    '取数据大小
    BytesToWrite = LenB(Data)
    If fHandle <> INVALID_HANDLE_VALUE Then
        fSuccess = WriteFile(fHandle, Data, _
        BytesToWrite, lBytesWritten, 0)
        'WriteFile 成功后返回一个非 0 值
        If fSuccess <> 0 Then
            '刷新文件缓冲， 马上写入数据
            fSuccess = FlushFileBuffers(fHandle)
        End If
    End If
End Sub
'***********************************************
'功能：写一个长整型型的数据到文件
'参数：Data用来存放被写入的数据
'***********************************************
Public Sub WriteLong(ByVal Data As Long)
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    Dim BytesToWrite As Long
    '取数据大小
    BytesToWrite = LenB(Data)
    If fHandle <> INVALID_HANDLE_VALUE Then
        fSuccess = WriteFile(fHandle, Data, _
        BytesToWrite, lBytesWritten, 0)
        'WriteFile 成功后返回一个非 0 值
        If fSuccess <> 0 Then
            '刷新文件缓冲， 马上写入数据
            fSuccess = FlushFileBuffers(fHandle)
        End If
    End If
End Sub

'***********************************************
'功能：写一个二维字节数组到文件
'参数：anArray存放被写入数据
'      Dim1数组第一维长度
'      Dim2数组第二维长度
'***********************************************
Public Sub WriteArray2Dim(anArray() As Byte, Dim1 As Integer, Dim2 As Integer)
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    Dim BytesToWrite As Long
    '取数据大小
    BytesToWrite = Dim1 * Dim2 * LenB(anArray(0, 0))
    If fHandle <> INVALID_HANDLE_VALUE Then
        fSuccess = WriteFile(fHandle, anArray(0, 0), _
        BytesToWrite, lBytesWritten, 0)
        'WriteFile 成功后返回一个非 0 值
        If fSuccess <> 0 Then
            '刷新文件缓冲， 马上写入数据
            fSuccess = FlushFileBuffers(fHandle)
        End If
    End If
End Sub

'***********************************************
'功能：写一个字节型的一维数组到文件
'参数：anArray用来存放被写入的数据
'***********************************************
Public Sub WriteArray(anArray() As Byte)
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    Dim BytesToWrite As Long
    '取数据大小
    BytesToWrite = (UBound(anArray) + 1) * LenB(anArray(0))
    If fHandle <> INVALID_HANDLE_VALUE Then
        fSuccess = WriteFile(fHandle, anArray(LBound(anArray)), _
        BytesToWrite, lBytesWritten, 0)
        'WriteFile 成功后返回一个非 0 值
        If fSuccess <> 0 Then
            '刷新文件缓冲， 马上写入数据
            fSuccess = FlushFileBuffers(fHandle)
        End If
    End If
End Sub

'***********************************************
'功能：类的初始化函数
'***********************************************
Private Sub Class_Initialize()
    fHandle = -1
End Sub

'***********************************************
'功能：类的析构函数
'***********************************************
Private Sub Class_Terminate()
    If fHandle <> -1 Then
        CloseHandle (fHandle)
    End If
End Sub