'===========================================================================
' Subject: SOUND BLASTER TO DISK             Date: 11-10-97 (00:29)       
' Author:  Andrew S. Gibson                  Code: QB, QBasic, PDS        
' Origin:  zapf_dingbat@juno.com           Packet: SOUND.ABC
'===========================================================================
'Hello fellow coders !  This little program is a cheap efficient way to
'*record* incoming audio from your Sound Blaster's Line-in or Microphone jack
'is you don't have an internal CD player or you want to use a cassette
'player. *You won't need to turn up the input volume very much at all !*
'This started as an experiment, but I turned it into a relatively viable
'application. You need to load QuickBASIC with this switch /L, compile
'Sound Blaster to Disk for extremely optimal speed ! ý
'I've tested this using a 386sx running at 25Mhz and (it didn't work so well
'but don't let that stop you from trying to record :)
'With My 486sx 33mhz system I been able to achieve a sampling rate of 10,250
'Hertz this is satisfatory and the file size was 2.167 Megabytes (that's
'standard for a nearly four minute song.)
'I highly recommend that You shouldn't alter any of the code, until you
'try it!
'Email me at this address if you desire: Zapf_DingBat@JUNO.COM
'My real name is Andrew Gibson and I wrote 25% of the code !
'Not the sound blaster dectection code though..
'I have tested this with a Sound Blaster 2.0 (the only sound card I have!)
'A 486sx 33Mhz based system is recommended and a very *fast* hardrive, try it
'wherever/whenever you can though !  Windows Protected mode really slows
'this down especially if you have applications is use !  EMM386 on a slow
'computers will make this program drag !
'
' Sound Blaster to Disk *Won't* stop recording unless to press any key, fill
' your remaining hardrive space or it stops because of an error.
'Once you compile this type SB2DSK /? for help.
'Release 1 / Update 2

DEFINT A-Z
DECLARE SUB HELP ()
DECLARE SUB ParseCmdLine (cmd$, Params$(), Found%)
DECLARE SUB STDOUT (MESSAGETEXT$)

TYPE RegType
  AX    AS INTEGER
  BX    AS INTEGER
  CX    AS INTEGER
  DX    AS INTEGER
  BP    AS INTEGER
  SI    AS INTEGER
  DI    AS INTEGER
  FLAGS AS INTEGER
  DS    AS INTEGER
  ES    AS INTEGER
END TYPE

CONST TRUE = -1, FALSE = 0
DIM SHARED Registers AS RegType
DIM Params$(1 TO 10)

' program defaults
  Hrequest = FALSE

ParseCmdLine COMMAND$, Params$(), NumParams%
'IF NumParams% = FALSE THEN Help: Noff = TRUE

FOR I% = 1 TO NumParams%
  q$ = Params$(I%)
  SELECT CASE q$
  CASE "?", "HELP", "-?": HELP: Hrequest = TRUE: EXIT FOR
END SELECT
NEXT
IF Hrequest = TRUE THEN GOTO Term 'bail out

STDOUT "SB2DSK Version .23á" + CHR$(10) + CHR$(13) + CHR$(10)
ON ERROR GOTO ErrHandle
IF LEFT$(q$, 3) = "-F:" THEN Name$ = MID$(q$, 4)
IF LEN(Name$) = 0 THEN ERROR 64

'STDOUT "Sound Blaster routines by Gary Maddox, obtained from SB-Digest Issue #5" + CHR$(10) + CHR$(13)

 BPORT = &H210: XPORT = &H216: WPORT = &H21C: RPORT = &H21A
 APORT = &H21E: READY = &HAA

DO
   OUT XPORT, 1
 
   FOR T = 0 TO 10
   ll! = TIMER
   DO
   LOOP WHILE ll! = TIMER
   NEXT
   OUT XPORT, 0
   loopctr = 0
   DO
     Byte = INP(RPORT)
     loopctr = loopctr + 1
   IF Byte = &HAA THEN EXIT DO
   IF loopctr > 100 THEN EXIT DO
   LOOP
   IF Byte <> &HAA THEN
     BPORT = BPORT + &H10
     XPORT = XPORT + &H10
     WPORT = WPORT + &H10
     RPORT = RPORT + &H10
 
     APORT = APORT + &H10
   END IF
 IF Byte = &HAA THEN EXIT DO
 IF RPORT = &H270 THEN EXIT DO
 LOOP
 
 IF BPORT = &H270 THEN
   STDOUT "Sound Blaster Not Found!" + CHR$(10) + CHR$(13)
   GOTO Term
 ELSE
   STDOUT "Sound Blaster Installed at Port: " + HEX$(BPORT) + "h." + CHR$(10) + CHR$(13)
 END IF
  STDOUT "Writing SB DAC output to " + Name$ + "." + CHR$(10) + CHR$(13)
  STDOUT "Synchronize your input and press a key to begin." + CHR$(13)
  DO: LOOP UNTIL INKEY$ <> ""
  STDOUT STRING$(48, 32) + CHR$(13)
  STDOUT "Press any key to stop." + CHR$(13)

ON ERROR GOTO ErrHandle
OPEN Name$ FOR OUTPUT AS #1 LEN = 32767 '<- don't change this buffer length !
' shovel data from SB DAC to disk
ON ERROR GOTO ErrHandle
DO
OUT WPORT, &H20
Byte$ = CHR$(INP(RPORT))
 PRINT #1, Byte$;
' ý
' If you are testing this in the QuickBASIC environment you will probably
' want to comment the next line, however you should remember to uncomment
' the line for compilation of SB2DSK. You might even have to tweak this
' delay for the sound to be audible without clicking or missing parts.
T = 0: DO: T = T + 1: LOOP UNTIL T = 124 '<- that number works for with my 486sx 33Mhz system.
LOOP UNTIL INKEY$ <> ""
CLOSE
STDOUT CHR$(10) + "Bye." + CHR$(10) + CHR$(13)
Term:
END

ErrHandle:
CLOSE
SELECT CASE ERR
  CASE IS = 7
   STDOUT "Program Error: Out of memory" + CHR$(10) + CHR$(13)
   STDOUT "I used up all of the DGROUP space, Try again." + CHR$(10) + CHR$(13)
  CASE IS = 9
   STDOUT "Program Error: Array Subscript out of range" + CHR$(10) + CHR$(13)
   STDOUT "Upper limit of allocated space exceeded." + CHR$(10) + CHR$(13)
  CASE IS = 14
   STDOUT "Program Error: Out of String Space" + CHR$(10) + CHR$(13)
  CASE IS = 24
   STDOUT "Informative Error: Device timeout" + CHR$(10) + CHR$(13)
   STDOUT "Program didn't recive information from an I/O device in time." + CHR$(10) + CHR$(13)
  CASE IS = 25
   STDOUT "Printer Error: Device fault" + CHR$(10) + CHR$(13)
   STDOUT "I can't talk to your printer or print que." + CHR$(10) + CHR$(13)
  CASE IS = 27
   STDOUT "Printer Error: Out of paper" + CHR$(10) + CHR$(13)
   STDOUT "Put Paper in your printer." + CHR$(10) + CHR$(13)
  CASE IS = 52
   STDOUT "Program or User Error: Bad File Name or number" + CHR$(10) + CHR$(13)
   STDOUT "You provided a bad file name or I tried to use a file number that doesn't exist." + CHR$(10) + CHR$(13)
  CASE IS = 53
   STDOUT "FileManager/User input Error: File not found" + CHR$(10) + CHR$(13)
   STDOUT "I cannot find the file you requested." + CHR$(10) + CHR$(13)
  CASE IS = 54
   STDOUT "FileManager/Programmer Error: Bad file mode" + CHR$(10) + CHR$(13)
   STDOUT "I am unable to read a file properly. Bug fix by programmer required." + CHR$(10) + CHR$(13)
  CASE IS = 55
   STDOUT "FileManager Error: File already open" + CHR$(10) + CHR$(13)
   STDOUT "A file was already opened, all files are now closed." + CHR$(10) + CHR$(13)
  CASE IS = 57
   STDOUT "System Fault: Device I/O error" + CHR$(10) + CHR$(13)
   STDOUT "I can not 'talk' to a specific device." + CHR$(10) + CHR$(13)
  CASE IS = 58
   STDOUT "Informative Error: File already exists" + CHR$(10) + CHR$(13)
  CASE IS = 59
   STDOUT "FileManager Error: Bad record length" + CHR$(10) + CHR$(13)
   STDOUT "A database record of some sort is not long enough or is too long." + CHR$(10) + CHR$(13)
  CASE IS = 61
   STDOUT "Informative Error: Disk FULL" + CHR$(10) + CHR$(13)
   STDOUT "Free up some disk space." + CHR$(10) + CHR$(13)
  CASE IS = 62
   STDOUT "FileManager Error: Input past end of file." + CHR$(10) + CHR$(13)
   STDOUT "Attempt to read beyond the end of current file." + CHR$(10) + CHR$(13)
  CASE IS = 63
   STDOUT "Program Error: Bad record number" + CHR$(10) + CHR$(13)
   STDOUT "A database record of some sort doesn't exist." + CHR$(10) + CHR$(13)
  CASE IS = 64
   STDOUT "User Error: Bad file name" + CHR$(10) + CHR$(13)
   'STDOUT "You specifically told me to use a file name that is incorrect." + CHR$(10) + CHR$(13)
  CASE IS = 67
   STDOUT "FileManager Fault: Too many files open" + CHR$(10) + CHR$(13)
   STDOUT "I can't handle more files than listed in your CONFIG.SYS file." + CHR$(10) + CHR$(13)
  CASE IS = 68
   STDOUT "System Error: Device UNAVAILABLE" + CHR$(10) + CHR$(13)
   STDOUT "A user serviceable device is not accessable to the computer." + CHR$(10) + CHR$(13)
  CASE IS = 71
   STDOUT "User or System Error: Disk not Ready" + CHR$(10) + CHR$(13)
   STDOUT "Insert a diskette in the current drive. (Excepting Hardrives)" + CHR$(10) + CHR$(13)
  CASE IS = 72
   STDOUT "Serious Informative Error: Disk-Media error" + CHR$(10) + CHR$(13)
   STDOUT "The recordable media surface of the current disk has developed a defect." + CHR$(10) + CHR$(13)
  CASE IS = 73
   STDOUT "Informative Error: Feature unavailable" + CHR$(10) + CHR$(13)
   STDOUT "An advanced capability is not available within this computer." + CHR$(10) + CHR$(13)
  CASE IS = 75
   STDOUT "FileManager/User input Error: Path/File access error" + CHR$(10) + CHR$(13)
  CASE IS = 76
   STDOUT "FileManager/User input Error: Path not found" + CHR$(10) + CHR$(13)
   STDOUT "The path to a file is non-existant." + CHR$(10) + CHR$(13)
  CASE ELSE
   STDOUT "Bug squashing Required. Contact orginal programmer." + CHR$(10) + CHR$(13)
