Find mounted volumes

New to FreeBASIC? Post your questions here.
Post Reply
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Find mounted volumes

Post by JL35 »

Is there a mean in Freebasic to know which volumes are mounted and accessible, like usb keys, memory cards, external disks and so on, without freezing if no volume is mounted on a given peripheral.
I have a solution in a vb script, but I would like one in fb.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Post by sir_mud »

the API calls should be similiar to what you have in vbscript. if you could post the vbscript it would greatly help someone help you translate the functionality.
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

The script is launched from a program fb by Shell command, and the result is recovered in the file "Z:\Volumes.txt" (Z: being 32M memory disk).
Here is the full script (sorry, in french):
' ----------------------------------------------------------
' Script donnant les caractéristiques des disques de l'ordinateur
' -> Z:\Volumes.txt
' ----------------------------------------------------------
typeD=Array("Inconnu","Amovible","Fixe","Réseau","CD-ROM","RAM Disk")
Dim net, shell, computer, fso, WMISet,oWinnt

Dim fst, fichier
Set fst = CreateObject("Scripting.FileSystemObject")
Set fichier = fst.CreateTextFile("Z:\Volumes.txt")

Set net = Wscript.CreateObject("WScript.Network")
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

computer=net.ComputerName
InfosDisques Computer
wscript.quit

'--------------------------------------------------------------------
Sub InfosDisques(computer)
set WMISet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).ExecQuery _
("SELECT * FROM Win32_LogicalDisk")
Message=VBCRLF
Message=Message & " | " & FormatStrL("Nom",11) & " | " & FormatStrL("Type",8)
Message=Message & " | " & FormatStrL("Système",8)
Message=Message & " | " & FormatStrL(" Taille (Mo) ",17)
Message=Message & " | " & FormatStrL(" % ",3)
Message=Message & " | " & FormatStrL("N°série",8)
Message=Message & VBCRLF
Message=Message & " | " & FormatStrL("",11) & " | " & FormatStrL("",8)
Message=Message & " | " & FormatStrL("",8)
Message=Message & " | " & FormatStrR("Maxi",7) & " | " & FormatStrR("Libre",7)
Message=Message & " | " & FormatStrL("lib",3)
Message=Message & " | "
Message=Message & VBCRLF
Message=Message & "---+-------------+----------+----------+---------+---------+-----+---------"
Message=Message & VBCRLF
CumulTotal=0
CumulAvail=0
Mega=1048576
For each Disk in WMISet
Capa=Disk.Size
Desc=TypeD(Disk.DriveType-1)
If Capa<>"" Then
Name=Disk.VolumeName
Serial=Disk.VolumeSerialNumber
TT=int(cdbl(Capa)/mega)
TL=int(cdbl(Disk.FreeSpace)/mega)
Syst=Disk.FileSystem
If TT>0 Then
pc=int(TL*100/TT)
Else
pc=""
End If
If Disk.DriveType=3 Then
CumulTotal=CumulTotal+TT
CumulAvail=CumulAvail+TL
End If
Else
Name=""
Serial=""
TT=""
TL=""
Syst="non prêt"
pc=""
End If
Message=Message & Disk.Name & " | " & FormatStrL(name,11) & " | " & FormatStrL(Desc,8)
Message=Message & " | " & FormatStrL(syst,8)
Message=Message & " | " & FormatStrR(TT,7) & " | " & FormatStrR(TL,7)
Message=Message & " | " & FormatStrR(pc,3)& " | " & Serial
Message=Message & VBCRLF
Next
Message=Message & "---+-------------+----------+----------+---------+---------+-----+---------"
Message=Message & VBCRLF
Message=Message & " | " & FormatStrL("TOTAL fixes",11) & " | " & FormatStrL("",8)
Message=Message & " | " & FormatStrL("",8)
Message=Message & " | " & FormatStrR(CumulTotal,7) & " | " & FormatStrR(CumulAvail,7)
Message=Message & " | " & FormatStrR(int(CumulAvail*100/CumulTotal),3)
Message=Message & " | " & VBCRLF

fichier.WriteLine (Message)
fichier.Close
End Sub
'--------------------------------------------------------------------
Function FormatStrL(ch,lmax)
l=len(ch)
If l<lmax Then
For k = l+1 To lmax
ch=ch & " "
Next
End If
FormatStrL=ch
End Function
'--------------------------------------------------------------------
Function FormatStrR(ch,lmax)
l=len(ch)
If l<lmax Then
For k = l+1 To lmax
ch=" " & ch
Next
End If
FormatStrR=ch
End Function
'--------------------------------------------------------------------
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Post by vdecampo »

Here is an OOP DriveList object I created to enumerate all of the drives, their type, and get their free disk space.

Code: Select all

Type _DriveList
Public:
   Declare Constructor()
   Declare Function  GetDiskSpace(ByRef drivename As ZString Ptr,_
                        ByRef bavail As ULongInt,_
                        ByRef btotal As ULongInt,_
                        ByRef bfree  As ULongInt) As Integer
   Declare Sub       Refresh()
   '
   As Integer  count
   As String   drive(10)
   As Integer  dType(10)
   As ULongInt tspace(10)
   As ULongInt fspace(10)
