'===========================================================================
' Subject: PB DISKINFO V2.5                   Date: 06-21-98 (05:12)       
'  Author: Marc van den Dikkenberg            Code: PB                     
'  Origin: excel@xs4all.nl                  Packet: DISK.ABC
'===========================================================================
$IF 0
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PB-DiskInfo 2.5 -- (C) 1998 By Marc van den Dikkenberg º
ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
º                The PowerBasic Archives                 º
º           http://www.xs4all.nl/~excel/pb.html          º
º                 http://come.to/pbdos                   º
ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
º This PowerBasic 3.x routine will return Total Size,    º
º Available Bytes, Volume Label, Serial Nr, FileSystem,  º
º Allocation Unit size, Compression, Win95 LFN support,  º
º and the percentages Filled/Free of any disk.           º
º                                                        º
º Besides that, it will also Detect and Indentify all    º
º available drives in your system: Floppy, Removable,    º
º CD-ROM, Fixed, Network, or SUBSTed.                    º
º The path is returned for Network and SUBSTed drives.   º
º                                                        º
º - Fixed network drive problem with DOS 7.0+ / Win95    º
º - Size is returned Accurately for FAT32 disks as well, º
º   even when exceeding the 2GB.                         º
º - Compression only recognizes compressed FAT32 disks   º
º   at this point.                                       º
º - This source is Freeware -- use at your own risk.     º
º   Copyright June 1998, Marc van den Dikkenberg         º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
' Drive Types:
' 0 -> Non Existant
' 1 -> Hard Disk
' 2 -> Removable
' 3 -> Network
' 4 -> CD
' 5 -> Diskette
' 6 -> SUBST
' 7 -> Unknown

$ENDIF

Type Bufstruc
   Drive 		as String*1
   Volume 		as String*11
   SerialNr 	as String*9
   TotalBytes 	as Dword
   FreeBytes 	as Dword
   Allocation 	as Dword
   PercentFull as Single
   PercentFree as Single
   FileSystem 	as String*8
   LFN 			as integer
   Compressed 	as integer
End Type

Dim DiskID as Shared Bufstruc
Dim ExtendedPath as Shared String
Dim Floppy.Measure as Shared Single
Dim Floppy.Capacity as Shared Integer
Dim CDBuff as Shared String*10

CLS

Print "Detected and Identified Devices"
Print "-------------------------------"

For t=1 to len(AllDrive$)
	Print mid$(AllDrive$,t,1)": ";
   Select Case TypeDrive(mid$(AllDrive$,t,1))
      Case 0 : Print "Not Detected   "
	   Case 1 : Print "Fixed Disk     "
      Case 2 : Print "Removable Disk "
      Case 3 : Print "Network Drive  ";ExtendedPath
      Case 4 : Print "CD-ROM Drive   "
      Case 5 : Print "Floppy Drive   ";Floppy.Measure;"inch,";Floppy.Capacity"KB"
      Case 6 : Print "SUBSTed Drive  ";ExtendedPath
      Case 7 : Print "Unknown Type   "
   End Select
Next t

' AllDrive$        -> Returns a string containing all detected devices
' WhichDrive$(...) -> Returns a string of drives which match these disktypes
' TypeDrive("C")   -> Returns the disktype for a single device

Print
Print "All Detected Drives : "AllDrive$
Print "CD and Floppydrives : "WhichDrive$(45)     ' 4 = CD, 5 = Floppy
Print "All but Floppydrives: "WhichDrive$(123467) ' Leave out the 5 (Floppy)
Print "Drive C: is of type :"TypeDrive("C")
Print

If TypeDrive("C")=0 then END

Locate 25,1
Print "Press Any Key To Display Drive information for Device C:";
a$=INPUT$(1)

CLS
DiskInfo "C:"

If DiskID.Drive=chr$(255) then
   Print "Drive not found"
