http://dieseyer.de • all rights reserved • © 2011 v11.4
'v4.9********************************************************
' File: hdd-test-kopieren.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Zum Testen der Festplatte bzw. der Datenübertragung (auch
' im Netz) werden Daten aus einem Verzeichnis in ein anderes
' kopiert - die Lesegeschwindigkeit spielt also auch eine
' Rolle.
'************************************************************
' Option Explicit
Dim fso, WSHShell, ShellAppl, Daten, LaufWerk, i, FileOut, Text, TextX
Dim Menge, LwFrei, Nr, ZielVerz, ZielLw, Zeit, Zeit2, MaxTst
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Daten = "C:\copy-tst"
Daten = "C:\cc-tst"
Daten = "C:\temp"
Daten = "C:\DRVS"
Daten = "C:\DRVS"
Daten = "C:\tester"
Daten = "C:\daten.tst"
Daten = "D:\TOOLS"
ZielVerz = "c:\1-tst-"
ZielVerz = "d:\1-tst-"
ZielVerz = "c:\1-tst-"
ZielLw = ""
ZielLw = "V:" ' bei RAM-Disk = V:
ZielLw = ""
MaxTst = 999
LaufWerk = fso.GetDriveName( ZielVerz )
Text = " "
'Wenn ZielLaufWerk doch keine RAM-Disk ist:
' if not FSO.GetDrive(ZielLW).DriveType = 5 then ZielLw = ""
' ZielLw kann eine RAM-Disk sein
If fso.DriveExists(ZielLw) then
if not fso.FolderExists( Daten ) then
wshshell.Popup "Das Verzeichnis " & Daten & " mit den Daten, die kopiert werden sollen, existiert nicht!" , 10, WScript.ScriptName , 32+16
WScript.Quit
End If
' Wenn es das Daten-Verzeichnis gibt, soll es gelöscht werden
' If fso.FolderExists( Left(ZielLw, 2) & Mid(Daten, 3) ) then fso.DeleteFolder(Left(ZielLw, 2) & Mid(Daten, 3) ), true
' Das Daten-Verzeichnis bis zum Überquellen füllen, wenn es sich auf der RAM-Disk befindet
Text = ""
If not fso.FolderExists( Left(ZielLw, 2) & Mid(Daten, 3) ) then
Text = " "
ShellFolderCopy Daten, Left(ZielLw, 2) & Mid(Daten, 3)
If not Text = "" Then
MsgBox "Fehler beim Füllen des Daten-Verzeichnis!" & vbCRLF & vbCRLF & Text & vbCRLF & vbCRLF & ". . . das ist das Ende!", , WScript.ScriptName
WScript.Quit
End If
End If
Daten = Left(ZielLw, 2) & Mid(Daten, 3)
End If
ParamAbfrage ' Function Aufruf
If Len(Daten) < 4 then
wshshell.Popup "Als Quelle für die Daten, die kopiert werden sollen, muss ein Verzeichnis angegeben werden!" , 10, WScript.ScriptName , 32+16
WScript.Quit
End If
if not fso.FolderExists( Daten ) then
wshshell.Popup "Das Verzeichnis " & Daten & " mit den Daten, die kopiert werden sollen, existiert nicht!" , 10, WScript.ScriptName , 32+16
WScript.Quit
End If
Menge = CLng(FormatNumber(fso.GetFolder( Daten ).size/1024/1024, 1))
Text = "Die Dateien im Verzeichnis " & Daten & " (" & Menge & "MB) " & vbCRLF
Text = Text & "werden jetzt " & MaxTst & " mal nach " & ZielVerz & " kopiert " & vbCRLF
Text = Text & "oder bis dort nur noch " & Menge * 2 & " MB frei sind. "
If vbNo = wshshell.Popup (Text , 10, WScript.ScriptName, 32 + 4 ) then
wshshell.Popup " . . . denn eben nicht!" , 10, WScript.ScriptName , 64
WScript.Quit
End If
if not fso.FolderExists(ZielVerz) Then
fso.CreateFolder(ZielVerz)
End If
i=0
LogDatei vbCRLF & now()
LogDatei " " & CLng(FormatNumber(fso.GetFolder( Daten ).size /1024/1024, 0)) & "MB von " & Daten & " nach " & ZielVerz
Menge = CLng(FormatNumber(fso.GetFolder( Daten ).size /1024/1024, 0))
Zeit = now()
Do
LwFrei = CDbl(FormatNumber(fso.GetDrive ( fso.GetDriveName( ZielVerz ) ).FreeSpace/1024/1024, 1))
' genügend Speicher frei?
if LwFrei > (2.00 * Menge) then
if i > 998 then Exit Do
if i > MaxTst - 1 then Exit Do
i = i + 1
nr = i
if Len(CStr(nr)) = 1 then nr = "0" & nr
if Len(CStr(nr)) = 2 then nr = "0" & nr
' if Len(CStr(nr)) = 3 then nr = "0" & nr
Zeit = Zeit - now()
Text = "Durchlauf " & nr & " wird gestartet. - "
Text = Text & Menge & " MB werden nach " & ZielVerz & " kopiert." & vbCRLF & vbCRLF
' Text = Text & "Bisher wurden insgesamt " & CLng(FormatNumber(fso.GetFolder( ZielVerz ).size/1024/1024, 0)) & "MB kopiert."
Text = Text & "Z.Z. sind auf " & fso.GetDriveName( ZielVerz ) & " " & LwFrei & " MB frei. "
if vbcancel = wshshell.Popup (Text , 10, WScript.ScriptName & " - " & CDate(Zeit), 64 + 1 ) then
i = i - 1
Zeit = Zeit + now()
Exit Do
End If
Zeit = Zeit + now()
Kopieren ' Function Kopieren Aufruf
Else
wshshell.Popup i & " Durchläufe absolviert. (" & LwFrei & " MB frei)" , 10, WScript.ScriptName , 64
exit do
End If
Loop
Zeit = CDate( now() - Zeit )
If CDate(Zeit ) < CDate( "00:00:01") then
wshshell.Popup "kleiner als 00:00:01 ist " & CDate(Zeit) , 10, WScript.ScriptName , 64
Zeit = CDate("00:00:01")
End If
Zeit = Second(Zeit) + 60* Minute(Zeit) + 60*60* Hour(Zeit)
TextX = CLng( FormatNumber( fso.GetFolder( ZielVerz ).size/1024/1024, 3))
Zeit = "In " & Zeit & " Sekunden wurden " & TextX & "MB kopiert - das sind ca. " & FormatNumber(TextX / Zeit, 2) & "MB/s. Es ist jetzt " & now()
LogDatei Zeit
Text = i & " mal " & Menge & " MB nach " & ZielVerz & "\xxx kopiert. (" & LwFrei & " MB frei)" & vbCRLF & vbCRLF
Text = Text & "Soll das Testverzeichnis " & ZielVerz & " mit "
Text = Text & TextX & " MB gelöscht werden?" & vbCRLF & vbCRLF
Text = Text & Zeit
If vbNo = wshshell.Popup (Text , 10, WScript.ScriptName, 32 + 4 ) then WScript.Quit
fso.DeleteFolder ZielVerz, True
if fso.FolderExists(ZielVerz) Then wshshell.Popup ZielVerz & " konnte nicht richtig gelöscht werden!" , 60, WScript.ScriptName , 32+16
if not fso.FolderExists(ZielVerz) Then wshshell.Popup ZielVerz & " wurde gelöscht!", 3, WScript.ScriptName
WScript.Quit
'*********************************
Function Kopieren ' Aufruf
'*********************************
Zeit2 = now()
if not fso.FolderExists(ZielVerz & "\" & Nr) Then fso.CreateFolder(ZielVerz & "\" & Nr)
' Text = "%comspec% /c xcopy /S/E " & Daten & "\*.* " & ZielVerz & "\" & Nr & "\*.*"
' WSHShell.run Text, 4, True
' WSHShell.run Text, 0, True
'************************************************************
' fso.CopyFolder Daten, ZielVerz & "\" & Nr, True
' MsgBox Daten & " - " & ZielVerz & "\" & Nr
ShellFolderCopy Daten, ZielVerz & "\" & Nr
If not Text = "" Then
MsgBox "Fehler/Abbruch beim Kopieren nach " & ZielVerz & "\" & Nr & " !" & vbCRLF & vbCRLF & Text & vbCRLF & vbCRLF & ". . . das ist das Ende!", , WScript.ScriptName
WScript.Quit
End If
Zeit2 = now() - Zeit2
If CDate(Zeit2 ) < CDate( "00:00:01") then Zeit2 = CDate("00:00:01")
Zeit2 = Second(Zeit2) + 60* Minute(Zeit2) + 60*60* Hour(Zeit2)
Text = FormatNumber(fso.GetFolder( ZielVerz & "\" & Nr ).size/1024/1024, 3)
Zeit2 = " " & i & vbTab & Zeit2 & "s " & vbTab & Text & "MB " & vbTab & FormatNumber(Text / Zeit2, 2) & "MB/s " & vbTab & vbTab & now()
LogDatei Zeit2
End Function ' Kopieren
'*********************************
Function ParamAbfrage ' Aufruf
'*********************************
Text = ""
Text = Text & MaxTst & " mal " & vbCRLF
Text = Text & vbTab & "werden die Daten von " & vbCRLF & Daten & vbCRLF
Text = Text & vbTab & "nach " & vbCRLF & ZielVerz & vbCRLF
Text = Text & vbTab & "kopiert - ist das korrekt?"
Text = wshshell.Popup (Text , 20, WScript.ScriptName, 32 + 4 )
If not Text = vbNo Then Exit Function
if not fso.FolderExists( Daten ) then Daten = ""
Daten = InputBox ("Aus welchem Verzeichnis sollen die Daten zum Kopieren verwendet werden?", WScript.ScriptName, Daten )
ZielVerz = InputBox ("In welches Verzeichnis sollen die Daten aus " & Daten & " kopiert werden?", WScript.ScriptName, ZielVerz )
MaxTst = InputBox ("Wie oft (max 999) soll der Kopiervorgang der Daten von " & Daten & " nach " & ZielVerz & " wiederholt werden?", WScript.ScriptName, MaxTst)
ParamAbfrage ' Function Aufruf
End Function ' ParamAbfrage
'*********************************
Sub LogDatei (LogTxt)
'*********************************
Dim FileOut, fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set FileOut = fso.OpenTextFile( WScript.ScriptName & "_" & Left(ZielVerz, 1) & "_ .log", 8, true)
' FileOut.WriteLine (vbCRLF & Now() )
FileOut.WriteLine (LogTxt)
Set FileOut = Nothing
End Sub ' LogDatei
'*********************************
Sub ShellFolderCopy (Quelle, Ziel) ' Aufruf
'*********************************
' für eine Fortschritsanzeige bei Kopiervorgängen muss: shell32.dll version 4.71 or later
' http://msdn.microsoft.com/library/en-us/shellcc/platform/Shell/reference/objects/folder/copyhere.asp
' Betriebssystem ermitteln ( WinNT/2k/XP oder Win9x/ME )
Text = "\system32"
If not "Windows_NT" = WScript.CreateObject("WScript.Shell").Environment("Process")("OS") then Text = "\system"
Text = WSHShell.ExpandEnvironmentStrings("%WinDir%") & Text & "\shell32.dll"
Text = fso.GetFileVersion( text ) ' Versionsinfo (der Shell32.dll) holen
' wshshell.Popup "Die Shell32.dll hat die Version " & Text , 3, WScript.ScriptName
Text = Left ( CDbl ( text ), 3 ) ' Versionsinfo formatieren
If Text < 471 then
On Error Resume Next
fso.CopyFolder Quelle, Ziel, True
if not err.Number = 0 Then Text = err.Number & ": " & err.Description
On Error GoTo 0
Else
if not fso.FolderExists( Ziel ) then fso.CreateFolder( Ziel )
Set ShellApp = CreateObject("Shell.Application")
Set oZielOrdner = ShellApp.NameSpace( Ziel )
On Error Resume Next
Text = ""
oZielOrdner.CopyHere Quelle , 16 'vOptions
if not err.Number = 0 Then Text = err.Number & ": " & err.Description
On Error GoTo 0
Set oZielOrdner = nothing
Set ShellApp = nothing
End If
End Sub ' ShellFolderCopy
http://dieseyer.de • all rights reserved • © 2011 v11.4