Medium im CD-/DVD-LW erkennen [Update]

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Medium im CD-/DVD-LW erkennen [Update]

Beitrag von scholly »

moin,moin...

Der Code mag weder effizient noch elegant oder beispielhaft sein, aber er ist cool, weil es die einzige Möglichkeit ist, mit der ich es schaffe, von PB aus die richtigen Infos auszulesen ;)

Ist zwar bitter, daß ich CDRecord und die CygWin.dll brauche, aber vielleicht kommt ja irgendwann jemand mit einer besseren Lösung.

Getestete Laufwerke: LG 4163b und Samsung SH-S182D.
Getestete Medien: leere+gebrannte CD-R, c't-CD-ROM,CD-RW, DVD-RAM, c't-DVD-ROM,leere+gebrannte DVD-R, gebrannte DVD+R, DVD+RW.

Über zusätzliche Testergebnisse oder Verbesserungen würde ich mich selbstverfreilich freuen :)

Have fun:

Code: Alles auswählen

; Typ das Mediums in einem CD-/DVD-LW herausfinden
; autor: scholly
; notwenig: 1. wmi-include von TS-Soft: http://www.purebasic.fr/german/viewtopic.php?t=2925&start=14
;           2. cdrecord + cygwin1.dll : http://www.paehl.com/open_source/?CDRTOOLS_with_DVD_Support

IncludeFile "wmi.pbi"

EnableExplicit

Define.s lw2check.s = "z:\"     ; In der richtigen Anwendung wird das LW irgendwo festgelegt
lw2check = Left(lw2check,2)
Define.s gefunden.s = ""
Define.s lwcaption.s
Define.s tempstr.s
Define.s devstr.s
Define.s mtype.s

Define.l cdrout

lw2check = Left(lw2check,2)

WMI_INIT()
WMI_Call("Select * FROM Win32_CDROMDrive", "drive, Caption")

ResetList(wmidata())
While NextElement(wmidata())
  gefunden = wmidata()
  Debug gefunden
  If (gefunden = UCase(lw2check))
    NextElement(wmidata())
    lwcaption = wmidata()
    Break
  EndIf
Wend
WMI_RELEASE("OK")
If lwcaption = "" ; dann gibts kein CD-/DVD-LW mit diesem Laufwerksbuchstaben
  Debug "NoOptical"
  End
EndIf

lwcaption = Left(lwcaption,8)
Debug "lwcaption: "+lwcaption

If OpenFile (1,"scanbus_kannweg.bat")
  WriteString(1,"cdrecord -scanbus >scanbus.kannweg.txt 2>&1")
  CloseFile(1)
  cdrout = RunProgram("scanbus_kannweg.bat", "", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Hide)
  Delay(4000) ; müßte auf das langsamste LW abgestimmt werden
  If ReadFile(2, "scanbus.kannweg.txt")   
    While Eof(2) = 0   
      tempstr = ReadString(2)               
      If ( FindString(tempstr, lwcaption,1))
        devstr = Left(LTrim(ReplaceString(tempstr,Chr(9),"  ")),5)             
      EndIf
    Wend
    CloseFile(2) 
    DeleteFile("scanbus.kannweg.txt")   
  Else
    MessageRequester("uups","kann scanbus.kannweg.txt nicht öffnen")
  EndIf
  DeleteFile("scanbus_kannweg.bat")
Else
  MessageRequester("uuups","keine scanbus_kannweg.bat geöffnet")
EndIf

Debug devstr

If OpenFile(3,"getMtype_kannweg.bat")
  WriteString(3,"cdrecord dev="+devstr+" -minfo >getMtype_kannweg.txt 2>&1")
  CloseFile(3)
  cdrout = RunProgram("getMtype_kannweg.bat", "", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Hide)
  Delay(4050) ; Auf dem LG dauert eine CD-R so lange :((((
  If ReadFile(4,"getMtype_kannweg.txt")
    While Eof(4) = 0   
      tempstr = ReadString(4)               
      If (Left(tempstr,19) = "Mounted media type:")
         Debug LTrim(RemoveString(tempstr,"Mounted media type:"))
         mtype = StringField(LTrim(RemoveString(tempstr,"Mounted media type:")),1," ")
         Debug mtype
         Debug Len(mtype)
      EndIf       
    Wend  
  CloseFile(4)
  DeleteFile("getMtype_kannweg.txt")
  Else
    MessageRequester("uups","kann getMtype_kannweg.txt nicht öffnen")
  EndIf    
  DeleteFile("getMtype_kannweg.bat")
Else
  MessageRequester("uuups","keine getMtype_kannweg.bat geöffnet")
EndIf

Debug mtype
End
un jezz guck ich Final Fantasy :) :) :)
scholly
Zuletzt geändert von scholly am 16.01.2008 19:30, insgesamt 2-mal geändert.
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

Lesen bildet :D

Das nervige Delay() und dank Win32_CDROMDrive und ScriptomaticV2 einen CDRecord-Aufruf ersetzt:

Code: Alles auswählen

; Typ des Mediums in einem CD-/DVD-LW herausfinden
; autor: scholly
; notwenig: 1. wmi-include von TS-Soft: http://www.purebasic.fr/german/viewtopic.php?t=2925&start=14
;           2. cdrecord + cygwin1.dll : http://www.paehl.com/open_source/?CDRTOOLS_with_DVD_Support

XIncludeFile "wmi.pbi"

EnableExplicit

; In der richtigen Anwendung wird vorher irgendwo das LW festgelegt, überprüft, 
; ob es ein CD-/DVD-LW ist und ob ein Medium eingelegt ist !!!!
;
; Es empfiehlt sich außerdem vorher die Existenz-/Funktionsprüfung für CDRecord

Define.s lw2check.s = "y:"   
Define.s MediumTyp.s  

Procedure.s ugs_GetDeviceStr(thisdrive.s) 
  Define devstr.s = ""
  WMI_INIT()
  WMI_Call("Select * FROM Win32_CDROMDrive", "drive, SCSIPort,SCSITargetId,SCSILogicalUnit")

  ResetList(wmidata())
  While NextElement(wmidata())
    If (UCase(wmidata()) = UCase(thisdrive))
      Debug UCase(wmidata())
      NextElement(wmidata()) ;das ist Port
      devstr + wmidata() +","
      NextElement(wmidata()) ;das ist Target
      devstr + wmidata() +","
      NextElement(wmidata()) ;das ist LUN
      devstr + wmidata()
      Break
    EndIf
  Wend
  WMI_RELEASE("OK")
  If devstr = ""                   ; dann gibts kein CD-/DVD-LW mit diesem Laufwerksbuchstaben
    ProcedureReturn "NoOptical"
  Else
    ProcedureReturn devstr    
  EndIf
EndProcedure

Procedure.s ugs_GetMediaType(thisdrive.s)

Define.s tempstr.s
Define.s devicestr.s
Define.s mtype.s = "kein Mounted media type gefunden"
Define.l cdrout

devicestr = ugs_GetDeviceStr(thisdrive) 

Debug "devicestr: "+devicestr

If devicestr = "NoOptical"
  ProcedureReturn "NoOptical"
Else
  If OpenFile(3,"getMtype_kannweg.bat")
    WriteString(3,"cdrecord dev="+devicestr+" -minfo >getMtype_kannweg.txt 2>&1")
    CloseFile(3)
    cdrout = RunProgram("getMtype_kannweg.bat", "", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Hide)
      WaitProgram(cdrout)
    CloseProgram(cdrout)
    If ReadFile(4,"getMtype_kannweg.txt")
      While Eof(4) = 0   
        tempstr = ReadString(4)               
        If (Left(tempstr,19) = "Mounted media type:")
          mtype = StringField(LTrim(RemoveString(tempstr,"Mounted media type:")),1," ")
        ElseIf (FindString(tempstr, "entweder falsch geschrieben", 1))
          mtype = "CDRecord entweder falsch geschrieben oder nicht gefunden" 
        EndIf       
      Wend  
    CloseFile(4)
    DeleteFile("getMtype_kannweg.txt")
    Else
      mtype = "kann getMtype_kannweg.txt nicht öffnen"
    EndIf    
    DeleteFile("getMtype_kannweg.bat")
  Else
    mtype = "keine getMtype_kannweg.bat geöffnet"
  EndIf
  ProcedureReturn mtype
EndIf
EndProcedure

MediumTyp = ugs_GetMediaType(lw2check)

MessageRequester("Ergebnis von ugs_GetMediaType()","MediumTyp: "+MediumTyp)

End
[edit1]
möglichen Fehlerquellen bei den temporären Files Beachtung geschenkt
[/edit1]
[edit2]
Sparkie hat im englischen Forum etwas per API hinbekommen, was mir als Ausgangspunkt reicht.
[/edit2]

Auf eine Erleuchtung in Sachen Win32_PhysicalMedia wartend... scholly
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Benutzeravatar
DataMiner
Beiträge: 220
Registriert: 10.10.2004 18:56

Beitrag von DataMiner »

Da ich mir das mir cygwin unter Vista nicht unbedingt antun will - welche Werte willst du eigentlich herausbekommen?
__________________________________________
Weniger glauben - mehr wissen!
------------------------------------------------------
Proud beneficial owner of SpiderBasic, PureBasic 3.x, 4.x, 5.x and PureVisionXP
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

moin, moin, DataMiner...

Ziel:
wissen, was für eine Scheibe im LW liegt: CD-ROM, CD-R, CD-RW, DVD-ROM, DVD-RAM oder DVD+-R/W (DL).

Hab mich in mehreren Foren auf die Suche nach geeigneten Quellen begeben, u.a. hier.
Is nirgendwo aus diversen Gründen was 100%iges herausgekommen, einzig sicher ist IMHO eigentlich nur CDRecord, guckst Du hier.

Ich hab u.a. auch mit Deinem WMI-Code erfolglos versucht über Win32_PhysicalMedia was zu erreichen, aber das liegt IMHO nicht am Code, denn mit dem Include von ts-soft und per VBS mit Scriptomatic kommt auch nix raus.

baw... scholly
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

moin, moin...

Basieren auf den Bemühungen von SFSxOI im Englischen Forum, IMAPI2 von PB aus zu nutzen, hab ich mal wieder was zusammengestrickt und hoffe, daß es Euren Tests standhält:

Code: Alles auswählen

;based on code from SFSxOI: http://www.purebasic.fr/english/viewtopic.php?t=30535

ProcedureDLL.s ShowAPIError(CheckReturnValue) ; Forum code, unsure of original author
  Buffer.s      = Space (4096)
  NumberOfChars = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, CheckReturnValue, 0, Buffer.s, Len(Buffer.s), 0)
  ProcedureReturn Left (Buffer.s, NumberOfChars-2)
EndProcedure

Procedure.S GetVariantString(*Variant.VARIANT)
  Protected String.S = ""

  If VariantChangeType_(*Variant, *Variant, 0, #VT_BSTR) = #S_OK
    String = PeekS(*Variant\bstrVal, -1, #PB_Unicode)
    VariantClear_(*Variant)
  Else
    Debug "VariantChangeType() failed!"
  EndIf

  ProcedureReturn String 
EndProcedure

ProcedureDLL.s ax_Uni2Ansi(unicodestr.l) ; Converts Unicode to normal (Ansi) string
  lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0);
  ansistr.s = Space(lenA)
  If (lenA > 0)
    WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0);
  EndIf
  ProcedureReturn ansistr
EndProcedure 

Procedure.l ugs_get_IMAPImediaType(driveletter.s)
DisableDebugger
Enumeration ;_#IMAPI_MEDIA_PHYSICAL_TYPE
  #IMAPI_MEDIA_TYPE_UNKNOWN = 0
  #IMAPI_MEDIA_TYPE_CDROM = $1
  #IMAPI_MEDIA_TYPE_CDR = $2
  #IMAPI_MEDIA_TYPE_CDRW = $3
  #IMAPI_MEDIA_TYPE_DVDROM = $4
  #IMAPI_MEDIA_TYPE_DVDRAM = $5
  #IMAPI_MEDIA_TYPE_DVDPLUSR = $6
  #IMAPI_MEDIA_TYPE_DVDPLUSRW = $7
  #IMAPI_MEDIA_TYPE_DVDPLUSR_DUALLAYER = $8
  #IMAPI_MEDIA_TYPE_DVDDASHR = $9
  #IMAPI_MEDIA_TYPE_DVDDASHRW = $a
  #IMAPI_MEDIA_TYPE_DVDDASHR_DUALLAYER = $b
  #IMAPI_MEDIA_TYPE_DISK = $c
  #IMAPI_MEDIA_TYPE_DVDPLUSRW_DUALLAYER = $0D
  #IMAPI_MEDIA_TYPE_HDDVDROM = $0E
  #IMAPI_MEDIA_TYPE_HDDVDR = $0F
  #IMAPI_MEDIA_TYPE_HDDVDRAM = $10
  #IMAPI_MEDIA_TYPE_BDROM = $11
  #IMAPI_MEDIA_TYPE_BDR = $12
  #IMAPI_MEDIA_TYPE_BDRE = $13
  #IMAPI_MEDIA_TYPE_MAX = $13
EndEnumeration

Interface IDiscMaster2 Extends IDispatch
  get__NewEnum(a)
  get_Item(index,value) 
  get_Count(a.l)
  get_IsSupportedEnvironment(value.l)
EndInterface

Interface IDiscRecorder2 Extends IDispatch
  EjectMedia()
  CloseTray()
  AcquireExclusiveAccess(a.l,b.s)
  ReleaseExclusiveAccess()
  DisableMcn()
  EnableMcn()
  InitializeDiscRecorder(a.l)
  get_ActiveDiscRecorder(value)
  get_VendorId(value)
  get_ProductId(value)
  get_ProductRevision(value)
  get_VolumeName(value)
  get_VolumePathNames(value) 
  get_DeviceCanLoadMedia(a.l)
  get_LegacyDeviceNumber(a.l)
  get_SupportedFeaturePages(a)
  get_CurrentFeaturePages(a)
  get_SupportedProfiles(a)
  get_CurrentProfiles(a)
  get_SupportedModePages(a)
  get_ExclusiveAccessOwner(value)
EndInterface

Interface IDiscFormat2 Extends IDispatch
  IsRecorderSupported(recorder.l, value.l)
  IsCurrentMediaSupported(recorder.l, value.l)
  get_MediaPhysicallyBlank(value.l)
  get_MediaHeuristicallyBlank(value.l)
  get_SupportedMediaTypes(value.l)
EndInterface

Interface IDiscFormat2Erase Extends IDiscFormat2
  put_Recorder(value)
  get_Recorder(value)
  put_FullErase(value)
  get_FullErase(value)
  get_CurrentPhysicalMediaType(value)
  put_ClientName(value.p-bstr)
  get_ClientName(value)
  EraseMedia()
EndInterface

Structure SAFEARRAYBOUND
  cElements.L  ; # of elements in the array dimension
  lLbound.L    ; Lower bounds of the array dimension
EndStructure

Structure SAFEARRAY
  cDims.W
  fFeatures.W
  cbElements.L
  cLocks.L
  pvData.L
  rgsabound.SAFEARRAYBOUND[60]
EndStructure

pp.variant
pp\vt = #VT_BSTR

Variant.VARIANT
*VariantArray.SAFEARRAY
thisletter.s = ""
     
CoInitialize_(0)
CoCreateInstance_(?CLSID_MsftDiscMaster2,0,1,?IID_IDiscMaster2,@DiscMaster.IDiscMaster2)
DiscMaster\get_Count(@count)

For x = 0 To count -1

  Debug " "
  
  DiscMaster\get_Item(x,@pp\bstrval)
  
  CoCreateInstance_(?CLSID_MsftDiscRecorder2,0,1,?IID_IDiscRecorder2,@Recorder.IDiscRecorder2)
  Recorder\InitializeDiscRecorder(pp\bstrval)
   
  CoCreateInstance_(?CLSID_MsftDiscFormat2Erase,0,1,?IID_IDiscFormat2Erase,@Format.IDiscFormat2Erase)
  Format\put_Recorder(Recorder)  
  
  Recorder\InitializeDiscRecorder(pp\bstrval)  
  Debug "drive:   " +Str(x) +"   is ID:       " +ax_Uni2Ansi(pp\bstrval)   

  Recorder\get_ProductId(@pp\bstrval)
  Debug "ProductID:              "+ax_Uni2Ansi(pp\bstrval)

  Recorder\get_VolumePathNames(@value.SAFEARRAY)
  Variant\parray = PeekL(value)
  *VariantArray = Variant\parray
  For i = 1 To *VariantArray\rgsabound[0]\cElements
    *Variant = *VariantArray\pvData + (i - 1) * 16

    thisletter = GetVariantString(*Variant)
    Debug "Your Drive Path is:   " +thisletter
  
    med_type = Format\get_CurrentPhysicalMediaType(@mediaType)
    Debug mediatype
  
  Next i
  If thisletter = UCase(driveletter)
    Break
  EndIf

    
  Debug ""
   
