看看吧，好长的，不过都有用
{***************************************************************
*
* 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-1do
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^ <> #0do
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 cdaudiodo
or open wait', nil, 0, 0);//handle);
end;
procedure CloseCDRom;
begin
mciSendString('Set cdaudiodo
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;
function DiskInDrive(Drive: Char): Boolean;
var ErrorMode: word;
begin
{ make it upper case }
if Drive in ['a'..'z'] then
Dec(Drive, $20);
{ make sure it's a letter }
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
{ turn off critical errors }
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
{ restore old error mode }
SetErrorMode(ErrorMode);
end;
end;
end.
