Code:
Option Explicit
ReDim arrFromDrive(0),arrToDrive(0)
ReDim arrFromFolder(0),arrToFolder(0)
ReDim arrFromFile(0),arrToFile(0)
Dim objFSO,objWMIService,strLogFile,iDriveCount,regEx
'Load the file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Set computer name to local
'Load the WMI Service object
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
'Load the regexp object
Set regEx = New RegExp
'Read the ini file
If ReadINIFile Then
'Set the log file name
strLogFile=CreateObject("Scripting.FileSystemObject").GetParentFolderName(Wscript.ScriptFullName) +"\reorg.log"
'Start the logging
StartLog
'Loop through the drives
For iDriveCount=0 to UBound(arrFromDrive)-1
'Start the reorg for the drive
StartReorg iDriveCount
Next
End If
Function StartReorg(iDrive)
Dim iFolderCount
LogEntry Now & " Starting reorg for drive " & arrFromDrive(iDrive)
'loop through the folders
For iFolderCount=0 to UBound(arrFromFolder)-1
'Start the reorg for the drive
ProcessFolder arrFromDrive(iDrive) & "\" & arrFromFolder(iFolderCount),arrToDrive(iDrive) & "\" & arrToFolder(iFolderCount)
Next
End function
Function ProcessFolder(strFromFolder,strToFolder)
Dim colFileList,objFile,objFolder,SubFolder
LogEntry Now & " Processing folder " & strFromFolder
'Create the output directory
LogEntry Now & " Creating directory " & strToFolder
CreateFolder strToFolder
'Query all files with WMI
Set colFileList = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='" & strFromFolder & "'} Where " & "ResultClass = CIM_DataFile")
'Loop through the files found
For Each objFile In colFileList
ProcessFile objFile.Name, strToFolder
Next
LogEntry Now & " Finished Processing folder " & strFromFolder
'Process the subfolders
For Each Subfolder in objFSO.GetFolder(strFromFolder).SubFolders
ProcessFolder strFromFolder & "\" & Subfolder.name, strToFolder & "\" & Subfolder.name
Next
End Function
Function ProcessFile(strFile,strToFolder)
Dim strFileName,iCount,strNewFileName
Const OverwriteExisting = TRUE
LogEntry Now & " Processing file " & strFile
'Get the file name
For iCount=Len(strFile) to 1 step -1
'Check for backslash
If Mid(strFile,iCount,1)="\" Then
'Get the short file name
strFileName=Mid(strFile,iCount+1)
'And exit the loop
Exit For
End If
Next
'Set the new file name
strNewFileName=strFileName
'Check if file name is in the list
For iCount=0 to UBound(arrFromFile)-1
'Check if the file corresponds
If InStr(UCase(arrFromFile(iCount)),"REGEX(") Then
'Check if the file name matches the regular expression
If MatchRegEx(strFileName,arrFromFile(iCount)) Then
'We've got a match here
If InStr(UCase(arrToFile(iCount)),"REPLACE(") Then
'It is a replace regex
strNewFileName=ReplaceRegEx(strFileName,arrToFile(iCount))
LogEntry Now & " Changing filename from " & Chr(34) & strFile & Chr(34) & " to " & Chr(34) & strNewFileName & Chr(34)
Exit For
Else
'No replace needed just take the filename
strNewFileName=arrToFile(iCount)
'Exit the loop
Exit For
End If
End If
ElseIf UCase(arrFromFile(iCount))=UCase(strFileName) Then
'Ok so lets change the new file name
strNewFileName = arrToFile(iCount)
'Exit the loop
Exit For
End If
Next
LogEntry Now & " Copying File " & strFile & " to " & strToFolder & "\" & strNewFileName
'Copy the file and overwrite existing files
objFSO.CopyFile strFile , strToFolder & "\" & strNewFileName, OverwriteExisting
LogEntry Now & " Finished Processing file " & strFile
End Function
Function MatchRegEx(strInput,strInputPattern)
Dim strPattern
'Set the correct pattern
strPattern=Mid(strInputPattern,InStr(UCase(strInputPattern),"(")+2)
strPattern=Left(strPattern,InStr(strPattern,Chr(34))-1)
'Tell the regex engine to ignore case
regEx.IgnoreCase = True
'Set the pattern
regEx.Pattern = strPattern
'Check if the pattern matches the input
If regEx.Test(strInput) Then
'Yes, the pattern matches
MatchRegEx=True
Else
'Nope, no match
MatchRegEx=False
End If
End Function
Function ReplaceRegEx(strInput,strInputPattern)
Dim strPattern,strReplace,iStart
'Set the correct pattern
strPattern=Mid(strInputPattern,InStr(UCase(strInputPattern),"(")+2)
strPattern=Left(strPattern,InStr(strPattern,Chr(34))-1)
'Get the replace pattern
iStart=InStr(UCase(strInputPattern),"(")+1
strReplace=Mid(strInputPattern,InStr(iStart,UCase(strInputPattern),",")+2)
strReplace=Left(strReplace,InStr(strReplace,Chr(34))-1)
'Tell the regex engine to ignore case
regEx.IgnoreCase = True
'Set the pattern
regEx.Pattern = strPattern
ReplaceRegEx = regEx.Replace(strInput, strReplace)
End Function
Function ReadINIFile()
Dim strMyPath,strSection,strFileName,strLabel,strText
Dim objTextStream,arrLines,ArrayCount,Count
'Get the path and name of the ini file
strFileName=CreateObject("Scripting.FileSystemObject").GetParentFolderName(Wscript.ScriptFullName) +"\reorg.ini"
'Set flag for reading
Const FOR_READING = 1
'Check if ini file exists
If Not objFSO.FileExists(strFileName) Then
MsgBox "Ini file " & strFileName & " not found!",vbOKOnly,"Error"
ReadINIFile=False
Exit function
End If
'Open the ini file
Set objTextStream = objFSO.OpenTextFile(strFileName, FOR_READING)
'Check if it is empty
If objTextStream.AtEndOfStream Then
MsgBox "Ini file " & strFileName & " is empty!",vbOKOnly,"Error"
ReadINIFile=False
Exit function
End If
'Read file content into an array
arrLines = Split(objTextStream.ReadAll, vbCrLf)
'Close the file
objTextStream.Close
'Loop thru each line of the array
For Count=0 to ubound(arrLines)
'Check the content of the line
select case arrLines(Count)
case "[Drives]"
'We are processing the drives section
strSection="Drives"
case "[Folders]"
'We are processing the folders section
strSection="Folders"
case "[Files]"
'We are processing the files section
strSection="Files"
case else
'Read the entry
if instr(arrLines(Count),"=") then
'Get the label in from of the equal sign
strLabel=left(arrLines(Count),instr(arrLines(Count),"=")-1)
'Get the value after the equal sign
strText=mid(arrLines(Count),instr(arrLines(Count),"=")+1)
'Are we in the drives section?
if strSection="Drives" then
'Yes, Set the from drive
arrFromDrive(ubound(arrFromDrive))=strLabel
'Set the to drive
arrToDrive(ubound(arrToDrive))=strText
'Increase the size of the arrays
ReDim Preserve arrFromDrive(ubound(arrFromDrive)+1)
ReDim Preserve arrToDrive(ubound(arrToDrive)+1)
end if
'Are we in the folders section?
if strSection="Folders" then
'Yes, Set the from folder
arrFromFolder(ubound(arrFromFolder))=strLabel
'Set the to folder
arrToFolder(ubound(arrToFolder))=strText
'Increase the size of the arrays
ReDim Preserve arrFromFolder(ubound(arrFromFolder)+1)
ReDim Preserve arrToFolder(ubound(arrToFolder)+1)
end if
'Are we in the files section?
if strSection="Files" then
'Yes, Set the from file
arrFromFile(ubound(arrFromFile))=strLabel
'Set the to file
arrToFile(ubound(arrToFile))=strText
'Increase the size of the arrays
ReDim Preserve arrFromFile(ubound(arrFromFile)+1)
ReDim Preserve arrToFile(ubound(arrToFile)+1)
end if
end if
end select
Next
ReadINIFile=True
End Function
Function StartLog
Dim objFile,iCount
'Does the log file already exist?
If objFSO.FileExists(strLogFile) Then
'Yes, so we delete it
Set objFile = objFSO.CreateTextFile(strLogFile)
Set objFile=nothing
End If
'Write initial log entries
LogEntry Now & " Reorg starting..."
LogEntry "*****************************************************************"
LogEntry "* Parameters"
LogEntry "* ----------"
LogEntry "* Drives"
LogEntry "* "
For iCount=0 to UBound(arrFromDrive)-1
LogEntry "* From Drive: " & arrFromDrive(iCount) & " to Drive: " & arrToDrive(iCount)
Next
LogEntry "* "
LogEntry "* Folders"
LogEntry "* "
For iCount=0 to UBound(arrFromFolder)-1
LogEntry "* From Folder: " & arrFromFolder(iCount) & " to Folder: " & arrToFolder(iCount)
Next
LogEntry "* "
LogEntry "* Files"
LogEntry "* "
For iCount=0 to UBound(arrFromFile)-1
LogEntry "* From File: " & arrFromFile(iCount) & " to File: " & arrToFile(iCount)
Next
LogEntry "*****************************************************************"
LogEntry ""
End Function
Function LogEntry(strEntry)
Dim objTextFile,objFile
'Does the log file exist?
If objFSO.FileExists(strLogFile) Then
'Yes, no need for furher action
Set objFile=nothing
Else
'Nope, so we create the file
Set objFile = objFSO.CreateTextFile(strLogFile)
Set objFile=nothing
End If
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
'Open the log file
Set objTextFile = objFSO.OpenTextFile(strLogFile, ForAppending, True)
'Write the entry
objTextFile.WriteLine(strEntry)
'And close the file
objTextFile.Close
'Show on the screen as well
Wscript.echo strEntry
End Function
Function CreateFolder(Folder)
Dim strFolder,objFolder,iCount
'Loop thru the folder name
For iCount = 4 to Len(Folder)
'Check for a backslash
If Mid(Folder,iCount,1)="\" Then
'Set the folder to check for
strFolder=Left(Folder,iCount-1)
'Does the folder exist?
If objFSO.FolderExists(strFolder)=False Then
'No, so let's create it
Set objFolder = objFSO.CreateFolder(strFolder)
End If
End If
Next
'Does the folder exist?
If objFSO.FolderExists(Folder)=False Then
'No, so let's create it
Set objFolder = objFSO.CreateFolder(Folder)
End If
End Function
Leutz\Anfangsbuchstabe\Name\Name Dateiname•••••) Mit Wildcards konnte ich das nicht universell genug formulieren, also habe ich mich da bei Regexp bedient und jetzt bin ich soweit, dass er bei allen Kandidaten die Datei Name Datei falsch••••• in Name Datei richtig••••• umbenennen konnte.
Zitieren