'===========================================================================
' Subject: Detect CD-ROM Drives               Date: 03-16-03 (  :  )       
'  Author: Mikerinos Altermann                Code: QB, PDS                
'  Origin: mikerinos@excite.com             Packet: DISK.ABC
'===========================================================================
'CDROM List program utility
'detect and list all CDROM drives existing in your system
'CD units emulated using special programs are also discovered
'works with MS-DOS 6.22 and Windows 3.x/95/98/Me/XP
'not tested for other systems, but it's possible to work
'if you find any bugs or problems,or have any suggestions to make
'please let me know
'Mikerinos Altermann
'CONTACT e-mail adress mikerinos@excite.com

'You must start environment using QB /l command

DECLARE SUB cdromlist (nrdrv%, cdlist$)
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

DIM SHARED REGISTERS AS RegType

CLS
PRINT
cdromlist nrdrv%, cdlist$
IF nrdrv% > 0 THEN
PRINT nrdrv%; "CDROM drives detected"
FOR i% = 1 TO nrdrv%
PRINT TAB(4); MID$(cdlist$, i%, 1) + ":"
NEXT
ELSE
PRINT "No CDROM found"
END IF
PRINT
END

SUB cdromlist (nrdrv%, cdlist$)
REGISTERS.AX = &H1500
REGISTERS.BX = 0
CALL INTERRUPTX(&H2F, REGISTERS, REGISTERS)
IF REGISTERS.BX <> 0 THEN
nrdrv% = REGISTERS.BX
REDIM a%(1 TO REGISTERS.BX \ 2 + 1)
REGISTERS.AX = &H150D
REGISTERS.ES = VARSEG(a%(1))
REGISTERS.BX = VARPTR(a%(1))
CALL INTERRUPTX(&H2F, REGISTERS, REGISTERS)
cdlist$ = SPACE$(nrdrv%)
FOR i% = 1 TO nrdrv%
IF i% \ 2 = i% / 2 THEN
MID$(cdlist$, i%, 1) = CHR$((a%(i% \ 2) \ 256) + 65)
ELSE
MID$(cdlist$, i%, 1) = CHR$((a%(i% \ 2 + 1) MOD 256) + 65)
END IF
NEXT
END IF
cdlist$ = RTRIM$(cdlist$)
END SUB