Option expedition
'/' // Physical sector data read / write operation '// Last Update: 2004-8-7' // kwanhong young '/
'// file systemPrivate 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 LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate 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 changedPrivate 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 changedPrivate Declare Function SetFilePointer Lib "kernel32" (Byval Hfile As Long, Byval LdistanceTomove As Long, Byval DWMOVEMETHIGH AS long) As long
Private const generic_read = & h80000000private const generic_write = & h40000000
Private const file_share_read = & h1private const file_share_write = & h2private const open_exiSTING = 3
Private const invalid_handle_value = -1
'// file seekprivate const file_begin = 0Private const file_current = 1Private const file_end = 2
Private const error_success = 0 &
'// device io controlPrivate 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 LongPrivate Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = & H70000 '458752Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = & H2D0C04Private Const IOCTL_DISK_FORMAT_TRACKS As Long = & H7C018Private Const FSCTL_LOCK_VOLUME As Long = & H90018Private Const FSCTL_UNLOCK_VOLUME As Long = & H9001CPrivate Const FSCTL_DISMOUNT_VOLUME As Long = & H90020Private Const FSCTL_GET_VOLUME_BITMAP = & H9006F
'// TypePrivate Type Large_integer lowpart as long highpart as longend 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 FixedMediaEnd Enum
Private Type Disk_geometry Cylinders As Media_TYPE TRACKSPERCYLINDER AS Long Sectorspertrack As Long Bytespector As LONGEND TYPE
'// private varsprivate hdisk as long' disk handleprivate lpgeometry as disk_geometry 'disk infoprivate lbuffersize as long' The buffer size of read / WRITE
Public Function OpenDisk (ByVal FileName As String) As Boolean '// Open Disk 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 functionpublic function closedisk () as boolean '// Close Disk CloseDisk = CloseHandle (HDisk) End Function
Public Function GetDiskGeometry () As Boolean '// Get disk parameters 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.bytespector * LpGeometry.sectorspertrack getDiskGGEMETRY = BRESULTEND FUNCTION
Public Sub GetDiskInfo (MediaType As Long, _ Cylinders As Long, _ TracksPerCylinder As Long, _ SectorsPerTrack As Long, _ BytesPerSector As Long) '// return the disk parameters MediaType = lpGeometry.MediaType Cylinders = lpGeometry.Cylinders.lowpart TracksPerCylinder = lpGeometry .Trackspercylinder sectorspertrack = lpGeometry.sectorspertrack bytespector = lpGeometry.bytespector
End Sub
Public property get buffersize () as long '// Returns the buffer size of each read / write buffersize = lbuffersizeend property
Public Function LockVolume () As Boolean '// volumes locking Dim dwOutBytes As Long Dim bResult As Boolean bResult = DeviceIoControl (hDisk, _ FSCTL_LOCK_VOLUME, _ ByVal 0 &, 0, _ ByVal 0 &, 0, _ dwOutBytes, _ ByVal 0 &) LockVolume = bResultEnd FunctionPublic Function UnlockVolume () As Boolean '// a volume unlock Dim dwOutBytes As Long Dim bResult As Boolean bResult = DeviceIoControl (hDisk, _ FSCTL_UNLOCK_VOLUME, _ ByVal 0 &, 0, _ ByVal 0 &, 0, _ dwOutBytes, _ ByVal 0 & ) UNLOCKVOLUME = BRESULTEND FUNCTION
Public Function DismountVolume () As Boolean '// remove the volume, so that re-identification system disk, the disk is equivalent to reinsert Dim dwOutBytes As Long Dim bResult As Boolean bResult = DeviceIoControl (hDisk, _ FSCTL_DISMOUNT_VOLUME, _ ByVal 0 &, 0, _BYVAL 0 &, 0, _ DWoutBytes, _ Byval 0 &) DISMOUNTVOLUME = BRESULTEND FUNCTION
Public Function ReadDisk (Byval Cylinders As Long, _BYVAL TRACKS As Long, _ DB () AS BYTE) AS Boolean '// Press Cylindrical and Channels to Read Disk Data DIM IPOS AS Long Dim Lread As Long ipos = Cylinders * TRACKS * LBuffersize if Seekabsolute (0, IPOS) Then readDisk = readbytes (LBuffersize, DB (), LREAD) End IFEND Function
Public Function WriteDisk (Byval Cylinders As Long, _BYVAL TRACKS AS Long, _ DB () AS BYTE) AS Boolean '// Press Cylindrical and Circuit to Write Disk Data DIM IPOS AS Long Dim Lread As long odos = cylinders * TRACKS * LBuffersize if Seekabsolute (0, IPOS) THEN WRITEDISK = Writebytes (LBuffersize, DB ()) end ifend 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 Tenain Seekabsolute = (Err.lastdller = 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 ) 'ActallyReadByte = >> 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
