moduleapi.bas

FAT硬盘格式读写程序,希望能有所裨益.

Attribute VB_Name = "ModuleAPI"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/09/30
'描    述：VB对磁盘的物理扇区数据读写操作
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Public Const MAX_PATH = 260
       '打开文件对话框结构
       Public Type OPENFILENAME
         lStructSize As Long
         hwndOwner As Long
         hInstance As Long
         lpstrFilter As String
         lpstrCustomFilter As String
         nMaxCustFilter As Long
         nFilterIndex As Long
         lpstrFile As String
         nMaxFile As Long
         lpstrFileTitle As String
         nMaxFileTitle As Long
         lpstrInitialDir As String
         lpstrTitle As String
         flags As Long
         nFileOffset As Integer
         nFileExtension As Integer
         lpstrDefExt As String
         lCustData As Long
         lpfnHook As Long
         lpTemplateName As String
       End Type
'//type
Private Type LARGE_INTEGER
       lowpart As Long
       highpart As Long
End Type
Public Enum Wheel_Sens
    WHEEL_UP
    WHEEL_DOWN
End Enum
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
Public Type SHITEMID
 cb   As Long 'Size of the ID (including cb itself)
 abID As Byte 'The item ID (variable length)
End Type
Public Type ITEMIDLIST
 mkid As SHITEMID
End Type

Private Type BROWSEINFO
 hOwner         As Long   'Handle to the owner window for the dialog box
 pidlRoot       As Long   'Pointer to an item identifier list (an
                          'ITEMIDLIST structure) specifying the location of
                          'the "root" folder to browse from. Only the
                          'specified folder and its subfolders appear in the dialog box.
                          'This member can be NULL, and in that case, the namespace
                          'root (the desktop folder) is used.
 pszDisplayName As String 'Pointer to a buffer that receives the display
                          'name of the folder selected by the user. The
                          'size of this buffer is assumed to be MAX_PATH bytes.
 lpszTitle      As String 'Pointer to a null-terminated string that is
                          'displayed above the tree view control in the
                          'dialog box.This string can be used to specify
                          'instructions to the user.
 ulFlags        As Long   'Value specifying the types of folders to be
                          'listed in the dialog box as well as other options.
                          'This member can include zero or more of
                          'the following values below.
 lpfn           As Long   'Address an application-defined function that the
                          'dialog box calls when events occur. For more information,
                          'see the description of the BrowseCallbackProc function.
                          'This member can be NULL. (note: VB4 does not support
                          'callbacks, therefore this member is ignored.)
 lParam         As Long   'Application-defined value that the dialog box
                          'passes to the callback function (if one is specified).
 iImage         As Long   'Variable that receives the image associated with
                          'the selected folder. The image is specified as an
                          'index to the system image list.
End Type
'权限常数
    Public Const SE_DEBUG_NAME = "SeDebugPrivilege"
    Public Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
    Public Const SE_PRIVILEGE_ENABLED = &H2
    Public Const TOKEN_ADJUST_PRIVILEGES = &H20
    Public Const TOKEN_QUERY = &H8
    Public Const ANYSIZE_ARRAY = 1
      Public Type Luid
         lowpart As Long
         highpart As Long
      End Type

      Public Type LUID_AND_ATTRIBUTES
         pLuid As Luid
         Attributes As Long
      End Type

      Public Type TOKEN_PRIVILEGES
         PrivilegeCount As Long
         Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
      End Type
      Public Type FILETIME ' 8 Bytes
           dwLowDateTime As Long
           dwHighDateTime As Long
      End Type
Public Declare Function SetFileTime Lib "Kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare Function GetFileTime Lib "Kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
'---文件夹浏览窗口函数（带"新建文件夹"按钮）
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetFolderPath Lib "shell32" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As String) As Long
Private Declare Function SHGetFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, pidl As ITEMIDLIST) As Long

Public Declare Function CreateFile Lib "Kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function FlushFileBuffers Lib "Kernel32" (ByVal hFile As Long) As Long
Public 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
Public Declare Function SetFilePointer Lib "Kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByVal lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function GetFileSize Lib "Kernel32" (ByVal hFile As Long, ByVal lpFileSizeHigh As Long) As Long
Public Declare Function SetEndOfFile Lib "Kernel32" (ByVal hFile As Long) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Public Declare Function LenANSI Lib "Kernel32" Alias "lstrlenA" (ByVal string1 As String) As Long
   
Declare Function GetCurrentProcess Lib "Kernel32" () As Long

Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
   
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
                                          "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As Luid) As Long
   
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
                                       NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

'//file system
Public 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

'//device io control
Public 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
'For the DeviceIoControl's Const
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
'文件夹常数
Private Const CSIDL_DESKTOP           As Long = &H0  'Desktop Folder
Private Const BIF_RETURNONLYFSDIRS   As Long = &H1     'Only return file system directories. If the user selects folders that are not part of the file system, the OK button is grayed
Private Const BIF_STATUSTEXT         As Long = &H4     'Include a status area in the dialog box. The callback function can set the status text by sending messages to the dialog box
Private Const BIF_EDITBOX            As Long = &H16    'Version 4.71. Include an edit control in the browse dialog box that allows the user to type the name of an item
Private Const BIF_VALIDATE           As Long = &H20    'If the user types an invalid name into the edit box, the browse dialog box will call the application's BrowseCallbackProc with the BFFM_VALIDATEFAILED message. This flag is ignored if BIF_EDITBOX is not specified
Private Const BIF_NEWDIALOGSTYLE     As Long = &H64    'Version 5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities including: drag and drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands. To use this flag, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder

'文件操作常数
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_READ = &H80000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_SYSTEM = &H4

Public Const CREATE_ALWAYS = 2
Public Const OPEN_ALWAYS = 4
'Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OF_READWRITE = &H2
Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2
Public Const ERROR_SUCCESS = 0&

'自定义打开对话框常数
Public Const DLG_SHOWOPEN = 1
Public Const DLG_SHOWSAVE = 2

Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647

'//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

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