<< Previous TopicReturn to Index  

a floppy diskette copy utility in qb45

December 6 2017 at 8:43 PM
Erik Jon Oredson  (Login eoredson)
R

 
DECLARE SUB DisplayError (Var%)
REM Disk copy 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 track data
DIM TrackData AS STRING * 30720 ' 1024 bytes * 30 sectors

' declare constants
CONST True = -1
CONST False = 0
CONST DFalse = 0#
CONST Nul = ""

' declare error routine
ON ERROR GOTO Error.Routine

' display banner
COLOR 15
PRINT "Diskette copy utility v1.1a."
COLOR 7

'Notes: The default parameter table is located at F000h:EFC7h

'Format of diskette parameter table:
'Offset Size Description (Table 01264)
' 00h BYTE first specify byte
' bits 7-4: step rate (Fh=2ms,Eh=4ms,Dh=6ms,etc.)
' bits 3-0: head unload time (0Fh = 240 ms)
' 01h BYTE second specify byte
' bits 7-1: head load time (01h = 4 ms)
' bit 0: non-DMA mode (always 0)
' Note: The DOS boot sector sets the head load time to 15ms,
' however, one should retry the operation on failure
' 02h BYTE delay until motor turned off (in clock ticks)
' 03h BYTE bytes per sector (00h = 128, 01h = 256, 02h = 512, 03h = 1024)
' 04h BYTE sectors per track (maximum if different for different tracks)
' 05h BYTE length of gap between sectors (2Ah for 5.25", 1Bh for 3.5")
' 06h BYTE data length (ignored if bytes-per-sector field nonzero)
' 07h BYTE gap length when formatting (50h for 5.25", 6Ch for 3.5")
' 08h BYTE format filler byte (default F6h)
' 09h BYTE head settle time in milliseconds
' 0Ah BYTE motor start time in 1/8 seconds

' 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 source/dest. drives
' where: 0=A, 1=B
Disk1 = 0
Disk2 = 0

' reset diskette parameters
Sides = 1
TracksPerSide = 80

' parse command line
Command.Line$ = COMMAND$
IF Command.Line$ <> "" THEN
IF Command.Line$ = "/?" THEN
COLOR 15
PRINT "Command line:"
COLOR 14
PRINT " Diskcopy A: B: [/1][/T:##][/S:##][/B:##]"
COLOR 15
PRINT "Where:"
COLOR 14
PRINT " A: and B: is source/dest."
PRINT " /1 copy side 1 only."
PRINT " /T:## tracks per side"
PRINT " /S:## sectors per track"
PRINT " /B:## bytes per sector"
COLOR 7
END
END IF
Var = INSTR(Command.Line$, "/T:")
IF Var THEN
Imbedded = Var
Command.Line$ = LEFT$(Command.Line$, Var - 1) + MID$(Command.Line$, Var + 3)
GOSUB Get.Numeric
TracksPerSide = Value
IF TracksPerSide < 1 OR TrackPerSide > 30 THEN
GOTO BootError
END IF
END IF
Var = INSTR(Command.Line$, "/S:")
IF Var THEN
Imbedded = Var
Command.Line$ = LEFT$(Command.Line$, Var - 1) + MID$(Command.Line$, Var + 3)
GOSUB Get.Numeric
SectorsPerTrack = Value
IF SectorsPerTrack < 1 OR SectorsPerTrack > 1024 THEN
GOTO BootError
END IF
END IF
Var = INSTR(Command.Line$, "/B:")
IF Var THEN
Imbedded = Var
Command.Line$ = LEFT$(Command.Line$, Var - 1) + MID$(Command.Line$, Var + 3)
GOSUB Get.Numeric
BytesPerSector = Value
SELECT CASE BytesPerSector
CASE 128, 256, 512, 1024
' nul
CASE ELSE
GOTO BootError
END SELECT
END IF
Var = INSTR(Command.Line$, "/1")
IF Var THEN
Sides = 0
Command.Line$ = LEFT$(Command.Line$, Var - 1) + MID$(Command.Line$, Var + 2)
END IF
Command.Line$ = LTRIM$(Command.Line$)
Command.Line$ = RTRIM$(Command.Line$)
IF LEN(Command.Line$) THEN
IF LEN(Command.Line$) <> 5 THEN
GOTO BootError
END IF
IF MID$(Command.Line$, 2, 1) <> ":" THEN
GOTO BootError
END IF
IF MID$(Command.Line$, 5, 1) <> ":" THEN
GOTO BootError
END IF
IF MID$(Command.Line$, 3, 1) <> " " THEN
GOTO BootError
END IF
IF MID$(Command.Line$, 1, 1) = "A" THEN
Disk1 = 0
ELSE
IF MID$(Command.Line$, 1, 1) = "B" THEN
Disk1 = 1
ELSE
GOTO BootError
END IF
END IF
IF MID$(Command.Line$, 4, 1) = "A" THEN
Disk2 = 0
ELSE
IF MID$(Command.Line$, 4, 1) = "B" THEN
Disk2 = 1
ELSE
GOTO BootError
END IF
END IF
END IF
END IF
TracksPerSide = TracksPerSide - 1
IF BytesPerSector = 0 THEN
COLOR 15
PRINT "Bytes per sector are not 128, 256, 512, or 1024."
COLOR 7
END
END IF

