📄 disktest.bas
字号:
Begin Dialog Dialog_1 108,83, 263, 224, "Disk Test ",.disktest
OptionGroup .GROUP_1
OptionButton 12,88,60,12, "Read Test",.rdtst
OptionButton 12,108,60,12, "Write Test",.wrttst
OptionButton 12,128,56,12, "Verify Test",.vtst
OptionButton 12,148,56,12, "Format Drive",.fmt
OptionButton 12,168,80,12, "Write/Read",.wrf
PushButton 12,208,32,12, "Start", .strt
OKButton 216,208,32,12,.ok
CancelButton 100,208,48,12,.cancel
Text 120,128,48,12, "Start Block #"
Text 124,144,48,12, "End Block #"
TextBox 184,128,56,12, .STARTBLK
TextBox 184,144,56,12, .ENDBLK
Text 116,166,52,12, "Current Block #"
TextBox 184,164,56,12, .CURRENTBLK
Text 0,4,52,12, "SCSI Adapter #"
TextBox 56,4,28,12, .HA
Text 20,20,32,12, "Target #"
TextBox 56,20,28,12, .TARGET
PushButton 92,8,48,16, "Scan Target", .scan
TextBox 4,36,244,16, .INQUIRY
Text 0,56,260,8, "================================================================"
Text 12,180,36,12, "Status:"
TextBox 8,192,240,12, .STATUS
' PushButton 172,8,76,16, "Test ALL Drives", .selectall
End Dialog
Dim dlg1 As Dialog_1
Dim ha As Integer
Dim ta As Integer
Dim lun As Integer
Dim product As String
Dim vendor As String
Dim ver As String
Dim retval As Integer
Dim subok As Integer
Dim target As Integer
Dim highblock As Long
Dim lowblock As Long
Dim blocksize As Long
Dim currentblock As Long
Dim sensedata(32) As Integer
Dim i As Integer
Dim strng As String
Dim cancel As Integer
Sub main
x = Dialog (dlg1)
End Sub
Function disktest( ControlID$, Action%, SuppValue%)
lun = 0
cancel = 0
Select Case Action%
Case 1
DlgText "INQUIRY", "Select Adapter & Target, then click Scan Target"
DlgEnable "rdtst", 0
DlgEnable "wrttst", 0
DlgEnable "vtst", 0
DlgEnable "fmt", 0
DlgEnable "wrf", 0
DlgEnable "strt", 0
Case 2
If ControlID$ = "cancel" Then
' MsgBox "Cancel clicked"
cancel = 1
reval = SCSICMQ()
End If
If ControlID$ = "scan" Then
DlgText "INQUIRY", ""
retval = SCSIGetVendor(dlg1.HA,dlg1.TARGET,lun,vendor)
If retval <> 1 Then
DlgText "INQUIRY", "No Target responds at this address"
DlgEnable "rdtst", 0
DlgEnable "wrttst", 0
DlgEnable "vtst", 0
DlgEnable "fmt", 0
DlgEnable "wrf", 0
DlgEnable "strt", 0
DlgText "STARTBLK", "0"
DlgText "ENDBLK", "0"
DlgText "CURRENTBLK", "0"
GoTo badtarget
End If
retval = SCSITUR(dlg1.HA,dlg1.TARGET,lun)
retval = SCSITUR(dlg1.HA,dlg1.TARGET,lun)
If retval <> 0 Then
MsgBox "This device is off line"
DlgText "STATUS", "This device is off line"
GoTo badtarget
End If
retval = SCSIGetProduct(dlg1.HA,dlg1.TARGET,lun,product)
retval = SCSIGetVersion(dlg1.HA,dlg1.TARGET,lun,ver)
DlgText "INQUIRY", vendor & product & ver
retval = SCSIReadCapacity(dlg1.HA,dlg1.TARGET,lun,highblock,blocksize)
retval = SCSIReadCapacity(dlg1.HA,dlg1.TARGET,lun,highblock,blocksize)
DlgText "ENDBLK", highblock
DlgText "STARTBLK",0
DlgEnable "rdtst", 1
DlgEnable "wrttst", 1
DlgEnable "vtst", 1
DlgEnable "fmt", 1
DlgEnable "wrf", 1
DlgEnable "strt", 1
badtarget:
End If 'scan
If ControlID$ = "ok" Then
disktest = 0
Stop
End If
If ControlID$ = "cancel" Then
disktest = 0
End If
If ControlID$ = "strt" Then
cancel = 0
Select Case dlg1.GROUP_1
Case 0 ' read test
DlgText "CURRENTBLK", dlg1.STARTBLK
DlgText "STATUS", "Reading disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK & " )"
retval = MsgBox("Click YES to start Read Test",36)
If retval <> 6 Then
GoTo cancelread
End If
retval = ReadTest()
If subok <> 1 Then
MsgBox "Read Test Failed"
GoTo badread
Else
MsgBox "Read Test Passed"
End If
GoTo skipbadread
cancelread:
DlgText "STATUS", "Read Test cancelled"
GoTo skipbadread
badread:
DlgText "STATUS", "Read Test Aborted on error"
skipbadread:
Case 1
' MsgBox "Write Test - blocks " & dlg1.STARTBLK & " - " & dlg1.ENDBLK
DlgText "CURRENTBLK", dlg1.STARTBLK
DlgText "STATUS", "Writing disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK & " )"
retval = MsgBox("Click YES to start Write Test",36)
If retval <> 6 Then
GoTo cancelwrite
End If
retval = WriteTest()
If subok <> 1 Then
MsgBox "Write Test Failed"
GoTo badwrite
Else
MsgBox "Write Test Passed"
End If
GoTo skipbadwrite
cancelwrite:
DlgText "STATUS", "Write Test cancelled"
GoTo skipbadwrite
badwrite:
DlgText "STATUS", "Write Test Aborted on error"
skipbadwrite:
Case 2
DlgText "CURRENTBLK", dlg1.STARTBLK
DlgText "STATUS", "Verifying disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK & " )"
retval = MsgBox("Click YES to start Verify Test",36)
If retval <> 6 Then
GoTo cancelverify
End If
retval = VerifyTest()
If subok <> 1 Then
MsgBox "Verify Test Failed"
GoTo badverify
Else
MsgBox "Verify Test Passed"
End If
GoTo skipbadverify
cancelverify:
DlgText "STATUS", "Verify Test cancelled"
GoTo skipbadverify
badverify:
DlgText "STATUS", "Verify Test Aborted on error"
skipbadverify:
Case 3
retval = MsgBox("Click YES to start FORMAT",36)
If retval <> 6 Then
GoTo cancelformat
End If
DlgText "STATUS", "Formatting disk ... May take a LONG time"
retval = SCSIDiskFormat(dlg1.HA,dlg1.TARGET,lun,0)
If retval <> 0 Then
DlgText "STATUS" , "Error formatting disk"
MsgBox "Error formatting disk"
retval = SCSIViewSense(sensedata)
MsgBox "Key = " & Hex(sensedata(2))& " " & "Code = " & Hex(sensedata(12)) & " " & "ASQ = " & Hex(sensedata(13))
GoTo badverify
Else
DlgText "STATUS", "Format Complete"
MsgBox "Format Complete - Success"
End If
cancelformat:
badformat:
Case 4
DlgText "CURRENTBLK", dlg1.STARTBLK
DlgText "STATUS", "Write/Read disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK & " )" & " + Format"
retval = MsgBox("Click YES to start Write/Read/Format Test",36)
If retval <> 6 Then
GoTo cancelwrf
End If
WriteTest
If subok <> 1 Then
MsgBox "Write Test Failed"
GoTo badwrf
Else
DlgText "STATUS", "Write portion of Write/Read Passed"
End If
ReadTest
If subok <> 1 Then
MsgBox "Read Test Failed"
GoTo badwrf
Else
DlgText "STATUS", "Read portion of Write/Read Passed"
End If
DlgText "STATUS", "Write/Read/Format Test Passed"
' DlgText "STATUS", "Formatting disk ... May take a LONG time"
' retval = SCSIDiskFormat(dlg1.HA,dlg1.TARGET,lun,0)
' If retval <> 0 Then
' DlgText "STATUS" , "Error formatting disk"
' MsgBox "Error formatting disk"
' retval = SCSIViewSense(sensedata)
' MsgBox "Key = " & Hex(sensedata(2))& " " & "Code = " & Hex(sensedata(12)) & " " & "ASQ = " & Hex(sensedata(13))
' GoTo badwrf
' Else
' DlgText "STATUS", "Format Complete"
MsgBox "Write/Read Complete - Success"
' End If
cancelwrf:
badwrf:
Case Else
End Select
End If 'start
Case 3
' MsgBox "box changed was " & ControlID$ & "number of chars = " & SuppValue%
Case Else
End Select
disktest = 1
End Function
Function ReadTest
DlgText "STATUS", "Reading disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK
For loopy = dlg1.STARTBLK To dlg1.ENDBLK Step 16
If loopy Mod 1600 = 0 Then
DlgText "CURRENTBLK", loopy + 16
End If
retval = SCSIDiskRead(dlg1.HA,dlg1.TARGET,lun,16,loopy,512,0)
If retval <> 0 Then
DlgText "STATUS" , "Error reading block " & loopy
MsgBox "Error reading disk"
retval = SCSIViewSense(sensedata)
MsgBox "Key = " & Hex(sensedata(2))& " " & "Code = " & Hex(sensedata(12)) & " " & "ASQ = " & Hex(sensedata(13))
subok = -1
GoTo readtestdone
End If
retval = SCSICMQ()
If cancel <> 0 Then
subok = 1
DlgText "STATUS", "Read Test Cancelled"
GoTo readtestdone
End If
Next 'loopy
DlgText "STATUS", "Read Test Complete - no errors"
subok = 1
readtestdone:
End Function ' readtest
Function WriteTest
DlgText "STATUS", "Writing disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK
For loopy = dlg1.STARTBLK To dlg1.ENDBLK Step 16
DlgText "CURRENTBLK", loopy + 16
retval = SCSIDiskWrite(dlg1.HA,dlg1.TARGET,lun,16,loopy,512,0)
If retval <> 0 Then
DlgText "STATUS" , "Error writing block " & loopy
MsgBox "Error writing disk"
retval = SCSIViewSense(sensedata)
MsgBox "Key = " & Hex(sensedata(2))& " " & "Code = " & Hex(sensedata(12)) & " " & "ASQ = " & Hex(sensedata(13))
subok = -1
GoTo writetestdone
End If
retval = SCSICMQ()
If cancel <> 0 Then
subok = 1
DlgText "STATUS", "Write Test Cancelled"
GoTo writetestdone
End If
Next 'loopy
DlgText "STATUS", "Write Test Complete - no errors"
subok = 1
writetestdone:
End Function 'write test
Function VerifyTest
DlgText "STATUS", "Verifying disk ... (from block " & dlg1.STARTBLK & " to block " & dlg1.ENDBLK
For loopy = dlg1.STARTBLK To dlg1.ENDBLK Step 16
DlgText "CURRENTBLK", loopy + 16
retval = SCSIDiskVerify(dlg1.HA,dlg1.TARGET,lun,16,loopy,512,0)
If retval <> 0 Then
DlgText "STATUS" , "Error verifying block " & loopy
MsgBox "Error verifying disk"
retval = SCSIViewSense(sensedata)
MsgBox "Key = " & Hex(sensedata(2))& " " & "Code = " & Hex(sensedata(12)) & " " & "ASQ = " & Hex(sensedata(13))
subok = -1
GoTo verifytestdone
End If
retval = SCSICMQ()
If cancel <> 0 Then
subok = 1
GoTo verifytestdone
DlgText "STATUS", "Verify Test Cancelled"
End If
Next 'loopy
DlgText "STATUS", "Verify Test Complete - no errors"
subok = 1
verifytestdone:
End function ' verifytest
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -