首页 > 编程 > VBScript > 正文

iPod文本分割器(VBS版)

2020-06-26 18:24:27
字体:
来源:转载
供稿:网友
前段时间,为了能在iPod Nano3上面看电子小说,偶写了个C++版本的文件分割器,但是由于时间关系,没有完成汉字编码的工作,造成很多初级用户不知道如何使用。
 

因此暑假闲暇编写了这个简短精悍的脚本版的分割器。脚本版的最大的好处可以由使用者进行DIY。 
具体情况就不多说了,关于txt编码的问题可以参考,
这里仅仅说明使用方法,将您需要分割的Txt文件直接拖放发到本脚本上就ok了。 
以下是脚本代码,直接复制后保存为vbs文件就可以了! 
Good Luck ! 

复制代码代码如下:

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

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表