Solved

How to deal with cdrom\dvd drives and inserted cdroms\dvd properly?

Posted on 2006-11-01
8
298 Views
Last Modified: 2010-04-05
Hi my friends!

My program should search for a file located on a cdrom inserted in some drive being either a cdrom or dvd drive. It would be nice if the program popped up a messagebox when it was done searching, stating that it had found the file + displaying the path to the file or stating it had not found the file because no cd was inserted, the cd could not be read or no cdrom dvd drive was present.

Kind regards,

Paul :)

Ps working samples do the trick. Please comment if you use complex code tnx in advance!
0
Comment
Question by:PeterdeB
  • 5
  • 3
8 Comments
 

Author Comment

by:PeterdeB
Comment Utility
Something like this seems to work >

procedure TForm1.btnCBDClick(Sender: TObject);
var i, ErrorMode: integer;
    Drive: String;
    C: Array[0..10] of Char;
    FatType: array [0..MAX_PATH] of Char;
    MaxLen1,fSysFlags: DWORD;
begin
   For i := 1 to 26 do begin
      StrPCopy(C, Chr(I+64)+':\');
      If GetDriveType(C) =  DRIVE_CDROM then
       begin
        FatType[0] := #0;
        Drive := C;
        ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
if not GetVolumeInformation(PChar(Drive), nil, 0,nil, MaxLen1, fSysFlags,FatType,DWORD(sizeof(FatType))) then
  begin
  ShowMessage('In station:  '+ Drive + ' is geen cdrom gevonden!');
  end else
  PageControl1.ActivePageIndex:=PageControl1.ActivePageIndex +1;
SetErrorMode(ErrorMode);
end;
end;
end;

Not sure what would happen when there are multiple cdroms....but so far..so good..:) Credits go to slick812, its his answer to a similar question.

If someone can adapt this baby to deal with multiple cdroms then won't have to bother for a refund :)

Kind regards,

Paul
0
 
LVL 11

Expert Comment

by:calinutz
Comment Utility
Here is some function to get the CD drives installed on your system in a StringList:

function GetCDRomPath: TStringList;
var
  i: Integer;
  Drives: DWORD;
  s:string;
  sl:TStringList;
begin
  sl:=TStringList.Create;
  sl.Clear;
  Result := nil;
  Drives := GetLogicalDrives;
  for i := 0 to 25 do
    if ((Drives and (1 shl i)) > 0) and (GetDriveType(PChar(Chr(65 + i) + ':\')) = DRIVE_CDROM) then
      begin
        sl.Add(Chr(65 + i) + ':\');
      end;
      Result:=sl;
end;



Regards
0
 
LVL 11

Expert Comment

by:calinutz
Comment Utility
Your code adapted here:

function GetCDRomPath: TStringList;
var
  i: Integer;
  Drives: DWORD;
  s:string;
  sl:TStringList;
  MaxLen1,fSysFlags: DWORD;
begin
  sl:=TStringList.Create;
  sl.Clear;
  Result := nil;
  Drives := GetLogicalDrives;
  for i := 0 to 25 do
    if ((Drives and (1 shl i)) > 0) and (GetDriveType(PChar(Chr(65 + i) + ':\')) = DRIVE_CDROM) then
      begin
        sl.Add(Chr(65 + i) + ':\');
  if not GetVolumeInformation(PChar(Chr(65 + i) + ':\'), nil, 0,nil, MaxLen1, fSysFlags,#0,DWORD(sizeof(#0))) then
  begin
  ShowMessage('In station:  '+ PChar(Chr(65 + i) + ':\') + ' is geen cdrom gevonden!');
  end
      end;
      Result:=sl;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.AddStrings(GetCDRomPath);
end;
0
 
LVL 11

Expert Comment

by:calinutz
Comment Utility
The above code checks to see if there is a CD inserted in any of the CDROMS that are installed in your system

Regards
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 11

Expert Comment

by:calinutz
Comment Utility
Also another way to put it:
Function to check if a disc is in a drive:

function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: Word;
begin
  if not (Drive in ['A'..'Z']) then
    raise EConvertError.Create('Not a valid drive ID');
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    { drive 1 = a, 2 = b, 3 = c, etc. }
    if DiskSize(Ord(Drive) - $40) = -1 then
      Result := False
    else
      Result := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;


All you have to do is parse through the CDROM drives and ask if there is a disc inside. All this using the 2 functions I posted above (btw the GetVolumeInformation does not work for me... I just used it to use some of your code, but you can get the general ideea by removing the lines that deal with this function)

:-)
0
 
LVL 11

Accepted Solution

by:
calinutz earned 500 total points
Comment Utility
Simplified:

function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: Word;
begin
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    { drive 1 = a, 2 = b, 3 = c, etc. }
    if DiskSize(Ord(Drive) - $40) = -1 then
      Result := False
    else
      Result := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;

procedure GetCDRomS;
var
  i: Integer;
  Drives: DWORD;
  s:string;
begin
  Drives := GetLogicalDrives;
  for i := 0 to 25 do
    if ((Drives and (1 shl i)) > 0) and (GetDriveType(PChar(Chr(65 + i) + ':\')) = DRIVE_CDROM) then
      begin
        If DiskInDrive(Chr(65 + i)) then ShowMessage('There is a disc inserted in '+Chr(65+i)+':\') else
ShowMessage('There is NO disc inserted in '+Chr(65+i)+':\');

      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetCDRomS;
end;
0
 

Author Comment

by:PeterdeB
Comment Utility
Hi my friend! :)

First of all tnx for your responses!!

I had justed finished another stage of this project, when I saw your post. This was my attempt to answer my question:

procedure TForm1.btnCBDClick(Sender: TObject);
var i, ErrorMode: integer;
    Drive: String;
    C: Array[0..10] of Char;
    FatType: array [0..MAX_PATH] of Char;
    MaxLen1,fSysFlags: DWORD;
begin
   For i := 1 to 26 do begin
      StrPCopy(C, Chr(I+64)+':\');
      If GetDriveType(C) =  DRIVE_CDROM then
       begin
        FatType[0] := #0;
        Drive := C;
        ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
if not GetVolumeInformation(PChar(Drive), nil, 0,nil, MaxLen1, fSysFlags,FatType,DWORD(sizeof(FatType))) then
case MessageDlg('In station:  '+ Drive + ' is geen cdrom gevonden! '+#13+#10+'Programma afsluiten? ', mtConfirmation, [mbOK, mbCancel], 0) of
    mrOk:Application.Terminate;
    mrCancel: Break;
  end
   else
  begin
   if FileExists(C + 'I386\_DEFAULT.PI_') then
   PageControl1.ActivePageIndex:=PageControl1.ActivePageIndex +1
  else
  MessageDlg('Dit is geen bruikbare versie van xp!', mtInformation,[mbOK],0) ;
SetErrorMode(ErrorMode);
end;
end;
end;
end;


This one works, it checks for the cdrom drive, it checks whether a disk is inserted and it checks whether some file exists on the disc. That's kinda what I needed, except for the situation in which 2 or more cdrom drives woudl exist ofcourse. I tested your code and it did not workfor me, although the correct cd was inserted it stated there was no cd rom inserted.

So I will stick to the  code I posted here myself...with one remark > my program should be able to cope with the situation in which 2 or more cdrom drives are present...if you manage to adapt my code then all points are yours....I can live with the piece of code I posted...but if you feel like making it more than 1 cd rom drive proof...please do so!

Kind regards,

Paul

Btw I will post some other questions all related to this program...:)
0
 

Author Comment

by:PeterdeB
Comment Utility
Calinutz > I had not noticed your last post, obviously:) I just copied and pasted it, it works great. I'm gonna reward the efforts you put into helping me.

Kind regards,

Paul :)
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
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…

728 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

10 Experts available now in Live!

Get 1:1 Help Now