作者在 2010-01-25 17:52:50 发布以下内容
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, shellAPI, FileCtrl,mmsystem;
type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
Label1: TLabel;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
Button2: TButton;
Label2: TLabel;
Label3: TLabel;
Button4: TButton;
ListBox1: TListBox;
Timer1: TTimer;
Label4: TLabel;
Button3: TButton;
Button5: TButton;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
winExec(pchar('subst '+ComboBox1.Text+' '+DirectoryListBox1.Directory),SW_HIDE);
{Subst——命令讲解
将路径与驱动器盘符关联
subst [drive1:[drive2:]path]
subst drive1: /d //空一格
如果在没有参数的情况下使用，subst 将显示有效的虚拟驱动器的名称。
drive1:
指定要为其指派路径的虚拟驱动器。
drive2:
指定包含指定路径的物理驱动器（如果不是当前的驱动器）。
path
指定要指派给虚拟驱动器的路径。
/d
删除虚拟驱动器。
}
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
winExec(pchar('subst '+ComboBox1.Text+' /d'),SW_HIDE);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i: Integer;
C: String;
DType: Integer;
DriveString: String;
begin
ListBox1.Clear; //清除当前Listbox中的内容
{从盘符A..Z中选取有效的盘符}
for i := 65 to 90 do //65是A的ASCII码，90是Z的ASCII码
begin
C := chr(i)+':\';
DType := GetDriveType(PChar(C));
case DType of
0: DriveString := C+' 驱动器类型不确定';
1: DriveString := C+' 系统目录不存在';
DRIVE_REMOVABLE: DriveString :=C+' 是可移动驱动器';
DRIVE_FIXED: DriveString :=C+' 是固定驱动器';
DRIVE_REMOTE: DriveString :=C+' 是网络驱动器';
DRIVE_CDROM: DriveString := C+' 是CD-ROM驱动器';
DRIVE_RAMDISK: DriveString := C+' 是虚拟驱动器';
end;
if not ((DType = 0) or (DType = 1)) then //排除0和1两种情况
ListBox1.Items.AddObject(DriveString, Pointer(i)); //往Listbox中添加内容
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Timer1.Enabled:=True; //开始监视
end;
{procedure TForm1.Button4Click(Sender: TObject);
//var
// ico : Ticon;
// IconIndex : word; //抽取图标，注意加入shellAPI.pas
begin
if OpenDialog1.Execute Then
try
ico := Ticon.create;
ico.handle := ExtractAssociatedIcon(hInstance,
Pchar(OpenDialog1.FileName),
IconIndex);
self.icon := ico;
finally
ico.free;
end;
end;}
function GetHDSerialNumber(Drv : String): String;
var
VolumeSerialNumber : DWORD;
MaxLength : DWORD;
FSFlags : DWORD;
begin
if Drv[Length(Drv)] =':' then
Drv := Drv + '\';
GetVolumeInformation(pChar(Drv),nil,0,@VolumeSerialNumber,MaxLength,fSFlags,nil,0);
Result:=IntToHex(HiWord(VolumeSerialNumber),4)+''+IntToHex(LoWord(VolumeSerialNumber),4);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Caption:='盘符系列号：'+GetHDSerialNumber(DriveComboBox1.Drive+':');
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
end;
end.