' open temp file
GOSUB Openfile

'--------B-1302-------------------------------
'INT 13 - DISK - READ SECTOR(S) INTO MEMORY
' AH = 02h
' AL = number of sectors to read (must be nonzero)
' CH = low eight bits of cylinder number (track)
' CL = sector number 1-63 (bits 0-5)
' high two bits of cylinder (bits 6-7, hard disk only)
' DH = head number
' DL = drive number (bit 7 set for hard disk)
' ES:BX -> data buffer
'Return: CF set on error
' if AH = 11h (corrected ECC error), AL = burst length
' CF clear if successful
' AH = status (see #00234)
' AL = number of sectors transferred (only valid if CF set for some
' BIOSes)
COLOR 14
IF Disk1 = 0 THEN
PRINT "Put source diskette in drive A: and press any key:"
ELSE
PRINT "Put source diskette in drive B: and press any key:"
END IF
COLOR 7
SLEEP
ErrorCount = 0
COLOR 10
PRINT "Reading diskette.."
COLOR 7
Start1:
Drive1 = Disk1
GOSUB ResetDrive
RecordNumber! = 0!
FOR Head = 0 TO Sides
FOR Track = 0 TO TracksPerSide
InregsX.ax = &H200 + SectorsPerTrack ' read sectors
InregsX.cx = Track * 256 + 1 ' track/sector number
InregsX.dx = Head * 256 + Disk1 ' head/drive 0=A, 1=B
InregsX.es = VARSEG(TrackData)
InregsX.bx = VARPTR(TrackData)
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 diskcopy."
END
END IF
END IF
RecordNumber! = RecordNumber! + 1!
PUT #1, RecordNumber!, TrackData
NEXT
NEXT

'--------B-1303-------------------------------
'INT 13 - DISK - WRITE DISK SECTOR(S)
' AH = 03h
' AL = number of sectors to write (must be nonzero)
' CH = low eight bits of cylinder number (track)
' CL = sector number 1-63 (bits 0-5)
' high two bits of cylinder (bits 6-7, hard disk only)
' DH = head number
' DL = drive number (bit 7 set for hard disk)
' ES:BX -> data buffer
'Return: CF set on error
' CF clear if successful
' AH = status (see #00234)
' AL = number of sectors transferred
' (only valid if CF set for some BIOSes)
COLOR 14
IF Disk2 = 0 THEN
PRINT "Put destination diskette in drive A: and press any key:"
ELSE
PRINT "Put destination diskette in drive B: and press any key:"
END IF
COLOR 7
SLEEP
ErrorCount = 0
COLOR 10
PRINT "Writing diskette.."
COLOR 7
Start2:
Drive1 = Disk2
GOSUB ResetDrive
RecordNumber! = 0!
FOR Head = 0 TO Sides
FOR Track = 0 TO TracksPerSide
RecordNumber! = RecordNumber! + 1!
GET #1, RecordNumber!, TrackData
InregsX.ax = &H300 + SectorsPerTrack ' write 1 sector
InregsX.cx = Track * 256 + 1 ' track/sector number
InregsX.dx = Head * 256 + Disk2 ' head/drive 0=A, 1=B
InregsX.es = VARSEG(TrackData)
InregsX.bx = VARPTR(TrackData)
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 writing diskette:"; Error1
COLOR 7
END
END IF
GOTO Start2
ELSE
IF Error1 < 0 THEN
Error1 = Error1 + 256
END IF
CALL DisplayError(Error1)
PRINT "Exiting diskcopy."
END
END IF
END IF
NEXT
NEXT
CLOSE #1
KILL Filename$
COLOR 15
PRINT "Diskette copy success."
COLOR 7
END

