Hi !
Can I burn files to CD/DVD drive ?
//****
FUNCTION BurnCDInXP()
//****
LOCAL cBurnPath
//
IF ( oCD := XPBurnObj() ) != NIL )
oFSO := CreateObject( "Scripting.FileSystemObject" ) // If we get here we're in XP and this shouldn't fail...
//
WITH OBJECT ( oCD )
:ClearFiles() // Erases ALL files from burning area...
//
MakeDir( cBurnPath := ( :BurnArea + "\Backup" ) ) // Build your directory structure...
MakeDir( cBurnPath += "\companyname" )
//
:AddFile( "c:\yourfile.ext" ) // This method add the file to the root of the CD..
oFSO:CopyFile( "u:\yourfile.zip", cBurnPath + "\backup.ext" )
// Copy to the directory you just created...
//
:StartBurn() // Invokes the XP Burning wizard...
END
ENDIF
//
RETURN (.T.)
//***
FUNCTION XPBurnObj()
//***
LOCAL oBurn
//
IF Os_IsWinXP()
TRY
oBurn := CreateObject( "BaydenBurn.XPBurn" )
IF !( oBurn:Equipped )
oBurn := NIL
ENDIF
CATCH
END
ENDIF
//
RETURN ( oBurn )
#include "hbclass.ch"
#include "classex.ch"
#define NERO_MEDIA_CD 1
#define NERO_MEDIA_CDRW 129
#define NERO_MEDIA_CDR 257
#define NERO_MEDIA_DVD_ANY 262172
#define NERO_AUDIO_TRACK_FILE_MP3 2
#define NERO_BURN_OPTION_USE_JOLIET 1
#define NERO_BURN_OPTION_CREATE_ISO_FS 8
#define NERO_BURN_FLAG_SIMULATE 2
#define NERO_BURN_FLAG_WRITE 4
CLASS NeroBurnCD
//****
CLASSDATA nInstance INIT 0
DATA oNero INIT NIL
DATA lNero INIT .F.
DATA oNeroDrives INIT NIL
DATA oNeroISOTrack INIT NIL
DATA aDrives INIT {}
DATA oNeroBurn INIT NIL
DATA oNeroFolder INIT NIL
DATA nDriveActive INIT 0
DATA cType INIT 0
DATA aFiles INIT {}
DATA aNeroFiles INIT {}
DATA oLastError INIT NIL
DATA aErrors INIT {}
ACCESS lBurnersOK INLINE ( LEN( ::aDrives ) > 0 )
ACCESS lNeroOK INLINE ( ::oLastError = NIL .AND. EMPTY(
::aErrors ) )
ACCESS EnableOverBurn INLINE IF( ::lNero, ::oNero:EnableOverBurn,
.F. )
ASSIGN EnableOverBurn( l ) INLINE IF( ::lNero, ::oNero:EnableOverBurn :=
l, NIL )
ACCESS DVDOverburnSize INLINE IF( ::lNero, ::oNero:DVDOverburnSize,
0 )
ASSIGN DVDOverburnSize( n ) INLINE IF( ::lNero, ::oNero:DVDOverburnSize
:= n, NIL )
METHOD New() CONSTRUCTOR
METHOD CreateAlbum() INLINE ::CreateNeroObj( "A" )
METHOD AddMP3( cFileName, cArtist, cTitle ) INLINE ::AddNewFile( "A",
cFileName, cArtist, cTitle )
METHOD CreateISOTrack( cTitle, rootFolder )
METHOD SetCDLabel( cTitle ) INLINE ::CreateISOTrack(
cTitle )
METHOD SetRootFolder( rootFolder ) INLINE ::CreateISOTrack(,
rootFolder )
METHOD CreateFolder() INLINE ::CreateNeroObj( "F" )
METHOD AddFile( cFileName ) INLINE ::AddNewFile( "F",
cFileName )
METHOD BurnCD( nSpeed, cArtist, cTitle )
METHOD GetFolder() INLINE ( ::oNeroFolder )
METHOD NeroInstalled() INLINE ( ::lNero )
METHOD GetDrives()
METHOD GetErrors() INLINE ( ::aErrors )
METHOD IsDeviceReady() INLINE IF( ::oNeroBurn = NIL,
.F., ::oNeroBurn:DeviceReady )
METHOD SetDriveToBurn( nDrive )
METHOD Destroy()
HIDDEN:
METHOD CreateNeroObj( cObj )
METHOD AddNewFile( cObj, cFileName, cArtist, cTitle )
ENDCLASS
//****
METHOD New() CLASS NeroBurnCD
//****
LOCAL i
//
::lNero := .F.
IF ( ++ ::nInstance > 1 )
RETURN Self
ENDIF
TRY
::oNero := GetActiveObject( "Nero.Nero" )
CATCH
TRY
::oNero := TOleAuto():new( "Nero.Nero" )
CATCH
::oNero := NIL
END
END
IF ( ::lNero := ( ::oNero != NIL ) )
::EnableOverburn := .F.
::DVDOverburnSize := 0
ENDIF
//
RETURN Self
//****
METHOD GetDrives()
//****
TRY
::oNeroDrives := ::oNero:GetDrives( NERO_MEDIA_CDRW +
NERO_MEDIA_DVD_ANY )
FOR i := 0 TO ::oNeroDrives:Count - 1
AADD( ::aDrives, ::oNeroDrives:Item( i ):DeviceName )
NEXT
::nDriveActive := 0
CATCH oError
::oLastError := oError
AADD( ::aErrors, oError:Description + " (" + ::oNero:LastError + ")" )
END
//
RETURN Self
//****
METHOD SetDriveToBurn( nDrive )
//****
TRY
::nDriveActive := nDrive - 1
::oNeroBurn := ::oNeroDrives:Item( ::nDriveActive )
ALERT( ::oNeroBurn:DeviceName + " activado !!!" )
CATCH oError
::oLastError := oError
AADD( ::aErrors, oError:Description + " (" + ::oNero:LastError + ")" )
::nDriveActive := 0
::oNeroBurn := NIL
END
//
RETURN Self
//****
METHOD CreateNeroObj( cObj )
//****
TRY
SWITCH cObj
CASE "F"
::oNeroFolder := TOleAuto():new( "Nero.NeroFolder" )
EXIT
CASE "A"
::oNeroFolder := TOleAuto():new( "Nero.NeroAudioTracks" )
EXIT
END
::cType := cObj
CATCH oError
::oLastError := oError
AADD( ::aErrors, oError:Description + " (" + ::oNero:LastError + ")" )
END
//
RETURN Self
//****
METHOD AddNewFile( cObj, cFileName, cArtist, cTitle )
//****
LOCAL oFile
//
TRY
IF ( ::oNeroFolder = NIL )
ALERT( "Cree el 'RootFolder' antes de añadir archivos !!!" )
BREAK
ENDIF
IF ( cFileName IN ::aFiles )
BREAK
ENDIF
IF FILE( cFileName )
SWITCH cObj
CASE "F"
oFile := TOleAuto():new( "Nero.NeroFile" )
oFile:Name := SUBSTR( cFileName, RAT("\",cFileName)+1 )
oFile:SourceFilePath := cFileName
EXIT
CASE "A"
oFile := TOleAuto():new( "Nero.NeroAudioTrack" )
oFile:Artist := IF( cArtist = NIL, "", cArtist )
oFile:Title := IF( cTitle = NIL, "", cTitle )
oFile:TrackType = NERO_AUDIO_TRACK_FILE_MP3
oFile:FileName := cFileName
EXIT
END
//
AADD( ::aFiles, cFileName )
AADD( ::aNeroFiles, oFile )
SWITCH cObj
CASE "F"
::oNeroFolder:Files:Add( oFile )
EXIT
CASE "F"
::oNeroFolder:Add( oFile )
EXIT
END
ELSE
ALERT( "El archivo '" + cFileName + "' no existe !!!" )
ENDIF
CATCH oError
::oLastError := oError
AADD( ::aErrors, oError:Description + " (" + ::oNero:LastError + ")" )
END
//
RETURN Self
//****
METHOD CreateISOTrack( cTitle, rootFolder )
//****
TRY
IF ( ::oNeroISOTrack = NIL )
::oNeroISOTrack := TOleAuto():new( "Nero.NeroISOTrack" )
::oNeroISOTrack:BurnOptions := ;
NERO_BURN_OPTION_CREATE_ISO_FS +
NERO_BURN_OPTION_USE_JOLIET
ENDIF
IF ( cTitle != NIL )
::oNeroISOTrack:name := cTitle
ENDIF
IF ( rootFolder != NIL ) // Has to be a Nero.Folder
object...
::oNeroISOTrack:RootFolder := rootFolder
ENDIF
CATCH oError
::oLastError := oError
AADD( ::aErrors, oError:Description + " (" + ::oNero:LastError + ")" )
END
//
RETURN Self
//****
METHOD BurnCD( nSpeed, cArtist, cTitle )
//****
TRY
::oNeroBurn:WaitForMedia( NERO_MEDIA_CD, ;
NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE,
NIL )
ALERT( "WaitForMedia" )
END
/*::oNeroBurn:UpdateDeviceInfo( NERO_MEDIA_CD )
ALERT( ::oNeroBurn:DeviceName )
ALERT( ::oNeroBurn:DeviceReady )
ALERT( ::oNeroBurn:DriveLetter )
ALERT( ::oNeroBurn:HostAdapterName ) */
//IF ::IsDeviceReady()
SWITCH ::cType
CASE "F"
::oNeroBurn:BurnIsoAudioCD( cArtist, cTitle, .F., ::oNeroISOTrack,
NIL, NIL, ;
NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, nSpeed,
NERO_MEDIA_CD )
EXIT
CASE "A"
::oNeroBurn:BurnIsoAudioCD( cArtist, cTitle, .F., NIL,
::oNeroFolder, NIL, ;
NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, nSpeed,
NERO_MEDIA_CD )
EXIT
END
//ELSE
// ALERT( "Falta configurar algo o la unidad no esta lista !!!" )
//ENDIF
::oNeroBurn:EjectCD()
::oNeroBurn:LoadCD()
//
RETURN Self
//****
METHOD Destroy()
//****
::lNero := .F.
::oNeroDrives := NIL
::oNeroISOTrack := NIL
::aDrives := {}
::oNeroBurn := NIL
::oNeroFolder := NIL
::aErrors := {}
::oNero := NIL
//
RETURN Self
#include "FiveWin.ch"
#define HKEY_CURRENT_USER 0x80000001
function Main()
local oCDRec := TCDRec():New()
local oReg32, cValue
MsgInfo( oCDRec:IsAvailable() )
MsgInfo( oCDRec:GetDrive() )
oReg32 = TReg32():New( HKEY_CURRENT_USER,;
"Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders" )
oReg32:Get( "CD Burning", @cValue )
MsgInfo( cValue )
oReg32:Close()
// MsgInfo( oCDRec:GetPath() )
// aqui llamar al método addfile por cada fichero
oCDRec:Burn()
oCDRec:End()
MsgInfo( "ok" )
return nil
CLASS TCDRec
DATA hCD
DATA aFiles
METHOD New()
METHOD AddFile( cFile ) VIRTUAL
METHOD GetSize() VIRTUAL
METHOD IsAvailable() INLINE CDAvailable( ::hCD )
METHOD GetDrive() INLINE CDDrive( ::hCD )
METHOD GetPath() INLINE CDGetPath()
METHOD Burn( hWnd ) INLINE CDBurn( ::hCD )
METHOD End() INLINE CoUninitialize()
ENDCLASS
METHOD New() CLASS TCDRec
CoInitialize()
::hCD = CDInit()
::aFiles := {}
return Self
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 85 guests