a floppy diskette compare utility in qb45

Joined: 4:40 AM - Jan 18, 2016

5:12 AM - May 08, 2018 #1

DECLARE SUB DisplayError (Var%)
REM Disk compare utility. v1.1a PD 07/17/2007.

' store all default variables as integer
DEFINT A-Z

' dimension arrays at runtime
REM $DYNAMIC

' read include files
REM $INCLUDE: 'qb.bi'

' declare interrupt structures
DIM InregsX AS RegTypeX, OutregsX AS RegTypeX

' declare variables
DIM Byte1 AS STRING * 1
DIM Byte2 AS STRING * 1
DIM OutputFile AS STRING
DIM Quote AS STRING * 1
DIM TotalBytes AS DOUBLE

' declare sector buffers
DIM Sector1Data1 AS STRING * 128
DIM Sector1Data2 AS STRING * 128
DIM Sector2Data1 AS STRING * 256
DIM Sector2Data2 AS STRING * 256
DIM Sector3Data1 AS STRING * 512
DIM Sector3Data2 AS STRING * 512
DIM Sector4Data1 AS STRING * 1024
DIM Sector4Data2 AS STRING * 1024

' declare constants
CONST True = -1
CONST False = 0
CONST DFalse = 0#
CONST Nul = ""
Quote = CHR$(34)

' declare error routine
ON ERROR GOTO Error.Routine

' display banner
COLOR 15, 0
PRINT "Disk compare v1.1a."

' reset offset
Memory% = &HEFC7

' check diskette
DEF SEG = &HF000
Bytes = PEEK(Memory% + 3)
SELECT CASE Bytes
CASE 0
BytesPerSector = 128
CASE 1
BytesPerSector = 256
CASE 2
BytesPerSector = 512
CASE 3
BytesPerSector = 1024
END SELECT
SectorsPerTrack = PEEK(Memory% + 4)
DEF SEG

' reset diskette parameters
Sides = 1
TracksPerSide = 80

' check command line
X$ = COMMAND$
IF X$ = "/?" THEN
GOTO BootUsage
END IF
L = INSTR(X$, "/T:")
IF L THEN
I = L
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 3)
GOSUB Get.Numeric
TracksPerSide = V
IF TracksPerSide < 1 OR TrackPerSide > 1024 THEN
GOTO BootError
END IF
END IF
L = INSTR(X$, "/S:")
IF L THEN
I = L
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 3)
GOSUB Get.Numeric
SectorsPerTrack = V
IF SectorsPerTrack < 1 OR SectorsPerTrack > 1024 THEN
GOTO BootError
END IF
END IF
L = INSTR(X$, "/B:")
IF L THEN
I = L
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 3)
GOSUB Get.Numeric
BytesPerSector = V
SELECT CASE BytesPerSector
CASE 128, 256, 512, 1024
' nul
CASE ELSE
GOTO BootError
END SELECT
END IF
L = INSTR(X$, "/1")
IF L > 0 THEN
Sides = 0
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 2)
END IF
L = INSTR(X$, "/C")
IF L > 0 THEN
BypassPrompt = True
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 2)
END IF
L = INSTR(X$, "/L")
IF L > 0 THEN
DisplayType = 1
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 2)
ELSE
FOR z = 1 TO 4
z$ = "/P" + MID$(STR$(z), 2)
L = INSTR(X$, z$)
IF L > 0 THEN
X$ = LEFT$(X$, L - 1) + MID$(X$, L + 3)
PortNumber = z
OutputFile = "LPT" + z$ + ":"
OPEN OutputFile FOR APPEND AS #1
DisplayType = 3
EXIT FOR
END IF
NEXT
END IF
X$ = LTRIM$(X$)
X$ = RTRIM$(X$)
IF LEFT$(X$, 3) = "/O:" THEN
IF DisplayType > 0 THEN
GOTO BootError
END IF
F = 0
X$ = MID$(X$, 4)
IF LEFT$(X$, 1) = Quote THEN
FOR L = 2 TO LEN(X$)
IF MID$(X$, L, 1) = Quote THEN
DisplayType = 2
OutputFile = LEFT$(X$, L - 1)
OutputFile = MID$(OutputFile, 2)
OPEN OutputFile FOR APPEND AS #1
X$ = MID$(X$, L + 1)
F = -1
EXIT FOR
END IF
NEXT
END IF
IF F = 0 THEN
GOTO BootError
END IF
END IF
IF LEN(X$) THEN
GOTO BootError
END IF
TracksPerSide = TracksPerSide - 1
IF BytesPerSector = 0 THEN
COLOR 15
PRINT "Bytes per sector not 128, 256, 512, or 1024."
COLOR 7
END
END IF
IF DisplayType > 0 THEN
GOTO StartLoop
END IF

