'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