Else
   Print "Drive Information for Device C:"
   Print "-------------------------------"
	Print "Drive        : "DiskID.Drive
   Print "VolumeLabel  : "DiskID.Volume
   Print "SerialNumber : "DiskID.SerialNr
	Print "FileSystem   : "DiskID.FileSystem
	Print "Disk Space   :"DiskID.TotalBytes
	Print "Free Space   :"DiskID.FreeBytes
	Print "Percent Full :"DiskID.PercentFull
	Print "Percent Free :"DiskID.PercentFree
	Print "Allocation   :"DiskID.Allocation
	Print "LFN support  :"DiskID.LFN
	Print "Compressed   :"DiskID.Compressed
	Print
End if

END


Sub DiskInfo (byval drive$)
   Dim Drivename AS String * 4
   Dim Filesysname AS String * 8
   Dim rax as Word
   Dim rbx as Word
   Dim rcx as Word
   Dim rdx as Word
   Dim seg1 as Word
   Dim off1 as Word
   Dim seg2 as Word
   Dim off2 as Word

   Drive$=ucase$(left$(drive$,1))
   Drivename = left$(drive$,1) +":\"+CHR$(0)
   DiskID.TotalBytes=0
   DiskID.FreeBytes=0
   DiskID.Allocation=0
   DiskID.PercentFull=0
   DiskID.PercentFree=0
   DiskID.FileSystem=""
   DiskID.lfn=0
   DiskID.compressed=0
   DiskID.SerialNr=""
   DiskID.Volume=""

   seg1=varseg(drivename)
   off1=varptr(drivename)
   seg2=varseg(filesysname)
   off2=varptr(filesysname)

	! MOV AX,&H71A0
	! MOV DS,seg1
	! MOV DX,off1
	! MOV ES,seg2
	! MOV DI,off2
	! MOV CX,&HFF
	! INT &H21
	! MOV RAX,AX
	! MOV RBX,BX

	if rax=&H7100 then
	   ' FAT32 not supported -- Using FAT16 Method instead.
	   Driv%=asc(left$(drive$,1))-64
	   ! PUSH DS
	   ! MOV AX,&H3600
	   ! MOV DX,driv%    ; Disk-#  01=A:, 02=B:, etc.
	   ! XOR CX,CX
	   ! XOR BX,DX
	   ! INT &H21
	   ! MOV rax,ax
	   ! MOV rbx,bx
	   ! MOV rcx,cx
	   ! MOV rdx,dx
	   ! POP DS
	   if rax<>&H0FFFF then
	      DiskID.TotalBytes = rax*rcx*rdx
	      DiskID.FreeBytes = rax*rbx*rcx
	      DiskID.Allocation = rax*rcx
	      DiskID.PercentFull = round(100-(rax*rcx*rbx)*100/(rax*rdx*rcx),2)
         DiskID.PercentFree = round(100-DiskID.PercentFull,2)
	      DiskID.drive=drive$
	      DiskID.FileSystem="FAT"
	   else
 		   ' Disk not found
	      DiskID.drive=chr$(255)
		end if
	else
	   DiskID.FileSystem=rtrim$(filesysname,chr$(0))
	   DiskID.drive=drive$
	   if bit(rbx,14) then DiskID.lfn=1
	   if bit(rbx,15) then DiskID.compressed=1

	   Dim buffer as String*44

		seg1=varseg(buffer)
		off1=varptr(buffer)
		seg2=varseg(drivename)
		off2=varptr(drivename)

		! PUSH DS
		! MOV AX,&H7303
		! MOV ds,seg2
		! MOV dx,off2
		! MOV es,seg1
		! MOV di,off1
		! MOV CX,128
		! INT &H21
		! MOV RAX,CX
		! MOV RBX,AX
		! POP DS

		if cvwrd(left$(buffer,2))<>0 then
		   ' FAT32
			DiskID.Allocation = CVDWD(mid$(buffer,9,4)) * CVDWD(mid$(buffer,5,4))
			DiskID.TotalBytes = CVDWD(mid$(buffer,9,4)) * CVDWD(mid$(buffer,5,4)) * CVDWD(mid$(buffer,17,4))
			DiskID.FreeBytes = CVDWD(mid$(buffer,9,4)) * CVDWD(mid$(buffer,5,4)) * CVDWD(mid$(buffer,13,4))
			DiskID.PercentFull = round(100-(DiskID.FreeBytes)*100/(DiskID.TotalBytes),2)
         DiskID.PercentFree = 100-DiskID.PercentFull
		else
         ' Disk not found
		   DiskID.drive=chr$(255)
		end if
	end if

   ' Obtain Volume Label, Serial & FileSystem

   Driv%=asc(left$(drive$,1))-64
   Dim buffr2 as String*25
   REG 1, &H6900
   REG 2, driv%            ' 0= Current Drive, 1=A, 2=B, 3=C ...
   REG 8, VARSEG(buffr2)
   REG 4, VARPTR(buffr2)
   CALL Interrupt &H21

   If (REG(0) AND 1)=0 then
      ' Function Supported (Undocumented feature, DOS 4.01+)
	   DiskID.Volume=mid$(buffr2,7,11)
	   DiskID.SerialNr="0000-0000"
	   ser1$=hex$(cvi(mid$(buffr2,5,2)))
	   mid$(DiskID.SerialNr,5-len(ser1$))=ser1$
	   ser1$=hex$(cvi(mid$(buffr2,3,2)))
	   mid$(DiskID.SerialNr,10-len(ser1$))=ser1$
	   If left$(mid$(buffr2,18,8),2)<>"CD" then
	      DiskID.FileSystem=rtrim$(mid$(buffr2,18,8))
	   End If
   End If