' read output type
COLOR 14, 0
DO
PRINT "Output type(1=screen,2=file,3=printer,4=quit)? ";
LOCATE , , 1
DO
InputChar$ = INKEY$
IF InputChar$ >= "1" AND InputChar$ <= "4" THEN
EXIT DO
END IF
LOOP
PRINT InputChar$
DisplayType = INT(VAL(InputChar$))
SELECT CASE DisplayType
CASE 1
EXIT DO
CASE 2
PRINT "Enter output filename: ";
LINE INPUT OutputFile
OPEN OutputFile FOR APPEND AS #1
EXIT DO
CASE 3
PRINT "Enter printer port(1-3)? ";
DO
InputChar$ = INKEY$
IF InputChar$ >= "1" AND InputChar$ <= "3" THEN
EXIT DO
END IF
LOOP
PRINT InputChar$
PortNumber = INT(VAL(InputChar$))
OutputFile = "LPT" + MID$(STR$(PortNumber), 2) + ":"
OPEN OutputFile FOR APPEND AS #1
EXIT DO
CASE 4
GOTO Terminate
END SELECT
LOOP
StartLoop:

' read diskettes
FOR Disk = 1 TO 2
IF Disk = 1 THEN
GOSUB OpenFile1
ELSE
GOSUB OpenFile2
END IF
COLOR 14
PRINT "Put diskette#" + MID$(STR$(Disk), 2) + " in drive A: and press any key:"
COLOR 7
SLEEP
ErrorCount = 0
COLOR 10
PRINT "Reading diskette#" + MID$(STR$(Disk), 2) + ".."
COLOR 7
Start1:
GOSUB ResetDrive
RecordNumber! = 0!
FOR Head = 0 TO Sides
FOR Track = 0 TO TracksPerSide
FOR Sector = 1 TO SectorsPerTrack
InregsX.ax = &H201 ' read 1 sector
InregsX.cx = Track * 256 + Sector ' track/sector number
InregsX.dx = Head * 256 ' head/drive 0=A, 1=B
SELECT CASE BytesPerSector
CASE 128
InregsX.es = VARSEG(Sector1Data1)
InregsX.bx = VARPTR(Sector1Data1)
CASE 256
InregsX.es = VARSEG(Sector2Data1)
InregsX.bx = VARPTR(Sector2Data1)
CASE 512
InregsX.es = VARSEG(Sector3Data1)
InregsX.bx = VARPTR(Sector3Data1)
CASE 1024
InregsX.es = VARSEG(Sector4Data1)
InregsX.bx = VARPTR(Sector4Data1)
END SELECT
CALL INTERRUPTX(&H13, InregsX, OutregsX)
IF (OutregsX.flags AND &H1) = &H1 THEN
Error1 = (OutregsX.ax AND &HFF00) / 256
IF Error1 = 6 THEN ' media changed
ErrorCount = ErrorCount + 1
IF ErrorCount > 3 THEN
COLOR 15
PRINT "Error reading diskette:"; Error1
COLOR 7
END
END IF
GOTO Start1
ELSE
IF Error1 < 0 THEN
Error1 = Error1 + 256
END IF
CALL DisplayError(Error1)
PRINT "Exiting diskcomp."
END
END IF
END IF
RecordNumber! = RecordNumber! + 1!
SELECT CASE BytesPerSector
CASE 128
PUT #2, RecordNumber!, Sector1Data1
CASE 256
PUT #2, RecordNumber!, Sector2Data1
CASE 512
PUT #2, RecordNumber!, Sector3Data1
CASE 1024
PUT #2, RecordNumber!, Sector4Data1
END SELECT
NEXT
NEXT
NEXT
NEXT