Next x

DiscMaster\Release()
Recorder\Release()   
Format\Release()

CoUninitialize_()
       
DataSection
  CLSID_MsftDiscMaster2:
    Data.l $2735412E
    Data.w $7F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E

  CLSID_MsftDiscRecorder2:
    Data.l $2735412D
    Data.w $7F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E

  CLSID_MsftDiscFormat2Erase:
    Data.l $2735412B
    Data.w $7F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E

  IID_IDiscMaster2:
    Data.l $27354130
    Data.w $7F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E

  IID_IDiscRecorder2:
    Data.l $27354133
    Data.w $7F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E

  IID_IDiscFormat2Erase:
    Data.l $27354156
    Data.w $8F64,$5B0F
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E
EndDataSection
EnableDebugger
ProcedureReturn mediatype

EndProcedure;ugs_get_IMAPImediaType(driveletter.s)

cdvdLW.s = "z:\"
Debug "LW to check: "+cdvdLW

thismediatype = ugs_get_IMAPImediaType(cdvdLW)
Select thismediaType 
   
  Case #IMAPI_MEDIA_TYPE_UNKNOWN
  Debug "Media Type is Unknown or no media loaded"
     
  Case #IMAPI_MEDIA_TYPE_CDROM
  Debug "Media Type is a CD-ROM (or burned CD-R)"
     
  Case #IMAPI_MEDIA_TYPE_CDR
  Debug "Media Type is CD-R"
     
  Case #IMAPI_MEDIA_TYPE_CDRW
  Debug "Media Type is CD-R/W"
     
  Case #IMAPI_MEDIA_TYPE_DVDROM
  Debug "Media Type is a DVD-ROM (or a burned DVD-R)"
    
  Case #IMAPI_MEDIA_TYPE_DVDRAM
  Debug "Media Type is DVD-RAM"
     
  Case #IMAPI_MEDIA_TYPE_DVDPLUSR
  Debug "Media Type is DVD+R"
    
  Case #IMAPI_MEDIA_TYPE_DVDPLUSRW
  Debug "Media Type is DVD+RW"
     
  Case #IMAPI_MEDIA_TYPE_DVDPLUSR_DUALLAYER
  Debug "Media Type is DVD+R DL"
    
  Case #IMAPI_MEDIA_TYPE_DVDDASHR
  Debug "Media Type is DVD-R"
    
  Case #IMAPI_MEDIA_TYPE_DVDDASHRW
  Debug "Media Type is DVD-RW"
    
  Case #IMAPI_MEDIA_TYPE_DVDDASHR_DUALLAYER
  Debug "Media Type is DVD-R DL"
   
  Case #IMAPI_MEDIA_TYPE_DISK
  Debug "Media Type is Disk"
   
  Case #IMAPI_MEDIA_TYPE_DVDPLUSRW_DUALLAYER
  Debug "Media Type is DVD+RW DL"
    
  Case #IMAPI_MEDIA_TYPE_HDDVDROM
  Debug "Media Type is HD DVD-ROM"
    
  Case #IMAPI_MEDIA_TYPE_HDDVDR
  Debug "Media Type is HD DVD-R"
  
  Case #IMAPI_MEDIA_TYPE_HDDVDRAM
  Debug "Media Type is HD DVD-RAM"
    
  Case #IMAPI_MEDIA_TYPE_BDROM
  Debug "Media Type is BD-ROM"
    
  Case #IMAPI_MEDIA_TYPE_BDR
  Debug "Media Type is BD-R"
    
  Case #IMAPI_MEDIA_TYPE_BDRE
  Debug "Media Type is BD-RE"

EndSelect

End

Ich selber habe mit 2 LW (LG 4163b und Samsung SH-S182D) folgende Medientypen blank und gebrannt getestet:
CD-R, CD-RW, DVD-RAM, DVD-R, DVD+R, DVD+RW

Bis denne... scholly

Update 080117- 21:36 : Ab jetzt auch direkt per Driveletter ;)
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Benutzeravatar
PMV
Beiträge: 2765
Registriert: 29.08.2004 13:59
Wohnort: Baden-Württemberg

