moddisk.bas

这个代码是基于软盘修复

Attribute VB_Name = "modDisk"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/20
'描    述：软盘分析修复维护工具 Ver 1.3.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit

'-----------------------------------------------Windows APIs
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, lpOverlapped As Any) As Long
Private 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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod 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
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
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function LockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Private Declare Function UnlockFile Lib "kernel32" (ByVal hFile As Long, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

'------------------------------------------------------Const
Private Const VWIN32_DIOC_DOS_IOCTL = 1
Private Const VWIN32_DIOC_DOS_INT13 = 4
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = 1
Private Const FILE_SHARE_WRITE = 2
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_FLAG_NO_BUFFERING = &H20000000
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FILE_BEGIN = 0

Private Const BytesPerSector = 512

'------------------------------------------------------Types
Private Type DIOC_REGISTERS
  EBX As Long
  EDX As Long
  ECX As Long
  EAX As Long
  EDI As Long
  ESI As Long
  Flags As Long
End Type

Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Private Type DiskControlBlock
  StartSector As Long
  SectorRead As Integer
  Data(1 To 9216) As Byte
End Type

Private Type OVERLAPPED
  Internal As Long
  InternalHigh As Long
  offset As Long
  OffsetHigh As Long
  hEvent As Long
End Type

'------------------------------------------------------Enums
Public Enum DiskFunction
  IOReadDisk = 2
  IOWriteDisk = 3
  IOVerifyDisk = 4
  IOFormatDisk = 5
  IOResetSystem = 0
End Enum

Public Enum FloppyNumber
  IOFloppyA = 0
  IOFloppyB = 1
End Enum

Public Enum SectorType
  IOboot = 1
  IOfat2 = 2
  IOempty = 3
  IOdata = 4
  IOfat1 = 5
  IOdir = 6
  IObad = 7
End Enum

Public Enum StatType
  statNormal = 1
  statOk = 2
  statError = 3
  statRead = 4
  statWrite = 5
  statVerify = 6
  statEdit = 7
End Enum
'--------------------------------------------------Variables
Public SectorVal(1 To 2880) As Long        'sector value in FAT
Public SectorInfo(1 To 2880) As SectorType 'type of sector
Public SectorStat(1 To 2880) As StatType   'sector status
Public IOdados(0 To 19216) As Byte         'sector data
Public IsWinNT As Boolean                  'true if WinNT 2000 or XP
Private auxDTA1(1 To 512) As Byte          '1 sector data
Private auxDTA3(1 To 1536) As Byte         '3 sector data
Private auxDTA9(1 To 4608) As Byte         '9 sector data
Private auxDTA18(1 To 9216) As Byte        '18 sector data
Private FileHandle As Long
Private FileNumber As Long
Private FileChunk As Long


'-------------------------------------------InitializaDiskIO
Public Sub InitializeDiskIO()
  If IsWinNT = False Then
    FileHandle = CreateFile("\\.\VWIN32", 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  Else
    FileHandle = CreateFile("\\.\A:", GENERIC_READ Or GENERIC_WRITE, _
           FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
  End If
End Sub

'------------------------------------------------CloseDiskIO
Public Sub CloseDiskIO()
  Call CloseHandle(FileHandle)
End Sub

'-----------------------------------------------------DiskIO
Public Function DiskIO(ByVal IOfunc As DiskFunction, ByVal IOdrive As FloppyNumber, ByVal IOnsec As Byte, ByVal IOtrack As Byte, ByVal IOside As Byte, ByVal IOsector As Byte) As Long
  Dim fResult As Long
  Dim BytesReturned As Long
  Dim Reg As DIOC_REGISTERS
  Dim res As Long
  Dim mByte As Long
  
  If IsWinNT = False Then
  
    'set Bios registers for int 13h
    Reg.EAX = IOfunc * 256 + IOnsec    ' INT 13 Function
    Reg.EBX = VarPtr(IOdados(0))       ' 32bit pointer to data
    Reg.ECX = IOtrack * 256 + IOsector ' Track & Sector
    Reg.EDX = IOside * 256 + IOdrive   ' Side & Drive
    Reg.Flags = 0
    'floppy disk IO
    fResult = DeviceIoControl(FileHandle, VWIN32_DIOC_DOS_INT13, _
        Reg, Len(Reg), Reg, Len(Reg), BytesReturned, 0)
    DiskIO = (Reg.EAX And &HFF00) / 256
  
  Else
    
    mByte = (SectorNumber(IOtrack, IOside, IOsector) - 1) * BytesPerSector
    Call SetFilePointer(FileHandle, mByte, 0, FILE_BEGIN)
    
    If IOfunc = IOReadDisk Then
      Call ReadFile(FileHandle, IOdados(0), IOnsec * BytesPerSector, res, 0&)
    End If
    If IOfunc = IOWriteDisk Then
      Call LockFile(FileHandle, LoWord(mByte), HiWord(mByte), LoWord(IOnsec * BytesPerSector), HiWord(IOnsec * BytesPerSector))
      Call WriteFile(FileHandle, IOdados(0), IOnsec * BytesPerSector, res, 0&)
      Call FlushFileBuffers(FileHandle)
      Call UnlockFile(FileHandle, LoWord(mByte), HiWord(mByte), LoWord(IOnsec * BytesPerSector), HiWord(IOnsec * BytesPerSector))
    End If
    If IOfunc = IOVerifyDisk Then
      Call ReadFile(FileHandle, IOdados(0), IOnsec * BytesPerSector, res, 0&)
    End If
    If IOfunc = IOFormatDisk Then
      Call LockFile(FileHandle, LoWord(mByte), HiWord(mByte), LoWord(IOnsec * BytesPerSector), HiWord(IOnsec * BytesPerSector))
      Call WriteFile(FileHandle, IOdados(0), IOnsec * BytesPerSector, res, 0&)
      Call FlushFileBuffers(FileHandle)
      Call UnlockFile(FileHandle, LoWord(mByte), HiWord(mByte), LoWord(IOnsec * BytesPerSector), HiWord(IOnsec * BytesPerSector))
    End If
    If IOfunc = IOResetSystem Then
      res = IOnsec * BytesPerSector
    End If
    
    If res = IOnsec * BytesPerSector Then DiskIO = 0 Else DiskIO = 255
    
  End If
End Function

'------------------------------------------------FormatTrack
Public Function FormatTrack(ByVal IOdrive As FloppyNumber, ByVal IOtrack As Byte, ByVal IOside As Byte, ByVal Light As Boolean) As Long
  Dim fResult As Long
  Dim BytesReturned As Long
  Dim Reg As DIOC_REGISTERS
  Dim res As Long
  Dim i As Long
  
  'Format Track
  For i = 1 To 18
    IOdados(0 + (i - 1) * 4) = IOtrack
    IOdados(1 + (i - 1) * 4) = IOside
    IOdados(2 + (i - 1) * 4) = i
    IOdados(3 + (i - 1) * 4) = 2
  Next i
  Reg.EAX = 5 * 256 + 18
  Reg.EBX = VarPtr(IOdados(0))
  Reg.ECX = IOtrack * 256
  Reg.EDX = IOside * 256 + IOdrive
  Reg.Flags = 0
  fResult = DeviceIoControl(FileHandle, VWIN32_DIOC_DOS_INT13, _
      Reg, Len(Reg), Reg, Len(Reg), BytesReturned, 0)
  res = (Reg.EAX And &HFF00) / 256
  If res <> 0 Then
    'Reset Disk
    Reg.EAX = 0                        ' Reset Disk system
    Reg.EBX = 0: Reg.ECX = 0
    Reg.EDX = IOdrive                  ' Drive
    Reg.Flags = 0
    fResult = DeviceIoControl(FileHandle, VWIN32_DIOC_DOS_INT13, _
        Reg, Len(Reg), Reg, Len(Reg), BytesReturned, 0)
  End If
  'Set Disk System area
  If IOtrack = 0 Then
    If IOside = 0 Then
      Call WriteBootSector
      For i = 0 To 4607: IOdados(i) = 0: Next i
      For i = 34 To 2880
        If SectorInfo(i) <> IObad Then
          SectorInfo(i) = IOempty
          SectorVal(i) = 0
        End If
        If (SectorInfo(i) = IObad) And (Light = False) Then
          SectorInfo(i) = IOempty
          SectorVal(i) = 0
        End If
      Next i
      Call WriteDiskDATA(False)
    Else
      For i = 0 To 3583: IOdados(i) = 0: Next i
      Call DiskIO(IOWriteDisk, IOFloppyA, 1, 0, 1, 1)
      Call DiskIO(IOWriteDisk, IOFloppyA, 7, 0, 1, 2)
      Call DiskIO(IOWriteDisk, IOFloppyA, 7, 0, 1, 9)
    End If
  End If
  FormatTrack = res
End Function

'-----------------------------------------------ReadDiskData
Public Sub ReadDiskDATA()
  Dim i As Long
  Dim Sector As Integer
  Dim val1 As Long
  Dim val2 As Long
  Dim FatPos As Integer
  
  Call InitializeDiskIO
  Call UltimateReadFAT
  'transfer data
  FatPos = 3
  Sector = 34
  Do While Sector <= 2880
    val1 = ((IOdados(FatPos + 1) And 15) * 256) + IOdados(FatPos)
    val2 = (IOdados(FatPos + 2) * 16) + ((IOdados(FatPos + 1) And 240) \ 16)
    SectorVal(Sector) = val1
    SectorInfo(Sector) = IOdata
    If val1 = 0 Then SectorInfo(Sector) = IOempty
    If (val1 >= &HFF0) And (val1 <= &HFF7) Then SectorInfo(Sector) = IObad
    If Sector < 2880 Then
      SectorVal(Sector + 1) = val2
      SectorInfo(Sector + 1) = IOdata
      If val2 = 0 Then SectorInfo(Sector + 1) = IOempty
      If (val2 >= &HFF0) And (val2 <= &HFF7) Then SectorInfo(Sector + 1) = IObad
    End If
    FatPos = FatPos + 3
    Sector = Sector + 2
  Loop
  SectorInfo(1) = IOboot
  For i = 2 To 10: SectorInfo(i) = IOfat1: Next i
  For i = 11 To 19: SectorInfo(i) = IOfat2: Next i
  For i = 20 To 33: SectorInfo(i) = IOdir: Next i
  For i = 1 To 2880: SectorStat(i) = statNormal: Next i
  SectorVal(1) = IOboot
  For i = 2 To 10: SectorVal(i) = IOfat1: Next i
  For i = 11 To 19: SectorVal(i) = IOfat2: Next i
  For i = 20 To 33: SectorVal(i) = IOdir: Next i
  Call CloseDiskIO
End Sub

'----------------------------------------------ClearDiskData
Public Sub ClearDiskData()
  Dim i As Long
  
  For i = 1 To 2880
    SectorInfo(i) = IOempty
    SectorStat(i) = statNormal
    SectorVal(i) = 0
  Next i
  SectorInfo(1) = IOboot
  For i = 2 To 10: SectorInfo(i) = IOfat1: Next i
  For i = 11 To 19: SectorInfo(i) = IOfat2: Next i
  For i = 20 To 33: SectorInfo(i) = IOdir: Next i
  SectorVal(1) = IOboot
  For i = 2 To 10: SectorVal(i) = IOfat1: Next i
  For i = 11 To 19: SectorVal(i) = IOfat2: Next i
  For i = 20 To 33: SectorVal(i) = IOdir: Next i
End Sub

'-------------------------------------------------GetSecType
Public Function GetSecType(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte) As SectorType
  Dim aux As Long
  Dim num As Long
  
  num = SectorNumber(Track, Side, Sector)
  aux = SectorVal(num)
  Select Case aux
    Case 0: GetSecType = IOempty
    Case 1: If num = 1 Then GetSecType = IOboot Else GetSecType = IOdata
    Case 2: If (num > 10) And (num < 20) Then GetSecType = IOfat2 Else GetSecType = IOdata
    Case 5: If (num > 1) And (num < 11) Then GetSecType = IOfat1 Else GetSecType = IOdata
    Case 6: If (num > 19) And (num < 34) Then GetSecType = IOdir Else GetSecType = IOdata
    Case Else:
      If (aux >= &HFF0) And (aux <= &HFF7) Then
         GetSecType = IObad
      Else
         GetSecType = IOdata
      End If
  End Select
End Function

'--------------------------------------------ResetDiskSystem
Public Sub DiskSystemReset()
  Call InitializeDiskIO
  Call DiskIO(IOResetSystem, IOFloppyA, 0, 0, 0, 0)
  Call CloseDiskIO
End Sub

'---------------------------------------------TestDiskChange
Public Function TestDiskChange() As Boolean
  Dim IOResult As Long
  
  Call InitializeDiskIO
  IOResult = DiskIO(IOReadDisk, IOFloppyA, 1, 0, 0, 1)
  If IOResult = &H6 Then
    TestDiskChange = True
  Else
    TestDiskChange = False
  End If
  Call CloseDiskIO
End Function

'----------------------------------------------TestDiskReady
Public Function TestDiskReady() As Boolean
  Dim IOResult As Long
  Dim Prep As Long
  
PrepDisk:
  Call InitializeDiskIO
  IOResult = DiskIO(IOReadDisk, IOFloppyA, 1, 0, 0, 1)
  If (IOResult <> 0) And (IOResult <> 6) Then
    TestDiskReady = False
    Prep = MsgBox("Error Reading Disk", vbExclamation Or vbAbortRetryIgnore, "Error")
    Select Case Prep
      Case 3: 'abort
         TestDiskReady = False
      Case 4: 'retry
         GoTo PrepDisk
      Case 5: 'Ignore
         TestDiskReady = True
    End Select
  Else
    TestDiskReady = True
  End If
  Call CloseDiskIO
End Function

'-------------------------------------------SetDiskSystemFAT
Public Sub SetDiskSystemFAT()
  Dim pFat As Long, Sec As Long

  Sec = 34: pFat = 3
  Do
    IOdados(pFat) = (SectorVal(Sec) And 255)
    IOdados(pFat + 1) = (SectorVal(Sec) \ 256)
    If Sec < 2880 Then IOdados(pFat + 1) = IOdados(pFat + 1) + ((SectorVal(Sec + 1) And 15) * 16)
    If Sec < 2880 Then IOdados(pFat + 2) = ((SectorVal(Sec + 1) And 4080) \ 16)
    pFat = pFat + 3
    Sec = Sec + 2
  Loop Until Sec = 2882
  For pFat = 4323 To 4607
    IOdados(pFat) = 0
  Next pFat
  IOdados(0) = &HF0
  IOdados(1) = &HFF
  IOdados(2) = &HFF
End Sub

'----------------------------------------------WriteDiskDATA
Public Sub WriteDiskDATA(Optional Side1 As Boolean = True)
  Dim HasBad As Long
  Dim res As Long
  Dim i As Long

  Call SetDiskSystemFAT
  HasBad = 0
  res = DiskIO(IOWriteDisk, IOFloppyA, 9, 0, 0, 2)