moduleapi.bas

磁盘FAT扇区数据读写操作 Ver 1.20(更新版)

'    '//获取磁盘参数
'    Dim dwOutBytes As Long
'    Dim bResult As Boolean
'
'    bResult = DeviceIoControl(hDisk, IOCTL_DISK_GET_DRIVE_GEOMETRY, ByVal 0&, 0, lpGeometry, Len(lpGeometry), dwOutBytes, _
'    ByVal 0&)
'
'    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack
'    GetDiskGeometry = bResult
'End Function
'Public Sub GetDiskInfo(MediaType As Long, Cylinders As Long, TracksPerCylinder As Long, SectorsPerTrack As Long, _
'                       BytesPerSector As Long)
'    '//返回磁盘的参数
'    MediaType = lpGeometry.MediaType
'    Cylinders = lpGeometry.Cylinders.lowpart
'    TracksPerCylinder = lpGeometry.TracksPerCylinder
'    SectorsPerTrack = lpGeometry.SectorsPerTrack
'    BytesPerSector = lpGeometry.BytesPerSector
'
'End Sub


'Public Property Get BufferSize() As Long
'    '//返回每次读/写的缓冲大小
'    BufferSize = lBufferSize
'End Property
Public Function LockVolume() As Boolean
    '// 将卷锁定
    Dim dwOutBytes As Long
    Dim bResult As Boolean
    
    bResult = DeviceIoControl(hDisk, FSCTL_LOCK_VOLUME, ByVal 0&, 0, ByVal 0&, 0, dwOutBytes, ByVal 0&)
    LockVolume = bResult
End Function


Public Function UnlockVolume() As Boolean
    '// 将卷解锁
    Dim dwOutBytes As Long
    Dim bResult As Boolean
    
    bResult = DeviceIoControl(hDisk, FSCTL_UNLOCK_VOLUME, ByVal 0&, 0, ByVal 0&, 0, dwOutBytes, ByVal 0&)
    UnlockVolume = bResult
End Function
'Public Function DismountVolume() As Boolean
'    '// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘
'    Dim dwOutBytes As Long
'    Dim bResult As Boolean
'
'    bResult = DeviceIoControl(hDisk, FSCTL_DISMOUNT_VOLUME, ByVal 0&, 0, ByVal 0&, 0, dwOutBytes, ByVal 0&)
'    DismountVolume = bResult
'End Function
'//按柱面和磁道来读取磁盘数据,要求
'Public Function ReadDisk(ByVal Cylinders As Long, ByVal Tracks As Long, db() As Byte) As Boolean
'
'    Dim iPos As Long
'    Dim lRead As Long
'
'    iPos = Cylinders * Tracks * lBufferSize
'    If SeekAbsolute(0, iPos) Then
'        ReadDisk = ReadBytes(lBufferSize, db(), lRead)
'    End If
'End Function

'----------------------------------------------
' Procedure  : ReadDiskbySector
' Auther     : WangWeiSheng
' Input      : lStartSector    要读的扇区起始位置
' Input      : lNumReadSector  要读多少个扇区
' Input      : db()            存放读出的数据的数组
' OutPut     : Boolean         读出是否成功
' Purpose    : 把一个文件直接从磁盘上读出,按扇区地址来读磁盘数据，这样不会出错
'----------------------------------------------
  '//
Public Function ReadDiskbySector(db() As Byte, ByVal lStartSector As Double, ByVal lNumReadSector As Long) As Boolean
  
    Dim lPosLow As Long               '位置的低32位
    Dim lPosHigh As Long              '位置的高32位
    Dim lRead As Long                 '实际读出的字节数
    Dim dStartPos As Double           '由扇区计算出的绝对起始位位置
    Dim lReadBytes As Long            '由扇区计算出的要读出的字节数
    dStartPos = lStartSector * 512
    lReadBytes = lNumReadSector * 512
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)

    If SeekAbsolute(lPosHigh, lPosLow) Then
        ReadDiskbySector = ReadBytes(lReadBytes, db(), lRead)
    End If
End Function
'----------------------------------------------
' Procedure  : WriteDiskbySector
' Auther     : WangWeiSheng
' Input      : lStartSector    要写的扇区起始位置
' Input      : lNumReadSector  要写入多少个扇区
' Input      : db()            存有写入数据的数组
' OutPut     : Boolean         写入是否成功
' Purpose    : 把数据写入磁盘,按扇区地址来写入磁盘数据，这样不会出错
'----------------------------------------------
  '//