Beitrag von PMV »

Ich hab schollys Code etwas gesäubert und die Programmlogik etwas
verbessert :D ... danke an dieser Stelle noch mal dir für deine Vorlage.

Denkt drann, es wird für XP das KB932716 benötigt, welches so weit ich
weis bis her nicht automatisch installiert wird. Mein aber gelesen zu
haben, dass es für SP4 geplant sei. ^_^
Die entsprechende Fehlermeldung hab ich zwar in den Code kommentiert,
da ich mir aber nicht 100% sicher bin, ob der Fehler in jedem Fall nur
deswegen auftauchen kann, hab ich ihn nicht explizit eingebaut.

Läuft min. ab PB4.20 unter Ascii und Unicode.

Code: Alles auswählen

;based on code from SFSxOI: http://www.purebasic.fr/english/viewtopic.php?t=30535 
;original by scholly: http://www.purebasic.fr/german/viewtopic.php?t=14820
;last edit by PMV
; ------------------------------
;required: Windows XP SP2 or SP3 and KB932716 (need additional download) ... or Windows Vista
;KB932716: http://www.microsoft.com/downloads/details.aspx?FamilyID=b5f726f1-4ace-455d-bad7-abc4dd2f147b

;- #IMAPI_MEDIA_PHYSICAL_TYPE 
  #IMAPI_MEDIA_TYPE_UNKNOWN = 0 
  #IMAPI_MEDIA_TYPE_CDROM = $1 
  #IMAPI_MEDIA_TYPE_CDR = $2 
  #IMAPI_MEDIA_TYPE_CDRW = $3 
  #IMAPI_MEDIA_TYPE_DVDROM = $4 
  #IMAPI_MEDIA_TYPE_DVDRAM = $5 
  #IMAPI_MEDIA_TYPE_DVDPLUSR = $6 
  #IMAPI_MEDIA_TYPE_DVDPLUSRW = $7 
  #IMAPI_MEDIA_TYPE_DVDPLUSR_DUALLAYER = $8 
  #IMAPI_MEDIA_TYPE_DVDDASHR = $9 
  #IMAPI_MEDIA_TYPE_DVDDASHRW = $a 
  #IMAPI_MEDIA_TYPE_DVDDASHR_DUALLAYER = $b 
  #IMAPI_MEDIA_TYPE_DISK = $c 
  #IMAPI_MEDIA_TYPE_DVDPLUSRW_DUALLAYER = $0D 
  #IMAPI_MEDIA_TYPE_HDDVDROM = $0E 
  #IMAPI_MEDIA_TYPE_HDDVDR = $0F 
  #IMAPI_MEDIA_TYPE_HDDVDRAM = $10 
  #IMAPI_MEDIA_TYPE_BDROM = $11 
  #IMAPI_MEDIA_TYPE_BDR = $12 
  #IMAPI_MEDIA_TYPE_BDRE = $13 
  #IMAPI_MEDIA_TYPE_MAX = $13 
; ------------------------


Interface IDiscMaster2 Extends IDispatch 
  get__NewEnum(a) 
  get_Item(index,value) 
  get_Count(a.l) 
  get_IsSupportedEnvironment(value.l) 
EndInterface 

Interface IDiscRecorder2 Extends IDispatch 
  EjectMedia() 
  CloseTray() 
  AcquireExclusiveAccess(a.l,b.s) 
  ReleaseExclusiveAccess() 
  DisableMcn() 
  EnableMcn() 
  InitializeDiscRecorder(a.l) 
  get_ActiveDiscRecorder(value) 
  get_VendorId(value) 
  get_ProductId(value) 
  get_ProductRevision(value) 
  get_VolumeName(value) 
  get_VolumePathNames(value) 
  get_DeviceCanLoadMedia(a.l) 
  get_LegacyDeviceNumber(a.l) 
  get_SupportedFeaturePages(a) 
  get_CurrentFeaturePages(a) 
  get_SupportedProfiles(a) 
  get_CurrentProfiles(a) 
  get_SupportedModePages(a) 
  get_ExclusiveAccessOwner(value) 
EndInterface 

Interface IDiscFormat2 Extends IDispatch 
  IsRecorderSupported(recorder.l, value.l) 
  IsCurrentMediaSupported(recorder.l, value.l) 
  get_MediaPhysicallyBlank(value.l) 
  get_MediaHeuristicallyBlank(value.l) 
  get_SupportedMediaTypes(value.l) 
