Club CDFreaks - Knowledge is Power - View Single Post - How to burn a folders tree in a data cd with NeroCOM

Jovan · 14-12-2004

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

14-12-2004	#8 (permalink)
Jovan New on Forum Join Date: Dec 2004 Location: Serbia & Montenegro Posts: 7	Re: How to burn a folders tree in a data cd with NeroCOM 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