АГ
Александр Гордеев

Можно ли написать скрипт для того...

что бы по нажатию на ярлык сначала дисковод вышел, а по второму клику дисковод убирался?

Кабанов Сергей
Кабанов Сергей

можно, но зачем? когда вставляешь диск в дисковод твоя рука же всё равно будет около кнопки открывания дисковода...

Олег
Олег

// Данная прога извлекает и закрывает CD-ROM, выбранные в Combobox1
// На форме разместите Button1, Button2 и Combobox1

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, MMSystem;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
function CloseCD(Drive : string) : Boolean;
function OpenCD(Drive : string) : Boolean;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;

var
Form1: TForm1;
Driv: array [1..25] of string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenCD(ComboBox1.Text);
end;

function TForm1.OpenCD(Drive: string): Boolean;
var
Res : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : string;
DeviceID : Word;
begin
Result:=false;
S:=Drive;
Flags:=mci_Open_Type or mci_Open_Element;
with OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
if Res<>0 then
exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
if Res=0 then
exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;

function TForm1.CloseCD(Drive: string): Boolean;
var
Res : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : string;
DeviceID : Word;
begin
Result:=false;
S:=Drive;
Flags:=mci_Open_Type or mci_Open_Element;
with OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
if Res<>0 then
exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
if Res=0 then
exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
w:dword;
Root:string;
I, K:integer;
begin
k:=0;
w:=GetLogicalDrives;
Root := '#:';
for i := 0 to 25 do
begin
Root[1] := Char(Ord('A')+i);
if (W and (1 shl i))>0 then
if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
begin
k:=k+1;
Driv[k] := Root;
ComboBox1.Items.Add(Driv[k]);
ComboBox1.Text := Driv[1];
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CloseCD(ComboBox1.Text);
end;

end.

АК
Анна Колосова

зачем изобретать велосипед?
есть программка, которая позволяет сделать нужное вам.. .
так же можно привязать данное действие на hotkey
http://www.cd-eject-tool.com/

Похожие вопросы
И так простите за беспокойство как написать скрипт?
сможете написать скрипт??
Помогите написать мини скрипт
Сложно ли написать скрипт или он есть в паблике?
кто может написать скрипт бесплатно
Как написать скрипт? Подскажите ...
Помогите написать скрипт!
[HTML] Как написать скрипт?
помогите написать скрипт +
Написать скрипт (VBS)