如果机器上装有多个光驱,如何获得光驱的总数量 和 每个光驱的型号?(200分)

  • 主题发起人 becauseI
  • 开始时间
B

becauseI

Unregistered / Unconfirmed
GUEST, unregistred user!
如果机器上装有多个光驱,如何获得光驱的总数量 和 每个光驱的型号?
 
{***************************************************************
*
* Unit Name: CXDiskFileUtils
* Purpose :
* Author : hubdog
* History : 0.01
*
****************************************************************}

unit CXDiskFileUtils;
interface
uses Classes, Sysutils;
//////////////CDRom Utils//////////////////////
//获得CDRom 序列号
function GetdiskserilNum(ADrive: string): string;
//获得CDRom卷标,返回''表示驱动器中没有光盘
function GetCDRomLabel(ADrive: string): string;
//获得第一个CDRom,返回''表示驱动器中没有光盘
function GetFirstCDROM: ShortString;
//获得系统驱动器列表
procedure Getdisks(Strings: TStringList);
//打开光驱
procedure OpenCDRom;
//关闭光驱
procedure CloseCDRom;
//切换光驱自动运行功能,设置在Windows重新启动后将生效
procedure SetCDRomAutoRun(AutoRun:Boolean);
implementation
uses Windows, MMSystem;
//////////////CDRom Utils////////////////////////////
function GetdiskserilNum(ADrive: string): string;
var
VolumeName : array[0..255] of char;
FileSystemType : array[0..255] of char;
SerialNum : DWORD;
MaxFilenameLength : DWORD;
Flags : DWORD;
begin
if (GetVolumeInformation(PChar(ADrive),
VolumeName,
256,
@SerialNum,
MaxFilenameLength,
Flags,
FileSystemType,
256)) then
Result := (IntToHex(SerialNum shr 16, 3) +
IntToHex((SerialNum shl 16) shr 16, 4));
end;

function GetCDRomLabel(ADrive: string): string;
var
VolumeName : array[0..255] of char;
FileSystemType : array[0..255] of char;
SerialNum : DWORD;
MaxFilenameLength : DWORD;
Flags : DWORD;
begin
//Result := '驱动器中没有CDRom';
if (GetVolumeInformation(PChar(ADrive),
VolumeName,
256,
@SerialNum,
MaxFilenameLength,
Flags,
FileSystemType,
256)) then
Result := VolumeName;
end;

function GetFirstCDROM: Shortstring;
var
AList : TStringList;
Counter : integer;
begin
//Result := '驱动器里无CDRom';
AList := TStringList.Create;
Getdisks(AList);
for Counter := 0 to AList.Count-1 do
if GetDriveType(PChar(Alist.Strings[Counter])) = DRIVE_CDROM then
Result := Alist.Strings[Counter]
end;

procedure Getdisks(Strings: TStringList);
const BufSize = 256;
var
Buffer : PChar;
P : PChar;
begin
GetMem(Buffer, BufSize);
try
Strings.begin
Update;
try
Strings.Clear;
if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then
begin
P := Buffer;
while P^ <> #0 do
begin
Strings.Add(P);
Inc(P, StrLen(P) + 1);
end;
end;
finally
Strings.EndUpdate;
end;
finally
FreeMem(Buffer, BufSize);
end;
end;

procedure OpenCDRom;
begin
mciSendString('Set cdaudio do
or open wait', nil, 0, 0);//handle);
end;

procedure CloseCDRom;
begin
mciSendString('Set cdaudio do
or closed wait', nil, 0, 0);//handle);
end;

procedure SetCDRomAutoRun(AutoRun:Boolean);
const
do
AutoRun : array[Boolean] of Integer = (0,1);
var
Reg:TRegistry;
begin
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('System/CurrentControlSet/Services/Class/CDROM') then
if Reg.OpenKey('System/CurrentControlSet/Services/Class/CDROM',FALSE) then
Reg.WriteBinaryData('AutoRun',DoAutoRun[AAutoRun],1);
finally
Reg.Free;
end;
//设置在Windows重新启动后将生效
end;

end.

 
从A 到Z
get diricvetype
 
你等等,我马上帮你写个例子贴出来。。
 
来了,都调试过了。。:)、
首玩在FORM上放一个ListBox 放你的光驱驱动器列表
在FORM上放一个Edit1放你的光驱驱动器记录数
放一个button 来点击取值。。。
下面是完例子。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Drv = 'D'..'Z';
//注意,在这儿定义 DRV
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
d:drv;
s:string;
i:Integer;
begin
i:=0;
for d:='D' to 'Z' do
begin
s:=d+':';
if GetDRiveType(Pchar(s))=DRIVE_CDROM then
begin
ListBox1.Items.Add(s);
Inc(i);
end;

end;
edit1.text:=IntToStR(i);
end;
end.
 
del520非常感谢你!
这个程序能否显示光驱的名称,比如:NEC 44X
 
顶部