'===========================================================================
' Subject: CHANGE DISK SERIAL NUMBER          Date: 09/93 (00:00)          
'  Author: Andy Thomas                        Code: QB, PDS                
'  Origin: CHANGE,DISK,SERIAL,NUMBER        Packet: DISK.ABC
'===========================================================================
 DEFINT A-Z
 ' Purpose: To change the serial number on any DOS disk.
 ' WARNING THE FOLLOWING PROGRAM USES DIRECT DISK WRITES!
 ' by Andy Thomas 9/93
 ' Author not responsible for misuse or errors of any kind.
 ' Use of this program could, but should not, damage your disk
 ' or render data unusable.
 '$INCLUDE: 'QB.BI'
 ' QB must be started with the /L switch!
 DIM inreg AS RegTypeX, outreg AS RegTypeX
 CLS
 TYPE DiskPacketType
   Sector AS LONG         ' DWORD - starting sector number
   CountWrite AS INTEGER  ' WORD - Number of sectors affected
   TransAddres AS STRING * 4 ' DWORD - Location of data transfer
                             '         Address
 END TYPE
 ' Note: Sector is a LONG while TransAddres is a string
 ' because we know Sector is going to be zero for this program.
 ' In other uses Sector would need to be made a string to avoid
 ' QuickBasic OVERFLOW errors.

 DIM DiskPacket AS DiskPacketType ' Disk Write Packet
 DIM DataStorage AS STRING * 512  ' string to read/write sector

 PRINT "Place disk in drive."   ' get drive to change
 PRINT "Enter drive letter:";
 DO
   Drive$ = UCASE$(INKEY$)
 LOOP UNTIL Drive$ <> ""
 PRINT Drive$
 PRINT

 DriveNumb = ASC(Drive$) - 65  ' drive number: A:=0, B:=1....
 inreg.cx = &HFFFF             ' Read/Write Absolute Sector
 inreg.ax = DriveNumb          ' Drive id
 DiskPacket.Sector = 0         ' start at sector 0
 DiskPacket.CountWrite = 1     ' load one sector

 'DWORD -- Seg:Off of DataStorage
 DiskPacket.TransAddres = CHR$(VARPTR(DataStorage) AND &HFF) +_
  CHR$(((VARPTR(DataStorage) AND &HFF00) \ 256) AND &HFF) +_
  CHR$((VARSEG(DataStorage) AND &HFF)) +_
  CHR$(((VARSEG(DataStorage) AND &HFF00) \ 256) AND &HFF)

 inreg.ds = VARSEG(DiskPacket)  ' DS:BX = Disk write packet
 inreg.bx = VARPTR(DiskPacket)

 CALL INTERRUPTX(&H25, inreg, outreg) ' read disk sector

 ' Get serial number from boot sector
 FOR I = &H2B TO &H28 STEP -1
   OldSerial$ = OldSerial$ + HEX$(ASC(MID$(DataStorage, I, 1)))
   IF LEN(OldSerial$) = 4 THEN OldSerial$ = OldSerial$ + "-"
 NEXT I

 PRINT "      Old serial number:"; OldSerial$
 LOCATE 5, 1
 PRINT "Enter new serial Number:"

 ' get user input for new serial number
 ' making sure only a valid serial number is entered
 Ptr = 0
 DashAdj = 0
 DO
   DO
     A$ = UCASE$(INKEY$)
   LOOP UNTIL (INSTR("0123456789ABCDEF" + CHR$(8), A$) > 0) AND_
  A$ <> ""
   IF A$ = CHR$(8) THEN    ' backspace for corrections
     IF Ptr > 0 THEN
       Ptr = Ptr - 1
       NewSerial$ = LEFT$(NewSerial$, Ptr)
     ELSE
       NewSerial$ = ""
     END IF
   ELSE
     Ptr = Ptr + 1
     NewSerial$ = NewSerial$ + A$
   END IF
   LOCATE 5, 25
   PRINT "         "

   LOCATE 5, 25
   PRINT LEFT$(NewSerial$, 4)
   IF Ptr > 4 THEN
     LOCATE 5, 29
     PRINT "-" + MID$(NewSerial$, 5, 8)
   END IF
 LOOP UNTIL Ptr = 8
 Ptr = 0

 ' Convert NewSerial$ into numerical ASCII codes
 ' and save within DataStorage
 FOR I = &H2B TO &H28 STEP -1
   Sbyte = 0
   FOR J = 1 TO 2
     A$ = MID$(NewSerial$, J + Ptr, 1)
     IF ASC(A$) > 64 AND ASC(A$) < 71 THEN Adj = 55 ELSE Adj= 48
     Sbyte = (Sbyte * 16) + (ASC(A$) - Adj)
   NEXT J
   DEF SEG = VARSEG(DataStorage)
   POKE VARPTR(DataStorage) + I - 1, Sbyte
   Ptr = Ptr + 2
 NEXT I

 ' Check to make sure new serial number was placed in
 ' correct location (this is a redundant check for safety)
 FOR I = &H2B TO &H28 STEP -1
   ChkSerial$ = ChkSerial$ + HEX$(ASC(MID$(DataStorage, I, 1)))
   IF LEN(ChkSerial$) = 4 THEN ChkSerial$ = ChkSerial$ + "-"
 NEXT I

 ' confirm change
 PRINT
 PRINT "                disk:"; Drive$
 PRINT "  from serial number:"; OldSerial$
 PRINT "to new serial number:"; ChkSerial$
 PRINT "Confirm change: (Y/N)"
 DO
   A$ = UCASE$(INKEY$)
 LOOP UNTIL A$ = "Y" OR A$ = "N"
 IF A$ = "Y" THEN ' make the change
   DiskPacket.TransAddres = CHR$(VARPTR(DataStorage) AND &HFF) +_
  CHR$(((VARPTR(DataStorage) AND &HFF00) \ 256) AND &HFF) +_
  CHR$((VARSEG(DataStorage) AND &HFF)) +_
  CHR$(((VARSEG(DataStorage) AND &HFF00) \ 256) AND &HFF)

   inreg.ds = VARSEG(DiskPacket)  ' DS:BX = Disk write packet
   inreg.bx = VARPTR(DiskPacket)

   CALL INTERRUPTX(&H26, inreg, outreg) ' write disk sector
 ELSE
   PRINT "Change Aborted."
 END IF

 END

 ' Methodology: The disk serial number is stored as a Double
 ' Word in the boot sector (sector zero) of every disk at
 ' location 27h. This program reads sector zero into a string,
 ' changes the dword value at offset 27h and writes the changed
 ' data back to sector zero. While this program should work, and
 ' has been tested on both hard drives and floppy disks, I
 ' suggest it only be used on floppy drives, as a error
 ' occurring while writing to sector zero on the hard drive
 ' could be disastrous.