'------------------------------------------------------------
' Description : Text division for iPod text reading.
' because of iPod can not display text length
' more than 4KB in each file, we have to split
' the bigger one.
' And iPod intrenal use Unicode, so this script
' can also tranfrom the character coding.
' Author : Guoyafeng@jspi.edu.cn
' Last Modified : 2008-8-31 11:05:13
'------------------------------------------------------------
Option Explicit
Sub OpenDir(Dir)
Dim WShell,CmdString
Set WShell = CreateObject("WScript.Shell")
CmdString = "Explorer.exe " Dir
WShell.Run CmdString,1,True
End Sub
Function FormatStrNum(iNum)
Const Mode = "0000"
Dim sNum
sNum = CStr(iNum)
FormatStrNum = Left(Mode,Len(Mode)-Len(sNum)) sNum
End Function
Function IIf(test,a,b)
If test = True Then IIf = a Else IIf = b
End Function
Function GetDragDropFile
If WScript.Arguments.Count = 0 Then MsgBox "请把需要分割的Txt文件拖放到本脚本上！"
WScript.Quit
Else
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(WScript.Arguments(0))) Then
GetDragDropFile = WScript.Arguments(0)
Set fso = Nothing
Else
Set fso = Nothing
MsgBox "无法找到文件" WScript.Arguments(0)
WScript.Quit
End If
End If
End Function
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Const TristateUseDefault=-2
Const TristateFalse=0
Dim ToWrite
Dim Index
Dim fso
Dim src
Dim dst
Dim TextSize
Dim MaxTextLength
Dim SourceFile
Dim DestinationFile
Dim BaseName
Dim OutFolderPath
Dim IsUnicode
Dim regEx,patrn
'***************************************************************
' Splited text size .
TextSize = 4 'KB
IsUnicode = True
'*****************************************************************
MaxTextLength = 1024 * TextSize / 2 - 1
patrn = "(\r\n\r\n)+|(　+)"
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True

Set fso = CreateObject("Scripting.FileSystemObject")
BaseName = fso.GetBaseName(GetDragDropFile)
OutFolderPath = fso.BuildPath(fso.GetParentFolderName(GetDragDropFile),_
BaseName)
Set src = fso.OpenTextFile(GetDragDropFile, ForReading,False,_
TristateUseDefault)
If Not fso.FolderExists(OutFolderPath) Then
fso.CreateFolder OutFolderPath
End If
Index = 1
While(src.AtEndOfStream > True)
ToWrite = src.Read(MaxTextLength)
DestinationFile = fso.BuildPath(OutFolderPath,BaseName _
FormatStrNum(Index) ".txt")
Set dst=fso.OpenTextFile(DestinationFile,ForWriting,True,IIf(IsUnicode,TristateTrue,TristateUseDefault))
Dim SlimText
SlimText = regEx.Replace(ToWrite,"")
dst.Write SlimText
dst.Close
Set dst = Nothing
Index = Index + 1
Wend
src.Close
Set src = Nothing
Set fso = Nothing
Set regEx = Nothing
OpenDir OutFolderPath