Solved

Filtering a drivelistbox

Posted on 2011-03-01
8
358 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
8 Comments
 
LVL 32

Accepted Solution

by:
ewangoya earned 25 total points
Comment Utility
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 25 total points
Comment Utility
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
Comment Utility
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
 
LVL 14

Expert Comment

by:systan
Comment Utility
hi
I think 50 points is not worth for the solution given.
and this post was answered, why not closed it then.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 14

Expert Comment

by:systan
Comment Utility
>>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
Comment Utility
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
Comment Utility
Thank you for the help.
0
 
LVL 14

Expert Comment

by:systan
Comment Utility
I understand now.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

743 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now