⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 moddtp.bas

📁 这个代码是基于软盘修复
💻 BAS
📖 第 1 页 / 共 3 页
字号:
  aux = (EndTick - StartTick) / 1000
  Call DigitalText(r4X, r4Y + Central.PicCentral.Top - 21, StrClock(aux), 3)
End Sub

'------------------------------------------------DepthScanIn
Private Function DepthScanIn(ByVal IOres As Long, ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal Light As Boolean) As Boolean
  If (Light = False) And (DepthScan = False) Then
    DepthScanIn = False
    Exit Function
  End If
  'no error, no depth going - nothing to do
  If (IOres = 0) And (DepthScan = False) Then
    DepthScanIn = False
    Exit Function
  End If
  'error - start depth scan or more depth scan
  If IOres <> 0 Then
    If mLightRead < 4 Then
      Call DisplaySectors(Track, Side, Sector, statNormal)
      mLightRead = mLightRead + 1
    Else
      DepthScanIn = False
      Exit Function
    End If
    Call DisplayReadSlider
    DepthScan = True
    DepthScanIn = True
    Exit Function
  End If
  'default
  DepthScanIn = False
End Function

'-----------------------------------------------DepthScanOut
Private Sub DepthScanOut(ByVal IOres As Long, ByVal Sector As Byte)
  If DepthScan = False Then oldNsec = mLightRead
  If (IOres = 0) And (DepthScan = True) Then
    Select Case Sector
      Case 1:
        mLightRead = 1
        DepthScan = False
      Case 10: mLightRead = 2
      Case 4, 7, 13, 16: mLightRead = 3
      Case Else: mLightRead = 4
    End Select
    Call DisplayReadSlider
  End If
  If (mLightRead < oldNsec) Or (EOFdisk = True) Then
    mLightRead = oldNsec
    DepthScan = False
    Call DisplayReadSlider
  End If
End Sub

'---------------------------------------------------AutoCopy
Private Sub AutoCopy(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte)
  Dim SecNum As Long
  Dim i As Byte
  Dim j As Long
  Dim sKey As String
  
  For i = 1 To nSect
    SecNum = SectorNumber(Track, Side, Sector + (i - 1))
    If SecCopy(SecNum) = False Then
      For j = 1 To 512
        SecList(SecNum, j) = IOdados((i - 1) * 512 + j - 1)
      Next j
      SecCopy(SecNum) = True
    End If
  Next i
End Sub

'-------------------------------------------TransferAutoCopy
Private Sub TransferAutoCopy(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte)
  Dim SecNum As Long
  Dim i As Byte
  Dim j As Long
  Dim sKey As String
  
  For i = 1 To nSect
    SecNum = SectorNumber(Track, Side, Sector + (i - 1))
    For j = 1 To 512
      IOdados((i - 1) * 512 + j - 1) = SecList(SecNum, j)
    Next j
  Next i
End Sub

'-----------------------------------------------TestAutoCopy
Private Function TestAutoCopy(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte)
  Dim i As Byte
  Dim curSec As Long
  Dim res As Boolean
  
  res = True
  For i = Sector To Sector + nSect - 1
    curSec = SectorNumber(Track, Side, i)
    If SecCopy(curSec) = False Then res = False
  Next i
  TestAutoCopy = res
End Function

'-------------------------------------------ReplaceByCopyFAT
Private Function ReplaceByCopyFAT(ByVal nSect As Long) As Long
  Dim i As Long
  
  If (nSect < 2) Or (nSect > 19) Then
    ReplaceByCopyFAT = 1
    Exit Function
  End If
  Select Case nSect
    Case 2, 3, 4, 5, 6, 7, 8, 9, 10:          'Get from FAT2
      If SecCopy(nSect + 9) = False Then
        ReplaceByCopyFAT = 1
        Exit Function
      End If
      For i = 1 To 512
        SecList(nSect, i) = SecList(nSect + 9, i)
      Next i
      SecCopy(nSect) = True
    Case 11, 12, 13, 14, 15, 16, 17, 18, 19:  'Get from FAT1
      If SecCopy(nSect - 9) = False Then
        ReplaceByCopyFAT = 1
        Exit Function
      End If
      For i = 1 To 512
        SecList(nSect, i) = SecList(nSect - 9, i)
      Next i
      SecCopy(nSect) = True
  End Select
  ReplaceByCopyFAT = 0
End Function

'-----------------------------------------MarkBadReservation
Private Sub MarkBadReservation(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte)
  Dim i As Byte
  Dim curSec As Long
  
  For i = Sector To Sector + nSect - 1
    curSec = SectorNumber(Track, Side, i)
    If SectorInfo(curSec) = IOempty Then
      SectorInfo(curSec) = IObad
      SectorVal(curSec) = &HFF7 'bad
      MarkBad = True
      Call DisplaySectorInside(IObad, Track, Side, i)
    End If
  Next i
End Sub

'---------------------------------------UnMarkBadReservation
Private Sub UnMarkBadReservation(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte)
  Dim i As Byte
  Dim curSec As Long
  
  For i = Sector To Sector + nSect - 1
    curSec = SectorNumber(Track, Side, i)
    If SectorInfo(curSec) = IObad Then
      SectorInfo(curSec) = IOempty
      SectorVal(curSec) = 0
      MarkBad = True
      Call DisplaySectorInside(IOempty, Track, Side, i)
    End If
  Next i
End Sub

'--------------------------------------------SetSectorStatus
Public Sub SetSectorStatus(ByVal Track As Byte, ByVal Side As Byte, ByVal Sector As Byte, ByVal nSect As Byte, ByVal IOResult As Long)
  Dim i As Byte
  Dim curSec As Long

  For i = Sector To Sector + nSect - 1
    curSec = SectorNumber(Track, Side, i)
    If IOResult = 0 Then
      SectorStat(curSec) = statOk
      If (mModWin = 1) Or (mModWin = 3) Then Call DisplaySector(Track, Side, i, statOk)
    Else
      SectorStat(curSec) = statError
      If (mModWin = 1) Or (mModWin = 3) Then Call DisplaySector(Track, Side, i, statError)
    End If
  Next i
  If (mModWin = 0) Or (mModWin = 2) Then
    Call DisplaySector(Track, 0, Side + 1, GetSideTrackSector(Track, Side))
  End If
End Sub
      
'---------------------------------------------------InitScan
Private Sub InitScan()
  Dim i As Long
  
  EOFdisk = False
  MarkBad = False
  DepthScan = False
  For i = 1 To 2880: SectorStat(i) = statNormal: Next i
  Call DisplaySurface
  StartSec = SectorNumber(Central.StartEnd.StartPosition - 1, 0, 1)
  CurrentSec = StartSec
  EndSec = SectorNumber(Central.StartEnd.EndPosition - 1, 1, 18)
  Call DisplayTiming
  Central.TimedWave1.Clear
  Call InitializeDiskIO
  DoEvents
  StartTick = GetTickCount()
End Sub

'------------------------------------------------SurfaceScan
Public Sub SurfaceScan()
  Dim Track As Byte
  Dim Side As Byte
  Dim Sector As Byte
  Dim IOResult As Long
  Dim nSect As Byte
  
  'prepare
  Track = Central.StartEnd.StartPosition - 1
  Side = 0
  Sector = 1
  Call InitScan
  'Scan
  Do While (EOFdisk = False) And (mWork = 1)
    nSect = NumSectors()
    Call DisplayPosition(Track, Side, Sector)
    If JumpBad(Track, Side, Sector, mLightScan(8)) = False Then
      IOResult = 0
      '-----------------------------------------------------
      'read
      If mLightScan(4) = True Then
        Call DisplaySectors(Track, Side, Sector, statRead)
        DoEvents
        IOResult = DiskIO(IOReadDisk, IOFloppyA, nSect, Track, Side, Sector)
        If (IOResult = 0) And (mLightScan(10) = True) Then Call AutoCopy(Track, Side, Sector, nSect)
      End If
      'write
      If mLightScan(5) = True Then
        If (IOResult = 0) Or (GetSideTrackInside(Track, Side, Sector) = IOempty) Or (GetSideTrackInside(Track, Side, Sector) = IObad) Then
          Call DisplaySectors(Track, Side, Sector, statWrite)
          DoEvents
          IOResult = DiskIO(IOWriteDisk, IOFloppyA, nSect, Track, Side, Sector)
          If IOResult = 0 Then
            Call DisplaySectors(Track, Side, Sector, statRead)
            DoEvents
            IOResult = DiskIO(IOReadDisk, IOFloppyA, nSect, Track, Side, Sector)
          End If
        End If
      End If
      'verify
      If (IOResult = 0) And (mLightScan(6) = True) Then
        Call DisplaySectors(Track, Side, Sector, statVerify)
        DoEvents
        IOResult = DiskIO(IOVerifyDisk, IOFloppyA, nSect, Track, Side, Sector)
      End If
      '----------------------------------------------------
      'Depth Scan (IN)
      If DepthScanIn(IOResult, Track, Side, Sector, mLightScan(9)) = True Then GoTo ContinueScan
      'set sector status
      Call SetSectorStatus(Track, Side, Sector, nSect, IOResult)
      'Mark Bad reservation
      If (IOResult <> 0) And (mLightScan(7) = True) Then Call MarkBadReservation(Track, Side, Sector, nSect)
    End If
    DoEvents
    'next sector
    If AdvanceSector(Track, Side, Sector) = False Then EOFdisk = True
    'Depth Scan (OUT)
    If DepthScan = False Then oldNsec = mLightRead
    Call DepthScanOut(IOResult, Sector)
    'Check time
    CurrentSec = SectorNumber(Track, Side, Sector)
    Call DisplayTiming
