Zdar a silu Petr, dna 01.10.2003 si napisal(a):
> Miro, podej prosim jeste report, jak se to chova, kdyz to narazi na
> chybu
> na CD (soubor nejde precist).
> Dovoli to preskocit soubor? Nebo to cely "spadne" a dal uz nekopiruje? Lze
> pak kopirovat dalsi CD, nebo se to musi pustit znovu?
> -pp21-
Kedze to vcera nepreslo tu je druha verzia, kt nepotrebuje ziadne externe exe
A pise log subor.
Len ma jednu chybicku krasy: pred spustenim musi byt nejake cd zasunute v
mechanike
Je to napisane pre win XP s WMP 9.0 ale malo by to ist aj s WMP 7.0
'********************* start cut **********************************
Set MyShell=Wscript.CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oWMP = CreateObject("WMPlayer.OCX")
dim cesta , errmessage
otvor_spusti
oWMP.Close
Set oWMP = Nothing
sub otvor_spusti
oWMP.cdromCollection.Item(0).Eject
oWMP.URL = "c:\WINDOWS\Media\Windows XP Startup.wav"
response = msgbox ("LOAD New CD and start COPY?",4)
if response = 6 then
oWMP.cdromCollection.Item(0).Eject
premenne=split(ShowDriveList,";")
myDay = day(now)
if len(myDay)< 2 then myDay= "0" & myDay
myMonth=month(now)
if len(myMonth)< 2 then myMonth= "0" & myMonth
myYear =year(now)
myTime = replace(time,":","")
if len(myTime)< 6 then myTime= "0" & myTime
cas = myYear & "_" & myMonth & "_" & myDay & "_" _
& myTime & "_"
'tu treba prepisat cestu'
cesta = "c:\temp\" & cas & premenne(1) & "\"
MyShell.run _
"xcopy " & premenne(0) & ":\ " & chr(34) & _
cesta & chr(34) & " /t /e ",0,True
CopyRutine(premenne(0) & ":\ ")
Set myLog = fso.OpenTextFile _
(cesta & "Logfile.log", 2, True)
if errmessage ="" then
myLog.Write "Copying successful"
else
myLog.Write errmessage
end if
Set myLog = nothing
errmessage =""
otvor_spusti
end if
end sub
sub CopyRutine(myDir)
Set f = fso.GetFolder(myDir)
for each myFldt in f.SubFolders
CopyRutine myFldt
next
for each su in f.Files
on error resume next
fso.CopyFile su, cesta & right(su,len(su)-3) _
, TRUE
if err.number > 0 then
errmessage = errmesage & "file:" & su & _
"not copied" & vbcrlf
err.clear
end if
next
end sub
Function ShowDriveList
Set dc = fso.Drives
For Each d in dc
n = ""
If d.DriveType = 4 then
do while d.IsReady = false
loop
s = d.DriveLetter & ";"
n = d.VolumeName
exit for
End If
Next
ShowDriveList = s & n
End Function
'********************* end cut ************************************
s pozdravom
AleXXX
--
Ked budem velky budem ZÁMYSELNIK.
Neviem co to je, ale znie to bohovo.
This archive was generated by hypermail 2.1.3 : 02. 10. 2003, 09:22 CEST