Лентяй 2
Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004
Репутация: 31
Всего: 155
|
Можно и больше, и проше. Но я так собрал, можно так сказать: все примеры в одном. (Посмотри еще работу с WMI) Короче изучай. Ах да, забыл: File-New-Application. Бросаеш на форму Memo и Button. Модуль заменяеш на представленный ниже. Цепляеш к обработчике Button.OnClik процедуру Button1Click | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActiveX, ComObj;
type
TCD_DVD=(CD,DVD,Virtual_CD_DVD,NoDetect);
TCD_Record=(Disk_Rom,Disk_R,Disk_RW,Disk_NoDetect);
TTypeCD=record
CD_DVD:TCD_DVD;
CD_Record:TCD_Record;
end;
TDosDevice=record
Path:string;
Vendor:String;
Product:String;
Revision:String;
TypeCD:TTypeCD;
end;
TCDDosDevice=record
Count:integer;
CDItems:array of TDosDevice;
end;
const
CLSID_MSDiscMasterObj: TGUID = '{520CCA63-51A5-11D3-9144-00104BA11C5E}';
type
IDiscRecorder = interface(IUnknown)
['{85AC9776-CA88-4cf2-894E-09598C078A41}']
function Init(pbyUniqueID: pbyte; nulIDSize, nulDriveNumber: ULONG): HResult; stdcall;
function GetRecorderGUID(var pbyUniqueID: byte; ulBufferSize: ULONG; out pulReturnSizeRequired: ULONG): HResult; stdcall;
function GetRecorderType(out fTypeCode: Integer): HResult; stdcall;
function GetDisplayNames(var pbstrVendorID: TBSTR; var pbstrProductID: TBSTR; var pbstrRevision: TBSTR): HResult; stdcall;
function GetBasePnPID(out pbstrBasePnPID: WideString): HResult; stdcall;
function GetPath(out pbstrPath: TBSTR): HResult; stdcall;
function GetRecorderProperties(out ppPropStg: IPropertyStorage): HResult; stdcall;
function SetRecorderProperties(pPropStg: IPropertyStorage): HResult; stdcall;
function GetRecorderState(out pulDevStateFlags: ULONG): HResult; stdcall;
function OpenExclusive: HResult; stdcall;
function QueryMediaType(out fMediaType: Integer; out fMediaFlags: Integer): HResult; stdcall;
function QueryMediaInfo(out pbSessions: byte; out pbLastTrack: byte; out ulStartAddress: ULONG; out ulNextWritable: ULONG; out ulFreeBlocks: ULONG): HResult; stdcall;
function Eject: HResult; stdcall;
function Erase(bFullErase: boolean): HResult; stdcall;
function Close: HResult; stdcall;
end;
IEnumDiscRecorders = interface(IUnknown)
['{9B1921E1-54AC-11d3-9144-00104BA11C5E}']
function Next(cRecorders: ULONG; out ppRecorder; out pcFetched: ULONG): HResult; stdcall;
function Skip(cRecorders: ULONG): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppEnum: IEnumDiscRecorders): HResult; stdcall;
end;
IEnumDiscMasterFormats = interface(IUnknown)
['{DDF445E1-54BA-11d3-9144-00104BA11C5E}']
function Next(cFormats: ULONG; out lpiidFormatID; out pcFetched: ULONG): HResult; stdcall;
function Skip(cFormats: ULONG): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppEnum: IEnumDiscMasterFormats): HResult; stdcall;
end;
IDiscMasterProgressEvents = interface(IUnknown)
['{EC9E51C1-4E5D-11D3-9144-00104BA11C5E}']
function QueryCancel(out pbCancel: boolean): HResult; stdcall;
function NotifyPnPActivity: HResult; stdcall;
function NotifyAddProgress(nCompletedSteps, nTotalSteps: Integer): HResult; stdcall;
function NotifyBlockProgress(nCompleted, nTotal: Integer): HResult; stdcall;
function NotifyTrackProgress(nCurrentTrack, nTotalTracks: Integer): HResult; stdcall;
function NotifyPreparingBurn(nEstimatedSeconds: Integer): HResult; stdcall;
function NotifyClosingDisc(nEstimatedSeconds: Integer): HResult; stdcall;
function NotifyBurnComplete(status: HResult): HResult; stdcall;
function NotifyEraseComplete(status: HResult): HResult; stdcall;
end;
IDiscMaster = interface(IUnknown)
['{520CCA62-51A5-11D3-9144-00104BA11C5E}']
function Open: HResult; stdcall;
function EnumDiscMasterFormats(out ppEnum: IEnumDiscMasterFormats): HResult; stdcall;
function GetActiveDiscMasterFormat(out lpiid: TGUID): HResult; stdcall;
function SetActiveDiscMasterFormat(var riid: TGUID; out ppUnk: IUnknown): HResult; stdcall;
function EnumDiscRecorders(out ppEnum: IEnumDiscRecorders ): HResult; stdcall;
function GetActiveDiscRecorder(out ppRecorder: IDiscRecorder):HResult; stdcall;
function SetActiveDiscRecorder(pRecorder: IDiscRecorder): HResult; stdcall;
function ClearFormatContent: HResult; stdcall;
function ProgressAdvise(pEvents: IDiscMasterProgressEvents; out pvCookie: PUINT):HResult; stdcall;
function ProgressUnadvise(vCookie: PUINT): HResult; stdcall;
function RecordDisc(bSimulate, bEjectAfterBurn: boolean): HResult; stdcall;
function Close: HResult; stdcall;
end;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function GetDosDevice(CDDriveID:integer):string;
function GetCDDosDevice():TCDDosDevice;
function TypeCDToStr(TypeCD:TTypeCD):string;
procedure GetRecorderDrive(CDDevice:TCDDosDevice);
procedure GetInfoCD_DVD(CDDevice:TCDDosDevice);
end;
var
Form1: TForm1;
CDDosDevice:TCDDosDevice;
implementation
{$R *.dfm}
function TForm1.GetDosDevice(CDDriveID:integer):string;
var
Buffer : array[0..500] of char;
TmpPC : PChar;
CdCtr:integer;
begin
CdCtr := 0;
result := '';
GetLogicalDriveStrings(SizeOf(Buffer),Buffer);
TmpPC := Buffer;
while TmpPC[0] <> #0 do begin
if Windows.GetDriveType(TmpPC) = DRIVE_CDROM then
begin
if CdCtr = CdDriveId then
begin
result := TmpPC;
exit;
end;
CdCtr := CdCtr+1;
end;
TmpPC := StrEnd(TmpPC)+1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
memo1.Clear;
CDDosDevice:=GetCDDosDevice;
GetRecorderDrive(CDDosDevice);
GetInfoCD_DVD(CDDosDevice);
if CDDosDevice.Count>0 then
begin
i:=0;
repeat
memo1.Lines.Add('CDDriveID: '+IntToStr(i));
memo1.Lines.Add('CDPath: '+CDDOSDevice.CDItems[i].Path);
memo1.Lines.Add('TypeCD: '+TypeCDToStr(CDDOSDevice.CDItems[i].TypeCD));
memo1.Lines.Add('Vendor: '+CDDOSDevice.CDItems[i].Vendor);
memo1.Lines.Add('Product: '+CDDOSDevice.CDItems[i].Product);
memo1.Lines.Add('Revision: '+CDDOSDevice.CDItems[i].Revision);
memo1.Lines.Add('');
inc(i);
until (i=CDDosDevice.Count);
end;
end;
procedure TForm1.GetInfoCD_DVD(CDDevice:TCDDosDevice);
Const
IOCTL_STORAGE_GET_MEDIA_TYPES_EX:DWord=$2D0C04;
FILE_DEVICE_8042_PORT:DWord=$00000027;
FILE_DEVICE_ACPI:DWord=$00000032;
FILE_DEVICE_BATTERY:DWord=$00000029;
FILE_DEVICE_BEEP:DWord=$00000001;
FILE_DEVICE_BUS_EXTENDER:DWord=$0000002a;
FILE_DEVICE_CD_ROM:DWord=$00000002;
FILE_DEVICE_CD_ROM_FILE_SYSTEM:DWord=$00000003;
FILE_DEVICE_CHANGER:DWord=$00000030;
FILE_DEVICE_CONTROLLER:DWord=$00000004;
FILE_DEVICE_DATALINK:DWord=$00000005;
FILE_DEVICE_DFS:DWord=$00000006;
FILE_DEVICE_DFS_FILE_SYSTEM:DWord=$00000035;
FILE_DEVICE_DFS_VOLUME:DWord=$00000036;
FILE_DEVICE_DISK:DWord=$00000007;
FILE_DEVICE_DISK_FILE_SYSTEM:DWord=$00000008;
FILE_DEVICE_DVD:DWord=$00000033;
FILE_DEVICE_FILE_SYSTEM:DWord=$00000009;
FILE_DEVICE_FIPS:DWord=$0000003a;
FILE_DEVICE_FULLSCREEN_VIDEO:DWord=$00000034;
FILE_DEVICE_INPORT_PORT:DWord=$0000000a;
FILE_DEVICE_KEYBOARD:DWord=$0000000b;
FILE_DEVICE_KS:DWord=$0000002f;
FILE_DEVICE_KSEC:DWord=$00000039;
FILE_DEVICE_MAILSLOT:DWord=$0000000c;
FILE_DEVICE_MASS_STORAGE:DWord=$0000002d;
FILE_DEVICE_MIDI_IN:DWord=$0000000d;
FILE_DEVICE_MIDI_OUT:DWord=$0000000e;
FILE_DEVICE_MODEM:DWord=$0000002b;
FILE_DEVICE_MOUSE:DWord=$0000000f;
FILE_DEVICE_MULTI_UNC_PROVIDER:DWord=$00000010;
FILE_DEVICE_NAMED_PIPE:DWord=$00000011;
FILE_DEVICE_NETWORK:DWord=$00000012;
FILE_DEVICE_NETWORK_BROWSER:DWord=$00000013;
FILE_DEVICE_NETWORK_FILE_SYSTEM:DWord=$00000014;
FILE_DEVICE_NETWORK_REDIRECTOR:DWord=$00000028;
FILE_DEVICE_NULL:DWord=$00000015;
FILE_DEVICE_PARALLEL_PORT:DWord=$00000016;
FILE_DEVICE_PHYSICAL_NETCARD:DWord=$00000017;
FILE_DEVICE_PRINTER:DWord=$00000018;
FILE_DEVICE_SCANNER:DWord=$00000019;
FILE_DEVICE_SCREEN:DWord=$0000001c;
FILE_DEVICE_SERENUM:DWord=$00000037;
FILE_DEVICE_SERIAL_MOUSE_PORT:DWord=$0000001a;
FILE_DEVICE_SERIAL_PORT:DWord=$0000001b;
FILE_DEVICE_SMARTCARD:DWord=$00000031;
FILE_DEVICE_SMB:DWord=$0000002e;
FILE_DEVICE_SOUND:DWord=$0000001d;
FILE_DEVICE_STREAMS:DWord=$0000001e;
FILE_DEVICE_TAPE:DWord=$0000001f;
FILE_DEVICE_TAPE_FILE_SYSTEM:DWord=$00000020;
FILE_DEVICE_TERMSRV:DWord=$00000038;
FILE_DEVICE_TRANSPORT:DWord=$00000021;
FILE_DEVICE_UNKNOWN:DWord=$00000022;
FILE_DEVICE_VDM:DWord=$0000002c;
FILE_DEVICE_VIDEO:DWord=$00000023;
FILE_DEVICE_VIRTUAL_DISK:DWord=$00000024;
FILE_DEVICE_WAVE_IN:DWord=$00000025;
FILE_DEVICE_WAVE_OUT:DWord=$00000026;
Type
STORAGE_MEDIA_TYPE=(DDS_4mm=$20,MiniQic,Travan,QIC,MP_8mm,AME_8mm,AIT1_8mm,
DLT,NCTP,IBM_3480,IBM_3490E,IBM_Magstar_3590,IBM_Magstar_MP,
STK_DATA_D3,SONY_DTF,DV_6mm,DMI,SONY_D2,CLEANER_CARTRIDGE,
CD_ROM,CD_R,CD_RW,DVD_ROM,DVD_R,DVD_RW,MO_3_RW,MO_5_WO,
MO_5_RW,MO_5_LIMDOW,PC_5_WO,PC_5_RW,PD_5_RW,ABL_5_WO,
PINNACLE_APEX_5_RW,SONY_12_WO,PHILIPS_12_WO,HITACHI_12_WO,
CYGNET_12_WO,KODAK_14_WO,MO_NFR_525,NIKON_12_RW,IOMEGA_ZIP,
IOMEGA_JAZ,SYQUEST_EZ135,SYQUEST_EZFLYER,SYQUEST_SYJET,
AVATAR_F2,MP2_8mm,DST_S,DST_M,DST_L,VXATape_1,VXATape_2,
STK_9840,LTO_Ultrium,LTO_Accelis,DVD_RAM,AIT_8mm,ADR_1,ADR_2,STK_9940);
DEVICE_MEDIA_INFO=record
Cylinders:LARGE_INTEGER;
MediaType:STORAGE_MEDIA_TYPE;
TracksPerCylinder:DWORD;
SectorsPerTrack:DWORD;
BytesPerSector:DWORD;
NumberMediaSides:DWORD;
MediaCharacteristics:DWORD;
end;
TMediaTypes=record
DeviceType:DWORD;
MediaInfoCount:DWORD;
MediaInfo:DEVICE_MEDIA_INFO;
end;
var H:THandle;
i,j:integer;
MediaTypes:TMediaTypes;
File_Name:String;
RetSize:DWord;
OsVerInfo:OSVERSIONINFO;
begin
if CDDevice.Count=0 then exit;
OsVerInfo.dwOSVersionInfoSize:=SizeOf(OsVerInfo);
if (GetVersionEx(OsVerInfo)=false)or(OsVerInfo.dwPlatformId<2) then exit;
i:=0;
repeat
j:=pos(':',CDDevice.CDItems[i].Path);
if j>0 then File_Name:='\\.\'+copy(CDDevice.CDItems[i].Path,1,j) else
File_Name:='\\.\'+CDDevice.CDItems[i].Path+':';
H:=CreateFile(PChar(File_Name),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if H<>INVALID_HANDLE_VALUE then
try
if DeviceIOControl(H,IOCTL_STORAGE_GET_MEDIA_TYPES_EX,nil,0,@MediaTypes,
SizeOf(MediaTypes),RetSize,nil) then
begin
if mediaTypes.DeviceType=FILE_DEVICE_CD_ROM then
CDDevice.CDItems[i].TypeCD.CD_DVD:=CD else
if mediaTypes.DeviceType=FILE_DEVICE_DVD then
CDDevice.CDItems[i].TypeCD.CD_DVD:=DVD else
case MediaTypes.MediaInfo.MediaType of
CD_ROM: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=CD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_Rom;
end;
CD_R: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=CD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_R;
end;
CD_RW: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=CD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_RW;
end;
DVD_ROM: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=DVD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_Rom;
end;
DVD_R: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=DVD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_R;
end;
DVD_RW: begin
CDDevice.CDItems[i].TypeCD.CD_DVD:=DVD;
CDDevice.CDItems[i].TypeCD.CD_Record:=Disk_RW;
end;
else
CDDevice.CDItems[i].TypeCD.CD_DVD:=NoDetect;
end;
if (mediaTypes.DeviceType=FILE_DEVICE_CD_ROM)and
(MediaTypes.MediaInfo.MediaType in [DVD_ROM,DVD_R,DVD_RW])or
(mediaTypes.DeviceType=FILE_DEVICE_DVD)and
(MediaTypes.MediaInfo.MediaType in [CD_ROM,CD_R,CD_RW])then
CDDevice.CDItems[i].TypeCD.CD_DVD:=Virtual_CD_DVD;
end// else CDDevice.CDItems[i].TypeCD.CD_DVD:=NoDetect;
finally
CloseHandle(H);
end;
inc(i);
until (i=CDDevice.Count);
end;
procedure TForm1.GetRecorderDrive(CDDevice:TCDDosDevice);
var pUnknown:IUnknown;
fDiscMaster:IDiscMaster;
ppRecorder:IDiscRecorder;
pcFetched:ULONG;
pEnumDiscRecorders:IEnumDiscRecorders;
pbStrPath,Vendor,ProductID,Revision:TBSTR;
DriveID:Integer;
typeCode: Integer;
i:integer;
sID:string;
begin
try
pUnknown:=CreateCOMObject(CLSID_MSDiscMasterObj);
fDiscMaster:=pUnknown as IDiscMaster;
except
exit;
end;
if Succeeded(fDiscMaster.Open) then
begin
if Succeeded(fDiscMaster.EnumDiscRecorders(pEnumDiscRecorders)) then
while((SUCCEEDED(pEnumDiscRecorders.Next(1, ppRecorder, pcFetched)))
and(pcFetched = 1))do
begin
pbstrPath:=nil;
Vendor:=nil;
ProductID:=nil;
Revision:=nil;
DriveID:=-1;
if Succeeded(ppRecorder.GetPath(pbstrPath)) then
begin
sID:=trim(OleStrToString(pbstrPath));
i:=Length(sID);
while (i>0)and(sID[i] in ['0'..'9']) do dec(i);
inc(i);
sID:=copy(sID,i,Length(sID));
try
DriveID:=StrToInt(sID);
except
end;
SysFreeString(pbstrPath);
end;
if (DriveID<0)or(DriveID>=CDDevice.Count) then
begin
DriveID:=CDDevice.Count;
inc(CDDevice.Count);
SetLength(CDDevice.CDItems,DriveID);
CDDevice.CDItems[DriveID].Path:='?';
CDDevice.CDItems[DriveID].TypeCD.CD_DVD:=NoDetect;
CDDevice.CDItems[DriveID].TypeCD.CD_Record:=Disk_NoDetect;
CDDevice.CDItems[DriveID].Vendor:='?';
CDDevice.CDItems[DriveID].Product:='?';
CDDevice.CDItems[DriveID].Revision:='?';
end;
if Succeeded(ppRecorder.GetRecorderType(typeCode)) then
case typeCode of
$1: CDDevice.CDItems[DriveID].TypeCD.CD_Record:=Disk_R;
$2: CDDevice.CDItems[DriveID].TypeCD.CD_Record:=Disk_RW;
else
CDDevice.CDItems[DriveID].TypeCD.CD_Record:=Disk_NoDetect;
end;
if Succeeded(ppRecorder.GetDisplayNames(Vendor,ProductID,Revision)) then
begin
CDDevice.CDItems[DriveID].Vendor:=OleStrToString(Vendor);
CDDevice.CDItems[DriveID].Product:=OleStrToString(ProductID);
CDDevice.CDItems[DriveID].Revision:=OleStrToString(Revision);
SysFreeString(Vendor);
SysFreeString(ProductID);
SysFreeString(Revision);
end;
end;
fDiscMaster.Close;
end;
end;
function TForm1.TypeCDToStr(TypeCD:TTypeCD):string;
var s:string;
begin
case TypeCD.CD_DVD of
CD: Result:='CD';
DVD: Result:='DVD';
Virtual_CD_DVD: Result:='Virtual CD/DVD';
else
Result:='NoDetect'
end;
case TypeCD.CD_Record of
Disk_Rom: s:='-Rom';
Disk_R: s:='-R';
Disk_RW: s:='-RW';
else
s:='-?';
end;
Result:=Result+s;
end;
function TForm1.GetCDDosDevice():TCDDosDevice;
var Buffer:array[0..500] of char;
TmpPC:PChar;
ID_CD:integer;
begin
ID_CD:=0;
SetLength(Result.CDItems,0);
GetLogicalDriveStrings(SizeOf(Buffer),Buffer);
TmpPC:=Buffer;
while TmpPC[0]<>#0 do
begin
if Windows.GetDriveType(TmpPC)=DRIVE_CDROM then
begin
SetLength(Result.CDItems,ID_CD+1);
Result.CDItems[ID_CD].Path:=TmpPC;
Result.CDItems[ID_CD].Vendor:='?';
Result.CDItems[ID_CD].Product:='?';
Result.CDItems[ID_CD].Revision:='?';
Result.CDItems[ID_CD].TypeCD.CD_DVD:=CD;
Result.CDItems[ID_CD].TypeCD.CD_Record:=Disk_Rom;
inc(ID_CD);
end;
TmpPC:=StrEnd(TmpPC)+1;
end;
Result.Count:=ID_CD;
end;
end.
|
Может быть какие ошибки есть, но ты уж сам отлаживай. Удачи. --------------------
Как слышим, так и пишим.
Истина где-то там... |
Тип CD привода (CD-R/RW,DVD-ROM/R/RW) 
Загрузка ...
