Hi you all, somebody have an example or "how to" burn a directory's tree in a cd using NeroCom in vb ?

I can't figure how do it, i read the nerocom.pdf repeated times,

The example is great for burn only one file in a audio format cd but i need burn a data cd, with various folders and subfolders and i can't make it work


Thanks in advance.

I tried the VB sample and added in extra folder. Simply declare more NeroFolder object and add the newly created neroFolder object to the rootfolder (ie variable folder in vb sample) of the isotrack.

e.g.
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
Dim file As NeroFile
Set file = New NeroFile
Folder.Files.Add file
file.Name = NameFromPath(edtFileName.Text)
file.SourceFilePath = edtFileName.Text
'New FOLDER !
Dim nFolder As New NeroFolder
nFolder.Name = "TEST"
'New FILE !
Dim file2 As New NeroFile
file2.Name = NameFromPath(edtFileName.Text)
file2.SourceFilePath = edtFileName.Text

nFolder.Files.Add file2

Folder.Folders.Add nFolder

'Continue with the sample code ...

Thanks in advance!

but.... really i need add file per file and folder per folder ?

I can't do a Folder.Folders.Add "c:\folders_tree\" ?

It seems not possible to do the following

Folder.Folders.Add "c:\"

because add method is not taking a "string",. I have seen something about .isDirectory in the API C++ sample but I dont think it is available and relavent to this object in VB COM. I agree with your suggestions and this should be added to a "wish list" for nero engineer

Great, im sure there is a solution in someway, it will be revelated in a dream tonight

You'll have to do a Rekursion for each folder...

I used a treeview to add all the folders... -> User may add rename folder files...

From the treeview i've got all the Fodlers with indexes (use the nodes.parent property)

e.g. dim nfolder() as NeroFolder
dim nFiles() as NeroFiles

then use
redim preserve nfolders(ifold_count)
redim preserve nfiles(ifile_count)

I have the exact directory structure, but I don't know how many files are in each directory, so I don't know how many files to declare. I don't know the names of the files either. How would I check how may files are in each directory, and add them to the root tree?

Any help will be much appreciated.

Ok I'll send Full code from one of mine aplication.
It take path and make cd with title name as the path.


Hire come the code: (sorry for Serbian but you can translate it on www.krstarica.com)http://club.cdfreaks.com/newreply.ph...te=1&p=454525#
Agree

----------------------------------------------------------
Option Explicit

Public WithEvents nero As nero
Public WithEvents drive As NeroDrive
'
Public drives As INeroDrives
Public Folder As INeroFolder
'
Public isotrack As NeroISOTrack
Public file As NeroFile
Public cnt As Integer
Public strMessages As String

Dim m_vstrSTARTDrive As String
Dim m_vstrSTARTDir As String
Dim m_vstrBrzina As String
Dim m_vblnNEMACDRW As Boolean (Nema -> ther is no)
Dim m_vstrIzvestaj 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