ContinueScan:
  Loop
  'Save FAT if marked bad
  If MarkBad = True Then
    Call WriteDiskDATA
    MarkBad = False
  End If
  Call CloseDiskIO
End Sub

'--------------------------------------------RecoverSaveDisk
Public Sub RecoverSaveDisk()
  Dim Track As Byte
  Dim Side As Byte
  Dim Sector As Byte
  Dim IOResult As Long
  Dim nSect As Byte
  Dim i As Long
  Dim num As Long
  
  'prepare
  Track = Central.StartEnd.StartPosition - 1
  Side = 0
  Sector = 1
  BkJump = mJumpNext
  Call InitScan
  Call CreateIdFile(mSaveName, "DTPRO-Saved Disk Image", 30)
  'Save
  Do While (EOFdisk = False) And (mWork = 3)
    If (mModWin = 0) Or (mModWin = 3) Then
      Call DigitalINT(Central, 135, 41 + Central.PicCentral.Top - 21, CountSecCopy(), 2, 4)
    End If
    nSect = NumSectors()
    Call DisplayPosition(Track, Side, Sector)
    If (JumpBad(Track, Side, Sector, mLightRecover(4)) = False) And _
       (JumpOnlyData(Track, Side, Sector, mLightRecover(4)) = False) Then
      IOResult = 0
      '-----------------------------------------------------
      'test auto copy
      If TestAutoCopy(Track, Side, Sector, nSect) = False Then
        Call DisplaySectors(Track, Side, Sector, statRead)
        DoEvents
        IOResult = DiskIO(IOReadDisk, IOFloppyA, nSect, Track, Side, Sector)
        'test if FAT problem
        If (nSect = 1) And (IOResult <> 0) Then
          num = SectorNumber(Track, Side, Sector)
          IOResult = ReplaceByCopyFAT(num)
        End If
        If IOResult = 0 Then Call AutoCopy(Track, Side, Sector, nSect)
      End If
      'Jump next after n readings
      If (IOResult <> 0) And (mJumpNext > 0) Then
        If DepthScanIn(IOResult, Track, Side, Sector, mLightRecover(5)) = False Then
          mJumpNext = mJumpNext - 1
          Call DigitalINT(Central, 135, 54 + Central.PicCentral.Top - 21, mJumpNext, 2, 4)
        End If
        GoTo ContinueRecover
      Else
        mJumpNext = BkJump
        Call DigitalINT(Central, 135, 54 + Central.PicCentral.Top - 21, mJumpNext, 2, 4)
      End If
      'transfer to IO buffer
      If IOResult = 0 Then Call TransferAutoCopy(Track, Side, Sector, nSect)
      '-----------------------------------------------------
      'set sector status
      Call SetSectorStatus(Track, Side, Sector, nSect, IOResult)
      'Mark Bad reservation
      If (IOResult <> 0) And (mLightRecover(3) = True) Then Call MarkBadReservation(Track, Side, Sector, nSect)
    Else
      For i = 1 To 512 * nSect
        IOdados(i - 1) = 0
      Next i
      Call AutoCopy(Track, Side, Sector, nSect)
      Call SetSectorStatus(Track, Side, Sector, nSect, 0)
    End If
    DoEvents
    'save data

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -