Solved

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

Posted on 2006-11-01
8
308 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
ID: 17849649
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
ID: 17850859
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
ID: 17850924
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
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 11

Expert Comment

by:calinutz
ID: 17850933
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
 
LVL 11

Expert Comment

by:calinutz
ID: 17851090
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
ID: 17851161
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
ID: 17851255
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
ID: 17851293
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…

830 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