END SELECT
END

SUB HELP
STDOUT "SB2DSK Version .23á" + CHR$(10) + CHR$(13) + CHR$(10) + CHR$(13)
STDOUT "Sound Blaster to Disk samples the data input from the Microphone" + CHR$(10) + CHR$(13)
STDOUT "or LineIn Jack AND writes it to disk in REALTIME !!!!!" + CHR$(10) + CHR$(13)
STDOUT "A fast CPU is highly recommended for the best possible sound..." + CHR$(10) + CHR$(13) + CHR$(10) + CHR$(13)
STDOUT "Sound Blaster to Disk take these parameters:" + CHR$(10) + CHR$(13)
STDOUT " /F:filename - where 'filename' a fully qualified DOS filename" + CHR$(10) + CHR$(13)
STDOUT " /?          - Shows this help." + CHR$(10) + CHR$(13) + CHR$(10) + CHR$(13)
STDOUT "Coded by Andrew Gibson, have fun." + CHR$(10) + CHR$(13)
END SUB

SUB ParseCmdLine (cmd$, Params$(), Found%)
'This parsing sub does NOT mistake filenames like "F-14G.ZIP" as
'containing a switch. That's why it looks so big.
  Found% = FALSE: Sep$ = "-/": Temp$ = LTRIM$(RTRIM$(cmd$)): InParam% = FALSE
  FOR p% = 1 TO LEN(Temp$)
    C$ = MID$(Temp$, p%, 1)
    IF InParam% = TRUE THEN 'Inside of a switch?
      IF INSTR(Sep$, C$) THEN 'Found another switch?
        'Terminate current switch, then start parsing the next one.
        GOSUB MakeParam: MID$(Temp$, p%, 1) = LEFT$(Sep$, 1)
        ParamStart% = p%
      ELSEIF ASC(C$) = 32 OR ASC(C$) = 9 THEN
        GOSUB MakeParam: InParam% = FALSE 'Terminate current switch.
      END IF
    ELSEIF InParam% = -2 THEN 'Inside of a parameter?
      IF ASC(C$) = 32 OR ASC(C$) = 9 THEN 'Terminate parameter with
        GOSUB MakeParam: InParam% = FALSE     'space or TAB.
      END IF
    ELSE
      IF INSTR(Sep$, C$) THEN 'Found start of a switch?
        'Make sure all switches start with "-".
        MID$(Temp$, p%, 1) = LEFT$(Sep$, 1): InParam% = TRUE
        ParamStart% = p%
      ELSEIF ASC(C$) <> 32 AND ASC(C$) <> 9 THEN 'If char isn't a
        InParam% = -2: ParamStart% = p% 'space or TAB it's a parameter.
      END IF
    END IF
  NEXT
 IF InParam% THEN GOSUB MakeParam
  EXIT SUB
MakeParam:
  Found% = Found% + 1
  Params$(Found%) = MID$(Temp$, ParamStart%, p% - ParamStart%)
  IF Found% = UBOUND(Params$) THEN EXIT SUB
RETURN
END SUB

SUB STDOUT (MESSAGETEXT$)
Registers.AX = &H4000
Registers.BX = &H1
Registers.CX = LEN(MESSAGETEXT$)
Registers.DS = VARSEG(MESSAGETEXT$)
Registers.DX = SADD(MESSAGETEXT$)
CALL InterruptX(&H21, Registers, Registers)
END SUB