数据Option Explicit

'/////////////////////////////////////////
'// 对磁盘的物理扇区数据读/写操作
'// last update: 2004-8-7
'// Kwanhong Young
'/////////////////////////////////////////


'//file system
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 Long) As Long '//declare has changed
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 '//declare has changed
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3

Private Const INVALID_HANDLE_VALUE = -1

'//file seek
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2

Private Const ERROR_SUCCESS = 0&

'//device io control
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long

Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000 '458752
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018
Private Const FSCTL_LOCK_VOLUME As Long = &H90018
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F

'//type
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Enum MEDIA_TYPE
Unknown
F5_1Pt2_512
F3_1Pt44_512
F3_2Pt88_512
F3_20Pt8_512
F3_720_512
F5_360_512
F5_320_512
F5_320_1024
F5_180_512
F5_160_512
RemovableMedia
FixedMedia
End Enum

Private Type DISK_GEOMETRY
Cylinders As LARGE_INTEGER
MediaType As MEDIA_TYPE
TracksPerCylinder As Long
SectorsPerTrack As Long
BytesPerSector As Long
End Type

'//private vars
Private hDisk As Long 'disk handle
Private lpGeometry As DISK_GEOMETRY 'disk info
Private lBufferSize As Long 'the buffer size of read/write

Public Function OpenDisk(ByVal FileName As String) As Boolean
'// 打开磁盘
hDisk = CreateFile(FileName, _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _
OPEN_EXISTING, _
0, _
0)
OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE)
End Function

Public Function CloseDisk() As Boolean
'//关闭磁盘
CloseDisk = CloseHandle(hDisk)
End Function

Public Function GetDiskGeometry() As Boolean
'//获取磁盘参数
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

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