📄 00301.htm
字号:
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>1</title>
</head>
<body bgcolor="#000000" text="#FFFFFF" link="#FFFFFF">
<p align="left"><span style="BACKGROUND-COLOR: #ff0000"><a href="00301.zip">源程序下载</a></span><b><span style="background-color: #000080"><br>
</span><span style="background-color: #000000">
<br>
</span><span style="background-color: #000080">
<a name="1"></a>
1：如何启动/关闭CD-ROM的自动运行<br>
</span><span style="background-color: #000000">
<br>
</span></b> 在Private声明部分说明一个SetCDAutoRun(AAutoRun:Boolean)用来设置是否让光盘自动运行，AAutoRun=True；自动运行；AAutoRun=False；不能自动运行。<br>
<br>
SetCDAutoRun(AAutoRun:Boolean)的过程如下：<br>
Procedure TForm1.SetCDAutoRun(AAutoRun:Boolean);<br>
const<br>
DoAutoRun : array[Boolean] of Integer = (0,1);<br>
var<br>
Reg:TRegistry;<br>
begin<br>
Reg := TRegistry.Create;<br>
try<br>
Reg.RootKey := HKEY_LOCAL_MACHINE;<br>
if Reg.KeyExists('System\CurrentControlSet\Services\Class\CDROM') then<br>
if Reg.OpenKey('System\CurrentControlSet\Services\Class\CDROM',FALSE) then<br>
Reg.WriteBinaryData('AutoRun',DoAutoRun[AAutoRun],1);<br>
finally<br>
Reg.Free;<br>
end;<br>
MessageBox(handle,'你的设置在Windows重新启动后将生效','信息',MB_IconInformation+MB_OK);<br>
End ;<br>
<span style="background-color: #000000">
<br>
</span>
<b><span style="background-color: #000080"><a name="2"></a>2：如何判断光驱中是否有光盘<br>
</span><span style="background-color: #000000">
<br>
</span></b>如果函数返回值为真，说明有盘，否则说明没有。<br>
function DiskInDrive(Drive: Char): Boolean;<br>
var<br>
ErrorMode: word;<br>
begin<br>
if Drive in ['a'..'z'] then Dec(Drive, $20); //make it upper case<br>
if not (Drive in ['A'..'Z']) then //make sure it's a letter<br>
raise<br>
EConvertError.Create('Not a valid drive ID'); //turn off critical errors<br>
ErrorMode :=SetErrorMode(SEM_FailCriticalErrors);<br>
try<br>
if DiskSize(Ord(Drive) - $40)=-1 then //drive 1=a, 2=b, 3=c, etc.<br>
Result :=False<br>
else Result :=True;<br>
finally<br>
SetErrorMode(ErrorMode); //restore old error mode<br>
End ;<br>
end;<br>
<span style="background-color: #000000">
<br>
</span>
<b><span style="background-color: #000080"><a name="3"></a>3：如何打开和关闭计算机的光驱</span></b>
</p>
<p> 要打开和关闭计算机的光驱，只要向MCI发送一条mciSendString指令即可，别忘了，在Uses里面加上mmsystem。程序代码如下：<br>
<br>
procedure TForm1.BitBtn1Click(Sender: TObject);<br>
begin<br>
mciSendString('Set cdaudio door open wait', nil, 0, handle); //打开光驱<br>
end;<br>
<br>
procedure TForm1.BitBtn2Click(Sender: TObject);<br>
begin<br>
mciSendString('Set cdaudio door closed wait', nil, 0, handle); //关闭光驱<br>
end;<br>
<span style="background-color: #000000">
<br>
</span>
<b><span style="background-color: #000080"><a name="4"></a>4：获得磁盘的类型<br>
</span><span style="background-color: #000000">
<br>
</span></b>Function GetDiskType(Disk : Char) : String ;<br>
var<br>
x:integer;<br>
driver:pchar;<br>
TempStr : String ;<br>
begin<br>
driver:=Pchar(Disk+':\'); //要显示的驱动器名<br>
x := GetDriveType(driver);<br>
Case x of<br>
2: Result := '该驱动器是可移动驱动器';<br>
3: Result := '该驱动器是固定驱动器';<br>
4: Result := '该驱动器是网络驱动器';<br>
5: Result := '该驱动器是CD-ROM驱动器';<br>
6: Result := '该驱动器是虚拟驱动器';<br>
Else Result := '该驱动器无效';<br>
End;<br>
end;<br>
<span style="background-color: #000000">
<br>
</span>
<b><span style="background-color: #000080"><a name="5"></a>5：获得磁盘的容量<br>
</span></b>
<span style="background-color: #000000">
<br>
</span>
Function GetDiskLarge(Disk : Char) : String;<br>
var<br>
driver:pchar;<br>
sec1, byt1, cl1, cl2:longword;<br>
begin<br>
driver:=PChar(Disk+':\'); //要显示的驱动器名<br>
GetDiskFreeSpace(driver, sec1, byt1, cl1, cl2);<br>
cl1 := cl1 * sec1 * byt1;<br>
cl2 := cl2 * sec1 * byt1;<br>
Result := '该驱动器总共容量' + Formatfloat('###,##0',cl2) + '字节' +#13+#13+<br>
'该驱动器可用容量' + Formatfloat('###,##0',cl1) + '字节' ;<br>
end;<br>
<br>
<span style="background-color: #FF0000"><a href="00301.zip">源程序下载</a></span>
</p>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -