Option Explicit On Error Resume Next Dim ObjWsh : Set ObjWsh = CreateObject("WScript.Shell") Dim ObjFso : Set ObjFso = CreateObject("Scripting.FileSystemObject") Dim ObjImg : Set ObjImg = CreateObject("ImageMagickObject.MagickImage.1") Dim ObjArg : Set ObjArg = WScript.Arguments Dim X,StrArg,StrSource,StrExtension,StrSolution,StrQuality,SrcFolder,Dum,DumS Dim RecursiveFile,RecursiveFolder,ChkFile,ImgQuelle,ImgZiel,StrLogfile,CntFiles Dim SizeFolderStart CntFiles = 0 If ObjArg.Count = 0 Then WScript.Echo "Es wurden keine Parameter übergeben" WScript.Echo "Skript wird beendet" ShowHelp WScript.Quit(9) Else For Each StrArg In ObjArg If Left(LCase(StrArg),Len("-q:")) = "-q:" Then StrSource = Mid(LCase(StrArg),Len("-q:") + 1) End If If Left(LCase(StrArg),Len("-e:")) = "-e:" Then StrExtension = Mid(LCase(StrArg),Len("-e:") + 1) End If If Left(LCase(StrArg),Len("-s:")) = "-s:" Then StrSolution = Mid(LCase(StrArg),Len("-s:") + 1) End If If Left(LCase(StrArg),Len("-j:")) = "-j:" Then StrQuality = Mid(LCase(StrArg),Len("-j:") + 1) End If If Left(LCase(StrArg),Len("-l:")) = "-l:" Then StrLogfile = Mid(LCase(StrArg),Len("-l:") + 1) End If Next End If If IsEmpty(StrSource) Or IsEmpty(StrExtension) Or IsEmpty(StrSolution) Or IsEmpty(StrQuality) Then WScript.Echo "Fehlende Parameter !" ShowHelp WScript.Quit(8) Else SizeFolderStart = GetFolderSize(StrSource) ' Rekursive Datei Abfrage If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , "##########################################################################################" WriteLog StrLogfile , "------------------------------------------------------------------------------------------" WriteLog StrLogfile , "Konvertieren wurde gestartet um " & GetDate() & " - " & GetTime() WriteLog StrLogfile , "Größe von [ " & StrSource & " ] beim Start des Skriptes [ " & SizeFolderStart & " GB ]" WriteLog StrLogfile , "------------------------------------------------------------------------------------------" End If WScript.Echo "-< Starte Überprüfung >-" WScript.Echo "-<" WScript.Echo "-< Dies kann je nach Ordnergröße einige Zeit in Anspruch nehmen" RecuFiles StrSource End If If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , "------------------------------------------------------------------------------------------" WriteLog StrLogfile , "Konvertieren wurde beendet um " & GetDate() & " - " & GetTime() WriteLog StrLogfile , "Es wurden " & CntFiles & " Dateien konvertiert" WriteLog StrLogfile , "Größe beim Start des Skriptes : " & SizeFolderStart & " GB" WriteLog StrLogfile , "Größe nach dem konvertieren : " & GetFolderSize(StrSource) & " GB" WriteLog StrLogfile , "Der Quellordner wurde um " & SizeFolderStart - GetFolderSize(StrSource) & " GB reduziert" WriteLog StrLogfile , "------------------------------------------------------------------------------------------" End If WScript.Echo "-< Es wurden " & CntFiles & " Dateien konvertiert" WScript.Echo "-< " & SizeFolderStart - GetFolderSize(StrSource) & " GB gespart" WScript.Quit(0) ' --------- FUNCTION Function RecuFiles(StrDir) Set SrcFolder = ObjFso.GetFolder(strDir) For Each RecursiveFile In SrcFolder.Files FileCheck RecursiveFile Next For Each RecursiveFolder In SrcFolder.SubFolders RecuFiles RecursiveFolder For Each RecursiveFile In SrcFolder.Files FileCheck RecursiveFile Next Next End Function Function FileCheck(StrFile) Set ChkFile = ObjFso.GetFile(StrFile) If LCase(ObjFso.GetExtensionName(ChkFile.Name)) = StrExtension Then If ChkFile.Size > 180000 Then If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , GetTime() & "|KONV| Datei : " & ChkFile.Name & " -> " & Replace(ChkFile.Path,ChkFile.Name,Left(ChkFile.Name,Len(ChkFile.Name)-4)) & "_neu." & StrExtension End If ' ----- IMAGEMAGICK - convert ObjImg.Convert ChkFile.Path , _ "-resize" , StrSolution , _ "-format" , "jpg" , _ "-quality" , StrQuality , _ Replace(ChkFile.Path,ChkFile.Name,Left(ChkFile.Name,Len(ChkFile.Name)-4)) & "_neu." & StrExtension ' ----- IMAGEMAGICK - mogrify ' ObjImg.Mogrify ChkFile.Path , _ ' "-resize" , StrSolution , _ ' "-format" , "jpg" , _ ' "-quality" , StrQuality If Err.Number = 0 Then ImgQuelle = ChkFile.Path ImgZiel = Replace(ChkFile.Path,ChkFile.Name,Left(ChkFile.Name,Len(ChkFile.Name)-4)) & "_neu." & StrExtension CntFiles = CntFiles + 1 If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , GetTime() & "|DELE| Datei : " & ImgQuelle End If ObjFso.DeleteFile ImgQuelle,True If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , GetTime() & "|MOVE| Datei : " & ImgZiel & " -> " & ImgQuelle End If WriteLog StrLogfile , "------------" ObjFso.MoveFile ImgZiel , ImgQuelle Else If IsEmpty(StrLogfile) = False Then WriteLog StrLogfile , GetTime() & "|ERRO| Datei : " & ChkFile.Path & " Err.Number : " & Err.Number & " Err.Description : " & Err.Description End If End If End If End If End Function Function ShowHelp() WScript.Echo "" WScript.Echo "Hilfe zu diesem Skript" WScript.Echo "------------------------------------------------------------------------------------------" WScript.Echo "-q: = Quelle zum Startordner" WScript.Echo "-e: = Welche Datei Typen sollen konvertiert werden" WScript.Echo "-s: = Auflösung der Konvertierten Bilder" WScript.Echo "-j: = Qualität für die Output Bilder (JPG 1-100 , PNG 1-9)" WScript.Echo "-l: = Schreibt ein Logfile mit an den angegeben Ort" WScript.Echo " wenn kein Wert übergeben wird , wird kein Logfile erzeugt" WScript.Echo "" WScript.Echo "z.B. konvPic.exe -q:D:\ORDNER -e:jpg -s:800x600 -j:72 -l:D:\ORDNER\Logfile.txt" WScript.Echo "------------------------------------------------------------------------------------------" WScript.Echo "Idee & Code : Christopher Pope" WScript.Echo "------------------------------------------------------------------------------------------" WScript.Echo " Dieses Skript benutzt Imagemagick dieses kann hier heruntergeladen werden" WScript.Echo "" WScript.Echo " http://www.imagemagick.org" WScript.Echo "" WScript.Echo " Lizenz : http://www.imagemagick.org/script/license.php" WScript.Echo "" WScript.Echo " Bitte darauf achten das die VBS Unterstützung mit installiert wird !" WScript.Echo "------------------------------------------------------------------------------------------" End Function Function WriteLog(LOGFILE,Inh) ' WriteLog1([String]) ' ---- schreibt ein Logfile ' ---- benötigt die Variable LOGFILE Dim FileOut Set FileOut = ObjFso.OpenTextFile(LOGFILE,8,true) FileOut.WriteLine (Inh) FileOut.Close Set FileOut = Nothing End Function Function GetDate() GetDate = zStellig(Day(Now)) & "." & zStellig(Month(Now)) & "." & Year(Now) End Function Function GetTime() GetTime = zStellig(Hour(Now)) & ":" & zStellig(Minute(Now)) End Function Function zStellig(Wert) If Wert < 10 Then zStellig = "0" & Wert Else zStellig = Wert End IF End Function Function GetFolderSize(FLD) Set DUM = ObjFso.GetFolder(FLD & "\") DumS = DUM.Size ' --- Folder in GB DumS = DumS / 1024 ' - KB DumS = DumS / 1024 ' - MB DumS = DumS / 1024 ' - GB GetFolderSize = FormatNumber(DumS,2) End Function