[VB6]: Verificare se un disco è riscrivibile

**x69asterix** · 17-07-2006, 21:21

esiste un modo a form attivato di verificare se il disco è un rescrivibile? praticamente con questo codice se è un cdrw lo cancella ma se non lo è và in run time

codice:

Private Sub cmdErase_Click()

    ‘Come sopra vengono dichiarate le variabili necessarie ad identificare i dispositivi e a creare 
    ‘una nuova directory radice vuota

    Set Folder = New NeroFolder
    Dim drives As INeroDrives
    Set drives = nero.GetDrives(NERO_MEDIA_CDR)
    Set drive = drives(AvailableDevices.ListIndex)
    Dim isotrack As NeroISOTrack
    Set isotrack = New NeroISOTrack

 ‘in questo modo verranno utilizzati i messaggi Joliet
 isotrack.BurnOptions = NERO_BURN_OPTION_USE_JOLIET Or NERO_BURN_OPTION_CREATE_ISO_FS


    Dim a   ‘Prima di procedere alla cancellazione, è necessario dichiarare una variabile alla quale
            ‘Nero assegnerà automaticamente il tempo necessario alla cancellazione del CD, senza la
            ‘quale si otterrebbe un messaggio di errore.
 
    If Combo1.Text = "Completa" Then
                            a = drive.CDRWErasingTime(False)
                            drive.EraseCDRW False
                                Else
                            a = drive.CDRWErasingTime(True)
                            drive.EraseCDRW True
    End If

‘anche qui gli errori vengono rilevati tramite stringa dal run-time di Nero.
handle_error:
    strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + nero.LastError
    edtMessages = strMessages

ed ecco tutto il codice per masterizzare chiaramente da "nero sdk"

codice:

Public WithEvents nero As nero
Public drives As INeroDrives
Public WithEvents drive As NeroDrive
Public cnt As Integer
Public Folder As INeroFolder
Public strMessages As String
Function NameFromPath(strPath As String) As String
    Dim lngPos          As Long
    Dim strPart         As String
    Dim blnIncludesFile As Boolean

    lngPos = InStrRev(strPath, "\")
    blnIncludesFile = InStrRev(strPath, ".") > lngPos
    strPart = ""

    If lngPos > 0 Then
        If blnIncludesFile Then
            strPart = Right$(strPath, Len(strPath) - lngPos)
        End If
    End If

    NameFromPath = strPart
End Function

Private Sub Browse_Click()
  SelectFileDialog.CancelError = True
  On Error GoTo ErrHandler
  SelectFileDialog.Flags = cdlOFNHideReadOnly
  SelectFileDialog.FilterIndex = 2
  SelectFileDialog.ShowOpen
  
  edtFileName.AddItem SelectFileDialog.FileName
  Burn.Enabled = True
  Exit Sub
  
ErrHandler:
  Exit Sub
End Sub
Private Sub btnAbort_Click()
    nero.Abort
End Sub
Private Sub Burn_Click()
    btnAbort.Enabled = True
    Browse.Enabled = False
    Burn.Enabled = False
 cmdErase.Enabled = False
    Set Folder = New NeroFolder
    Dim drives As INeroDrives
    Set drives = nero.GetDrives(NERO_MEDIA_CDR)
    Set drive = drives(AvailableDevices.ListIndex)
    Dim isotrack As NeroISOTrack
    Set isotrack = New NeroISOTrack
    isotrack.Name = Text1.Text
    isotrack.RootFolder = Folder
    
    Dim file As NeroFile
    Set file = New NeroFile
    Folder.Files.Add file
    
    For i = 0 To edtFileName.ListCount - 1
    file.Name = NameFromPath(edtFileName.List(i))
    file.SourceFilePath = edtFileName.List(i)
    Next
    Close
    
    isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET
    
    drive.BurnIsoAudioCD "Pop Star", "Title", 0, isotrack, Nothing, Nothing, NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, 4, NERO_MEDIA_CD
    GoTo quit

handle_error:
    strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + nero.LastError
    edtMessages = strMessages
quit:
End Sub

Private Sub cmdErase_Click()
'Come sopra vengono dichiarate le variabili necessarie ad identificare i dispositivi e a creare
'una nuova directory radice vuota
  cmdErase.Enabled = False
    Set Folder = New NeroFolder
    Dim drives As INeroDrives
    Set drives = nero.GetDrives(NERO_MEDIA_CDR)
    Set drive = drives(AvailableDevices.ListIndex)
    Dim isotrack As NeroISOTrack
    Set isotrack = New NeroISOTrack
    
'in questo modo verranno utilizzati i messaggi Joliet
 isotrack.BurnOptions = NERO_BURN_OPTION_USE_JOLIET Or NERO_BURN_OPTION_CREATE_ISO_FS
 
'Prima di procedere alla cancellazione, è necessario dichiarare una variabile alla quale
'Nero assegnerà automaticamente il tempo necessario alla cancellazione del CD, senza la
'quale si otterrebbe un messaggio di errore.

Dim A

    If Combo1.Text = "Completa" Then
                            A = drive.CDRWErasingTime(False)
                            drive.EraseCDRW False
                                Else
                            A = drive.CDRWErasingTime(True)
                            drive.EraseCDRW True
                          
    End If

'anche qui gli errori vengono rilevati tramite stringa dal run-time di Nero.
handle_error:
    strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + nero.LastError
    edtMessages = strMessages
quit:

End Sub

Private Sub drive_OnAborted(Abort As Boolean)
    Abort = False
End Sub
Private Sub drive_OnAddLogLine(TextType As NEROLib.NERO_TEXT_TYPE, Text As String)
    strMessages = strMessages + Text + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub drive_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR)
    strMessages = strMessages + Chr(13) + Chr(10) + nero.ErrorLog + Chr(13) + Chr(10)
    strMessages = strMessages + nero.LastError + Chr(13) + Chr(10)
    strMessages = strMessages + "Burn finished "
    If StatusCode <> NEROLib.NERO_BURN_OK Then
        strMessages = strMessages + "NOT (" & StatusCode & ")"
    End If
    strMessages = strMessages + "successfully!" + Chr(13) + Chr(10)
    edtMessages = strMessages
    btnAbort.Enabled = False
    Browse.Enabled = True
    Burn.Enabled = True
     cmdErase.Enabled = True
    ProgressBar.Value = 0
    MsgBox "Scrittura eseguita correttamente!", vbInformation, "Scrittura Ok!"
