Delphi構建硬盤映射和光驅映射，刪除光驅映射，獲取盤符系列，驅動器映射，包括監制各類驅動器的使用情況，下面的程序運行截圖：
實現代碼如下：
001
unit Unit1;
002
interface
003
uses
004
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
005
Dialogs, StdCtrls, ExtCtrls, ComCtrls, shellAPI, FileCtrl,mmsystem;
006
type
007
TForm1 = class(TForm)
008
Button1: TButton;
009
ComboBox1: TComboBox;
010
Label1: TLabel;
011
DriveComboBox1: TDriveComboBox;
012
DirectoryListBox1: TDirectoryListBox;
013
Button2: TButton;
014
Label2: TLabel;
015
Label3: TLabel;
016
Button4: TButton;
017
ListBox1: TListBox;
018
Timer1: TTimer;
019
Label4: TLabel;
020
Button3: TButton;
021
Button5: TButton;
022
Button6: TButton;
023
procedure Button1Click(Sender: TObject);
024
procedure Button2Click(Sender: TObject);
025
procedure Timer1Timer(Sender: TObject);
026
procedure Button4Click(Sender: TObject);
027
procedure Button3Click(Sender: TObject);
028
procedure Button6Click(Sender: TObject);
029
procedure Button5Click(Sender: TObject);
030
private
031
{ Private declarations }
032
public
033
{ Public declarations }
034
end;
035
var
036
Form1: TForm1;
037
implementation
038
{$R *.dfm}
039
procedure TForm1.Button1Click(Sender: TObject);
040
begin
041
winExec(pchar('subst '+ComboBox1.Text+' '+DirectoryListBox1.Directory),SW_HIDE);
042
{Subst——命令講解
043
將路徑與驅動器盤符關聯
044
subst [drive1:[drive2:]path]
045
subst drive1: /d //空一格
046
如果在沒有參數的情況下使用，subst 將顯示有效的虛擬驅動器的名稱。
047
drive1:
048
指定要為其指派路徑的虛擬驅動器。
049
drive2:
050
指定包含指定路徑的物理驅動器（如果不是當前的驅動器）。
051
path
052
指定要指派給虛擬驅動器的路徑。
053
/d
054
刪除虛擬驅動器。
055
}
056
end;
057
procedure TForm1.Button2Click(Sender: TObject);
058
begin
059
winExec(pchar('subst '+ComboBox1.Text+' /d'),SW_HIDE);
060
end;
061
062
procedure TForm1.Timer1Timer(Sender: TObject);
063
var
064
i: Integer;
065
C: String;
066
DType: Integer;
067
DriveString: String;
068
begin
069
ListBox1.Clear; //清除當前Listbox中的內容
070
{從盤符A..Z中選取有效的盤符}
071
for i := 65 to 90 do //65是A的ASCII碼，90是Z的ASCII碼
072
begin
073
C := chr(i)+':\';
074
DType := GetDriveType(PChar(C));
075
case DType of
076
0: DriveString := C+' 驅動器類型不確定';
077
1: DriveString := C+' 系統目錄不存在';
078
DRIVE_REMOVABLE: DriveString :=C+' 是可移動驅動器';
079
DRIVE_FIXED: DriveString :=C+' 是固定驅動器';
080
DRIVE_REMOTE: DriveString :=C+' 是網絡驅動器';
081
DRIVE_CDROM: DriveString := C+' 是CD-ROM驅動器';
082
DRIVE_RAMDISK: DriveString := C+' 是虛擬驅動器';
083
end;
084
if not ((DType = 0) or (DType = 1)) then //排除0和1兩種情況
085
ListBox1.Items.AddObject(DriveString, Pointer(i)); //往Listbox中添加內容
086
end;
087
end;
088
089
procedure TForm1.Button4Click(Sender: TObject);
090
begin
091
Timer1.Enabled:=True; //開始監視
092
end;
093
094
{procedure TForm1.Button4Click(Sender: TObject);
095
//var
096
// ico : Ticon;
097
// IconIndex : Word; //抽取圖標，注意加入shellAPI.pas
098
begin
099
if OpenDialog1.Execute Then
100
try
101
ico := Ticon.create;
102
ico.handle := ExtractAssociatedIcon(hInstance,
103
Pchar(OpenDialog1.FileName),
104
IconIndex);
105
self.icon := ico;
106
finally
107
ico.free;
108
end;
109
end;}
110
function GetHDSerialNumber(Drv : String): String;
111
var
112
VolumeSerialNumber : DWord;
113
MaxLength : DWord;
114
FSFlags : DWord;
115
begin
116
if Drv[Length(Drv)] =':' then
117
Drv := Drv + '\';
118
GetVolumeInformation(pChar(Drv),nil,0,@VolumeSerialNumber,MaxLength,fSFlags,nil,0);
119
Result:=IntToHex(HiWord(VolumeSerialNumber),4)+''+IntToHex(LoWord(VolumeSerialNumber),4);
120
end;
121
procedure TForm1.Button3Click(Sender: TObject);
122
begin
123
Caption:='盤符系列號：'+GetHDSerialNumber(DriveComboBox1.Drive+':');
124
end;
125
procedure TForm1.Button6Click(Sender: TObject);
126
begin
127
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
128
end;
129
procedure TForm1.Button5Click(Sender: TObject);
130
begin
131
mciSendString('Set cdaudio door open wait', nil, 0, handle);
132
end;
133
end.
可將代碼保存為Unit1.pas，在Delphi7下創建其它工程文件，可編譯運行。
