Alexander c585c2f0cb Initial
Исходный код версии 2.0
2022-05-04 07:31:33 +03:00

142 lines
3.4 KiB
Plaintext

library cdejecter;
{$mode delphi}
{$codepage UTF8}
uses Interfaces, Classes, LazUTF8Classes, sysutils, cde_types, windows, mmsystem, LazFileUtils;
{$R *.res}
function GetCDDiscs: PWideChar;
var i, j : Integer;
Buf : array [0..95] of Char;
SL: TStringListUTF8;
begin
GetLogicalDriveStrings(96, Buf);
for j:=0 to 25 do
if Buf[j*4+2] <> #92 then
Break;
SL:= TStringListUTF8.Create;
for i:=0 to j-1 do
begin
if GetDriveType(@Buf[i*4])= DRIVE_CDROM then
SL.Add(AnsiLowerCase(String(Buf[i*4])) + ':\');
end;
SL.Delimiter:= ';';
Result:= PWideChar(SL.DelimitedText);
SL.Clear;
SL.Free;
end;
function GetDiscState (const ADisc: WideChar): TDiscState;
var sRec: TSearchRec;
res: Integer;
begin
Result:= dsNIL;
SetErrorMode(SEM_FAILCRITICALERRORS);
{$I-}
res:= FindFirstUTF8(ADisc + ':\*.*', faAnyfile, SRec);
FindCloseUTF8(SRec);
{$I+}
case res of
0: Result:= dsNormal;
2,18: Result:= dsEmpty;
21,3: Result:= dsNIL;
else
Result:= dsUnFormatted;
end;
end;
function GetVolumeInfo (const ADisc: WideChar): TDiscInfo;
var root: PChar;
res: LongBool;
VolumeNameBuffer, FileSystemNameBuffer: PChar;
VolumeNameSize,FileSystemNameSize: DWORD;
VolumeSerialNumber, MaximumComponentLength, FileSystemFlags: DWORD;
s: String;
begin
s:= ADisc + ':\';
root:= PChar(s);
GetMem(VolumeNameBuffer, 256);
Getmem(FileSystemNameBuffer, 256);
VolumeNameSize:= 255;
FileSystemNameSize:= 255;
res:= GetVolumeInformation(Root, VolumeNameBuffer, VolumeNameSize, @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, FileSystemNameBuffer, FileSystemNameSize);
with Result do
begin
diHasInfo:= res;
diDrive:= ADisc;
diVolumeName:= VolumeNameBuffer;
diFileSystem:= FileSystemNameBuffer;
diSerial:= VolumeSerialNumber;
end;
Freemem(VolumeNameBuffer, 256);
Freemem(FileSystemNameBuffer, 256);
end;
function EjectCD (const ADisc: WideChar): Boolean;
var Res: MciError;
OpenParm: TMCI_Open_Parms;
Flags: DWord;
S: String;
DeviceID: Word;
begin
Result:= False;
if ADisc = '' then
Abort;
S:= ADisc + ':';
if (GetDriveType(PChar(S)) = DRIVE_CDROM) and (GetDiscState(ADisc) <> dsNIL) then
begin
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;
end;
function CloseCD (const ADisc: WideChar): Boolean;
var Res: MciError;
OpenParm: TMCI_Open_Parms;
Flags: DWord;
S: String;
DeviceID: Word;
begin
Result:= False;
if ADisc = '' then
Abort;
S:= ADisc + ':';
if (GetDriveType(PChar(S)) = DRIVE_CDROM) and (GetDiscState(ADisc) <> dsNIL) then
begin
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;
end;
exports GetCDDiscs, GetDiscState, GetVolumeInfo, EjectCD;
begin
end.