[磁盘文件IO]modIO.bas（快速读/写磁盘文件）

dreamerate

快速存取磁盘文件的模块。内包括：

1、读/写指定文件名磁盘文件（by string）;
2、读/写指定文件名磁盘文件（by byte()）;
3、读/写INI文件；
4、修复INI文件内SECTION区间紧凑的问题；
5、获取指定的路径；
6、目录文件操作（是否存在/复制/删除）；
7、……

完整内容请下载附件。

'/////////////////////////////////////////////////////////////////////////////////////
'BOOL GetSpecifiedPath(dwType)
'dwType:
Enum enumGSP
   GSP_WND  ' Windows Directory
   GSP_SYS  ' System Directory
   GSP_APP  ' Application path
   GSP_PRG  ' Program files
   GSP_COM  ' Common files
   GSP_TMP  ' Temp Path
   GSP_DSK  ' Desktop
End Enum

'/////////////////////////////////////////////////////////////////////////////////////

Public Function ReadFileName(ByVal sFileName As String) As String

   Dim hFile As Long
   Dim dwFileSize As Long
   Dim dwBytesRead As Long
   Dim pFile() As Byte

   'Get a handle to a file sFileName.
   hFile = CreateFile(sFileName, _
                       GENERIC_READ, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                       ByVal 0&, _
                       OPEN_ALWAYS, _
                       FILE_FLAG_SEQUENTIAL_SCAN, 0)
                        
   'Here you should test to see if you get a file handle or not.
   'CreateFile returns INVALID_HANDLE_VALUE if it fails.
   If hFile <> INVALID_HANDLE_VALUE Then
   
      'Get the file size
      dwFileSize = GetFileSize(hFile, 0)
      If dwFileSize = -1 Or dwFileSize = 0 Then
         Call CloseHandle(hFile)
         Exit Function
      End If
      
      ReDim pFile(dwFileSize - 1)
      
      If ReadFile(hFile, pFile(0), dwFileSize, dwBytesRead, 0) <> 0 Then
         ReadFileName = StrConv(pFile, vbUnicode)
      End If
      
      'ReadFile returns a non-zero value if it is successful.
      'Now you just close the file.
      Call CloseHandle(hFile)
      
   End If
   
End Function

Public Function WriteFileName(ByVal sFileName As String, _
                              ByVal sFile As String _
                              ) As Boolean

   Dim hFile As Long
   Dim nBytesWritten As Long

   'Get a handle to a file Fname.
   hFile = CreateFile(sFileName, _
                       GENERIC_WRITE, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                       ByVal 0&, _
                       CREATE_ALWAYS, _
                       FILE_FLAG_SEQUENTIAL_SCAN, 0)
                       
   'Here you should test to see if you get a file handle or not.
   'CreateFile returns INVALID_HANDLE_VALUE if it fails.
   If hFile <> INVALID_HANDLE_VALUE Then
              
      'Check to see if you were successful writing the data
      If WriteFile(hFile, ByVal sFile, MStrLen2(ByVal sFile), nBytesWritten, 0) <> 0 Then
      
         'Flush the file buffers to force writing of the data.
         'Call FlushFileBuffers(hFile)
         
         WriteFileName = True
         
      End If
      
      'Close the file.
      Call CloseHandle(hFile)
      
   End If
   
End Function

Public Function ReadFileToByte(ByVal sFileName As String, _
                               ByRef pFile() As Byte) As Boolean

   Dim hFile As Long
   Dim dwFileSize As Long
   Dim dwBytesRead As Long

   'Get a handle to a file sFileName.
   hFile = CreateFile(sFileName, _
                       GENERIC_READ, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                       ByVal 0&, _
                       OPEN_ALWAYS, _
                       FILE_FLAG_SEQUENTIAL_SCAN, 0)
                        
   'Here you should test to see if you get a file handle or not.
   'CreateFile returns INVALID_HANDLE_VALUE if it fails.
   If hFile <> INVALID_HANDLE_VALUE Then

      'Get the file size
      dwFileSize = GetFileSize(hFile, 0)
      If dwFileSize = -1 Or dwFileSize = 0 Then
         Call CloseHandle(hFile)
         Exit Function
      End If
      
      ReDim pFile(dwFileSize - 1)
      
      If ReadFile(hFile, pFile(0), dwFileSize, dwBytesRead, 0) <> 0 Then
         ReadFileToByte = True
      End If
      
      'ReadFile returns a non-zero value if it is successful.
      'Now you just close the file.
      Call CloseHandle(hFile)
      
   End If
   