' reset files
CLOSE #2
CLOSE #3

' open files
SELECT CASE BytesPerSector
CASE 128
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 128
OPEN CompareFile2$ FOR RANDOM SHARED AS #3 LEN = 128
CASE 256
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 256
OPEN CompareFile2$ FOR RANDOM SHARED AS #3 LEN = 256
CASE 512
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 512
OPEN CompareFile2$ FOR RANDOM SHARED AS #3 LEN = 512
CASE 1024
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 1024
OPEN CompareFile2$ FOR RANDOM SHARED AS #3 LEN = 1024
END SELECT

' reset display flags
Display1 = False
QuitFlag = False
IF DisplayType = 1 THEN
COLOR 14
PRINT "Comparing disks.."
END IF

' file compare loop
RecordNumber! = 0! ' record
FOR Head = 0 TO Sides ' heads
FOR Track = 0 TO TracksPerSide ' tracks
FOR Sector = 1 TO SectorsPerTrack ' sectors
RecordNumber! = RecordNumber! + 1!

' read from temp files
SELECT CASE BytesPerSector
CASE 128
GET #2, RecordNumber!, Sector1Data1
GET #3, RecordNumber!, Sector1Data2
CASE 256
GET #2, RecordNumber!, Sector2Data1
GET #3, RecordNumber!, Sector2Data2
CASE 512
GET #2, RecordNumber!, Sector3Data1
GET #3, RecordNumber!, Sector3Data2
CASE 1024
GET #2, RecordNumber!, Sector4Data1
GET #3, RecordNumber!, Sector4Data2
END SELECT

' check buffers
Flag = 0
SELECT CASE BytesPerSector
CASE 128
IF Sector1Data1 <> Sector1Data2 THEN
Flag = -1
END IF
CASE 256
IF Sector2Data1 <> Sector2Data2 THEN
Flag = -1
END IF
CASE 512
IF Sector3Data1 <> Sector3Data2 THEN
Flag = -1
END IF
CASE 1024
IF Sector4Data1 <> Sector4Data2 THEN
Flag = -1
END IF
END SELECT
IF Flag THEN
' check bytes
FOR Byte = 1 TO BytesPerSector

' store bytes
SELECT CASE BytesPerSector
CASE 128
Byte1 = MID$(Sector1Data1, Byte, 1)
Byte2 = MID$(Sector1Data2, Byte, 1)
CASE 256
Byte1 = MID$(Sector2Data1, Byte, 1)
Byte2 = MID$(Sector2Data2, Byte, 1)
CASE 512
Byte1 = MID$(Sector3Data1, Byte, 1)
Byte2 = MID$(Sector3Data2, Byte, 1)
CASE 1024
Byte1 = MID$(Sector4Data1, Byte, 1)
Byte2 = MID$(Sector4Data2, Byte, 1)
END SELECT

' check byte values
IF Byte1 <> Byte2 THEN

' check display flag
IF Display1 = False THEN
GOSUB Header
END IF