'--------B-1300-------------------------------
'INT 13 - DISK - RESET DISK SYSTEM
' AH = 00h
' DL = drive (if bit 7 is set both hard disks and floppy disks reset)
'Return: AH = status (see #00234)
' CF clear if successful (returned AH=00h)
' CF set on error
'Notes: errors on a floppy may be due to the motor failing to spin up
' quickly enough; the read should be retried at least three times,
' resetting the disk with AH=00h between attempts
ResetDrive:
ErrorRetry = 0
DO
InregsX.ax = &H0
InregsX.dx = Drive1
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

'--------B-1301-------------------------------
'INT 13 - DISK - GET STATUS OF LAST OPERATION
' AH = 01h
' DL = drive (bit 7 set for hard disk)
'Return: CF clear if successful (returned status 00h)
' CF set on error
' AH = status of previous operation (see #00234)
ReadStatus:
InregsX.ax = &H100
InregsX.dx = &H0 ' drive 0=A, 1=B
CALL INTERRUPTX(&H13, InregsX, OutregsX)
IF (OutregsX.flags AND &H1) = &H1 THEN
Status = (OutregsX.ax AND &HFF) / 256
ELSE
Status = 0
END IF
RETURN

' converts string to value
Get.Numeric:
Value = 0
DO
Temp$ = MID$(Command.Line$, Imbedded, 1)
IF Temp$ >= "0" AND Temp$ <= "9" THEN
Value = Value * 10 + VAL(Temp$)
Command.Line$ = LEFT$(Command.Line$, Imbedded - 1) + MID$(Command.Line$, Imbedded + 1)
ELSE
RETURN
END IF
LOOP
RETURN

' open temp file
Openfile:
Rand = INT(RND * 999 + 1)
Ext$ = RIGHT$("000" + MID$(STR$(Rand), 2), 3)
ErrorTrap = -1
ErrorNumber = 0
Filename$ = "C:\TEMP\DATAFILE." + Ext$
OPEN Filename$ FOR RANDOM SHARED AS #1 LEN = 30720
ErrorTrap = 0
IF ErrorNumber THEN
ErrorTrap = -1
ErrorNumber = 0
Filename$ = "C:\DATAFILE." + Ext$
OPEN Filename$ FOR RANDOM SHARED AS #1 LEN = 30720
ErrorTrap = 0
IF ErrorNumber THEN
COLOR 15
PRINT "Error opening temp datafile."
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 Diskcopy."
END

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

' 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

 
 Respond to this message   
AuthorReply
easylangs
(Login easylangs)
Python and FIG Forum

its nice that someones doing utilities in qb64

December 6 2017, 9:22 PM 

i realise youre not the only one-- but i learned computing on one of these:

https://upload.wikimedia.org/wikipedia/commons/thumb/9/9f/Ibm_pcjr_with_display.jpg/300px-Ibm_pcjr_with_display.jpg


and although i think games are great-- and love doing simple graphics programs: http://www.network54.com/Forum/754391/thread/1418526765

i am mostly interested in utility-type programming, which seems a lot less popular in qb now.

im glad there are a few people doing utilities too. that ide stuff definitely counts, incidentally.


    
This message has been edited by easylangs on Dec 6, 2017 9:23 PM


 
 Respond to this message   
 
  << Previous TopicReturn to Index  
 Copyright © 1999-2017 Network54. All rights reserved.   Terms of Use   Privacy Statement