End Sub

Function AllDrive$
	dim var1 as string*4
	dim var2 as string*255
	dim ads as word
	dim asi as word
	dim aes as word
	dim adi as word
	ads=varseg(var1)
	asi=varptr(var1)
	aes=varseg(var2)
	adi=varptr(var2)

	Out &H70,&H10
	x=Inp(&H71)
	if x\16<>0 then internal$=internal$+"A"
	if (x and &H0F)<>0 then internal$=internal$+"B"

	for t = asc("C") to asc ("Z")
		var2=string$(255,0)
		driv$=chr$(t)
		var1=DRIV$+":\"+chr$(0)

		! MOV AX,&H6000
		! MOV DS,ADS
		! MOV SI,ASI
		! MOV ES,AES
		! MOV DI,ADI
		! INT &H21

		if (reg(0) AND 1)=1 then AllDrive$="":exit function

		final$=var2
		final$=rtrim$(final$,chr$(0))

		if final$<>"" then internal$=internal$+left$(var1,1)
	Next T
	AllDrive$=internal$
End Function


Function TypeDrive(DriveLetter$)
	dim var1 as string*4
	dim var2 as string*255
	dim ads as word, asi as word, aes as word
	dim adi as word, dbx as word, dby as word
	ads=varseg(var1) : asi=varptr(var1)
	aes=varseg(var2) : adi=varptr(var2)
   ExtendedPath=""
   Floppy.Measure=0
   Floppy.Capacity=0

   DriveLetter$=ucase$(Left$(DriveLetter$,1))
   if DriveLetter$="A" or DriveLetter$="B" then
		Out &H70,&H10
		x=Inp(&H71)
      if DriveLetter$="A" and x\16<>0 then
      	TypeDrive=5
         Select Case x\16
				Case 1: Floppy.Measure=5.25:Floppy.Capacity=360
				Case 2: Floppy.Measure=5.25:Floppy.Capacity=1200
			   Case 3: Floppy.Measure=3.5:Floppy.Capacity=720
			   Case 4: Floppy.Measure=3.5:Floppy.Capacity=1440
            Case 5: Floppy.Measure=3.5:Floppy.Capacity=2880
         End Select
         Exit Function
      elseif DriveLetter$="B" and (x AND &H0F)<>0 then
         TypeDrive=5
         Select Case (x AND &H0F)
				Case 1: Floppy.Measure=5.25:Floppy.Capacity=360
				Case 2: Floppy.Measure=5.25:Floppy.Capacity=1200
			   Case 3: Floppy.Measure=3.5:Floppy.Capacity=720
			   Case 4: Floppy.Measure=3.5:Floppy.Capacity=1440
            Case 5: Floppy.Measure=3.5:Floppy.Capacity=2880
         End Select
         Exit Function
      else
         TypeDrive=0
         Exit Function
      end if
   end if

   If Left$(CDBuff,1)=chr$(0) then CALL CDROMList
   ' Function CDRomList fills CDBuff with detected Drives
   ' Only needs to be done once.

	var2=string$(255,0)
	var1=DriveLetter$+":\"+chr$(0)

	! MOV AX,&H6000
	! MOV DS,ADS
	! MOV SI,ASI
	! MOV ES,AES
	! MOV DI,ADI
	! INT &H21

	if (reg(0) AND 1)=1 then TypeDrive=7: Exit Function

	final$=var2
	final$=rtrim$(final$,chr$(0))

   if left$(final$,1)="\" then
      ' Detected drive is a Network drive.
      ' This method only works outside Windows, and with DOS < 7.0
      ' The Windows / DOS 7+ Network check can be found below.
      TypeDrive=3
  	   ExtendedPath=final$
      Exit Function
   end if

	if left$(var1,1)=left$(final$,1) then
	   if instr(CDbuff,chr$(asc(left$(final$,1))-65)) then
         ' Drive is a CD-ROM
			TypeDrive=4: Exit Function
   	else
	      DRIV%=asc(left$(var1,1))-64
	      REG 1,&H4408
	      REG 2,DRIV%
	      CALL INTERRUPT &H21
	      IF (REG(0) AND 1)=1 then
	         ' Unknown - 'removable'-check not supported for this drive.
            ' Let's check if it's a network drive!
            ' But first set TypeDrive to 7 (Unknown), just to be sure.
            TypeDrive=7
				Reg 1, &H00
				Call Interrupt &H2A
				if (reg(1)\256)<>0 then
               ' NetBios detected.
               ' Now check for Network Drive + Path
               ' This method works in Windows / DOS 7.0+ too.
					ttt%=0
					DevNam$=string$(16,0)
					NetPat$=string$(128,0)
					Do
						REG 1, &H5F02
						REG 2, ttt%
						REG 8, STRSEG(DevNam$)
						REG 5, STRPTR(DevNam$)
						REG 9, STRSEG(NetPat$)
						REG 6, STRPTR(NetPat$)
						CALL INTERRUPT &H21
				      DevName$=LEFT$(DevNam$,1)
						incr ttt%,1
						if ttt%=26 then exit do
						if driveletter$=left$(devnam$,1) then
							ExtendedPath=RTRIM$(NetPat$,CHR$(0))
							TypeDrive=3:Exit Function
						end if
         	   Loop
  			   end if
	      else
	         if reg(1)=0 then
	            ' Removable Disk
	            TypeDrive=2:Exit Function
	         else
	            ' Fixed Disk
	            TypeDrive=1:Exit Function
	         end if
	      end if
	   end if
	elseif len(final$)<>0 then
      ' SUBSTed Drive
      TypeDrive=6
      ExtendedPath=Final$
      Exit Function
   end if
