清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>

Option Explicit


Private Const OFS_MAXPATHNAME = 128

Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const OF_READ = &H0
Private Const OF_WRITE = &H1
Private Const FILE_BEGIN = 0
Private Const FILE_END = 2
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000



'将Byte数组写入到文件
Public Function WriteBytesToFile(ByVal filePath As String, ByRef bBytes() As Byte) As Boolean
    Dim fHandle As Long
    Dim OF As OFSTRUCT, retB As Boolean
    Dim nSize As Long, ret As Long
    retB = False
    nSize = UBound(bBytes)
    fHandle = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_ALWAYS, 0, 0)
    If fHandle <> -1 Then
        SetFilePointer fHandle, 0, 0, FILE_BEGIN
        WriteFile fHandle, bBytes(0), nSize + 1, ret, ByVal 0&
        CloseHandle fHandle
        retB = True
    End If
    WriteBytesToFile = retB
End Function


'将二进制文件读入到 Byte数组
Public Function ReadFileToBytes(ByVal filePath As String, ByRef bBytes() As Byte) As Boolean
    On Error Resume Next
    Dim fHandle As Long
    Dim OF As OFSTRUCT, retu As Boolean
    Dim nSize As Long, ret As Long
    retu = False
    fHandle = OpenFile(filePath, OF, OF_READ)
    If fHandle <> -1 Then
        nSize = GetFileSize(fHandle, 0)
        If nSize > 0 Then
            ReDim bBytes(nSize - 1) As Byte
            SetFilePointer fHandle, 0, 0, FILE_BEGIN
            ReadFile fHandle, bBytes(0), nSize, ret, ByVal 0&
            retu = True
        End If
        CloseHandle fHandle
    End If
    If Err Then
        Err.Clear
        retu = False
    End If
    ReadFileToBytes = retu
End Function


'API方式写文本文件
Public Function SaveToTextFile(filePath As String, content As String, saveMode As Byte) As Boolean
    Dim i As Long, L As Long, bBytes(1) As Byte, ascValue As Long
    Dim fHandle As Long, ret As Long, retB As Boolean
    retB = False
    
    '检查参数
    If Len(filePath) = 0 Or Len(content) = 0 Then
        SaveToTextFile = False
        Exit Function
    End If
    
    '打开文件
    If saveMode = 2 Then
    fHandle = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, 0, 0)
    Else
    fHandle = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_ALWAYS, 0, 0)
    End If
    If fHandle <> -1 Then
        If saveMode = 2 Then
        SetFilePointer fHandle, 0, 0, FILE_BEGIN
        Else
        SetFilePointer fHandle, 0, 0, FILE_END
        End If
        L = Len(content)
        For i = 1 To L
            ascValue = Asc(Mid(content, i, 1))
            bBytes(0) = ascValue And &HFF
            bBytes(1) = (ascValue And &HFF00&) \ 256
            If bBytes(1) > 0 Then
                WriteFile fHandle, bBytes(1), 1, ret, ByVal 0&
                WriteFile fHandle, bBytes(0), 1, ret, ByVal 0&
            Else
                WriteFile fHandle, bBytes(0), 1, ret, ByVal 0&
            End If
        Next
        CloseHandle fHandle
        retB = True
    End If
    SaveToTextFile = retB
End Function



'API方式读文本文件
Public Function ReadFromTextFile(ByVal filePath As String, ByRef content As String) As Boolean
    On Error Resume Next
    Dim fHandle As Long, bBytes() As Byte
    Dim OF As OFSTRUCT, sFile As String
    Dim nSize As Long, ret As Long, retu As Boolean
    
    retu = False
    sFile = filePath
    fHandle = OpenFile(sFile, OF, OF_READ)
    
    If fHandle <> -1 Then
        nSize = GetFileSize(fHandle, 0)
        If nSize > 0 Then
            ReDim bBytes(nSize - 1) As Byte
            SetFilePointer fHandle, 0, 0, FILE_BEGIN
            ReadFile fHandle, bBytes(0), nSize, ret, ByVal 0&
            content = StrConv(bBytes(), vbUnicode)
            retu = True
        End If
        CloseHandle fHandle
    End If
    
    If Err Then
        Err.Clear
        retu = False
    End If
    ReadFromTextFile = retu
End Function