Public Function WriteDiskbySector(db() As Byte, ByVal lStartSector As Double, ByVal lNumWriteSector As Long) As Boolean
  
    Dim lPosLow As Long               '位置的低32位
    Dim lPosHigh As Long              '位置的高32位
    Dim dStartPos As Double           '由扇区计算出的绝对起始位位置
    Dim lWriteBytes As Long           '由扇区计算出的要写入的字节数
    
    dStartPos = lStartSector * 512
    lWriteBytes = lNumWriteSector * 512
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)

    If SeekAbsolute(lPosHigh, lPosLow) Then
        WriteDiskbySector = WriteBytes(lWriteBytes, db())
    End If
End Function
  '//按绝对地址来读磁盘数据，要求绝对地址满足512字节的倍数，否则会出错
Public Function ReadDiskbyPos(db() As Byte, ByVal dStartPos As Double, ByVal lReadBytes As Long) As Boolean
  
    Dim lPosLow As Long
    Dim lPosHigh As Long
    Dim lRead As Long
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)
'    iPos = Cylinders * Tracks * lBufferSize
'    lBufferSize = lReadBytes
    If SeekAbsolute(lPosHigh, lPosLow) Then
        ReadDiskbyPos = ReadBytes(lReadBytes, db(), lRead)
    End If
End Function
'//按绝对地址来写磁盘数据，要求绝对地址满足512字节的倍数，否则会出错
Public Function WriteDiskbyPos(ByVal dStartPos As Double, ByVal lWriteBytes As Long, db() As Byte) As Boolean

    Dim lPosLow As Long
    Dim lPosHigh As Long
    Dim lWrite As Long
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)
    
    If SeekAbsolute(lPosHigh, lPosLow) Then
        WriteDiskbyPos = WriteBytes(lWriteBytes, db())
    End If
End Function
Public Function UnsignedToLong(Value As Double) As Long
        If Value < 0 Or Value >= OFFSET_4 Then Error 6
        If Value <= MAXINT_4 Then
          UnsignedToLong = Value
        Else
          UnsignedToLong = Value - OFFSET_4
        End If
      End Function
'Public Function WriteDisk(ByVal Cylinders As Long, ByVal Tracks As Long, db() As Byte) As Boolean
'    '//按柱面和磁道来写磁盘数据
'    Dim iPos As Long
'    Dim lRead As Long
'
'    iPos = Cylinders * Tracks * lBufferSize
'
'    If SeekAbsolute(0, iPos) Then
'        WriteDisk = WriteBytes(lBufferSize, db())
'    End If
'End Function
'/////////////////////////////////////////////////////////////////////////////////////
'//file system

Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean
'//seek file查找文件定读写位置
'//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte
LowPos = SetFilePointer(hDisk, LowPos, VarPtr(HighPos), FILE_BEGIN)
If LowPos = -1 Then
  SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS)
Else
  SeekAbsolute = True
End If
End Function
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean
'//read data to array
Dim RetVal As Long
RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0)
'ActuallyReadByte =>> if the bytesRead=0 mean EOF
ReadBytes = Not (RetVal = 0)

End Function

Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean
'//write data from array
Dim RetVal As Long
Dim BytesToWrite As Long
Dim BytesWritten As Long

RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0)

WriteBytes = Not (RetVal = 0)
End Function

Public Function SynBrowseForFolder(ByVal lngwHandle As Long, ByVal strTitle As String) As String
On Error Resume Next
        
    Dim BI    As BROWSEINFO
     Dim lPid  As Long
     Dim sPath As String
     Dim iPos  As Integer
    
     Dim lPidlRoot As ITEMIDLIST
     Call SHGetFolderLocation(lngwHandle, CSIDL_DESKTOP, 0&, 0&, lPidlRoot)
     
     'Fill in the required members for the browse
     With BI
        .hOwner = lngwHandle
       .pidlRoot = lPidlRoot.mkid.cb '0&
       .pszDisplayName = Space$(MAX_PATH)
       .lpszTitle = strTitle
       .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_STATUSTEXT Or BIF_EDITBOX Or BIF_VALIDATE     '  '这个参数就是有一个新建文件夹按钮
     End With
    
     'show the browse dialog
     lPid = SHBrowseForFolder(BI)
     Dim flName As String
     If InStr(1, Trim(BI.pszDisplayName), "?") Then
        flName = ""
    Else
        If lPid <> 0 Then
          'got a pidl .. but is it valid?
          sPath = Space$(MAX_PATH)
          If SHGetPathFromIDList(ByVal lPid, ByVal sPath) Then
            'valid, so get the share path
            iPos = InStr(sPath, Chr$(0))
            flName = Left$(sPath, iPos - 1)
            If Len(flName) = 3 Then
                flName = Left(flName, 2)
            End If
          End If
        Else