End Function

Function CDROMList
   ' Generate a list of the driveletters in use by CD-ROM's

	Dim DBX as word
   !  mov AX, &HDADA
   !  push AX
   !  mov AX, &H01100
   !  int &H2F
   !  pop BX
   !  cmp BX, &HADAD
   !  jne mscdex_not_installed
   !  cmp AL, &H0FF
   !  jne mscdex_not_installed

   goto mscdex_version

	mscdex_not_installed:
   Exit function

	mscdex_version:
	! MOV AX,&H150C
	! INT &H2F
	! MOV dbx,BX

	if (DBX\256)>=2 THEN
		dim s1 as word
		dim o1 as word
		s1=varseg(CDbuff)
		o1=varptr(CDbuff)

		! MOV AX,&H150D
		! MOV ES,S1
		! MOV BX,O1
		! INT &H2F
	END IF
End Function

Function WhichDrive$(BYVAL Temp2 as single)
   temp1$=str$(temp2)
   internal$=""
   temp$=AllDrive$
   For t=1 to len(Temp$)
      For t2=1 to len(temp1$)
         If TypeDrive(mid$(temp$,t,1))=val(mid$(temp1$,t2,1)) then
            if instr(internal$,mid$(temp$,t,1))=0 then
            internal$=internal$+mid$(Temp$,t,1)
            end if
         End If
      next t2
   next T
   WhichDrive$=internal$
End Function