Function FolderFromPath(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 = Left$(strPath, lngPos)
End If
End If

FolderFromPath = strPart
End Function

Private Function SplitText(ByVal Data As String) As Boolean
Dim Temp As String
Dim i As Integer

SplitText = False

Temp = ""
For i = 1 To Len(Data)
If Mid$(Data, i, 1) = Chr$(13) Then
lst_Messages.AddItem Trim$(Temp)
Temp = ""
ElseIf Mid$(Data, i, 1) <> Chr$(10) Then
Temp = Temp + Mid$(Data, i, 1)
End If
Next

If Temp <> "" Then
lst_Messages.AddItem Trim$(Temp)
End If

If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
SplitText = True

End Function 'Recursive function to build the Folders/Files to burn

Function ProveriPrazan() As Boolean (ProveriPrazan-> is it empty)

'Dim nerostring As String

'Dim info As NeroCDInfo
'
'On Error GoTo pukao
'

'
'drive.UpdateDeviceInfo (NERO_MEDIA_CDRW)
' 'nerostring = drive.WaitForMedia(NERO_MEDIA_CDR, NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW)
'' If drive..WaitForMedia(NERO_MEDIA_CDR, NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW) = "" Then
'' End If
''drive.WaitForMedia
'' Dim sl As String
'' Dim i As Integer
'' sl = drive.WriteSpeeds
'' i = drive.AvailableSpeeds(NERO_ACCESSTYPE_WRITE, NERO_MEDIA_CDRW)
''
''
''
''If NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW Then
' ProveriPrazan = True
''End If
'pukao:
' MsgBox ""
End Function

Private Sub BuildFileFolderTree(ByRef nroFolderToUse As NeroFolder, folCurrent As Folder)
Dim folTMP As Folder
Dim filTMP As file
Dim nroFolTmp As NeroFolder
Dim nroFilTmp As NeroFile
Dim l_vinti As Long
'Add all files in the current directory


For Each filTMP In folCurrent.Files
Set nroFilTmp = New NeroFile
nroFilTmp.Name = filTMP.Name
nroFilTmp.SourceFilePath = filTMP.Path
nroFolderToUse.Files.Add nroFilTmp
ProgressBar.Value = Int(Rnd * 100)
Next

'Write the sub folders
For Each folTMP In folCurrent.SubFolders
Set nroFolTmp = New NeroFolder
nroFolTmp.Name = folTMP.Name
nroFolderToUse.Folders.Add nroFolTmp
ProgressBar.Value = Int(Rnd * 100) - 1
Call BuildFileFolderTree(nroFolTmp, folTMP)
Next

End Sub

Private Sub cboBrzine_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub cmbRaspoloziviUredjaji_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub cmdFolder_Click()

On Error GoTo ErrHandler

cmdIzlaz.Enabled = False
cmdErase.Enabled = False

m_vstrSTARTDir = txtRadniDir.Text

dirList.Path = txtRadniDir.Text
If txtRadniDir.Text <> "" Then
drvList.drive = Left$(txtRadniDir.Text, 1)
End If
Frame5.Visible = True
Frame5.Enabled = True


cmdPrihvati.Enabled = True
cmdPrihvati.Visible = True

cmdOdustani.Enabled = True
cmdOdustani.Visible = True

cmdPrihvati.Default = True
Exit Sub

ErrHandler:
MsgBox "Ime direktorijuma " & m_vstrSTARTDir & " je promenjeno od strane neke druge aplikacije", vbCritical, "Snimanje CD/DVD medija"
dirList.Path = "c:\"
Exit Sub
End Sub

Private Sub cmdErase_Click()
On Error Resume Next
Dim l_vlngErasingTime As Long
Dim l_vTimer As Long

m_vstrIzvestaj = m_vstrIzvestaj & "Korisnik je pokrenuo brisanje tj. Erase CDRW medije" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & "************************************************************************" & vbNewLine & vbNewLine


Set drives = nero.GetDrives(NERO_MEDIA_CDR)
Set drive = drives(Val(Left$(cmbRaspoloziviUredjaji.Text, 1)))

If drive.DeviceReady Then
If MsgBox(" Da li zelite da obrisete CD-RW /DVD-RW mediju (Ok->DA)", vbOKCancel, "Brisanje RW Medija") = vbOK Then
If MsgBox(" Da li zelite Potpuno tj. temeljno brisanje (Ok) , a u slucaju (Cancel) brisace se samo zaglavlje CD/DVD-RW medije", vbOKCancel, "Brisanje RW Medija") = vbOK Then

m_vstrIzvestaj = m_vstrIzvestaj & "Korisnik je Full brisanje tj. Erase CDRW medije" & vbNewLine
lst_Messages.AddItem "Zapoceto je Potpuno BRISANJE CD-RW mediju."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
l_vlngErasingTime = drive.CDRWErasingTime(False)
lst_Messages.AddItem "Procenjeno vreme brisanja je oko " & l_vlngErasingTime & "sec."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
cmdErase.Enabled = False
cmdSnimi.Enabled = False
drive.EraseCDRW (False)

l_vTimer = Round(Timer, 0)
Do
ProgressBar.Value = ((Timer - l_vTimer) / l_vlngErasingTime) * 100
DoEvents

Loop Until Timer >= (l_vTimer + l_vlngErasingTime) Or ProgressBar.Value = 100
ProgressBar.Value = 0

drive_OnDoneErase (True)

Else
m_vstrIzvestaj = m_vstrIzvestaj & "Korisnik je odabrao 'Brzo' brisanje tj. Erase CDRW medije" & vbNewLine

lst_Messages.AddItem "Zapoceto je 'Brzo' BRISANJE CD-RW medije. (Brise se samo zaglavlje)"
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If

l_vlngErasingTime = drive.CDRWErasingTime(True)
lst_Messages.AddItem "Procenjeno vreme brisanja je oko " & l_vlngErasingTime & "sec."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If

cmdErase.Enabled = False
cmdSnimi.Enabled = False

drive.EraseCDRW (True)

l_vTimer = Round(Timer, 0)
Do
ProgressBar.Value = ((Timer - l_vTimer) / l_vlngErasingTime) * 100
DoEvents

Loop Until Timer >= (l_vTimer + l_vlngErasingTime) Or ProgressBar.Value > 99
ProgressBar.Value = 0
drive_OnDoneErase (True)


End If
End If
Else
MsgBox " CDRW Medija ili CD-RW /DVD-RW uredaj nisu spremni", vbCritical, "Brisanje RW Medija"
End If

cmdErase.Enabled = True

End Sub

Private Sub cmdIzlaz_Click()
Unload Me
End Sub

Private Sub cmdOdustani_Click()
Frame5.Visible = False
Frame5.Enabled = False
cmdPrihvati.Enabled = False
cmdPrihvati.Value = False

cmdIzlaz.Enabled = True
cmdErase.Enabled = True

End Sub

Private Sub cmdPrekini_Click()
If MsgBox(" Da li ste stvarno sigurni da zelite da prekinete rezanje? " & Chr$(13) & _
" CD je posle toga neupotrebljiv!!!", vbCritical + vbYesNo, "Snimanje CD/DVD medija") = vbYes Then
nero.Abort


m_vstrIzvestaj = m_vstrIzvestaj & "Korisnik je nasilno prekinuo proces snimanja CD Medija!!!" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & "************************************************************************" & vbNewLine & vbNewLine

cmdIzlaz.Enabled = True
cmdErase.Enabled = True

cmdFolder.Enabled = True
cboBrzine.Enabled = True
txtRadniDir.Enabled = True
cmbRaspoloziviUredjaji.Enabled = True
cmdPrekini.Enabled = False
cmdSnimi.Enabled = True
cmdErase.Enabled = True

Set Folder = Nothing
Set drives = Nothing
Set drive = Nothing
Set isotrack = Nothing

End If

End Sub

Private Sub cmbRaspoloziviUredjaji_Change()
Dim l_vvarBrzine As Variant
Dim drives As INeroDrives
Set drives = nero.GetDrives(NERO_MEDIA_CDRW)
Set drive = drives(Val(Left$(cmbRaspoloziviUredjaji.Text, 1)))
With drive
l_vvarBrzine = .WriteSpeeds.BaseSpeedKBs

'AvailableSpeeds(NERO_ACCESSTYPE_WRITE).Item (1)
End With

End Sub


Private Sub cmdPrihvati_Click()
On Error GoTo Prihvati_error


m_vstrSTARTDrive = drvList.drive
m_vstrSTARTDir = dirList.Path

' if m_vstrSTARTDrive = nero.GetDrives(NERO_MEDIA_CDR)
If m_vstrSTARTDir <> txtRadniDir.Text Then

txtRadniDir.Text = m_vstrSTARTDir
g_vintBrojCD_a = 0

End If

m_vstrIzvestaj = m_vstrIzvestaj & "Taster prihvati direktorijum kliknut" & vbNewLine & _
"Odabrana je putanja: >>" & m_vstrSTARTDir & " " & Date$ & " " & Time$ & vbNewLine & _
"************************************************************************" & vbNewLine & vbNewLine


txtRadniDir.Visible = True

Frame5.Visible = False
Frame5.Enabled = False
cmdPrihvati.Enabled = False
cmdPrihvati.Value = False

cmdOdustani.Enabled = False
cmdOdustani.Visible = False

cmdSnimi.Enabled = True

cmdIzlaz.Enabled = True
cmdErase.Enabled = True

If (VelicinaDIR(m_vstrSTARTDir) + VelicinaDIR("c:\Admin_ASV")) > 650 Then
MsgBox "Nije moguce snimanje na CD medij" & Chr(13) & _
"Radni direktorijum ima vise od 650MB", vbCritical, "Snimanje CD/DVD medija"

m_vstrIzvestaj = m_vstrIzvestaj & "Problem!!!. Nije moguce snimanje na CD medij. Odabrana putanja: >>" & m_vstrSTARTDir & vbNewLine & _
"Ima kapacitet veci od fizicke velicine Cd medije tj. vise od 650MB" & m_vstrSTARTDir & " " & Date$ & " " & Time$ & vbNewLine & vbNewLine


Unload Me
Exit Sub
Else


If VelicinaDIR(m_vstrSTARTDir) > 640 Or g_vblnFolderPun Then
cmdSnimi.Enabled = True

ElseIf Day(Date) < 25 And Day(Date) > 8 Then
MsgBox "Nije moguce snimanje na CD medij" & Chr(13) & _
"Radni direktorijum se moze snimati samo pri kraju ili na pocetku meseca. Od 26-tog do 7. u narednom mesecu." & vbNewLine & "Ili ako je dostigao zapreminu CD Medije", vbCritical, "Snimanje CD/DVD medija"
cmdSnimi.Enabled = False
Unload Me
Exit Sub

End If

If Day(Date) >= 25 Or Day(Date) <= 8 Then

cmdSnimi.Enabled = True
End If

End If


Exit Sub
Prihvati_error:
MsgBox " Greska pri definisanju putanje, molim vas pokusajte ponovo", vbCritical, "Sistemska Greska"

m_vstrIzvestaj = m_vstrIzvestaj & "Greska pri definisanju putanje!. Nije moguce snimanje na CD medij." & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & vbNewLine

End Sub

Private Sub cmdSnimi_Click() ' Burns CD/CDRW...

Dim Source_Dir As String
Dim X As Boolean
Dim Temp
Dim fso As New FileSystemObject

On Error GoTo handle_error
Source_Dir = m_vstrSTARTDir

m_vstrIzvestaj = m_vstrIzvestaj & "Proces mesecnog snimanja CD Medije zapocet!" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & "************************************************************************" & vbNewLine & vbNewLine

m_vstrIzvestaj = m_vstrIzvestaj & "Radna putanja file sistema: >>" & Source_Dir & " " & vbNewLine
m_vstrIzvestaj = m_vstrIzvestaj & "CDRW Uredjaj: >> " & cmbRaspoloziviUredjaji.Text & " " & vbNewLine
m_vstrIzvestaj = m_vstrIzvestaj & "Odabrana brzina snimanja: >>" & cboBrzine.Text & " " & vbNewLine

' lst_Messages.Clear

cmdPrekini.Enabled = True
cmdSnimi.Enabled = False
cmdErase.Enabled = False

cmdFolder.Enabled = False
cboBrzine.Enabled = False
txtRadniDir.Enabled = False
cmbRaspoloziviUredjaji.Enabled = False

lst_Messages.Clear
cmdIzlaz.Enabled = False

If g_vintBrojCD_a >= 3 Then
MsgBox " Vec su uspesno snimljene 3 CD kopije istog sadrzaja!" & Chr$(13) & " Nije dozvoljeno dalje snimanje!", vbCritical, "Snimanje CD/DVD medija"

cmdIzlaz.Enabled = True
Exit Sub
Else

Set Folder = New NeroFolder
Set drives = nero.GetDrives(NERO_MEDIA_CDRW)
Set drive = drives(Val(Left$(cmbRaspoloziviUredjaji.Text, 1)))
Set isotrack = New NeroISOTrack

m_vstrBrzina = cboBrzine.Text

If ProveriPrazan Then
MsgBox "Nije prazan", vbInformation, "Snimanje CD/DVD medija"
End If

PripremamDir
'Kopiram
fso.CopyFolder "c:\Admin_ASV", Source_Dir & "\Admin_ASV", True

Call BuildFileFolderTree(Folder, fso.GetFolder(Source_Dir))

' Call BuildFileFolderTree(Folder, fso.GetFolder("c:\Admin_ASV"))

ProgressBar.Value = 0
If g_vstrNazivCDa = "" Then
If (Mid$(g_vstrRootDir, 4) <> Mid$(Source_Dir, InStrRev(Source_Dir, "\") + 1)) And (g_vstrRootDir <> "") Then

isotrack.Name = Mid$(g_vstrRootDir, 4)
Else
isotrack.Name = Mid$(Source_Dir, InStrRev(Source_Dir, "\") + 1)
End If

Else
isotrack.Name = g_vstrNazivCDa
isotrack.VolumeSet = g_vstrNazivCDa
End If


isotrack.RootFolder = Folder
isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET + NERO_BURN_OPTION_RELAX_JOLIET + NERO_BURN_OPTION_USE_MODE2 + NERO_BURN_OPTION_USE_ALLSPACE

'>>>>> Postavljamo copy right informacije CD-a <<<<

isotrack.Copyright = "2004® DDOR " & Chr(34) & "Novi Sad" & Chr(34) & " AD"
isotrack.DataPreparer = g_vstrUserName & " PC:" & g_vstrImeServer
isotrack.Application = "Arhiviranje_Steta_Na_Vozilima"
isotrack.Publisher = "2004® DDOR " & Chr(34) & "Novi Sad" & Chr(34) & " AD"

'>>>>> Fakticki potvrdjujemo pravi naziv CD-a <<<<
g_vstrNazivCDa = isotrack.Name

If drive.Capabilities And NERO_CAP_BUF_UNDERRUN_PROT Then

m_vstrIzvestaj = m_vstrIzvestaj & "CDRW Uredjaj: >> " & cmbRaspoloziviUredjaji.Text & " Podrzava BUFFER UNDER RUN tehnologiju i bice ukljucena" & vbNewLine

'drive.BurnIsoAudioCD "DDOR Novi Sad", g_vstrNazivCDa, False, isotrack, Nothing, Nothing, NERO_BURN_FLAG_CLOSE_SESSION + NERO_BURN_FLAG_BUF_UNDERRUN_PROT + NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_VERIFY, Round(Val(m_vstrBrzina), 0), NERO_MEDIA_CD

drive.BurnIsoAudioCD "DDOR Novi Sad AD", g_vstrNazivCDa, False, isotrack, Nothing, Nothing, _
NERO_BURN_FLAG_DAO + NERO_BURN_FLAG_CLOSE_SESSION + NERO_BURN_FLAG_DISABLE_ABORT + NERO_BURN_FLAG_BUF_UNDERRUN_PROT + NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_VERIFY + NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW, _
Round(Val(m_vstrBrzina), 0), NERO_MEDIA_CDR


Else

m_vstrIzvestaj = m_vstrIzvestaj & "CDRW Uredjaj: >> " & cmbRaspoloziviUredjaji.Text & " NE Podrzava BUFFER UNDER RUN tehnologiju i bice ukljucena samo verifikacija" & vbNewLine

drive.BurnIsoAudioCD "DDOR Novi Sad AD", g_vstrNazivCDa, False, isotrack, Nothing, Nothing, _
NERO_BURN_FLAG_CLOSE_SESSION + NERO_BURN_FLAG_DISABLE_ABORT + NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_VERIFY + NERO_BURN_FLAG_DETECT_NON_EMPTY_CDRW, _
Round(Val(m_vstrBrzina), 0), NERO_MEDIA_CDRW


End If

End If
Set fso = Nothing

Exit Sub
handle_error:
MsgBox " Greska u toku sesije snimanja CD medije, molim vas pokusajte ponovo", vbCritical, "Sistemska Greska"
lst_Messages.AddItem Err.Description + nero.LastError
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
Set fso = Nothing
quit:
End Sub

Private Sub DirList_LostFocus()

dirList.Path = dirList.List(dirList.ListIndex)

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)
If Not SplitText(Text) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If
End Sub
Private Sub drive_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR)
Dim strMessages As String
If Not SplitText(nero.ErrorLog) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If
If Not SplitText(nero.LastError) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If

strMessages = "Snimanje zavrseno "

If StatusCode <> NEROLib.NERO_BURN_OK Then
strMessages = strMessages + "NE Uspesno (" & StatusCode & ")"

m_vstrIzvestaj = m_vstrIzvestaj & "CDRW Uredjaj: >> " & cmbRaspoloziviUredjaji.Text & " SNIMANJE ZAVRSENO NEUSPESNO!!!" & vbNewLine & _
strMessages & " " & Date$ & " " & Time$ & vbNewLine & "************************************************************************" & vbNewLine & vbNewLine
Else
strMessages = strMessages + "Uspesno"
g_vintBrojCD_a = g_vintBrojCD_a + 1
MsgBox " Uspesno snimljen " & g_vintBrojCD_a & " cd po redu! " & Chr$(13) & " Ubacite Prazan CD i pritisnite ", vbSystemModal, "Snimljen CD"

' Proveravao da li je i koji je cd po redu

If g_vintBrojCD_a > 2 Then
g_vblnUspesnoSnimljenCD3 = True

' Snimljena su 3 CD-a pa bi bi to bilo to
cmdSnimi.Enabled = False

Unload Me
Exit Sub

End If

m_vstrIzvestaj = m_vstrIzvestaj & "CDRW Uredjaj: >> " & cmbRaspoloziviUredjaji.Text & " SNIMANJE ZAVRSENO USPESHNO!!!" & vbNewLine & _
"Uspesno snimljen " & g_vintBrojCD_a & " cd po redu! " & Date$ & " " & Time$ & vbNewLine & "************************************************************************" & vbNewLine & vbNewLine

End If

lst_Messages.AddItem strMessages

If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If

cmdPrekini.Enabled = False
cmdFolder.Enabled = True
cmdSnimi.Enabled = True
cmdIzlaz.Enabled = True
cmdErase.Enabled = True


' Brišemo i praznimo objekte kako bi mogli opet da se iskoriste.

Set Folder = Nothing
Set drives = Nothing
Set drive = Nothing
Set isotrack = Nothing

ProgressBar.Value = 0


End Sub

Private Sub drive_OnDoneCDInfo(ByVal pCDInfo As NEROLib.INeroCDInfo)

If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub

Private Sub drive_OnDoneErase(Ok As Boolean)
ProgressBar.Value = 100
lst_Messages.AddItem "Zavrseno BRISANJE CD-RW medije."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
MsgBox " Zavrseno brisanje CD RW medije", vbInformation, "Snimanje CD/DVD medija"
m_vstrIzvestaj = m_vstrIzvestaj & " Zavrseno brisanje CD RW medije" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine
cmdSnimi.Enabled = True

End Sub

Private Sub drive_OnDoneEstimateTrackSize(ByVal bOk As Boolean, ByVal BlockSize As Long)
lst_Messages.AddItem "Vlicina CD file sistema je oko: " & BlockSize
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
MsgBox "Vlicina CD file sistema je oko: " & BlockSize, vbInformation, "Snimanje CD/DVD medija"
m_vstrIzvestaj = m_vstrIzvestaj & "Vlicina CD file sistema je oko: " & BlockSize & vbNewLine & _
Date$ & " " & Time$ & vbNewLine
End Sub

Private Sub drive_OnDoneWaitForMedia(Success As Boolean)
lst_Messages.AddItem "Zavrsen period cekanja na mediju."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
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)
If Not SplitText(Text) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If
End Sub

Private Sub drvList_Change()
On Error GoTo DriveHandler
dirList.Path = drvList.drive
Exit Sub

DriveHandler:
drvList.drive = dirList.Path
Exit Sub
End Sub



Private Sub Form_GotFocus()

frmSnimanjeCDA.Refresh

End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
' if KeyAscii = then
' KeyAscii = SamoCifre(KeyAscii)
' End If
End Sub

Private Sub Form_Load()
On Error GoTo Form_loaderror

'Iz inicijalizacije prosledjujemo root folder
txtRadniDir.Text = g_vstrRootDir
'*********** Uspesno Snimljen CD

Form_Activate

Exit Sub

Form_loaderror:
Unload Me
End Sub


Private Sub nero_OnDisconnect(Response As NEROLib.NERO_RESPONSE)
lst_Messages.AddItem "CD/DVD-RW Uredjaj se diskonektovao"
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub


Private Sub nero_OnMegaFatal()
lst_Messages.AddItem "Mega fatalna greska se dogodila."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub

Private Sub nero_OnNonEmptyCDRW(Response As NEROLib.NERO_RESPONSE)
lst_Messages.AddItem "CD-RW Nije Prazan!"
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
Response = NERO_RETURN_EXIT

m_vstrIzvestaj = m_vstrIzvestaj & "CD-RW Nije Prazan!" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & vbNewLine


cmdErase.Enabled = True
cmdErase.Value = True
End Sub

Private Sub nero_OnRestart()

lst_Messages.AddItem "Sistem se restartovao."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub

Private Sub nero_OnWaitCD(WaitCD As NEROLib.NERO_WAITCD_TYPE, WaitCDLocalizedText As String)

MsgBox "Molim vas ubacite prazan CD medij u uredjaj!", vbCritical, "Snimanje CD/DVD medija"
If Not SplitText(WaitCDLocalizedText) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If
lst_Messages.AddItem "Molim vas ubacite prazan CD"

m_vstrIzvestaj = m_vstrIzvestaj & "Korisnik zamoljen da ubaci Prazan CD-RW!" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine
End Sub

Private Sub nero_OnWaitCDDone()
lst_Messages.AddItem "Snimanje na CD je Zavrseno."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If

End Sub

Private Sub nero_OnWaitCDMediaInfo(LastDetectedMedia As NEROLib.NERO_MEDIA_TYPE, LastDetectedMediaName As String, RequestedMedia As NEROLib.NERO_MEDIA_TYPE, RequestedMediaName As String)
lst_Messages.AddItem "Cekam odredjeni tip medije:"
If Not SplitText(RequestedMediaName) Then
MsgBox "Error Splitting Message Data!", vbCritical, "Snimanje CD/DVD medija"
End If
End Sub

Private Sub nero_OnWaitCDReminder()
lst_Messages.AddItem "Jos uvek cekam na CD..."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub

Private Sub PripremamDir()
lst_Messages.AddItem "Kreiranje CD file sistema u toku..."
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If

m_vstrIzvestaj = m_vstrIzvestaj & "Kreiranje CD file sistema u zapoceto toku..." & vbNewLine & _
Date$ & " " & Time$ & vbNewLine

End Sub

Private Sub Form_Activate()
Dim l_vintIndex As Integer
Dim l_vintIndex1 As Integer
Dim l_vstrDrive As String
Dim l_vintCboIndex As Integer
Dim CDDrives As NeroDrives

On Error GoTo Form_Initialize_error

g_vblnNEMACDRW = False

m_vstrIzvestaj = ""
m_vstrIzvestaj = m_vstrIzvestaj & " *****************************************************" & vbNewLine & _
" Pocetak rada na snimanju mesecne CD sesije" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine


ProgressBar.Value = 0
lst_Messages.Clear
Call MeniOnemogucen(False)

'Iz inicijalizacije prosledjujemo root folder
txtRadniDir.Text = g_vstrRootDir
'*********** Uspesno Snimljen CD

'Postavljamo proveru uspenosti rezanja na false
If g_vblnUspesnoSnimljenCD3 And g_vblnInicijalizovana Then
g_vblnUspesnoSnimljenCD3 = False
' g_vintBrojCD_a = 0
ElseIf g_vintBrojCD_a > 0 Then
MsgBox "Potrebno je da snimite jos " & g_vintBrojCD_a - 3 & " CD kopije", vbInformation, "Snimanje CD/DVD medija"
Else
g_vintBrojCD_a = 0
g_vblnUspesnoSnimljenCD3 = False
End If


ProgressBar.Value = 0
g_vintBrojCD_a = 0
l_vintCboIndex = 0
l_vstrDrive = ""
strMessages = ""
cmdIzlaz.Enabled = True

'*********** Inicijalizacija CD uredjaja
cmbRaspoloziviUredjaji.Clear
Set nero = New nero
Set CDDrives = nero.GetDrives(NERO_MEDIA_CDRW)
' MsgBox " Nadjen je: " & CDDrives(0).DeviceName & " i spreman je= " & CDDrives(0).DeviceReady, vbInformation, "Status CD Uredjaj"
''*********** spisak raspolozivih CD-RW uredjaja

If CDDrives.Count > 0 Then
For l_vintIndex = 0 To CDDrives.Count - 1
l_vstrDrive = CDDrives(l_vintIndex).DeviceName
If InStr(1, l_vstrDrive, "DVD-RW", vbTextCompare) Or InStr(1, l_vstrDrive, "RW", vbTextCompare) _
Or InStr(1, l_vstrDrive, "CD-RW", vbTextCompare) Or InStr(1, l_vstrDrive, "COMBO", vbTextCompare) Or InStr(1, l_vstrDrive, "LTR", vbTextCompare) Then

cmbRaspoloziviUredjaji.AddItem l_vintIndex & " " & CDDrives(l_vintIndex).DeviceName, l_vintCboIndex

l_vstrDrive = ""
l_vintCboIndex = l_vintCboIndex + 1

End If
Next
Else
MsgBox "Nema raspolozivih CD-R/CD-RW/DVD-RW uredjaja!!!", vbCritical, "Detekcija CD/DVD-RW Uredjaja"
g_vblnNEMACDRW = True 'Nema raspolozivih CD-R/CD-RW/DVD-RW uredjaja

Exit Sub

End If
cboBrzine.Clear

For l_vintIndex1 = 0 To 5

Select Case l_vintIndex1
Case 0
cboBrzine.AddItem "4", l_vintIndex1
Case 1
cboBrzine.AddItem "8", l_vintIndex1
Case 2
cboBrzine.AddItem "10", l_vintIndex1
Case 3
cboBrzine.AddItem "12", l_vintIndex1
Case 4
cboBrzine.AddItem "16", l_vintIndex1
Case 5
cboBrzine.AddItem "24", l_vintIndex1
End Select
cboBrzine.Text = "8"
Next

cmbRaspoloziviUredjaji.ListIndex = 0

Exit Sub

Form_Initialize_error:
If l_vintCboIndex < 1 Then
MsgBox "Nema raspolozivih CD-R/CD-RW/DVD-RW uredjaja!!!", vbCritical, "Detekcija CD/DVD-RW Uredjaja"
g_vblnNEMACDRW = True 'Nema raspolozivih CD-R/CD-RW/DVD-RW uredjaja

Exit Sub
Else
MsgBox "Doslo je do sistemske greshke :" & Err.Number & " " & Err.Description & vbNewLine & " pri inicijalizaciji CD-RW uredjaja", vbCritical, "Detekcija CD/DVD-RW Uredjaja"
Exit Sub
End If
End Sub
Private Sub MeniOnemogucen(ByVal v_blnOmoguceno)


With frmGlavnaMDI
.mnuInicijalizuj.Visible = v_blnOmoguceno

.mnuUnos.Visible = v_blnOmoguceno

.mnuPostojeciPodaci.Visible = v_blnOmoguceno
.mnuSnimanjeCD.Visible = v_blnOmoguceno

.mnuIzlaz.Enabled = v_blnOmoguceno
.mnuIzlaz.Visible = v_blnOmoguceno
.stbInfo.Visible = v_blnOmoguceno
.mnuPraz1.Visible = v_blnOmoguceno
.mnuPraz1.Enabled = False

.mnuIzvestaji.Visible = v_blnOmoguceno

.mnuPomoc.Enabled = v_blnOmoguceno
.mnuPomoc.Visible = v_blnOmoguceno

.mnuAdministracija.Visible = v_blnOmoguceno

.mnuOdjavaKorisnika.Enabled = v_blnOmoguceno
.mnuOdjavaKorisnika.Visible = v_blnOmoguceno

.Enabled = v_blnOmoguceno

End With

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

On Error GoTo errorUnload
'
' GlavniMeni True
If Not g_vblnNEMACDRW Then
If MsgBox("Da li ste sigurni da zelite da izadjete iz programa za snimanje CD-a (yes - DA)", vbYesNo, "Snimanje CD/DVD medija") = vbYes Then

If g_vintBrojCD_a > 1 And g_vblnUspesnoSnimljenCD3 Then

Cancel = False
UnloadMode = True

Set nero = Nothing
Set drive = Nothing
Set drives = Nothing
Set Folder = Nothing
Set isotrack = Nothing
Set file = Nothing

MsgBox " Posle uspesno zavrsene sesije snimanja CD-a, potrebno je inicijalizovati novu File-strukturu. ", vbInformation, "Snimanje CD/DVD medija"

Call MeniOnemogucen(True)
frmGlavnaMDI.WindowState = vbMinimized
frmGlavnaMDI.WindowState = vbMaximized
DoEvents

frmInicijalizacija.Show
frmInicijalizacija.cmdOK.SetFocus
DoEvents

' frmInicijalizacija.txtIme.Text = ""

Else
Cancel = False
UnloadMode = True

Set nero = Nothing
Set drive = Nothing
Set drives = Nothing
Set Folder = Nothing
Set isotrack = Nothing
Set file = Nothing

Call MeniOnemogucen(True)
frmGlavnaMDI.WindowState = vbMinimized
frmGlavnaMDI.WindowState = vbMaximized
DoEvents


End If
Else
Cancel = True
UnloadMode = False
End If
Else
Cancel = False
UnloadMode = True

Set nero = Nothing
Set drive = Nothing
Set drives = Nothing
Set Folder = Nothing
Set isotrack = Nothing
Set file = Nothing

End If

Exit Sub

errorUnload:
Cancel = False
UnloadMode = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Unload_kraj

m_vstrIzvestaj = m_vstrIzvestaj & " *****************************************************" & vbNewLine & _
" Kraj rada na snimanju mesecne CD sesije" & vbNewLine & _
Date$ & " " & Time$ & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine

If KreirajLogFile(g_cstrDnevniLogFile, m_vstrIzvestaj) Then
g_vstrLogFile = g_vstrLogFile & vbNewLine & m_vstrIzvestaj
End If

Unload Me
Exit Sub

Unload_kraj:

Exit Sub

End Sub


Private Sub Form_Terminate()
On Error GoTo Unload_Terminate

Unload Me

Unload_Terminate:
Exit Sub
End Sub

Or see:

http://club.cdfreaks.com/showthread.php?t=84858

or

http://club.cdfreaks.com/showthread.php?t=116409

Mike