Hi,

I am having trouble getting this code to burn all directories, files, (including all subdirectories & files) to a CD.

Please help

Code Below (lots of it)

Option Explicit

Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const ERROR_NO_MORE_FILES = 18&
Private Const INVALID_HANDLE_VALUE = -1
Private Const DDL_DIRECTORY = &H10

Public ArchivePath As String
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
Public from_dir As String
Private Sub Burn_Click()
Dim fileNum
btnAbort.Enabled = True
Browse.Enabled = False
Burn.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 = "TestTrack"
isotrack.RootFolder = Folder

fileNum = BurnFiles(Folder, ArchivePath)
strMessages = strMessages + "Prepared " & Format$(fileNum) & " files & Directories for writing."
edtMessages = strMessages

isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET
drive.BurnIsoAudioCD , , 0, isotrack, Nothing, Nothing, NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, 0, NERO_MEDIA_CD
GoTo quit

handle_error:
strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + nero.LastError
edtMessages = strMessages
quit:
End Sub
' Burn all files below this directory. Return the
' number of files burned.
Private Function BurnFiles(ByRef nroFolderToUse As NeroFolder, from_dir As String) As Long
Dim files_copied As Long
Dim dirs As Collection
Dim fname As String
Dim search_handle As Long
Dim file_data As WIN32_FIND_DATA
Dim i As Integer
Dim nroFolTmp As NeroFolder
Dim nroFilTmp As NeroFile
Dim from_folder As String

Set dirs = New Collection
'store the selected directory for later
from_folder = from_dir

' Get the first file.
search_handle = FindFirstFile(from_dir & "*.*", file_data)
If search_handle <> INVALID_HANDLE_VALUE Then
' Get the rest of the files.
Do
' Get the file name.
fname = file_data.cFileName
fname = Left$(fname, InStr(fname, Chr$(0)) - 1)

' Skip the files "." and "..".
If fname <> "." And fname <> ".." Then
files_copied = files_copied + 1

' See if the file is a directory.
If file_data.dwFileAttributes And DDL_DIRECTORY Then
' This is a directory.
' Burn the new directory.
Set nroFolTmp = New NeroFolder
nroFolTmp.Name = fname
nroFolderToUse.Folders.Add nroFolTmp
strMessages = strMessages + "Directory " + nroFolTmp.Name + " added" + Chr(13) + Chr(10)
Me.edtMessages = strMessages

' Save the directory name so we can search it later.
dirs.Add fname
Else
' This is not a directory.
' Burn the file.
Set nroFilTmp = New NeroFile
nroFilTmp.Name = fname
nroFilTmp.SourceFilePath = from_folder
nroFolderToUse.Files.Add nroFilTmp
strMessages = strMessages + "File " + from_folder + fname + " added" + Chr(13) + Chr(10)
Me.edtMessages = strMessages
End If
End If

' Get the next file.
If FindNextFile(search_handle, file_data) = 0 Then Exit Do
Loop

' Close the file search hanlde.
FindClose search_handle
End If

' Search subdirectories.
For i = 1 To dirs.Count
fname = dirs(i)
files_copied = files_copied + BurnFiles(Folder, from_dir & fname & "\")
Next i

BurnFiles = files_copied
End Function
Private Sub Browse_Click()
On Error GoTo ErrHandler

' Displays the Open dialog box for the user to locate the Directory to archive
ArchivePath = GetDirectory("Select a Directory for Archive", Me) + "\"

If ArchivePath <> "" Then
Me!DirName.Text = ArchivePath + "*.*"
End If

Burn.Enabled = True
Exit Sub

ErrHandler:
Exit Sub
End Sub
Private Sub btnAbort_Click()
nero.Abort
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
ProgressBar.Value = 0
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 Form_Initialize()
Dim myIndex
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 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

Can you please explain your issue in more detail? What exactly seems to be the problem?

The files all write to the root of the CD and I have empty sub directories. Also, all of the files are 0KB and seem to be incomplete. However, all of the files are listed. When I run the code, I get warnings that it can't find the files after it starts the simulation. In debug as the nerofiles and nerofolders load up it appears that the variables are correct.

Is there a better way to do this. What I am trying to do shouldn't be this hard. I just need VB6 code to grab a directory and all of its contents (including subdirs) and burn to CD.

Thank you,
Shane

See code in thread "driveondoneimport never fires"