PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

CD-/DVD-Medium per IMAPI ermitteln

https://www.purebasic.fr/german/viewtopic.php?t=17162

Seite 1 von 2

CD-/DVD-Medium per IMAPI ermitteln

Verfasst: 13.07.2008 17:29
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...

Verfasst: 13.07.2008 17:44
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

Verfasst: 13.07.2008 18:03
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?

Verfasst: 13.07.2008 18:14
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

Verfasst: 13.07.2008 18:21
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

Verfasst: 13.07.2008 18:29
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.

Verfasst: 13.07.2008 19:51
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 ;)

Verfasst: 13.07.2008 20:39
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

Verfasst: 13.07.2008 21:01
von scholly
ARGL... vor lauter Brettern hab ich nur an "define" und nicht "protected" gedacht.

Bild

Verfasst: 13.07.2008 21:03
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: )
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de