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