Hixi, пробуйте:
Option Explicit
Dim strSourceFolder
Dim strDestFolder
Dim objFile
Dim strText
Dim strPhrase
Dim strDate
Dim strDestPath
If WScript.Arguments.Count >= 1 Then
strSourceFolder = WScript.CreateObject("WScript.Shell").CurrentDirectory
strDestFolder = "c:\"
With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strDestFolder) Then
WScript.Echo "Source folder: [" & strSourceFolder & "]"
WScript.Echo "Destination folder: [" & strDestFolder & "]"
WScript.Echo "--------------------------------------------"
strDate = GetLocalDate()
For Each objFile In .GetFolder(strSourceFolder).Files
If LCase(.GetExtensionName(objFile.Name)) = "txt" Then
WScript.Echo "File: " & objFile.Path
With objFile.OpenAsTextStream()
strText = StrConvert(.ReadAll(), "windows-1251", "cp866")
.Close
End With
For Each strPhrase In WScript.Arguments
If InStr(1, strText, strPhrase, vbTextCompare) > 0 Then
WScript.Echo Space(4) & "Phrase found: " & strPhrase
strDestPath = .BuildPath(.BuildPath(strDestFolder, strPhrase), strDate)
CreateFolderEx strDestPath
objFile.Move .BuildPath(strDestPath, "\")
WScript.Echo Space(4) & "Moved to folder [" & strDestPath & "]"
End If
Next
End If
Next
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]"
End If
End With
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Phrase 1> <Phrase 2> ... <Phrase N>"
End If
WScript.Quit 0
'=============================================================================
'=============================================================================
Function GetLocalDate()
Dim objSWbemObjectEx
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
For Each objSWbemObjectEx In .ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem")
GetLocalDate = Left(objSWbemObjectEx.LocalDateTime, 8)
Exit For
Next
End With
End Function
'=============================================================================
'=============================================================================
Sub CreateFolderEx(strPath)
With WScript.CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(strPath) Then
CreateFolderEx .GetParentFolderName(strPath)
.CreateFolder strPath
End If
End With
End Sub
'=============================================================================
'=============================================================================
' HKEY_CLASSES_ROOT\MIME\Database\Charset
' cp866, windows-1251, koi8-r, unicode, utf-8, _autodetect
'=============================================================================
Function StrConvert(ByVal strText, ByVal strSourceCharset, ByVal strDestCharset)
Const adTypeText = 2
Const adModeReadWrite = 3
With WScript.CreateObject("ADODB.Stream")
.Type = adTypeText
.Mode = adModeReadWrite
.Open
.Charset = strSourceCharset
.WriteText strText
.Position = 0
.Charset = strDestCharset
StrConvert = .ReadText
.Close
End With
End Function
'=============================================================================
Пример вызова скрипта:
cscript.exe //nologo "Script.vbs" "рабы не" Мама
Возможный результат:
Source folder: [E:\Песочница\0266]
Destination folder: [c:\]
--------------------------------------------
File: E:\Песочница\0266\0001.txt
Phrase found: Мама
Moved to folder [c:\Мама\20130531]
File: E:\Песочница\0266\0002.txt
Phrase found: рабы не
Moved to folder [c:\рабы не\20130531]
File: E:\Песочница\0266\0003.txt