?
Solved

Filtering a drivelistbox

Posted on 2011-03-01
8
Medium Priority
?
375 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:
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
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.

 
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

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

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

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Integration Management Part 2
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses
Course of the Month14 days, 7 hours left to enroll

807 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