快速业务通道

iPod文本分割器(VBS版)

作者 佚名 来源 ASP编程 浏览 发布时间 2013-07-09

因此暑假闲暇编写了这个简短精悍的脚本版的分割器。脚本版的最大的好处可以由使用者进行DIY。
具体情况就不多说了,关于txt编码的问题可以参考,iPod文本分割器
这里仅仅说明使用方法,将您需要分割的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

凌众科技专业提供服务器租用、服务器托管、企业邮局、虚拟主机等服务,公司网站:http://www.lingzhong.cn 为了给广大客户了解更多的技术信息,本技术文章收集来源于网络,凌众科技尊重文章作者的版权,如果有涉及你的版权有必要删除你的文章,请和我们联系。以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!

分享到: 更多

Copyright ©1999-2011 厦门凌众科技有限公司 厦门优通互联科技开发有限公司 All rights reserved

地址(ADD):厦门软件园二期望海路63号701E(东南融通旁) 邮编(ZIP):361008

电话:0592-5908028 传真:0592-5908039 咨询信箱:web@lingzhong.cn 咨询OICQ:173723134

《中华人民共和国增值电信业务经营许可证》闽B2-20100024  ICP备案:闽ICP备05037997号