EndInterface 

Interface IDiscFormat2Erase Extends IDiscFormat2 
  put_Recorder(value) 
  get_Recorder(value) 
  put_FullErase(value) 
  get_FullErase(value) 
  get_CurrentPhysicalMediaType(value) 
  put_ClientName(value.p-bstr) 
  get_ClientName(value) 
  EraseMedia() 
EndInterface 

Structure SAFEARRAYBOUND 
  cElements.l  ; # of elements in the array dimension 
  lLbound.l    ; Lower bounds of the array dimension 
EndStructure 

Structure SAFEARRAY 
  cDims.w 
  fFeatures.w
  cbElements.l 
  cLocks.l 
  *pvData 
  rgsabound.SAFEARRAYBOUND[0]
EndStructure 

Procedure.i IMAPI2_MediaType(driveletter.s) 
  Protected pp.Variant 
  Protected *Variant.Variant
  Protected *VariantArray.SAFEARRAY 
  Protected hres.i, Count.i, i.i, ii.i
  Protected DiscMaster.IDiscMaster2
  Protected Recorder.IDiscRecorder2
  Protected Format.IDiscFormat2Erase
  Protected Result.i = -1, Counter.i
  driveletter = UCase(driveletter)
  
  pp\vt = #VT_BSTR 

  hres = CoInitialize_(0)
  If hres <> #S_OK And hres <> #S_FALSE  : ProcedureReturn Result : EndIf

  ;CoCreateInstance_() = -2147221164 = Klasse nicht registriert = IMAPI2 fehlt!
  If CoCreateInstance_(?CLSID_MsftDiscMaster2, #Null, 1, ?IID_IDiscMaster2, @DiscMaster) = #S_OK
    If DiscMaster\get_Count(@Counter) = #S_OK And Counter ;wie viele Geräte gibt es?
      If CoCreateInstance_(?CLSID_MsftDiscRecorder2, 0,1,?IID_IDiscRecorder2, @Recorder) = #S_OK
        If CoCreateInstance_(?CLSID_MsftDiscFormat2Erase, 0,1,?IID_IDiscFormat2Erase, @Format) = #S_OK
          For i = 0 To Counter - 1 
            If DiscMaster\get_Item(i, @pp\bstrval) <> #S_OK : Continue : EndIf
            If Recorder\InitializeDiscRecorder(pp\bstrval) <> #S_OK : Continue : EndIf
            If Format\put_Recorder(Recorder) <> #S_OK : Continue : EndIf
            If Recorder\get_VolumePathNames(@*VariantArray)  <> #S_OK : Continue : EndIf
            For ii = 1 To *VariantArray\rgsabound[0]\cElements
              *Variant = *VariantArray\pvData + (ii - 1) * *VariantArray\cbElements
              If *Variant\vt = #VT_BSTR
                If PeekS(*Variant\bstrval, -1, #PB_Unicode) = driveletter
                  Format\get_CurrentPhysicalMediaType(@Result) 
                  Break 2
                EndIf
              EndIf
            Next
          Next 
      
          Format\Release()
        EndIf
        Recorder\Release()
      EndIf
    EndIf
    DiscMaster\Release() 
  EndIf
  CoUninitialize_()
          
  ProcedureReturn Result 
EndProcedure 

DataSection 
  CLSID_MsftDiscMaster2: 
    Data.l $2735412E 
    Data.w $7F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 

  CLSID_MsftDiscRecorder2: 
    Data.l $2735412D 
    Data.w $7F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 

  CLSID_MsftDiscFormat2Erase: 
    Data.l $2735412B 
    Data.w $7F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 

  IID_IDiscMaster2: 
    Data.l $27354130 
    Data.w $7F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 

  IID_IDiscRecorder2: 
    Data.l $27354133 
    Data.w $7F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 

  IID_IDiscFormat2Erase: 
    Data.l $27354156 
    Data.w $8F64,$5B0F 
    Data.b $8F,$00,$5D,$77,$AF,$BE,$26,$1E 
EndDataSection
MFG PMV
alte Projekte:
TSE, CWL, Chatsystem, GameMaker, AI-Game DLL, Fileparser, usw. -.-
Antworten