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
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