End Function

Public Function WriteFileByByte(ByVal sFileName As String, _
                                ByRef pFile() As Byte _
                                ) As Boolean

   Dim hFile As Long
   Dim nBytesWritten As Long
   
   'Get a handle to a file Fname.
   hFile = CreateFile(sFileName, _
                       GENERIC_WRITE, _
                       FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                       ByVal 0&, _
                       CREATE_ALWAYS, _
                       FILE_FLAG_SEQUENTIAL_SCAN, 0)
                       
   'Here you should test to see if you get a file handle or not.
   'CreateFile returns INVALID_HANDLE_VALUE if it fails.
   If hFile <> INVALID_HANDLE_VALUE Then
            
      'Check to see if you were successful writing the data
      If WriteFile(hFile, pFile(0), UBound(pFile) + 1, nBytesWritten, 0) <> 0 Then
      
         'Flush the file buffers to force writing of the data.
         'Call FlushFileBuffers(hFile)
      
         WriteFileByByte = True
      
      End If
      
      'Close the file.
      Call CloseHandle(hFile)
      
   End If
   
End Function

'修复INI的[SECTION]标头没加回车换行的情况
Public Function FixINIFile(ByVal sFile As String) As Boolean
   
   Dim pFile() As Byte
   Dim pWriteFile() As Byte
   Dim i As Long
   Dim j As Long
   
   'read file
   If Not ReadFileToByte(sFile, pFile) Then
      Exit Function
   End If
   
   'allocate memory
   ReDim pWriteFile(UBound(pFile) * 2)
   
   'begin to fixing
   For i = 0 To UBound(pFile)
      'checking
      If i > 3 Then
         'if not equal to '['
         If pFile(i) = 91 Then
            'if not equal to chr(10) and chr(13) and chr(10)
            If pFile(i - 1) = 10 And pFile(i - 2) = 13 And pFile(i - 3) = 10 Then
               pWriteFile(j) = pFile(i)
            'if not equal to chr(10) and chr(10)
            ElseIf pFile(i - 1) = 10 And pFile(i - 2) = 10 Then
               pWriteFile(j) = pFile(i)
            Else
               pWriteFile(j) = 13                           'vbCr
               pWriteFile(j + 1) = 10                       'vbLf
               pWriteFile(j + 2) = pFile(i)
               j = j + 2
            End If
         Else
            pWriteFile(j) = pFile(i)
         End If
      Else
         pWriteFile(j) = pFile(i)
      End If
      j = j + 1
   Next
   
   'adjust writting size
   ReDim Preserve pWriteFile(j)

   'write file
   FixINIFile = WriteFileByByte(sFile, pWriteFile)
   
End Function

'判断是否目录？
Public Function IsDir(ByVal sDirPath As String) As Boolean
   
   Dim nAttr As Long
   
   nAttr = GetFileAttributes(sDirPath)
   
   If nAttr > 0 And (nAttr And FILE_ATTRIBUTE_DIRECTORY) Then
      IsDir = True
   End If

End Function

Public Function FileExists(ByVal sFileName As String) As Boolean
   
   Dim nAttr As Long
   
   nAttr = GetFileAttributes(sFileName)
   
   If nAttr > 0 And (nAttr And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
      FileExists = True
   End If

End Function

'读 INI 字符
Public Function GetPProfileStr(ByVal sSection As String, _
                              ByVal sKeyName As String, _
                              ByVal sDefault As String, _
                              ByVal sFileName As String _
                              ) As String

   Dim sReturnStr As String
   Dim nResult As Long
   
   sReturnStr = String(MAX_PATH, Chr(0))
   
   nResult = GetPrivateProfileString(sSection, _
                                     sKeyName, _
                                     sDefault, _
                                     sReturnStr, _
                                     MAX_PATH, _
                                     sFileName)
   
   GetPProfileStr = StripNulls(Left(sReturnStr, nResult))
   
End Function

'读 INI 数字
Public Function GetPProfileInt(ByVal sSection As String, _
                              ByVal sKeyName As String, _
                              ByVal nDefault As Long, _
                              ByVal sFileName As String _
                              ) As Long

    GetPProfileInt = GetPrivateProfileInt(sSection, _
                                          sKeyName, _
                                          nDefault, _
                                          sFileName)
   
End Function

'写 INI 字符
Public Function WritePProfileStr(ByVal sSection As String, _
                                 ByVal sKeyName As String, _
                                 ByVal sWriteValue As String, _
                                 ByVal sFileName As String _
                                 ) As Boolean

   Dim nResult As Long
   
   nResult = WritePrivateProfileString(sSection, _
                                       sKeyName, _
                                       sWriteValue, _
                                       sFileName)
   
   If nResult <> 0 Then
      'Call FixINIFile(sFileName)
      WritePProfileStr = True
   End If
   
End Function

'写 INI 数字
Public Function WritePProfileInt(ByVal sSection As String, _
                                 ByVal sKeyName As String, _
                                 ByVal nWriteValue As Long, _
                                 ByVal sFileName As String _
                                 ) As Boolean

   Dim nResult As Long
   
   nResult = WritePrivateProfileString(sSection, _
                                       sKeyName, _
                                       ByVal CStr(nWriteValue), _
                                       sFileName)
   
   If nResult <> 0 Then
      'Call FixINIFile(sFileName)
      WritePProfileInt = True
   End If
   
End Function

'删除 INI 字段
Public Function DeletePProfileStr(ByVal sSection As String, _
                                  ByVal sKeyName As String, _
                                  ByVal sFileName As String _
                                  ) As Boolean

   Dim nResult As Long
   
   nResult = WritePrivateProfileString(sSection, _
                                       sKeyName, _
                                       ByVal 0&, _
                                       sFileName)
   
   If nResult <> 0 Then
      DeletePProfileStr = True
   End If
   
End Function

'删除 INI 小节
Public Function DeletePProfileSection(ByVal sSection As String, _
                                      ByVal sFileName As String _
                                      ) As Boolean

   Dim nResult As Long
   
   nResult = WritePrivateProfileString(sSection, _
                                       ByVal 0&, _
                                       ByVal 0&, _
                                       sFileName)
   
   If nResult <> 0 Then
      DeletePProfileSection = True
   End If
   
End Function

'复制目录
Public Function CopyDir(ByVal sSrc As String, _
                        ByVal sDest As String _
                        ) As Boolean
   
    Dim fileop As SHFILEOPSTRUCT
   
    Dim sSrcDir As String
    Dim sDestDir As String
   
    sSrcDir = sSrc
    sDestDir = sDest
   
    If Right(sSrcDir, 1) = "\" Or Right(sSrcDir, 1) = "/" Then
        sSrcDir = Left(sSrcDir, Len(sSrcDir) - 1)
    End If
   
    If Right(sDestDir, 1) <> "\" Or Right(sDestDir, 1) <> "/" Then
        sDestDir = sDestDir + "\"
    End If
   
    With fileop
        .hWnd = GetActiveWindow()
        .wFunc = FO_COPY
        .pFrom = sSrcDir + vbNullChar + vbNullChar
        .pTo = sDestDir + vbNullChar + vbNullChar
        .fFlags = FOF_SIMPLEPROGRESS Or FOF_CONFIRMMOUSE Or _
                  FOF_NOCONFIRMMKDIR Or FOF_NOCONFIRMATION
    End With
   
    If SHFileOperation(fileop) <> 0 Then
        'MsgAlert Err.LastDllError
        Exit Function
    Else
        If fileop.fAnyOperationsAborted <> 0 Then
            MsgAlert "操作失败！"
            Exit Function
        End If
    End If
   
    CopyDir = True
   
End Function

'删除目录
Public Function DeleteDir(ByVal sDirPath As String) As Boolean
   
    Dim fileop As SHFILEOPSTRUCT
   
    If Right(sDirPath, 1) = "\" Or Right(sDirPath, 1) = "/" Then
        sDirPath = Left(sDirPath, Len(sDirPath) - 1)
    End If
   
    With fileop
        .hWnd = GetActiveWindow()
        .wFunc = FO_DELETE
        .pFrom = sDirPath + vbNullChar + vbNullChar
        .fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or FOF_CONFIRMMOUSE
    End With
   
    If SHFileOperation(fileop) <> 0 Then
        'MsgAlert Err.LastDllError
        Exit Function
    Else
        If fileop.fAnyOperationsAborted <> 0 Then
            MsgAlert "操作失败！"
            Exit Function
        End If
    End If
   
    DeleteDir = True
   
End Function

'获取指定的路径
Public Function GetSpecifiedPath(ByVal dwType As enumGSP) As String
   
   Dim sPath As String
   Dim nLength As Long
   
   sPath = String(MAX_PATH, Chr(0))
   
   Select Case dwType
   
      Case GSP_WND
         nLength = GetWindowsDirectory(sPath, MAX_PATH)
         sPath = Left(sPath, nLength)
         
      Case GSP_SYS
         nLength = GetSystemDirectory(sPath, MAX_PATH)
         sPath = Left(sPath, nLength)
         
      Case GSP_APP
         sPath = App.Path
         
      Case GSP_TMP
         nLength = GetTempPath(MAX_PATH, sPath)
         sPath = Left(sPath, nLength)
         
      Case GSP_COM
         nLength = GetSystemDirectory(sPath, MAX_PATH)
         sPath = Left(sPath, 3) + &quotrogram Files\Common Files\"
         
      Case GSP_PRG
         nLength = GetSystemDirectory(sPath, MAX_PATH)
         sPath = Left(sPath, 3) + "Program Files\"
      
      Case GSP_DSK
         Call SHGetSpecialFolderPath(0, sPath, CSIDL_DESKTOP, 0)
         sPath = TrimNull(sPath)
         
   End Select
   
   sPath = FixDirectory(sPath)
   GetSpecifiedPath = sPath
   
End Function

'修复 Win32 目录 规范化。即路径最后的字符串必须是“\”
Public Function FixDirectory(ByVal sPath As String) As String
   
   sPath = StrConv(sPath, vbProperCase)
   
   Select Case Right$(sPath, 1)
       Case "\", "/"
       Case Else
           sPath = sPath + "\"
   End Select
   
   FixDirectory = sPath
   
End Function

dreamerate

代码这么长，不知大家有没有信心看呢？

高手应该都有自己编写这样的函数吧？让大家见笑了，本不想拿出来的。

哎！大家又要扔砖块了……  

系统崩溃

这是使用API中ReadFile、WriteFile读写文件，尽管比VB函数效率高点儿，却也到不了本质差距。dreamerate擅长汇编，如果以此来实现，效率是否可以进一步提高？

另外想请教一下，在32位系统中，由于标准函数使用long类型，单个文件长度无法超过2GB，该如何生成、读写并保存更大的文件呢（我见过长达15GB的高清视频文件）？

dreamerate

由于用VB读写文件的方法很烦琐，并且不规范，所以偶不采用。即使是汇编，在WIN32下，由于保护模式的原因，WINDOWS不允许我们直接操作磁盘的，直接写磁盘还是很麻烦的。所以不如用API算了。

由于是在32BITS的OS限制下，原则上每个PE只能使用OS为你分配的4GB内存，高端的2GB系统已使用，而你能使用就是低端的<2GB。读写超过2G的文件，用文件映射应该可以吧，速度也很快，我没有试过。这方面比较少接触，有机会要试试。

dreamerate

一般用于读/写超过2G的文件方法，大多数都是用分割。利如DVD：）

Gfyy_2005

可以升级 .NET 了吧？最新版的 VB 2005 中 My.Computer.FileStream 命名空间有很多快捷操作。

遥感地狱

VS.NET 可以用吗