Код:
Option Explicit
Dim strSourceFile
Dim dtNow
Dim strDestFile
Dim objFSO
Dim strContent
strSourceFile = "E:\Песочница\0433\transfer.txt"
dtNow = Now()
strDestFile = _
Join( _
Array( _
"D:\logs", _
CStr(Year(dtNow)), _
ZeroPadRight(Month(dtNow), 2), _
ZeroPadRight(Day(dtNow), 2), _
Join( _
Array( _
ZeroPadRight(Hour(dtNow), 2), _
ZeroPadRight(Minute(dtNow), 2), _
ZeroPadRight(Second(dtNow), 2) _
), _
"_" _
) & ".txt" _
), _
"\" _
)
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strSourceFile) Then
With objFSO.OpenTextFile(strSourceFile)
strContent = StrConvert(.ReadAll(), "windows-1251", "utf-8")
.Close
End With
With WScript.CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Pattern = "<h1>Admin log</h1>([\s\S]*)<!--end Tourneys-->"
If .Test(strContent) Then
strContent = .Execute(strContent).Item(0).Submatches(0)
CreateFolderEx objFSO.GetParentFolderName(strDestFile)
With objFSO.CreateTextFile(strDestFile)
.Write strContent
.Close
End With
Else
WScript.Echo "Can't find pattern [" & .Pattern & "] in source file [" & strSourceFile & "]."
WScript.Quit 2
End If
End With
Else
WScript.Echo "Can't find source file [" & strSourceFile & "]."
WScript.Quit 1
End If
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
' 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
'=============================================================================
'=============================================================================
Sub CreateFolderEx(strPath)
With WScript.CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(strPath) Then
CreateFolderEx .GetParentFolderName(strPath)
.CreateFolder strPath
End If
End With
End Sub
'=============================================================================
'=============================================================================
Function ZeroPadRight(intValue, intLength)
ZeroPadRight = Right(String(intLength, "0") & CStr(intValue), intLength)
End Function
'=============================================================================
