VB6 Code to burn directories and files

vbimport

#1

Okay,

I now have my code working to copy all files and build subdirectories, bu now all the folders end up at the root rather than in their appropriate sub-dirs. Below is the code.

Thanks

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
edtMessages = “”
edtMessages.Refresh

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 Or 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 + fname
                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
MsgBox (“CD was completed successfylly!”)
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


#2

the answer is to simply add folders to the root folder. here is some simplified code I wrote that will add an entire folder tree to your root folder using the “ms scripting runtime” component. (which can simply be added by going to the references screen in VB and checking “ms scripting runtime”…) also notice my use of the word my in front of many of my variable names. i did that to remove the ambiguity of the filenames when i was trying to learn what all of the code in the examples was doing.

only thing i haven’t figured out yet is how to title the cd correctly. if anyone knows how this is done please let me know

'///////////////////////////////////////////////////////////////////////
'global

Public fs As New FileSystemObject
Public WithEvents myNero As nero
Public WithEvents myNeroDrive As NeroDrive
Public myNeroDrives As NeroDrives

'///////////////////////////////////////////////////////////////////////
Private Sub Form_Initialize()
Set myNero = New nero
Set myNeroDrives = myNero.GetDrives(NERO_MEDIA_CD)

For i = 0 To (myNeroDrives.Count - 1)
AvailableDevices.AddItem myNeroDrives(i).DeviceName
Next

AvailableDevices.ListIndex = 0

ErrHandler:
Exit Sub
End Sub
'///////////////////////////////////////////////////////////////////////
Public Sub get_disc_files()
Dim myFolder As folder
Dim myRootNeroFolder As NeroFolder

’ create the iso root folder first
Set myRootNeroFolder = New NeroFolder
myRootNeroFolder.name = “SomeName”

’ use ms filesystem to get the folder you want to add to the cd
Set myFolder = fs.GetFolder(“full path to a folder here”)

’ add it to the root folder using the recursive “add_folder_files()” function (defined below)
myRootNeroFolder.folders.Add add_folder_files(myFolder)

’ repeate the 2 calls above as many times as you like to add different folders to the root

’ set up the isotrack
Set myNeroISOtrack = New NeroISOTrack
myNeroISOtrack.name = txtTitle.Text
myNeroISOtrack.RootFolder = myRootNeroFolder
myNeroISOtrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET

’ set the correct drive here
Set myNeroDrive = myNeroDrives(AvailableDevices.ListIndex)

’ burn the disc
myNeroDrive.BurnIsoAudioCD “aaaa”, “bbbb”, 0, myNeroISOtrack, Nothing, Nothing, NERO_BURN_FLAG_WRITE, 32, NERO_MEDIA_CD
End Sub
'///////////////////////////////////////////////////////////////////////
’ notice this function returns a NeroFolder. This makes it easy to add the entire tree to an existing NeroFolder

Public Function add_folder_files(dir) As NeroFolder
Dim myNeroFolder As NeroFolder
Dim myNeroFile As NeroFile

Dim myFile As file
Dim myFolder As folder
Dim myFiles As files
Dim myFolders As folders

’ get the folder and files for this folder
Set myFolder = fs.GetFolder(dir.Path)
Set myFolders = myFolder.SubFolders
Set myFiles = myFolder.files

’ create a new nero folder and name it
Set myNeroFolder = New NeroFolder
myNeroFolder.name = dir.name

’ add all the files to the nero folder
For Each myFile In myFiles
Set myNeroFile = New NeroFile
myNeroFile.name = myFile.name
myNeroFile.SourceFilePath = myFile.Path
myNeroFolder.files.Add myNeroFile
Next

’ add all of the folders to the nero folder
For Each myFolder In myFolders
myNeroFolder.folders.Add add_folder_files(myFolder)
Next

’ return this folder
Set add_folder_files = myNeroFolder
End Function