' display prompt
IF DisplayType = 1 THEN
IF LineCount >= 22 THEN
IF BypassPrompt = False THEN
COLOR 15, 0
PRINT "Press any key(q to quit):";
LOCATE , , 1
InputChar$ = Nul
DO
InputChar$ = INKEY$
IF InputChar$ <> Nul THEN
IF LCASE$(InputChar$) = "q" THEN
PRINT "q";
QuitFlag = True
END IF
EXIT DO
END IF
LOOP
PRINT
PRINT
IF QuitFlag THEN
EXIT FOR
END IF
END IF
GOSUB Header
END IF
END IF

' printer formfeed
IF DisplayType = 3 THEN
IF LineCount >= 56 THEN
PRINT #1, CHR$(12);
GOSUB Header
END IF
END IF

' create output string
Output$ = "Head " + STR$(Head) + ", "
Output$ = Output$ + "Track " + STR$(Track) + ", "
Output$ = Output$ + "Sector " + STR$(Sector) + ", "
Output$ = Output$ + "Byte " + STR$(Byte)

' output string
SELECT CASE DisplayType
CASE 1 ' display on screen
COLOR 10, 0
PRINT Output$
LineCount = LineCount + 1
CASE 2 ' print to file
PRINT #1, Output$
CASE 3 ' send to printer
PRINT #1, Output$
LineCount = LineCount + 1
END SELECT

' create output string
R2! = (RecordNumber! - 1!) * CSNG(BytesPerSector) + CSNG(Byte)
Output$ = "0x" + RIGHT$("00000000" + HEX$(R2! - 1!), 8) + " "
Output$ = Output$ + "(" + RIGHT$("0000000000" + MID$(STR$(R2!), 2), 10) + ") "

Var1 = ASC(Byte1)
Var1$ = "0x" + RIGHT$("000" + HEX$(Var1), 2) + " "
Var1$ = Var1$ + "(" + RIGHT$("000" + MID$(STR$(Var1), 2), 3) + ")"

Var2 = ASC(Byte2)
Var2$ = "0x" + RIGHT$("000" + HEX$(Var2), 2) + " "
Var2$ = Var2$ + "(" + RIGHT$("000" + MID$(STR$(Var2), 2), 3) + ")"

Output$ = Output$ + " " + Var1$
Output$ = Output$ + " " + Var2$

' output string
SELECT CASE DisplayType
CASE 1 ' display on screen
COLOR 14, 0
PRINT Output$
LineCount = LineCount + 1
CASE 2 ' print to file
PRINT #1, Output$
CASE 3 ' send to printer
PRINT #1, Output$
LineCount = LineCount + 1
END SELECT

' increment mismatched byte counter
TotalBytes = TotalBytes + 1#
END IF
NEXT
END IF

' get keyboard input
InputChar$ = INKEY$

' check escape key
IF InputChar$ = CHR$(27) THEN
QuitFlag = True
END IF

' check quit flag
IF QuitFlag THEN
GOTO ExitLabel
END IF
NEXT
NEXT
NEXT

' exit compare
ExitLabel:

' close files
CLOSE #1
CLOSE #2
CLOSE #3

' remove temp files
KILL CompareFile1$
KILL CompareFile2$

' display final message
COLOR 15, 0
IF Display1 = False THEN
PRINT "Diskettes are equal."
IF DisplayType = 2 THEN
PRINT #1, ""
PRINT #1, "DiskComp: " + DATE$ + " " + TIME$
PRINT #1, "Diskettes are equal."
ELSE
IF DisplayType = 3 THEN
PRINT #1, "Diskettes are equal."
END IF
END IF
ELSE
Output$ = "Total bytes not matching:" + STR$(TotalBytes)
PRINT Output$
IF DisplayType >= 2 THEN
PRINT #1, Output$
END IF
END IF
IF DisplayType >= 2 THEN
PRINT "File info appended to " + OutputFile
END IF
IF DisplayType = 3 THEN
PRINT #1, CHR$(12);
END IF
IF DisplayType = 1 THEN
IF BypassPrompt = False THEN
PRINT "Press any key:";
LOCATE , , 1
SLEEP
PRINT
END IF
END IF

' terminate program
Terminate:

