'###DECLARATIONS Public WithEvents Nero As Nero Public WithEvents Graveur As NeroDrive Private tmpSaveFile As String Private saveFile As String '### FONCTIONS DE GRAVURE '###FONCTIONS DE GRAVURE Sub burnData() 'Gestion des erreurs On Error GoTo gestionErreur 'Lors du lancement de la gravure des donnees, on... '...initialise NERO '================== '...cree un objet Nero Set Nero = New Nero Dim Lecteurs As NeroDrives '...recupere la liste des graveurs de DVD+RW de l'ordi Set Lecteurs = Nero.GetDrives(NERO_MEDIA_DVD_P_RW) Dim i As Integer '...selectionne le graveur qui supporte les RW For i = 0 To Lecteurs.Count - 1 If Lecteurs(i).DevType = NERO_SCSI_DEVTYPE_WORM Then Exit For Next Set Graveur = Lecteurs(i) '...initialise le repertoire des donnees du cd Dim cdFolder As NeroFolder Set cdFolder = New NeroFolder '....initialise la piste ISO Dim pisteISO As NeroISOTrack Set pisteISO = New NeroISOTrack pisteISO.RootFolder = cdFolder '...test si il y a plusieurs disques '======================================= 'Si il n'y a qu'un seul disque a graver, on... '...initialise le numero du disque discNum = 1 '...indique l'etat saveForm.setState BurnDVD '...le met dans le nero iso track Dim fichierNero As NeroFile Set fichierNero = New NeroFile cdFolder.Files.Add fichierNero fichierNero.name = tmpSaveFile fichierNero.SourceFilePath = "D:" & fichierNero.name '...initialise le nom de la piste iso pisteISO.name = "ASP63_" & Format(Now, "yyyy-mm-dd") '...initialise la gravure '======================== '...options de gravure de la piste ISO : system de fichier iso + joliet pisteISO.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET '...lancement de la gravure Graveur.BurnIsoAudioCD "", "", False, pisteISO, Nothing, Nothing, _ NERO_BURN_FLAG_BUF_UNDERRUN_PROT + _ NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW + _ NERO_BURN_FLAG_WRITE, 0, NERO_MEDIA_DVD_P_RW Exit Sub gestionErreur: 'En cas d'erreur avec nero Nero.Abort MsgBox "Erreur lors du lancement de la gravure de la sauvegarde.", vbCritical + vbOKOnly, End Sub Sub eraseDisc() 'Pour effacer un disque, on... '...indique l'etat saveForm.setState EraseDVD '...l'efface Graveur.eraseDisc True, NERO_ERASE_MODE_DEFAULT End Sub '#EVENEMENTS '#GRAVEUR Private Sub Graveur_OnDoneErase(ok As Boolean) 'Lorsque l'effacage est termine, on... '...test si il a ete correctement termine If ok Then 'Si termine correctement, on... '...ejecte le CD 'Graveur.EjectCD '...recharge le CD 'Graveur.LoadCD '...lance la gravure If nbDisc = 1 Then burnData False ElseIf nbDisc > 1 Then burnData True End If ElseIf Not ok Then 'Si termine non correctement, on... '...annule la gravure Nero.Abort '...ferme la fenetre saveForm.closeIt '...affiche un message MsgBox "Erreur lors de l'effacage du disque.", vbCritical + vbOKOnly End If End Sub '#NERO Private Sub Graveur_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR) 'Lorsque la gravure est terminee, on... '...test comment elle s'est terminee Select Case StatusCode Case NERO_BURN_OK 'Avec succes ! 'Si il n'y a qu'un disque, on... '...ferme la fenetre saveForm.closeIt '...indique que la gravure s'est termine avec succes MsgBox "La sauvegarde est terminée.", vbInformation + vbOKOnly Case Else End Select End Sub Private Sub nero_OnNonEmptyCDRW(Response As NEROLib.NERO_RESPONSE) 'Si le disque n'est pas vierge, on... '...annule la gravure 'Nero.Abort '...efface le cd saveForm.eraseDisc End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question