CD-/DVD-Medium per IMAPI ermitteln

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.
Antworten
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

CD-/DVD-Medium per IMAPI ermitteln

Beitrag von scholly »

moin, moin...
Nachfolgender Code funktioniert bei mir [XPHome(SP)+PB4.2] problemlos.

Könnte ihn bitte der ein oder andere unter verschiedenen Vista-Versionen testen und Erfahrungen posten?

Code: Alles auswählen

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

Procedure.S   sfs_Get_VariantString(*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

Procedure.s    ax_Uni2Ansi(unicodestr.l) 
  ;user: aXend
  ;forum: http://www.purebasic.fr/english/viewtopic.php?t=16569
  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)

Debug driveletter
For imapidrives = 0 To count

  Debug " "
  
  DiscMaster\get_Item(imapidrives,@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(imapidrives) +"   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 = sfs_Get_VariantString(*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 imapidrives

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)
Debug thismediatype
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
mDv...
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Der Code ist ja unmöglich formatiert, Interfaces, Strukturen usw. haben in
Proceduren eigentlich nichts verloren :mrgreen:
Debugger-Ausgabe hat geschrieben:LW to check: z:\
Line: 13 - Invalid memory access, (read error at address 16)
Vista Ultimate 64 SP1

Gruß
Thomas
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

ts-soft hat geschrieben:Der Code ist ja unmöglich formatiert, Interfaces, Strukturen usw.
haben in Proceduren eigentlich nichts verloren :mrgreen:
Jaja, :oops: ich schäm mich auch dafür, aber ich war froh, daß ich was verläßliches zur Medien-Typ-Erkennung gefunden und benutzen konnte, auch wenn ich nur 10% verstehe :lol:
Debugger-Ausgabe hat geschrieben:LW to check: z:\
Line: 13 - Invalid memory access, (read error at address 16)
Und wenn Du einen bei Dir vorhandenen DVD-LW-Buchstaben nimmst?
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

scholly hat geschrieben:Und wenn Du einen bei Dir vorhandenen DVD-LW-Buchstaben nimmst?
Debugger hat geschrieben:LW to check: s:\
0
Media Type is Unknown or no media loaded

LW to check: l:\
0
Media Type is Unknown or no media loaded
Funktioniert in ANSI und Unicode
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

Aha !

Danke Dir.

Ist dieser code vom Aufbau her richtiger?

Code: Alles auswählen

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

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

Procedure.S   sfs_Get_VariantString(*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

Procedure.s    ax_Uni2Ansi(unicodestr.l) 
  ;user: aXend
  ;forum: http://www.purebasic.fr/english/viewtopic.php?t=16569
  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

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)

Debug driveletter
For imapidrives = 0 To count

  Debug " "
  
  DiscMaster\get_Item(imapidrives,@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(imapidrives) +"   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 = sfs_Get_VariantString(*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 imapidrives

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

CoUninitialize_()
       
EnableDebugger
ProcedureReturn mediatype

EndProcedure;ugs_get_IMAPImediaType(driveletter.s)

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

thismediatype = ugs_get_IMAPImediaType(cdvdLW)
Debug thismediatype
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

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
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

> Ist dieser code vom Aufbau her richtiger?
Ja, aber der Code selber enthält nicht nur unnötiges, sondern auch div.
Fehler. Deklariert wird variant, aber genutzt wird *variant :mrgreen:
Nur variantarray wurde als pointer deklariert. uni2ansi ist seit PB4 unnötig,
usw.

Mach mal EnableExplicit und beseitige erstmal alle offentsichtlichen Fehler,
dann sehen wird weiter.

PS: Warum unter Code, Tipps und Tricks? Gehört eher nach Allgemein.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

ts-soft hat geschrieben:uni2ansi ist seit PB4 unnötig
wußtichbishernich, habbich raus...
ts-soft hat geschrieben:Mach mal EnableExplicit
Bei "pp.variant" komm ich schon nicht weiter mit definieren, weil ich den ganzen IMAPI-Code eigentlich nicht verstehe, sondern nur über try+error zum Laufen gebracht habe :oops:
ts-soft hat geschrieben:PS: Warum unter Code, Tipps und Tricks? Gehört eher nach Allgemein.
Dann mag MOD das verschieben ;)
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Ich weiß nicht obs so sein soll, aber vielleicht kommste so weiter:

Code: Alles auswählen

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

EnableExplicit

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

Procedure.S sfs_Get_VariantString(*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

Procedure.s ax_Uni2Ansi(unicodestr.l)
  If unicodestr
    ProcedureReturn PeekS(unicodestr, - 1, #PB_Unicode)
  EndIf
EndProcedure

Procedure.l ugs_get_IMAPImediaType(driveletter.s)
  Protected pp.variant
  pp\vt = #VT_BSTR

  Protected Variant.VARIANT
  Protected *Variant
  Protected *VariantArray.SAFEARRAY
  Protected thisletter.s = ""
  Protected DiscMaster.IDiscMaster2
  Protected count.l, imapidrives.l, i.l, mediaType.l
  Protected Recorder.IDiscRecorder2
  Protected Format.IDiscFormat2Erase
  Protected value.SAFEARRAY

  CoInitialize_(0)
  CoCreateInstance_(? CLSID_MsftDiscMaster2, 0, 1, ? IID_IDiscMaster2, @DiscMaster.IDiscMaster2)
  DiscMaster\get_Count(@count)

  Debug driveletter
  For imapidrives = 0 To count

    Debug " "

    DiscMaster\get_Item(imapidrives, @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(imapidrives) + "   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)
    If Variant\parray > 0
      *VariantArray = Variant\parray
      For i = 1 To *VariantArray\rgsabound[0]\cElements
        *Variant = *VariantArray\pvData +(i - 1) * 16

        thisletter = sfs_Get_VariantString(*Variant)
        Debug "Your Drive Path is:   " + thisletter

        Format\get_CurrentPhysicalMediaType(@mediaType)
        Debug mediatype
      Next i
      If thisletter = UCase(driveletter)
        Break
      EndIf

      Debug ""
    EndIf
  Next imapidrives

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

  CoUninitialize_()

  ProcedureReturn mediatype

EndProcedure ;ugs_get_IMAPImediaType(driveletter.s)

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

Define.l thismediatype = ugs_get_IMAPImediaType(cdvdLW)
Debug thismediatype
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

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
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

ARGL... vor lauter Brettern hab ich nur an "define" und nicht "protected" gedacht.

Bild
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Wenn Du Dir jetzt mal die "Procedure.s ax_Uni2Ansi(unicodestr.l) " ansiehst,
wirste merken das die garnicht nötig ist, wollte es nur nicht an den vielen
Stellen im Code anpassen (Faulheit :mrgreen: )
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“