COLOR 7, 0
PRINT "Returning to system:"
END

' display header
Header:
COLOR 15, 0
LineCount = 2
IF Display1 = False THEN
IF DisplayType = 2 THEN
PRINT #1, ""
PRINT #1, "DiskComp: " + DATE$ + " " + TIME$
END IF
END IF
IF Display1 THEN
IF DisplayType = 1 THEN
IF BypassPrompt THEN
RETURN
END IF
END IF
END IF
Display1 = True
Output2$ = "Position offset (hex/asc) Diskette#1 Diskette#2"
Output3$ = "------------------------- ------------ ------------"
IF DisplayType = 1 THEN
PRINT Output2$
PRINT Output3$
ELSE
PRINT #1, Output2$
PRINT #1, Output3$
END IF
RETURN

' boot error display
BootError:
COLOR 14, 0
PRINT "Command line error. Type Diskcomp /? for help."
COLOR 7, 0
END

' boot usage display
BootUsage:
COLOR 14, 0
PRINT "Usage:"
PRINT " Diskcomp [/1][/C][/T:##][/S:##][/B:##][/L|/Px|/O:" + Quote + "filename.ext" + Quote + "]"
PRINT "Where:"
PRINT " /1 compare side 1 only"
PRINT " /C bypass prompts"
PRINT " /T:## tracks per side"
PRINT " /S:## sectors per track"
PRINT " /B:## bytes per sector"
PRINT "Output:"
PRINT " /L display to screen, or"
PRINT " /Px send to printer port(x=1 to 4), or"
PRINT " /O:" + Quote + "filename.ext" + Quote + " send to output file."
PRINT " (must be enclosed in quotes)"
GOTO Terminate

' converts string to value
Get.Numeric:
V = 0
DO
T$ = MID$(X$, I, 1)
IF T$ >= "0" AND T$ <= "9" THEN
V = V * 10 + VAL(T$)
X$ = LEFT$(X$, I - 1) + MID$(X$, I + 1)
ELSE
RETURN
END IF
LOOP
RETURN

' open temp file#1
OpenFile1:
CLOSE #2
Rand = INT(RND * 999 + 1)
Ext1$ = RIGHT$("000" + MID$(STR$(Rand), 2), 3)
CompareFile1$ = "C:\TEMP\DATA1." + Ext1$
ErrorTrap = -1
ErrorNumber = 0
SELECT CASE BytesPerSector
CASE 128
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 128
CASE 256
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 256
CASE 512
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 512
CASE 1024
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 1024
END SELECT
ErrorTrap = 0
IF ErrorNumber THEN
ErrorTrap = -1
ErrorNumber = 0
CompareFile1$ = "C:\DATA1." + Ext1$
SELECT CASE BytesPerSector
CASE 128
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 128
CASE 256
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 256
CASE 512
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 512
CASE 1024
OPEN CompareFile1$ FOR RANDOM SHARED AS #2 LEN = 1024
END SELECT
ErrorTrap = 0
IF ErrorNumber THEN
COLOR 15
PRINT "Error opening temp filename#1."
COLOR 7
END
END IF
END IF
RETURN

' open temp file#2
OpenFile2:
CLOSE #2
Rand = INT(RND * 999 + 1)
Ext2$ = RIGHT$("000" + MID$(STR$(Rand), 2), 3)
CompareFile2$ = "C:\TEMP\DATA2." + Ext2$
ErrorTrap = -1
ErrorNumber = 0
SELECT CASE BytesPerSector
CASE 128
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 128
CASE 256
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 256
CASE 512
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 512
CASE 1024
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 1024
END SELECT
ErrorTrap = 0
IF ErrorNumber THEN
ErrorTrap = -1
ErrorNumber = 0
CompareFile2$ = "C:\DATA2." + Ext2$
SELECT CASE BytesPerSector
CASE 128
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 128
CASE 256
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 256
CASE 512
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 512
CASE 1024
OPEN CompareFile2$ FOR RANDOM SHARED AS #2 LEN = 1024
END SELECT
ErrorTrap = 0
IF ErrorNumber THEN
COLOR 15
PRINT "Error opening temp filename#2."
COLOR 7
END
END IF
END IF
RETURN

