批处理之家's Archiver

broly 发表于 2011-1-29 00:20

VBS版文本分割器

此作品暂时有几个缺点:
      1、分割出来的一些文本开头可能会有乱码。(网上查了下,是大多数分割软件的通病。)当然,原因我知道,正在改善中。。
      2、暂时支持GB2312。分割unicode编码文本会乱码。(我有另外一种方法不会出现这情况,但是个人感觉有点麻烦,先研究下这种方法可否改善)
      3、大文本没测试过,小文本测试了,速度还行。[code]'//VBS版文本分割器 v1.0 @CODE BY Broly
'//我的博客:http://blog.sina.com.cn/brolyblog
'//声明:此代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!

'//创建分割文本的类SplitText
Class SplitText
  Private mstrName,mstrPath,mary()
  
  Private mobjFSO,mobjStream,mobjFile
  
  Private mi
  
  Private Sub Class_Initialize
    Set mobjFSO = _
      WScript.CreateObject("Scripting.FileSystemObject")
    Set mobjStream = _
      WScript.CreateObject("Adodb.Stream")
  End Sub
  
  Public Property Let Name(strName)
    mstrName=strName
  End Property
  
  Public Property Let SavePath(strPath)
    mstrPath=strPath
  End Property
  
  '//函数SplitOfSize的作用为以文件大小分割,单位为KB
  Public Function SplitOfSize(strFilePath,sngSize)
    If sngSize<=0 Or IsEmpty(sngSize) Then sngSize=100
    Set mobjFile=mobjFSO.GetFile(strFilePath)
    If mobjFile.Size=0 Then Exit Function
    Call SplitFile(mobjFile,Int(mobjFile.Size/sngSize/1024),sngSize*1024)
    Set mobjFile=Nothing
  End Function
  
  '//函数SplitOfCount的作用为以文件数量分割
  Public Function SplitOfCount(strFilePath,intCount)
    If intCount<=0 Or IsEmpty(intCount) Then intCount=10
    Set mobjFile=mobjFSO.GetFile(strFilePath)
    If mobjFile.Size=0 Then Exit Function
    Call SplitFile(mobjFile,intCount-1,mobjFile.Size/intCount)
    Set mobjFile=Nothing
  End Function
  
  Private Sub SplitFile(objFile,intCount,sngSize)
    ReDim mary(intCount)
    With mobjStream
        .Type=1
        .Open
        .LoadFromFile objFile
    End With
    For mi=0 To intCount
      mary(mi)=mobjStream.Read(sngSize)
    Next
    mobjStream.Close
    If IsEmpty(mstrName) Then mstrName=mobjFSO.GetBaseName(objFile)
    If IsEmpty(mstrPath) Then
      mstrPath=mobjFSO.GetParentFolderName(objFile) & "\" & mstrName
      mobjFSO.CreateFolder(mstrPath)
      If Err.Number<>0 Then Err.Clear
    End If  
    For mi=0 To intCount
      With mobjstream
       .Type=1  : .Mode=3 : .Open()
       .Write mary(mi)
       .SaveToFile mstrPath & "\" & _
          mstrName & "_" & mi & ".txt",2
       .Close
      End With
    Next
  End Sub
  
  Private Sub Class_Terminate
    Set mobjFSO=Nothing
    Set mobjStream=Nothing
  End Sub
  
End Class

On Error Resume Next
Dim objSplit,objArgs,strChoice,ary,i
Set objArgs=WScript.Arguments
Set objSplit=New SplitText
'//////////////////////////////////////////////
'//
'//   以下代码是支持几种方式运行:
'//       (注意:如果不设置路径和名称,
'//               将默认创建在脚本当前目录
'//               名称为文本名称。)
'//
'//      1、直接双击运行。
'//
'//      2、将文本文件拖拽至此VBS脚本身上。
'//         此方法默认是分割为10份,保存至当前目录
'//         若要进行修改,可修改此VBS源码。
'//         P.S:支持多文件拖拽
'//
'//      3、命令行下运行,格式:
'//
'//  cscript.exe 文本分割器.vbs 文本路径1 [文本路径2] ......
'//
'//         此方法默认是分割为10份,保存至当前目录
'//         若要进行修改,可修改此VBS源码。
'//
'////////////////////////////////////////////

If objArgs.Count<1 Then
  strChoice=InputBox("请输入分割文本的方式和文本的绝对路径,用“|”隔开:" & _
     vbCrLf & vbCrLf & "1、按数量分割" & vbCrLf & "2、按大小分割(单位KB)" & _
     vbCrLf & vbCrLf & "格式如:1|3|文本路径c:\test.txt|要保存的目录(可选)  即按数量分割为3份" & vbCrLf , _
     "VBS版文本分割器v1.0 @CODE BY Broly")
  ary=Split(strChoice,"|",-1,1)
  '//此处可以设置生成文本的名称,在下一行添加一句:
  '//     objSplit.Name="替换为的你文本名称"
  ReDim Preserve ary(3)
  If Not IsEmpty(ary(3)) Then objSplit.SavePath=ary(3)
  Select Case ary(0)
    Case 1
      objSplit.SplitOfCount ary(2),ary(1)
    Case 2
      objSplit.SplitOfSize ary(2),ary(1)
    Case Else
      MsgBox "输入有误,请重新输入!",vbOKOnly+vbExclamation,"提示"
      WScript.Quit
  End Select
  CreateObject("WScript.Shell").PopUp "已完成所有操作!",2,"提示",64
Else  
  For i=0 To objArgs.Count-1
    '//要设置
    '//注意:要修改分割数量请将下行的10替换为你所想的数
    objSplit.SplitOfCount objArgs.Item(i),10
    '//如果要以固定文本大小分割,请将上句替换为:
    '//objSplit.SplitOfSize objArgs.Item(i),100
    '//同样,要修改分割大小请将上行的100替换为你所想的数(单位KB)
  Next
  WScript.Echo "已完成所有操作!"
End If
Set objSplit=Nothing
WScript.Quit[/code]

broly 发表于 2011-1-29 13:42

今天用家里的台式机测试了一下,10M的文本居然不用1秒。看来速度还行。
=_=

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.