Hi,
I have a VB6 application that backs up all the files in a Folder / Sub Folder location. I calculate the ISO track size and if there are more files that can fit on 1 CD, I have the application prompt the user to insert the next disk, I then call the Burn Sub again.
If I step through the code in debug mode it works perfectly. If I let it run normally it crashes when it gets to the Drive.Burn with the following error:
An instruction at 0x058637d7 referenced memory at 0x018937e8. The memory can't be "read".
Here are my Declares and the Subs that are involved;
Option Explicit
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
Dim NumberOfCDs As Double
Const CDSize = 681574400
Dim TotalSize As Double
Dim Mode As String
Dim NumberOfFilesToRestore As Integer
Dim BurnSize As Double
Dim NumberOfFilesBurned As Integer
Dim NumberOfCDsCompleted As Integer
Dim cdISOtrack As NeroISOTrack
Dim Speeds As NeroSpeeds
Dim BurnSpeed As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Burn_Click()
btnAbort.Enabled = True
Browse.Enabled = False
Burn.Enabled = False
cmdExit.Enabled = False
cmdRestore.Enabled = False
Dim i As Integer
On Error GoTo ErrorHandler
AvailableDevices.Enabled = False
cmbSpeeds.Enabled = False
frmDialog.txtMessage.Text = vbCrFl & "Please Wait. Initializing CD Writer."
frmDialog.OKButton.Visible = False
frmDialog.Show
Sleep (15000)
frmDialog.Hide
frmDialog.OKButton.Visible = True
Dim FSOCD As FileSystemObject
Set FSOCD = New FileSystemObject
Set Folder = New NeroFolder
Folder.Name = txtEventName.Text
Dim drives As INeroDrives
Set drives = nero.GetDrives(NERO_MEDIA_CDR)
Set Drive = drives(AvailableDevices.ListIndex)
Set cdISOtrack = New NeroISOTrack
If txtEventName.Text <> "" Then
cdISOtrack.Name = txtEventName.Text
Else
cdISOtrack.Name = Date
txtEventName.Text = Date
End If
cdISOtrack.RootFolder = Folder
Dim File As NeroFile
Dim FileToburn As File
Dim ImagesFolder As Folder
Set ImagesFolder = FSOCD.GetFolder("C:\Program Files\DCSoftware\Image\Temp")
For Each FileToburn In ImagesFolder.Files
If BurnSize + FileToburn.Size < CDSize Then
BurnSize = BurnSize + FileToburn.Size
BurnedList.AddItem FileToburn.Name
Set File = New NeroFile
File.Name = FileToburn.Name
File.SourceFilePath = FileToburn.Path
Folder.Files.Add File
NumberOfFilesBurned = NumberOfFilesBurned + 1
Else
Exit For
End If
Next
'Set the Drive Burn Options
cdISOtrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET
' ' set the correct drive here
' Set Drive = drives(AvailableDevices.ListIndex)
' burn the disc
'Drive.BurnIsoAudioCD txtEventName.Text, txtEventName.Text, 0, cdISOtrack, Nothing, Nothing, _
NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_BUF_UNDERRUN_PROT, BurnSpeed, NERO_MEDIA_CD
Set ImagesFolder = Nothing
Set FileToburn = Nothing
Set FSOCD = Nothing
Exit Sub
ErrorHandler:
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 & ")"
strMessages = strMessages + "successfully!" + Chr(13) + Chr(10)
edtMessages.Text = strMessages
btnAbort.Enabled = False
Browse.Enabled = True
Burn.Enabled = True
ProgressBar.Value = 0
Exit Sub
End If
strMessages = strMessages + "successfully!" + Chr(13) + Chr(10)
edtMessages.Text = strMessages
btnAbort.Enabled = False
Browse.Enabled = True
Burn.Enabled = True
ProgressBar.Value = 0
NumberOfCDsCompleted = NumberOfCDsCompleted + 1
Dim FSOCD As FileSystemObject
Set FSOCD = New FileSystemObject
Dim TempFolder As Folder
Dim TempFile As File
Dim b As Integer
Dim P As Integer
Set TempFolder = FSOCD.GetFolder("C:\Program Files\DCSoftware\Image\Temp")
For b = 1 To BurnedList.ListCount
For Each TempFile In TempFolder.Files
If TempFile.Name = BurnedList.List(0) Then
For P = 0 To ImageList.ListCount - 1
If ImageList.List(P) = TempFile.Name Then
ImageList.RemoveItem (P)
Exit For
End If
Next
TotalSize = TotalSize - TempFile.Size
If FSOCD.FileExists(TempFile) Then
FSOCD.DeleteFile TempFolder & "\" & TempFile.Name
End If
NumberOfFiles.Caption = Str(Int(NumberOfFiles.Caption) - 1)
TrackSize.Caption = Format$(TotalSize, "000,000,000")
Me.Refresh
DoEvents
Exit For
End If
Next
BurnedList.RemoveItem (0)
Next
Frame3.Caption = "Progress: "
If NumberOfCDsCompleted < NumberOfCDsRequired Then
Load frmDialog
frmDialog.txtMessage = "Please remove completed CD and insert next blank. Press OK to continue"
frmDialog.Show vbModal, Me
DoEvents
Set TempFile = Nothing
Set TempFolder = Nothing
Set FSOCD = Nothing
NumberOfCDsRequired.Caption = Str(Int(NumberOfCDsRequired) - 1)
BurnSize = 0
While Drive.DeviceReady = False
frmDialog.txtMessage = "Waiting for Drive to become ready"
frmDialog.OKButton.Visible = False
frmDialog.Show
DoEvents
Wend
frmDialog.Visible = False
DoEvents
Call Burn_Click
Exit Sub
End If
Set TempFile = Nothing
Set TempFolder = Nothing
Set FSOCD = Nothing
If NumberOfCDsCompleted = NumberOfCDsRequired Then
cmdExit.Enabled = True
cmdRestore.Enabled = True
AvailableDevices.Enabled = True
cmbSpeeds.Enabled = True
End If
End Sub
Any Ideas as to why it is crashing on the second CD? I added a Sleep routing to sleep the program for 15 seconds to allow the Drive to get ready with the new blank CD and I create a New ISO track.
Thanks Much!