' critical error trap
Error.Routine:
IF ErrorTrap THEN
ErrorNumber = ERR
RESUME NEXT
END IF
COLOR 7, 0
Data.Error = ERR
PRINT "Critical error: " + STR$(Data.Error) + " in Diskcomp."
END

ResetDrive:
ErrorRetry = 0
DO
InregsX.ax = &H0
InregsX.dx = &H0
CALL INTERRUPTX(&H13, InregsX, OutregsX)
IF (OutregsX.flags AND &H1) = &H0 THEN
EXIT DO
END IF
IF (OutregsX.flags AND &H1) = &H1 THEN
ErrorRetry = ErrorRetry + 1
IF ErrorRetry > 3 THEN
Error1 = (OutregsX.ax AND &HFF00) / 256
IF Error1 < 0 THEN
Error1 = Error1 + 256
END IF
COLOR 15
PRINT "Error resetting drive:"; Error1
COLOR 7
END
END IF
END IF
LOOP
RETURN

' display diskette error code message
SUB DisplayError (Var)
COLOR 12
PRINT "Error: ";
SELECT CASE Var
CASE &H0
PRINT "successful completion"
CASE &H1
PRINT "invalid function in AH or invalid parameter"
CASE &H2
PRINT "address mark not found"
CASE &H3
PRINT "disk write-protected"
CASE &H4
PRINT "sector not found/read error"
CASE &H5
PRINT "reset failed (hard disk)"
CASE &H6
PRINT "disk changed (floppy)"
CASE &H7
PRINT "drive parameter activity failed (hard disk)"
CASE &H8
PRINT "DMA overrun"
CASE &H9
PRINT "data boundary error (attempted DMA across 64K boundary or >80h sectors)"
CASE &HA
PRINT "bad sector detected (hard disk)"
CASE &HB
PRINT "bad track detected (hard disk)"
CASE &HC
PRINT "unsupported track or invalid media"
CASE &HD
PRINT "invalid number of sectors on format (PS/2 hard disk)"
CASE &HE
PRINT "control data address mark detected (hard disk)"
CASE &HF
PRINT "DMA arbitration level out of range (hard disk)"
CASE &H10
PRINT "uncorrectable CRC or ECC error on read"
CASE &H11
PRINT "data ECC corrected (hard disk)"
CASE &H20
PRINT "controller failure"
CASE &H31
PRINT "no media in drive (IBM/MS INT 13 extensions)"
CASE &H32
PRINT "incorrect drive type stored in CMOS (Compaq)"
CASE &H40
PRINT "seek failed"
CASE &H80
PRINT "timeout (not ready)"
CASE &HAA
PRINT "drive not ready (hard disk)"
CASE &HB0
PRINT "volume not locked in drive (INT 13 extensions)"
CASE &HB1
PRINT "volume locked in drive (INT 13 extensions)"
CASE &HB2
PRINT "volume not removable (INT 13 extensions)"
CASE &HB3
PRINT "volume in use (INT 13 extensions)"
CASE &HB4
PRINT "lock count exceeded (INT 13 extensions)"
CASE &HB5
PRINT "valid eject request failed (INT 13 extensions)"
CASE &HB6
PRINT "volume present but read protected (INT 13 extensions)"
CASE &HBB
PRINT "undefined error (hard disk)"
CASE &HCC
PRINT "write fault (hard disk)"
CASE &HE0
PRINT "status register error (hard disk)"
CASE &HFF
PRINT "sense operation failed (hard disk)"
CASE ELSE
PRINT "unknown error"
END SELECT
COLOR 7
END SUB
Quote
Like
Share