Bianca
Bianca

Reputation: 973

Get valid drive letter and is occupied

I want scan all available drive letter that exist on my computer, and get detail with it (chk if occupied, chk for type and size).

I have no problem about how to get size by using the codes bellow

var
  FreeAvail, totalSpace: Int64;
begin
  if SysUtils.GetDiskFreeSpaceEx(PChar('F:\'), FreeAvail, totalSpace, nil) = True
  then
  begin
    F1.Liner('Drive F total space ');
    F1.pBold(IntToStr(totalSpace div (1024 * 1024 * 1024)) + ' GB ,');
    F1.Liner(' available free space ');
    F1.pBold(IntToStr(FreeAvail div (1024 * 1024 * 1024)) + ' GB.');
  end;
end;

But if the drive is unoccupied, i don't like this situation.

error message if no media

Question: How to get available ALL drive(s) - CDROM, USB Stick, etc. To be more specific, i want the display result like this example;

Drive E [Local Disk] - TotalSpace 500 GB - FreeSpace 200 GB

Drive F [CD Drive] - Unoccupied - FreeSpace 0

Drive G [Removable] - TotalSpace 8 GB - FreeSpace 2 GB

Upvotes: 5

Views: 2415

Answers (2)

Ken White
Ken White

Reputation: 125698

I've provided a couple of functions that might help. The first uses the Win32 API function GetLogicalDriveStrings to retrieve a list of the assigned drive letters on the computer. The second queries a drive to see if it's ready for use (has a disk in it). (There's also a utility function that converts a drive letter to the integer value needed for DiskSize, the old Pascal I/O function.)

The code has worked since Win95 days, and was just tested on Win7 64-bit in a Delphi 2007 console application. There's a console test application included below.

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows, Types;

// Returns an array filled wit the assigned
// drive letters on the current computer.
function  GetDriveList: TStringDynArray;
var
  Buff: array[0..128] of Char;
  ptr: PChar;
  Idx: Integer;
begin
  if (GetLogicalDriveStrings(Length(Buff), Buff) = 0) then
    RaiseLastOSError;
  // There can't be more than 26 lettered drives (A..Z).
  SetLength(Result, 26);      

  Idx := 0;
  ptr := @Buff;
  while StrLen(ptr) > 0 do
  begin
    Result[Idx] := ptr;
    ptr := StrEnd(ptr);
    Inc(ptr);
    Inc(Idx);
  end;
  SetLength(Result, Idx);
end;

// Converts a drive letter into the integer drive #
// required by DiskSize().
function DOSDrive( const sDrive: String ): Integer;
begin
  if (Length(sDrive) < 1) then
    Result := -1
  else
    Result := (Ord(UpCase(sDrive[1])) - 64);
end;

// Tests the status of a drive to see if it's ready
// to access. 
function DriveReady(const sDrive: String): Boolean;
var
  ErrMode: Word;
begin
  ErrMode := SetErrorMode(0);
  SetErrorMode(ErrMode or SEM_FAILCRITICALERRORS);
  try
    Result := (DiskSize(DOSDrive(sDrive)) > -1);
  finally
    SetErrorMode(ErrMode);
  end;
end;

// Demonstrates using the above functions.
var
  DrivesArray: TStringDynArray;
  Drive: string;
const
  StatusStr = 'Drive %s is ready: %s';
begin
  DrivesArray := GetDriveList;
  for Drive in  DrivesArray do
    WriteLn(Format(StatusStr, [Drive, BoolToStr(DriveReady(Drive), True)]));
  ReadLn;
end.

Sample output when run on my system (Win7 64, two physical hard drives (C: and D:), an ISO device with no image mounted (E:), and a DVD drive (Z:).

Drive C:\ is ready: True 
Drive D:\ is ready: True 
Drive E:\ is ready: False
Drive Z:\ is ready: True

Upvotes: 11

David Heffernan
David Heffernan

Reputation: 612963

The error dialog is a backwards compatibility issue. Older versions (much older) of Windows showed such dialogs. The designers realised that they were often undesirable. Applications need to be able to handle these conditions themselves.

But changing wholesale would have affected those apps that wanted to have the dialogs. So a mechanism was introduced to allow applications to control certain aspects of error handling.

You can suppress such error dialogs by calling SetErrorMode. This allows you to suppress the dialog and instead have the failing API call return an error.

Call the following function once at startup:

procedure SetProcessErrorMode;
var
  CurrentMode: DWORD;
begin
  CurrentMode := SetErrorMode(0);
  SetErrorMode(CurrentMode or SEM_FAILCRITICALERRORS
    or SEM_NOOPENFILEERRORBOX);
end;

This call should be made once at startup. The error mode is a process wide property and modifications after startup can lead to undesirable and unpredictable side effects. MSDN says:

Best practice is that all applications call the process-wide SetErrorMode function with a parameter of SEM_FAILCRITICALERRORS at startup. This is to prevent error mode dialogs from hanging the application.

I personally recommend adding SEM_NOOPENFILEERRORBOX too.

I've attempted here to address part of your question, but not all of it. I think that's reasonable when you ask multiple questions at once.

Upvotes: 6

Related Questions