?
Solved

Filtering a drivelistbox

Posted on 2011-03-01
8
Medium Priority
?
372 Views
Last Modified: 2012-05-11
Is there an easy way to make a drivelistbox not show empty CD, DVD and Blu Ray drives ?
I get an error if I select an empty drive. Where do I attach an error handling message to say "Drive Empty" ?
0
Comment
Question by:ChLa
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 32

Accepted Solution

by:
Ephraim Wangoya earned 75 total points
ID: 35008317
Try this code but you have to test it thoroughly
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    procedure Button1Click(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
  private
    procedure DirException(Sender: TObject; E: Exception);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Ext, FilePart, FileName: string;
begin
  FileName := 'test.txt';
  Ext := ExtractFileExt(FileName);
  FilePart := ChangeFileExt(Filename, '');
  ShowMessage(Ext + '  ' +  FilePart);
end;

procedure TForm1.DirException(Sender: TObject; E: Exception);
begin
  if Pos('I/O ERROR', Uppercase(E.Message)) > 0 then
  begin
    DriveComboBox1.OnChange := nil;
    DriveComboBox1.ItemIndex := 0;
    DriveComboBox1.OnChange := DriveComboBox1Change;
    ShowMessage('Empty Drive');
  end
  else
    raise Exception.Create(E.Message);
end;

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  Application.OnException := DirException;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
  Application.OnException := nil;
end;

end.

Open in new window

0
 
LVL 3

Assisted Solution

by:maosalah
maosalah earned 75 total points
ID: 35011210
List Drives without empty drives (procedure List_Drives)



function IsDriveReady(Root: string): Boolean;
var
  Oem:      Cardinal;
  Dw1, Dw2: DWORD;
begin
  Oem := SetErrorMode(SEM_FAILCRITICALERRORS);
  if Length(Root) = 1 then Root := Root + ':\';
  Result := GetVolumeInformation(PChar(Root), nil, 0, nil, Dw1, Dw2, nil, 0);
  SetErrorMode(Oem);
end;

{ Get List Drives }
procedure List_Drives(List : TStrings);
const
  DRIVE_UNKNOWN = 0;
  DRIVE_NO_ROOT_DIR = 1;
  DRIVE_REMOVABLE = 2;
  DRIVE_FIXED = 3;
  DRIVE_REMOTE = 4;
  DRIVE_CDROM = 5;
  DRIVE_RAMDISK = 6;
var
  r: LongWord;
  Drives: array[0..128] of char;
  pDrive: PChar;
begin
  List.Clear;
  r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
  if r = 0 then Exit;
  if r > SizeOf(Drives) then
    raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
  pDrive := Drives;
Try
  while pDrive^ <> #0 do
  begin

   if ((GetDriveType(pDrive) = DRIVE_REMOVABLE) or     
      (GetDriveType(pDrive) = DRIVE_FIXED) or 
      (GetDriveType(pDrive) = DRIVE_CDROM))  then
    if IsDriveReady(pDrive) then
       List.Add(pDrive) ;
    Inc(pDrive, 4);
  end;
Finally
end;
end;

Open in new window

0
 

Author Comment

by:ChLa
ID: 35043698
oops...I meant to say DriveComboBox. Anyway, I found what I needed in the experts exchange archives...a procedure that checks the frive before pointing the DirectoryListBox, and it works. Thankyou
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 14

Expert Comment

by:systan
ID: 35123167
hi
I think 50 points is not worth for the solution given.
and this post was answered, why not closed it then.
0
 
LVL 14

Expert Comment

by:systan
ID: 35124183
>>oops...
You meant to say that your not going to accept there comments as good answer?

Oops..
I forgot, I should look first the profile before I answer, maybe a guy is greed to accept answers, where points isn't to be responded unless was forced by a moderator.
0
 

Author Comment

by:ChLa
ID: 35129403
I have no idea how to assign a point value. Is it my guess as to how easy the question is to answer, or, how valuable the answer is to me ? I cannot know how easy the answer may be to to have come up with. Perhpas it seems like it should be easy to me, but it isn't. Perhaps it seems hard to me but is extremely simple to the person providing the answer. As you can see from my last comment four boxes up, I found the answer I used, and didn't use anyone's answer here. How do I close this question without selecting a specific answer ? I will now try to "Accept Multiple Solutions.
0
 

Author Closing Comment

by:ChLa
ID: 35129421
Thank you for the help.
0
 
LVL 14

Expert Comment

by:systan
ID: 35130461
I understand now.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
Suggested Courses
Course of the Month9 days, 9 hours left to enroll

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question