End Sub

Private Sub drive_OnDoneErase(Ok As Boolean)
cmdErase.Enabled = True
 MsgBox "Disco cancellato correttamente!", vbInformation, "Scrittura Ok!"

End Sub

Private Sub drive_OnDoneWaitForMedia(Success As Boolean)
    strMessages = strMessages + "Done waiting for media." + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub drive_OnProgress(ProgressInPercent As Long, Abort As Boolean)
    Abort = False
    ProgressBar.Value = ProgressInPercent
End Sub
Private Sub drive_OnSetPhase(Text As String)
    strMessages = strMessages + Text + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub

Private Sub edtFileName_DblClick()
edtFileName.RemoveItem (i)
End Sub

Private Sub Form_Initialize()
    Set nero = New nero
    
    ProgressBar.Value = 0
    strMessages = ""
    Dim drives As INeroDrives
    Set drives = nero.GetDrives(NERO_MEDIA_CDR)
    
    For myIndex = 0 To drives.Count - 1
        AvailableDevices.AddItem drives(myIndex).DeviceName, myIndex
    Next
    AvailableDevices.ListIndex = 0
ErrHandler:
    Exit Sub
End Sub

Private Sub Form_Load()
For i = 0 To Form1.File2.ListCount - 1
edtFileName.AddItem Form1.File2.Path & "\" & Form1.File2.List(i)

Next
Close

End Sub

Private Sub nero_OnFileSelImage(FileName As String)
      ImageFileDialog.CancelError = True
      On Error GoTo ErrHandler
      ImageFileDialog.Flags = cdlOFNHideReadOnly
      ImageFileDialog.FilterIndex = 2
      ImageFileDialog.ShowOpen
      FileName = ImageFileDialog.FileName
      Exit Sub
ErrHandler:
      Exit Sub
End Sub
Private Sub nero_OnMegaFatal()
    strMessages = strMessages + "A mega fatal error has occurred." + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub nero_OnNonEmptyCDRW(Response As NEROLib.NERO_RESPONSE)
  strMessages = strMessages + "CD-RW not empty!" + Chr(13) + Chr(10)
  edtMessages = strMessages
  Response = NERO_RETURN_EXIT
End Sub
Private Sub nero_OnRestart()
    strMessages = strMessages + "The system is being restarted." + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub nero_OnWaitCD(WaitCD As NEROLib.NERO_WAITCD_TYPE, WaitCDLocalizedText As String)
    strMessages = strMessages + WaitCDLocalizedText + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub nero_OnWaitCDDone()
    strMessages = strMessages + "Done waiting for CD." + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub nero_OnWaitCDMediaInfo(LastDetectedMedia As NEROLib.NERO_MEDIA_TYPE, LastDetectedMediaName As String, RequestedMedia As NEROLib.NERO_MEDIA_TYPE, RequestedMediaName As String)
    strMessages = strMessages + "Waiting for a particular media type:" + Chr(13) + Chr(10)
    strMessages = strMessages + RequestedMediaName + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub
Private Sub nero_OnWaitCDReminder()
    strMessages = strMessages + "Still waiting for CD..." + Chr(13) + Chr(10)
    edtMessages = strMessages
End Sub

Private Sub XPButton1_Click()
edtFileName.Clear
End Sub

poi se esiste la possibilità di non chiudere il disco in scrittura, sarebbe il massimo

**x69asterix** · 18-07-2006, 14:50

nessuno ha notizie in merito di come implementare questo codice?

Discussione: [VB6]: Verificare se un disco è riscrivibile

Strumenti discussione

Ricerca discussione

Visualizza

[VB6] nero burn

Permessi di invio