'------------------------------------------------------------ 
' 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