library cdejecter; {$mode delphi} {$codepage UTF8} uses Interfaces, Classes, LazUTF8Classes, sysutils, cde_types, windows, mmsystem, LazFileUtils, LazUTF8, cde_dir, SimplyJSON; {$R *.res} function DiskChar2Byte (const ADiskChar: WideChar): Byte; const ALetters: UTF8String = 'abcdefghijklmnopqrstuvwxyz'; begin Result:= UTF8Pos(ADiskChar, ALetters); end; function FiltreIt (const ADisc: WideChar): Boolean; var ConfigFile: String; SL: TStringListUTF8; i: Integer; begin Result:= False; ConfigFile:= GetCDEPath + 'configs\configs.json'; SL:= TStringListUTF8.Create; SL.Delimiter:= ';'; SL.Sorted:= True; case JSReadInteger('/filter/type', 0, ConfigFile) of 0: ; 1: begin SL.DelimitedText:= JSReadString('/filter/whitelist', '', ConfigFile); SL.Sort; Result:= not (SL.Find(ADisc, i)); end; 2: begin SL.DelimitedText:= JSReadString('/filter/blacklist', '', ConfigFile); SL.Sort; Result:= SL.Find(ADisc, i); end; end; FreeAndNil(SL); end; 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 if not FiltreIt(WideChar(AnsiLowerCase(String(Buf[i*4]))[1])) 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; diDiscSize:= DiskSize(DiskChar2Byte(ADisc)); diDiscFree:= DiskFree(DiskChar2Byte(ADisc)); 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) 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); finally mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm)); end; end; Result:= (GetDiscState(ADisc) = dsNIL); 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); Result:= True; finally mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm)); end; end; end; exports GetCDDiscs, GetDiscState, GetVolumeInfo, EjectCD, CloseCD; begin end.