Private:
   As ZString*255 drives
End Type

Constructor _DriveList
Dim As Integer buff,idx

   buff = GetLogicalDriveStrings(255,@drives)

   idx=0
   For a As Integer = 0 To buff-1
      If drives[a]=0 Then
         this.dtype(idx)=GetDriveType(this.drive(idx))    
         idx+=1
         If idx>10 Then Exit For
      Else
         drive(idx)+=Chr(drives[a])
      EndIf   
   Next
   
   this.count = idx
   this.Refresh
   
End Constructor

Function _DriveList.GetDiskSpace(ByRef drivename As ZString Ptr,_
                                 ByRef bavail As ULongInt,_
                                 ByRef btotal As ULongInt,_
                                 ByRef bfree  As ULongInt) As Integer

   Return   GetDiskFreeSpaceEx(_
                  drivename,_
                  Cast(ULARGE_INTEGER Ptr,@bavail),_
                  Cast(ULARGE_INTEGER Ptr,@btotal),_
                  Cast(ULARGE_INTEGER Ptr,@bfree))
   
End Function

Sub _DriveList.Refresh
   For idx As Integer = 0 To this.count-1
      Select Case this.dType(idx)
         Case DRIVE_REMOVABLE,DRIVE_FIXED
            this.GetDiskSpace this.drive(idx),0,this.tspace(idx),this.fspace(idx)
      End Select
   Next
End Sub
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

Thank you vdecampo, but I seem to miss a library call (or several) with your code, many "Variable not declared..."
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Post by vdecampo »

JL35 wrote:Thank you vdecampo, but I seem to miss a library call (or several) with your code, many "Variable not declared..."
Make sure you include "windows.bi"

-Vince
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

Yes ! its much better with windows.bi !
I experiment, thank you very much.

Edit: Sorry, I am an ass ('Beginner'), but I don't know how to retrieve the informations...
calstover
Posts: 68
Joined: Aug 21, 2006 16:51

Post by calstover »

Simpler method:

Code: Select all

#Include Once "windows.bi"
Dim Shared As UInteger logDrvs



logDrvs = GetLogicalDrives()

....

Function exists(idx As Byte) As Integer
  'idx 0 = drive A, 1 = B, etc
  Return Bit(logDrvs, idx)
  
End Function
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Post by vdecampo »

JL35 wrote:Yes ! its much better with windows.bi !
I experiment, thank you very much.

Edit: Sorry, I am an ass ('Beginner'), but I don't know how to retrieve the informations...
Add this code at the bottom...

Code: Select all

Dim As _DriveList DriveList

For dr As Integer = 0 To DriveList.count -1
   Print "Drive " & DriveList.drive(dr)
   Print "Free Space=" & DriveList.fspace(dr)
   Print
Next

Sleep
-Vince
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Post by Zippy »

A partial disphelper+WMI translation:

Code: Select all

'disphelper, report virtual disks with freespace on same
'
#include once "windows.bi"               'in
#define UNICODE                          'this
#include once "disphelper/disphelper.bi" 'order
'
dim as ulongint freespace,disksize
dim as string ts
dim as HRESULT hres
dim as zstring ptr devID,devFS,devSZ
'
DISPATCH_OBJ(wmiSvc)
DISPATCH_OBJ(colDisk)
dhInitialize(TRUE)
'
'this reports errors whether you want to see them or not:
'dhToggleExceptions(TRUE)
'
Screen 18
'
hres=dhGetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2",NULL,@wmiSvc)
hres=dhGetValue("%o",@colDisk,wmiSvc,".ExecQuery(%s)","Select * from Win32_LogicalDisk")
'
FOR_EACH0(objDisk,colDisk,NULL)
    '
    hres=dhGetValue("%s",@devID,objDisk,".DeviceID")
    hres=dhGetValue("%s",@devFS,objDisk,".FreeSpace")
    hres=dhGetValue("%s",@devSZ,objDisk,".Size")
    '
    if hres=0 then 'hres <> 0 when device not ready/no media?

        freespace=CUlngInt(*devFS)
        disksize =CUlngInt(*devSZ)
        
        ts="& #,###.## gbytes    Free: #,###.## gbytes"
        
        print using ts;*devID,disksize/2^20/1024,freespace/2^20/1024
        
    end if
    '
NEXT_(objDisk)
'
SAFE_RELEASE(wmiSvc)
SAFE_RELEASE(colDisk)
dhUninitialize(TRUE)
'
print:print "Sleeping to Exit.."
sleep
ETA:

WMI offers much greater detail than I've exposed, see:

http://msdn.microsoft.com/en-us/library ... 85%29.aspx

for the Win32_LogicalDisk Class.
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

@Vince
I get four Windows error messages titled 'Windows - no disk' with "Exception Processing Message 0xc... " and 3 buttons Cancel Retry Continue, which I must click, before getting the correct list of disks beginning by C:

@Zippy
Your code is very simple and gives me the solution I was searching.

Thank you very much to both you for aid.
Post Reply